Explorar el Código

* rest of the previous accidental partial commit

git-svn-id: branches/fixes_3_2@41250 -
Jonas Maebe hace 6 años
padre
commit
3ac703506c
Se han modificado 100 ficheros con 1972 adiciones y 1844 borrados
  1. 3 2
      .gitattributes
  2. 1 1
      compiler/arm/cgcpu.pas
  3. 1 1
      compiler/arm/narmadd.pas
  4. 2 2
      compiler/arm/symcpu.pas
  5. 1 1
      compiler/avr/cgcpu.pas
  6. 1 1
      compiler/blockutl.pas
  7. 10 1
      compiler/dbgdwarf.pas
  8. 2 0
      compiler/dbgstabs.pas
  9. 7 8
      compiler/defcmp.pas
  10. 7 4
      compiler/defutil.pas
  11. 3 2
      compiler/hlcg2ll.pas
  12. 3 4
      compiler/hlcgobj.pas
  13. 67 72
      compiler/htypechk.pas
  14. 3 15
      compiler/i386/n386flw.pas
  15. 2 2
      compiler/i386/symcpu.pas
  16. 6 6
      compiler/i8086/n8086add.pas
  17. 4 4
      compiler/i8086/symcpu.pas
  18. 3 3
      compiler/jvm/hlcgcpu.pas
  19. 141 2
      compiler/jvm/jvmdef.pas
  20. 1 1
      compiler/jvm/njvmcnv.pas
  21. 1 1
      compiler/jvm/njvminl.pas
  22. 9 2
      compiler/jvm/njvmutil.pas
  23. 5 136
      compiler/jvm/pjvm.pas
  24. 3 3
      compiler/jvm/symcpu.pas
  25. 8 1
      compiler/llvm/hlcgllvm.pas
  26. 2 1
      compiler/llvm/llvmdef.pas
  27. 1 1
      compiler/llvm/nllvmcnv.pas
  28. 1 1
      compiler/llvm/nllvmld.pas
  29. 1 1
      compiler/m68k/cgcpu.pas
  30. 2 2
      compiler/m68k/symcpu.pas
  31. 12 0
      compiler/msg/errore.msg
  32. 3 2
      compiler/msgidx.inc
  33. 379 370
      compiler/msgtxt.inc
  34. 38 38
      compiler/nadd.pas
  35. 4 2
      compiler/ncal.pas
  36. 1 1
      compiler/ncgcnv.pas
  37. 5 1
      compiler/ncgld.pas
  38. 0 18
      compiler/ncgmem.pas
  39. 6 11
      compiler/ncgnstld.pas
  40. 2 2
      compiler/ncgnstmm.pas
  41. 2 1
      compiler/ncgrtti.pas
  42. 6 12
      compiler/ncnv.pas
  43. 6 55
      compiler/nflw.pas
  44. 1 1
      compiler/ngenutil.pas
  45. 6 3
      compiler/ngtcon.pas
  46. 8 6
      compiler/ninl.pas
  47. 1 0
      compiler/nmat.pas
  48. 0 73
      compiler/nmem.pas
  49. 11 1
      compiler/nobj.pas
  50. 0 2
      compiler/node.pas
  51. 7 7
      compiler/nset.pas
  52. 10 0
      compiler/nutils.pas
  53. 1 1
      compiler/optconstprop.pas
  54. 16 2
      compiler/optcse.pas
  55. 0 1
      compiler/optutils.pas
  56. 0 1
      compiler/pass_2.pas
  57. 3 3
      compiler/pdecl.pas
  58. 5 5
      compiler/pdecobj.pas
  59. 5 666
      compiler/pdecsub.pas
  60. 10 10
      compiler/pdecvar.pas
  61. 46 7
      compiler/pexpr.pas
  62. 6 3
      compiler/pgenutil.pas
  63. 2 2
      compiler/pmodules.pas
  64. 2 2
      compiler/powerpc/symcpu.pas
  65. 690 5
      compiler/pparautl.pas
  66. 1 1
      compiler/ppcgen/cgppc.pas
  67. 2 2
      compiler/ppcgen/ngppcadd.pas
  68. 1 1
      compiler/ppu.pas
  69. 88 0
      compiler/procdefutil.pas
  70. 17 2
      compiler/procinfo.pas
  71. 0 2
      compiler/pstatmnt.pas
  72. 20 10
      compiler/psub.pas
  73. 10 7
      compiler/psystem.pas
  74. 4 4
      compiler/ptype.pas
  75. 1 1
      compiler/scanner.pas
  76. 1 1
      compiler/sparcgen/cgsparc.pas
  77. 1 1
      compiler/symconst.pas
  78. 22 84
      compiler/symcreat.pas
  79. 60 22
      compiler/symdef.pas
  80. 49 3
      compiler/symutil.pas
  81. 3 3
      compiler/systems/i_android.pas
  82. 3 3
      compiler/systems/i_aros.pas
  83. 12 12
      compiler/systems/i_bsd.pas
  84. 2 2
      compiler/systems/i_embed.pas
  85. 3 3
      compiler/systems/i_linux.pas
  86. 2 2
      compiler/systems/i_sunos.pas
  87. 6 0
      compiler/utils/ppuutils/ppudump.pp
  88. 1 1
      compiler/x86/cgx86.pas
  89. 1 1
      compiler/x86_64/cpupara.pas
  90. 3 17
      compiler/x86_64/nx64flw.pas
  91. 2 2
      compiler/x86_64/symcpu.pas
  92. 2 2
      packages/cocoaint/src/CocoaAll.pas
  93. 2 2
      packages/cocoaint/src/Foundation.pas
  94. 2 2
      packages/cocoaint/src/InlineFunctions.inc
  95. 10 10
      packages/cocoaint/src/appkit/NSATSTypesetter.inc
  96. 3 3
      packages/cocoaint/src/appkit/NSAccessibility.inc
  97. 9 9
      packages/cocoaint/src/appkit/NSAlert.inc
  98. 2 2
      packages/cocoaint/src/appkit/NSAnimation.inc
  99. 31 31
      packages/cocoaint/src/appkit/NSApplication.inc
  100. 1 1
      packages/cocoaint/src/appkit/NSApplicationScripting.inc

+ 3 - 2
.gitattributes

@@ -192,7 +192,7 @@ compiler/hlcg2ll.pas svneol=native#text/plain
 compiler/hlcgobj.pas svneol=native#text/plain
 compiler/html/i386/readme.txt svneol=native#text/plain
 compiler/html/powerpc/readme.txt svneol=native#text/plain
-compiler/htypechk.pas -text svneol=native#text/plain
+compiler/htypechk.pas svneol=native#text/plain
 compiler/i386/aoptcpu.pas svneol=native#text/plain
 compiler/i386/aoptcpub.pas svneol=native#text/plain
 compiler/i386/aoptcpud.pas svneol=native#text/plain
@@ -498,7 +498,7 @@ compiler/nobj.pas svneol=native#text/plain
 compiler/nobjc.pas svneol=native#text/plain
 compiler/node.pas svneol=native#text/plain
 compiler/nopt.pas svneol=native#text/plain
-compiler/nset.pas -text svneol=native#text/plain
+compiler/nset.pas svneol=native#text/plain
 compiler/nutils.pas svneol=native#text/plain
 compiler/objcasm.pas svneol=native#text/plain
 compiler/objcdef.pas svneol=native#text/plain
@@ -647,6 +647,7 @@ compiler/ppcx64.lpi svneol=native#text/plain
 compiler/ppcx64llvm.lpi svneol=native#text/plain
 compiler/ppheap.pas svneol=native#text/plain
 compiler/ppu.pas svneol=native#text/plain
+compiler/procdefutil.pas svneol=native#text/plain
 compiler/procinfo.pas svneol=native#text/plain
 compiler/pstatmnt.pas svneol=native#text/plain
 compiler/psub.pas svneol=native#text/plain

+ 1 - 1
compiler/arm/cgcpu.pas

@@ -2946,7 +2946,7 @@ unit cgcpu;
               if not((def.typ=pointerdef) or
                     ((def.typ=orddef) and
                      (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                               pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                                               pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
                  ai.SetCondition(C_VC)
               else
                 if TAiCpu(List.Last).opcode in [A_RSB,A_RSC,A_SBC,A_SUB] then

+ 1 - 1
compiler/arm/narmadd.pas

@@ -634,7 +634,7 @@ interface
                   end;
 
                   if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
-                    resultdef:=pasbool8type;
+                    resultdef:=pasbool1type;
                   result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
                       ctypeconvnode.create_internal(right,fdef),
                       ccallparanode.create(

+ 2 - 2
compiler/arm/symcpu.pas

@@ -101,7 +101,7 @@ type
     { library symbol for AROS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -208,7 +208,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

+ 1 - 1
compiler/avr/cgcpu.pas

@@ -2317,7 +2317,7 @@ unit cgcpu;
         if not ((def.typ=pointerdef) or
                ((def.typ=orddef) and
                 (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                          pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                                          pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
           cond:=C_VC
         else
           cond:=C_CC;

+ 1 - 1
compiler/blockutl.pas

@@ -207,7 +207,7 @@ implementation
           exit;
         end;
       { bare copy, so that self etc are not inserted }
-      result:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc));
+      result:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,''));
       { will be called accoding to the ABI conventions }
       result.proccalloption:=pocall_cdecl;
       { add po_is_block so that a block "self" pointer gets added (of the type

+ 10 - 1
compiler/dbgdwarf.pas

@@ -1596,7 +1596,7 @@ implementation
                 ]);
               finish_entry;
             end;
-          pasbool8 :
+          pasbool1 :
             begin
               append_entry(DW_TAG_base_type,false,[
                 DW_AT_name,DW_FORM_string,'Boolean'#0,
@@ -1605,6 +1605,15 @@ implementation
                 ]);
               finish_entry;
             end;
+          pasbool8 :
+            begin
+              append_entry(DW_TAG_base_type,false,[
+                DW_AT_name,DW_FORM_string,'Boolean8'#0,
+                DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean,
+                DW_AT_byte_size,DW_FORM_data1,1
+                ]);
+              finish_entry;
+            end;
           bool8bit :
             begin
               append_entry(DW_TAG_base_type,false,[

+ 2 - 0
compiler/dbgstabs.pas

@@ -696,6 +696,7 @@ implementation
             case def.ordtype of
               uvoid :
                 ss:=def_stab_number(def);
+              pasbool1,
               pasbool8,
               pasbool16,
               pasbool32,
@@ -724,6 +725,7 @@ implementation
                 ss:='-20;';
               uwidechar :
                 ss:='-30;';
+              pasbool1,
               pasbool8,
               bool8bit :
                 ss:='-21;';

+ 7 - 8
compiler/defcmp.pas

@@ -196,7 +196,7 @@ implementation
           (bvoid,
            bint,bint,bint,bint,bint,
            bint,bint,bint,bint,bint,
-           bbool,bbool,bbool,bbool,
+           bbool,bbool,bbool,bbool,bbool,
            bbool,bbool,bbool,bbool,
            bchar,bchar,bint);
 
@@ -415,7 +415,7 @@ implementation
                                 end;
                             end;
                           uvoid,
-                          pasbool8,pasbool16,pasbool32,pasbool64,
+                          pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
                           bool8bit,bool16bit,bool32bit,bool64bit:
                             eq:=te_equal;
                           else
@@ -491,9 +491,8 @@ implementation
                    end;
                  arraydef :
                    begin
-                     if (((m_mac in current_settings.modeswitches) and
-                          is_integer(def_to)) or
-                         is_widechar(def_to)) and
+                     if (m_mac in current_settings.modeswitches) and
+                        is_integer(def_to) and
                         (fromtreetype=stringconstn) then
                        begin
                          eq:=te_convert_l3;
@@ -1880,7 +1879,7 @@ implementation
                else
                 { Just about everything can be converted to a formaldef...}
                 if not (def_from.typ in [abstractdef,errordef]) then
-                  eq:=te_convert_l2;
+                  eq:=te_convert_l6;
              end;
         end;
 
@@ -1962,9 +1961,9 @@ implementation
                 u8bit,u16bit,u32bit,u64bit,
                 s8bit,s16bit,s32bit,s64bit :
                   is_subequal:=(torddef(def2).ordtype in [s64bit,u64bit,s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]);
-                pasbool8,pasbool16,pasbool32,pasbool64,
+                pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
                 bool8bit,bool16bit,bool32bit,bool64bit :
-                  is_subequal:=(torddef(def2).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]);
+                  is_subequal:=(torddef(def2).ordtype in [pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]);
                 uchar :
                   is_subequal:=(torddef(def2).ordtype=uchar);
                 uwidechar :

+ 7 - 4
compiler/defutil.pas

@@ -478,7 +478,7 @@ implementation
                is_ordinal:=dt in [uchar,uwidechar,
                                   u8bit,u16bit,u32bit,u64bit,
                                   s8bit,s16bit,s32bit,s64bit,
-                                  pasbool8,pasbool16,pasbool32,pasbool64,
+                                  pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
                                   bool8bit,bool16bit,bool32bit,bool64bit];
              end;
            enumdef :
@@ -558,14 +558,14 @@ implementation
     function is_boolean(def : tdef) : boolean;
       begin
         result:=(def.typ=orddef) and
-                    (torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]);
+                    (torddef(def).ordtype in [pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]);
       end;
 
 
     function is_pasbool(def : tdef) : boolean;
       begin
         result:=(def.typ=orddef) and
-                    (torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64]);
+                    (torddef(def).ordtype in [pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]);
       end;
 
     { true if def is a C-style boolean (non-zero value = true, zero = false) }
@@ -902,7 +902,7 @@ implementation
     { true, if def is a 8 bit ordinal type }
     function is_8bit(def : tdef) : boolean;
       begin
-         result:=(def.typ=orddef) and (torddef(def).ordtype in [u8bit,s8bit,pasbool8,bool8bit,uchar])
+         result:=(def.typ=orddef) and (torddef(def).ordtype in [u8bit,s8bit,pasbool1,pasbool8,bool8bit,uchar])
       end;
 
     { true, if def is a 16 bit int type }
@@ -1146,6 +1146,8 @@ implementation
                      range_to_type(torddef(def).low,torddef(def).high,result);
                  end
                else case torddef(def).ordtype of
+                 pasbool1:
+                   result:=pasbool1type;
                  pasbool8:
                    result:=pasbool8type;
                  pasbool16:
@@ -1601,6 +1603,7 @@ implementation
                 result:=tkQWord;
               s64bit:
                 result:=tkInt64;
+              pasbool1,
               pasbool8,
               pasbool16,
               pasbool32,

+ 3 - 2
compiler/hlcg2ll.pas

@@ -304,7 +304,7 @@ unit hlcg2ll;
 
           procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);override;
           procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);override;
-          procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override;
+          procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;var size:tdef;maybeconst:boolean);override;
 //          procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override;
 
           procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel); override;
@@ -1250,7 +1250,7 @@ implementation
       end;
     end;
 
-  procedure thlcg2ll.location_force_mmregscalar(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean);
+  procedure thlcg2ll.location_force_mmregscalar(list: TAsmList; var l: tlocation; var size: tdef; maybeconst: boolean);
     var
       reg : tregister;
       href : treference;
@@ -1297,6 +1297,7 @@ implementation
                reg:=getmmregister(list,newsize);
                a_loadmm_loc_reg(list,size,newsize,l,reg,mms_movescalar);
                l.size:=def_cgsize(newsize);
+               size:=newsize;
              end;
           location_freetemp(list,l);
           location_reset(l,LOC_MMREGISTER,l.size);

+ 3 - 4
compiler/hlcgobj.pas

@@ -570,7 +570,7 @@ unit hlcgobj;
           procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);virtual;
           procedure location_force_fpureg(list:TAsmList;var l: tlocation;size: tdef;maybeconst:boolean);virtual;
           procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);virtual;
-          procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;
+          procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;var size:tdef;maybeconst:boolean);virtual;
 //          procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;abstract;
 
           { Retrieve the location of the data pointed to in location l, when the location is
@@ -4089,7 +4089,7 @@ implementation
       end;
     end;
 
-  procedure thlcgobj.location_force_mmregscalar(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean);
+  procedure thlcgobj.location_force_mmregscalar(list: TAsmList; var l: tlocation; var size: tdef; maybeconst: boolean);
     var
       reg : tregister;
       href : treference;
@@ -4134,6 +4134,7 @@ implementation
           l.size:=def_cgsize(newsize);
           location_freetemp(list,l);
           location_reset(l,LOC_MMREGISTER,l.size);
+          size:=newsize;
           l.register:=reg;
         end;
     end;
@@ -4983,8 +4984,6 @@ implementation
                 end
               else
                 begin
-                  { pass proper alignment info }
-                  localcopyloc.reference.alignment:=tparavarsym(p).vardef.alignment;
                   g_concatcopy(list,tparavarsym(p).vardef,href,localcopyloc.reference);
                 end;
               { update localloc of varsym }

+ 67 - 72
compiler/htypechk.pas

@@ -152,22 +152,22 @@ interface
     function token2managementoperator(optoken:ttoken):tmanagementoperator;
 
     { check operator args and result type }
-
-    type
-      toverload_check_flag = (
-        ocf_check_non_overloadable, { also check operators that are (currently) considered as
-                                      not overloadable (e.g. the "+" operator for dynamic arrays
-                                      if modeswitch arrayoperators is active) }
-        ocf_check_only              { only check whether the operator is overloaded, but don't
-                                      modify the passed in node (return true if the operator is
-                                      overloaded, false otherwise) }
-      );
-      toverload_check_flags = set of toverload_check_flag;
-
+
+    type
+      toverload_check_flag = (
+        ocf_check_non_overloadable, { also check operators that are (currently) considered as
+                                      not overloadable (e.g. the "+" operator for dynamic arrays
+                                      if modeswitch arrayoperators is active) }
+        ocf_check_only              { only check whether the operator is overloaded, but don't
+                                      modify the passed in node (return true if the operator is
+                                      overloaded, false otherwise) }
+      );
+      toverload_check_flags = set of toverload_check_flag;
+
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
     function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
-    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
-    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
 
     { Register Allocation }
     procedure make_not_regable(p : tnode; how: tregableinfoflags);
@@ -515,9 +515,9 @@ implementation
                     end;
 
                  { <dyn. array> + <dyn. array> is handled by the compiler }
-                 if (m_array_operators in current_settings.modeswitches) and
-                     (treetyp=addn) and
-                     (is_dynamic_array(ld) or is_dynamic_array(rd)) then
+                 if (m_array_operators in current_settings.modeswitches) and
+                     (treetyp=addn) and
+                     (is_dynamic_array(ld) or is_dynamic_array(rd)) then
                     begin
                       allowed:=false;
                       exit;
@@ -720,7 +720,7 @@ implementation
       end;
 
 
-    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
       var
         ld      : tdef;
         optoken : ttoken;
@@ -742,11 +742,11 @@ implementation
         else
           inlinenumber:=in_none;
 
-        if not (ocf_check_non_overloadable in ocf) and not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
+        if not (ocf_check_non_overloadable in ocf) and not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
           exit;
 
         { operator overload is possible }
-        result:=not (ocf_check_only in ocf);
+        result:=not (ocf_check_only in ocf);
 
         optoken:=NOTOKEN;
         case t.nodetype of
@@ -766,11 +766,11 @@ implementation
         end;
         if (optoken=NOTOKEN) then
           begin
-            if not (ocf_check_only in ocf) then
-              begin
-                CGMessage(parser_e_operator_not_overloaded);
-                t:=cnothingnode.create;
-              end;
+            if not (ocf_check_only in ocf) then
+              begin
+                CGMessage(parser_e_operator_not_overloaded);
+                t:=cnothingnode.create;
+              end;
             exit;
           end;
 
@@ -790,11 +790,11 @@ implementation
           begin
             candidates.free;
             ppn.free;
-            if not (ocf_check_only in ocf) then
-              begin
-                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
-                t:=cnothingnode.create;
-              end;
+            if not (ocf_check_only in ocf) then
+              begin
+                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
+                t:=cnothingnode.create;
+              end;
             exit;
           end;
 
@@ -811,16 +811,16 @@ implementation
           begin
             candidates.free;
             ppn.free;
-            if not (ocf_check_only in ocf) then
-              begin
-                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
-                t:=cnothingnode.create;
-              end;
+            if not (ocf_check_only in ocf) then
+              begin
+                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
+                t:=cnothingnode.create;
+              end;
             exit;
           end;
 
         { Multiple candidates left? }
-        if (cand_cnt>1) and not (ocf_check_only in ocf) then
+        if (cand_cnt>1) and not (ocf_check_only in ocf) then
           begin
             CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
@@ -833,13 +833,13 @@ implementation
           end;
         candidates.free;
 
-        if ocf_check_only in ocf then
-          begin
-            ppn.free;
-            result:=true;
-            exit;
-          end;
-
+        if ocf_check_only in ocf then
+          begin
+            ppn.free;
+            result:=true;
+            exit;
+          end;
+
         addsymref(operpd.procsym);
 
         { the nil as symtable signs firstcalln that this is
@@ -852,7 +852,7 @@ implementation
       end;
 
 
-    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
       var
         rd,ld   : tdef;
         optoken : ttoken;
@@ -945,14 +945,14 @@ implementation
         { load easier access variables }
         ld:=tbinarynode(t).left.resultdef;
         rd:=tbinarynode(t).right.resultdef;
-        if not (ocf_check_non_overloadable in ocf) and
-            not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
+        if not (ocf_check_non_overloadable in ocf) and
+            not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
           exit;
 
         { operator overload is possible }
-        { if we only check for the existance of the overload, then we assume that
-          it is not overloaded }
-        result:=not (ocf_check_only in ocf);
+        { if we only check for the existance of the overload, then we assume that
+          it is not overloaded }
+        result:=not (ocf_check_only in ocf);
 
         case t.nodetype of
            equaln:
@@ -997,19 +997,19 @@ implementation
              optoken:=_OP_IN;
            else
              begin
-               if not (ocf_check_only in ocf) then
-                 begin
-                   CGMessage(parser_e_operator_not_overloaded);
-                   t:=cnothingnode.create;
-                 end;
+               if not (ocf_check_only in ocf) then
+                 begin
+                   CGMessage(parser_e_operator_not_overloaded);
+                   t:=cnothingnode.create;
+                 end;
                exit;
              end;
         end;
 
-        cand_cnt:=search_operator(optoken,(optoken<>_NE) and not (ocf_check_only in ocf));
+        cand_cnt:=search_operator(optoken,(optoken<>_NE) and not (ocf_check_only in ocf));
 
         { no operator found for "<>" then search for "=" operator }
-        if (cand_cnt=0) and (optoken=_NE) and not (ocf_check_only in ocf) then
+        if (cand_cnt=0) and (optoken=_NE) and not (ocf_check_only in ocf) then
           begin
             ppn.free;
             ppn:=nil;
@@ -1021,15 +1021,15 @@ implementation
         if (cand_cnt=0) then
           begin
             ppn.free;
-            if not (ocf_check_only in ocf) then
-              t:=cnothingnode.create;
-            exit;
-          end;
-
-        if ocf_check_only in ocf then
-          begin
-            ppn.free;
-            result:=true;
+            if not (ocf_check_only in ocf) then
+              t:=cnothingnode.create;
+            exit;
+          end;
+
+        if ocf_check_only in ocf then
+          begin
+            ppn.free;
+            result:=true;
             exit;
           end;
 
@@ -1964,7 +1964,7 @@ implementation
               { all types can be passed to a formaldef,
                 but it is not the prefered way }
               if not is_constnode(fromnode) then
-                eq:=te_convert_l2
+                eq:=te_convert_l6
               else
                 eq:=te_incompatible;
             end;
@@ -2037,11 +2037,6 @@ implementation
       begin
         { Note: eq must be already valid, it will only be updated! }
         case def_to.typ of
-          formaldef :
-            begin
-              { all types can be passed to a formaldef }
-              eq:=te_equal;
-            end;
           stringdef :
             begin
               { to support ansi/long/wide strings in a proper way }
@@ -3122,7 +3117,7 @@ implementation
         variantorddef_cl: array[tordtype] of tvariantequaltype =
           (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,tve_incompatible,
            tve_shortint,tve_smallint,tve_longint,tve_chari64,tve_incompatible,
-           tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
+           tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_chari64,tve_chari64,tve_dblcurrency);
 { TODO: fixme for 128 bit floats }

+ 3 - 15
compiler/i386/n386flw.pas

@@ -58,7 +58,7 @@ implementation
     symconst,symbase,symtable,symsym,symdef,
     cgbase,cgobj,cgcpu,cgutils,tgobj,
     cpubase,htypechk,
-    parabase,paramgr,pdecsub,pass_1,pass_2,ncgutil,cga,
+    parabase,paramgr,pass_1,pass_2,ncgutil,cga,
     aasmbase,aasmtai,aasmdata,aasmcpu,procinfo,cpupi;
 
   var
@@ -168,13 +168,7 @@ constructor ti386tryfinallynode.create(l, r: TNode);
       (df_generic in current_procinfo.procdef.defoptions)
       then
       exit;
-    finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
-    finalizepi.force_nested;
-    finalizepi.procdef:=create_finalizer_procdef;
-    finalizepi.entrypos:=r.fileinfo;
-    finalizepi.entryswitches:=r.localswitches;
-    finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
-    finalizepi.exitswitches:=current_settings.localswitches;
+    finalizepi:=tcgprocinfo(current_procinfo.create_for_outlining('$fin$',current_procinfo.procdef.struct,potype_exceptfilter,voidtype,r));
     { Regvar optimization for symbols is suppressed when using exceptions, but
       temps may be still placed into registers. This must be fixed. }
     foreachnodestatic(r,@reset_regvars,finalizepi);
@@ -196,13 +190,7 @@ constructor ti386tryfinallynode.create_implicit(l, r: TNode);
     if df_generic in current_procinfo.procdef.defoptions then
       InternalError(2013012501);
 
-    finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
-    finalizepi.force_nested;
-    finalizepi.procdef:=create_finalizer_procdef;
-    finalizepi.entrypos:=current_filepos;
-    finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
-    finalizepi.entryswitches:=r.localswitches;
-    finalizepi.exitswitches:=current_settings.localswitches;
+    finalizepi:=tcgprocinfo(current_procinfo.create_for_outlining('$fin$',current_procinfo.procdef.struct,potype_exceptfilter,voidtype,r));
     include(finalizepi.flags,pi_has_assembler_block);
     include(finalizepi.flags,pi_do_call);
     include(finalizepi.flags,pi_uses_exceptions);

+ 2 - 2
compiler/i386/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AROS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

+ 6 - 6
compiler/i8086/n8086add.pas

@@ -149,17 +149,17 @@ interface
                     internalerror(2014040606);
                 end;
               ltn:
-                t:=cordconstnode.create(ord(word(qword(lv))<word(qword(rv))),pasbool8type,true);
+                t:=cordconstnode.create(ord(word(qword(lv))<word(qword(rv))),pasbool1type,true);
               lten:
-                t:=cordconstnode.create(ord(word(qword(lv))<=word(qword(rv))),pasbool8type,true);
+                t:=cordconstnode.create(ord(word(qword(lv))<=word(qword(rv))),pasbool1type,true);
               gtn:
-                t:=cordconstnode.create(ord(word(qword(lv))>word(qword(rv))),pasbool8type,true);
+                t:=cordconstnode.create(ord(word(qword(lv))>word(qword(rv))),pasbool1type,true);
               gten:
-                t:=cordconstnode.create(ord(word(qword(lv))>=word(qword(rv))),pasbool8type,true);
+                t:=cordconstnode.create(ord(word(qword(lv))>=word(qword(rv))),pasbool1type,true);
               equaln:
-                t:=cordconstnode.create(ord(lv=rv),pasbool8type,true);
+                t:=cordconstnode.create(ord(lv=rv),pasbool1type,true);
               unequaln:
-                t:=cordconstnode.create(ord(lv<>rv),pasbool8type,true);
+                t:=cordconstnode.create(ord(lv<>rv),pasbool1type,true);
               else
                 internalerror(2014040605);
             end;

+ 4 - 4
compiler/i8086/symcpu.pas

@@ -110,7 +110,7 @@ type
 
   tcpuprocvardef = class(ti86procvardef)
     constructor create(level:byte);override;
-    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp):tstoreddef;override;
+    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;override;
     function address_type:tdef;override;
     function ofs_address_type:tdef;override;
     function size:asizeint;override;
@@ -133,7 +133,7 @@ type
     procedure Setinterfacedef(AValue: boolean);override;
    public
     constructor create(level:byte;doregister:boolean);override;
-    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp):tstoreddef;override;
+    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;override;
     function address_type:tdef;override;
     function ofs_address_type:tdef;override;
     function size:asizeint;override;
@@ -334,7 +334,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp):tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;
     begin
       result:=inherited;
       if is_far then
@@ -428,7 +428,7 @@ implementation
     end;
 
 
-  function tcpuprocvardef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp):tstoreddef;
+  function tcpuprocvardef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;
     begin
       result:=inherited;
       if is_far then

+ 3 - 3
compiler/jvm/hlcgcpu.pas

@@ -1241,7 +1241,7 @@ implementation
           if not ((size.typ=pointerdef) or
                  ((size.typ=orddef) and
                   (torddef(size).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                            pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                                             pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
             begin
               a_load_reg_stack(list,size,src1);
               if op in [OP_SUB,OP_IMUL] then
@@ -1346,7 +1346,7 @@ implementation
         orddef:
           begin
             case torddef(eledef).ordtype of
-              pasbool8,s8bit,u8bit,bool8bit,uchar,
+              pasbool1,pasbool8,s8bit,u8bit,bool8bit,uchar,
               s16bit,u16bit,bool16bit,pasbool16,
               uwidechar,
               s32bit,u32bit,bool32bit,pasbool32,
@@ -1371,7 +1371,7 @@ implementation
             else
               begin
                 { deepcopy=true }
-                a_load_const_stack(list,pasbool8type,1,R_INTREGISTER);
+                a_load_const_stack(list,pasbool1type,1,R_INTREGISTER);
                 { ndim }
                 a_load_const_stack(list,s32inttype,ndim,R_INTREGISTER);
                 { eletype }

+ 141 - 2
compiler/jvm/jvmdef.pas

@@ -30,7 +30,7 @@ interface
     uses
       globtype,
       node,
-      symbase,symtype;
+      symbase,symtype,symdef;
 
     { returns whether a def can make use of an extra type signature (for
       Java-style generics annotations; not use for FPC-style generics or their
@@ -90,6 +90,10 @@ interface
       array }
     procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
 
+    { the JVM specs require that you add a default parameterless
+      constructor in case the programmer hasn't specified any }
+    procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
+
 
 implementation
 
@@ -97,7 +101,8 @@ implementation
     cutils,cclasses,constexp,
     verbose,systems,
     fmodule,
-    symtable,symconst,symsym,symdef,symcpu,symcreat,
+    symtable,symconst,symsym,symcpu,symcreat,
+    pparautl,
     defutil,paramgr;
 
 {******************************************************************
@@ -539,6 +544,7 @@ implementation
           orddef:
             begin
               case torddef(def).ordtype of
+                pasbool1,
                 pasbool8:
                   begin
                     objdef:=tobjectdef(search_system_type('JLBOOLEAN').typedef);
@@ -622,6 +628,7 @@ implementation
           orddef:
             begin
               case torddef(def).ordtype of
+                pasbool1,
                 pasbool8:
                   result:='BOOLEANVALUE';
                 s8bit,
@@ -784,6 +791,7 @@ implementation
           orddef:
             begin
               case torddef(def).ordtype of
+                pasbool1,
                 pasbool8:
                   begin
                     result:=tobjectdef(search_system_type('FPCBOOLEANTHREADVAR').typedef);
@@ -1021,4 +1029,135 @@ implementation
       end;
 
 
+
+{******************************************************************
+                   Adding extra methods
+*******************************************************************}
+    procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
+      var
+        sym: tsym;
+        ps: tprocsym;
+        pd: tprocdef;
+        topowner: tdefentry;
+        i: longint;
+        sstate: tscannerstate;
+        needclassconstructor: boolean;
+      begin
+        ps:=nil;
+        { if there is at least one constructor for a class, do nothing (for
+           records, we'll always also need a parameterless constructor) }
+        if not is_javaclass(obj) or
+           not (oo_has_constructor in obj.objectoptions) then
+          begin
+            { check whether the parent has a parameterless constructor that we can
+              call (in case of a class; all records will derive from
+              java.lang.Object or a shim on top of that with a parameterless
+              constructor) }
+            if is_javaclass(obj) then
+              begin
+                pd:=nil;
+                { childof may not be assigned in case of a parser error }
+                if not assigned(tobjectdef(obj).childof) then
+                  exit;
+                sym:=tsym(tobjectdef(obj).childof.symtable.find('CREATE'));
+                if assigned(sym) and
+                   (sym.typ=procsym) then
+                  pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
+                if not assigned(pd) then
+                  begin
+                    Message(sym_e_no_matching_inherited_parameterless_constructor);
+                    exit
+                  end;
+              end;
+            { we call all constructors CREATE, because they don't have a name in
+              Java and otherwise we can't determine whether multiple overloads
+              are created with the same parameters }
+            sym:=tsym(obj.symtable.find('CREATE'));
+            if assigned(sym) then
+              begin
+                { does another, non-procsym, symbol already exist with that name? }
+                if (sym.typ<>procsym) then
+                  begin
+                    Message1(sym_e_duplicate_id_create_java_constructor,sym.realname);
+                    exit;
+                  end;
+                ps:=tprocsym(sym);
+                { is there already a parameterless function/procedure create? }
+                pd:=ps.find_bytype_parameterless(potype_function);
+                if not assigned(pd) then
+                  pd:=ps.find_bytype_parameterless(potype_procedure);
+                if assigned(pd) then
+                  begin
+                    Message1(sym_e_duplicate_id_create_java_constructor,pd.fullprocname(false));
+                    exit;
+                  end;
+              end;
+            if not assigned(sym) then
+              begin
+                ps:=cprocsym.create('Create');
+                obj.symtable.insert(ps);
+              end;
+            { determine symtable level }
+            topowner:=obj;
+            while not(topowner.owner.symtabletype in [staticsymtable,globalsymtable]) do
+              topowner:=topowner.owner.defowner;
+            { create procdef }
+            pd:=cprocdef.create(topowner.owner.symtablelevel+1,true);
+            if df_generic in obj.defoptions then
+              include(pd.defoptions,df_generic);
+            { method of this objectdef }
+            pd.struct:=obj;
+            { associated procsym }
+            pd.procsym:=ps;
+            { constructor }
+            pd.proctypeoption:=potype_constructor;
+            { needs to be exported }
+            include(pd.procoptions,po_global);
+            { by default do not include this routine when looking for overloads }
+            include(pd.procoptions,po_ignore_for_overload_resolution);
+            { generate anonymous inherited call in the implementation }
+            pd.synthetickind:=tsk_anon_inherited;
+            { public }
+            pd.visibility:=vis_public;
+            { result type }
+            pd.returndef:=obj;
+            { calling convention, self, ... (not for advanced records, for those
+              this is handled later) }
+            if obj.typ=recorddef then
+              handle_calling_convention(pd,[hcc_declaration,hcc_check])
+            else
+              handle_calling_convention(pd,hcc_default_actions_intf);
+            { register forward declaration with procsym }
+            proc_add_definition(pd);
+          end;
+
+        { also add class constructor if class fields that need wrapping, and
+          if none was defined }
+        if obj.find_procdef_bytype(potype_class_constructor)=nil then
+          begin
+            needclassconstructor:=false;
+            for i:=0 to obj.symtable.symlist.count-1 do
+              begin
+                if (tsym(obj.symtable.symlist[i]).typ=staticvarsym) and
+                   jvmimplicitpointertype(tstaticvarsym(obj.symtable.symlist[i]).vardef) then
+                  begin
+                    needclassconstructor:=true;
+                    break;
+                  end;
+              end;
+            if needclassconstructor then
+              begin
+                replace_scanner('custom_class_constructor',sstate);
+                if str_parse_method_dec('constructor fpc_jvm_class_constructor;',potype_class_constructor,true,obj,pd) then
+                  pd.synthetickind:=tsk_empty
+                else
+                  internalerror(2011040501);
+                restore_scanner(sstate);
+              end;
+          end;
+      end;
+
+
+
+
 end.

+ 1 - 1
compiler/jvm/njvmcnv.pas

@@ -1497,7 +1497,7 @@ implementation
         if node.nodetype=asn then
           node.resultdef:=realtodef
         else
-          node.resultdef:=pasbool8type;
+          node.resultdef:=pasbool1type;
     end;
 
 

+ 1 - 1
compiler/jvm/njvminl.pas

@@ -487,7 +487,7 @@ implementation
         { prepend new }
         newparas:=ccallparanode.create(newnode,newparas);
         { prepend deepcopy }
-        newparas:=ccallparanode.create(cordconstnode.create(0,pasbool8type,false),newparas);
+        newparas:=ccallparanode.create(cordconstnode.create(0,pasbool1type,false),newparas);
         { call the right setlenght helper }
         if ndims>1 then
           begin

+ 9 - 2
compiler/jvm/njvmutil.pas

@@ -28,7 +28,7 @@ interface
   uses
     cclasses,
     node,nbas,
-    ngenutil,
+    fmodule,ngenutil,
     symtype,symconst,symsym,symdef;
 
 
@@ -36,6 +36,7 @@ interface
     tjvmnodeutils = class(tnodeutils)
       class function initialize_data_node(p:tnode; force: boolean):tnode; override;
       class function finalize_data_node(p:tnode):tnode; override;
+      class procedure append_struct_initfinis(u: tmodule; initfini: tstructinifinipotype; var stat: tstatementnode); override;
       class function force_init: boolean; override;
       class procedure insertbssdata(sym: tstaticvarsym); override;
       class function create_main_procdef(const name: string; potype: tproctypeoption; ps: tprocsym): tdef; override;
@@ -63,7 +64,7 @@ interface
 implementation
 
     uses
-      verbose,cutils,globtype,globals,constexp,fmodule,compinnr,
+      verbose,cutils,globtype,globals,constexp,compinnr,
       aasmdata,aasmtai,cpubase,aasmbase,aasmcpu,
       symbase,symcpu,symtable,defutil,jvmdef,
       ncnv,ncon,ninl,ncal,nld,nmem,
@@ -172,6 +173,12 @@ implementation
     end;
 
 
+  class procedure tjvmnodeutils.append_struct_initfinis(u: tmodule; initfini: tstructinifinipotype; var stat: tstatementnode);
+    begin
+      { class constructors are implicitly called by the JVM runtime and cannot be called explicitly }
+    end;
+
+
   class function tjvmnodeutils.force_init: boolean;
     begin
       { we need an initialisation in case the al_globals list is not empty

+ 5 - 136
compiler/jvm/pjvm.pas

@@ -30,10 +30,6 @@ interface
       globtype,
       symconst,symtype,symbase,symdef,symsym;
 
-    { the JVM specs require that you add a default parameterless
-      constructor in case the programmer hasn't specified any }
-    procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
-
     { records are emulated via Java classes. They require a default constructor
       to initialise temps, a deep copy helper for assignments, and clone()
       to initialse dynamic arrays }
@@ -56,138 +52,11 @@ implementation
     verbose,globals,systems,
     fmodule,
     parabase,aasmdata,
-    pdecsub,ngenutil,pparautl,
+    ngenutil,pparautl,
     symtable,symcreat,defcmp,jvmdef,symcpu,nobj,
     defutil,paramgr;
 
 
-    { the JVM specs require that you add a default parameterless
-      constructor in case the programmer hasn't specified any }
-    procedure maybe_add_public_default_java_constructor(obj: tabstractrecorddef);
-      var
-        sym: tsym;
-        ps: tprocsym;
-        pd: tprocdef;
-        topowner: tdefentry;
-        i: longint;
-        sstate: tscannerstate;
-        needclassconstructor: boolean;
-      begin
-        ps:=nil;
-        { if there is at least one constructor for a class, do nothing (for
-           records, we'll always also need a parameterless constructor) }
-        if not is_javaclass(obj) or
-           not (oo_has_constructor in obj.objectoptions) then
-          begin
-            { check whether the parent has a parameterless constructor that we can
-              call (in case of a class; all records will derive from
-              java.lang.Object or a shim on top of that with a parameterless
-              constructor) }
-            if is_javaclass(obj) then
-              begin
-                pd:=nil;
-                { childof may not be assigned in case of a parser error }
-                if not assigned(tobjectdef(obj).childof) then
-                  exit;
-                sym:=tsym(tobjectdef(obj).childof.symtable.find('CREATE'));
-                if assigned(sym) and
-                   (sym.typ=procsym) then
-                  pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
-                if not assigned(pd) then
-                  begin
-                    Message(sym_e_no_matching_inherited_parameterless_constructor);
-                    exit
-                  end;
-              end;
-            { we call all constructors CREATE, because they don't have a name in
-              Java and otherwise we can't determine whether multiple overloads
-              are created with the same parameters }
-            sym:=tsym(obj.symtable.find('CREATE'));
-            if assigned(sym) then
-              begin
-                { does another, non-procsym, symbol already exist with that name? }
-                if (sym.typ<>procsym) then
-                  begin
-                    Message1(sym_e_duplicate_id_create_java_constructor,sym.realname);
-                    exit;
-                  end;
-                ps:=tprocsym(sym);
-                { is there already a parameterless function/procedure create? }
-                pd:=ps.find_bytype_parameterless(potype_function);
-                if not assigned(pd) then
-                  pd:=ps.find_bytype_parameterless(potype_procedure);
-                if assigned(pd) then
-                  begin
-                    Message1(sym_e_duplicate_id_create_java_constructor,pd.fullprocname(false));
-                    exit;
-                  end;
-              end;
-            if not assigned(sym) then
-              begin
-                ps:=cprocsym.create('Create');
-                obj.symtable.insert(ps);
-              end;
-            { determine symtable level }
-            topowner:=obj;
-            while not(topowner.owner.symtabletype in [staticsymtable,globalsymtable]) do
-              topowner:=topowner.owner.defowner;
-            { create procdef }
-            pd:=cprocdef.create(topowner.owner.symtablelevel+1,true);
-            if df_generic in obj.defoptions then
-              include(pd.defoptions,df_generic);
-            { method of this objectdef }
-            pd.struct:=obj;
-            { associated procsym }
-            pd.procsym:=ps;
-            { constructor }
-            pd.proctypeoption:=potype_constructor;
-            { needs to be exported }
-            include(pd.procoptions,po_global);
-            { by default do not include this routine when looking for overloads }
-            include(pd.procoptions,po_ignore_for_overload_resolution);
-            { generate anonymous inherited call in the implementation }
-            pd.synthetickind:=tsk_anon_inherited;
-            { public }
-            pd.visibility:=vis_public;
-            { result type }
-            pd.returndef:=obj;
-            { calling convention, self, ... (not for advanced records, for those
-              this is handled later) }
-            if obj.typ=recorddef then
-              handle_calling_convention(pd,[hcc_check])
-            else
-              handle_calling_convention(pd,hcc_all);
-            { register forward declaration with procsym }
-            proc_add_definition(pd);
-          end;
-
-        { also add class constructor if class fields that need wrapping, and
-          if none was defined }
-        if obj.find_procdef_bytype(potype_class_constructor)=nil then
-          begin
-            needclassconstructor:=false;
-            for i:=0 to obj.symtable.symlist.count-1 do
-              begin
-                if (tsym(obj.symtable.symlist[i]).typ=staticvarsym) and
-                   jvmimplicitpointertype(tstaticvarsym(obj.symtable.symlist[i]).vardef) then
-                  begin
-                    needclassconstructor:=true;
-                    break;
-                  end;
-              end;
-            if needclassconstructor then
-              begin
-                replace_scanner('custom_class_constructor',sstate);
-                if str_parse_method_dec('constructor fpc_jvm_class_constructor;',potype_class_constructor,true,obj,pd) then
-                  pd.synthetickind:=tsk_empty
-                else
-                  internalerror(2011040501);
-                restore_scanner(sstate);
-              end;
-          end;
-      end;
-
-
     procedure add_java_default_record_methods_intf(def: trecorddef);
       var
         sstate: tscannerstate;
@@ -505,7 +374,7 @@ implementation
 
         { add a method to call the procvar using unwrapped arguments, which
           then wraps them and calls through to JLRMethod.invoke }
-        methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc));
+        methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
         finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass);
         insert_self_and_vmt_para(methoddef);
         insert_funcret_para(methoddef);
@@ -540,7 +409,7 @@ implementation
             { add a method prototype matching the procvar (like the invoke
               in the procvarclass itself) }
             symtablestack.push(pvintf.symtable);
-            methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc));
+            methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
             finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf);
             insert_self_and_vmt_para(methoddef);
             insert_funcret_para(methoddef);
@@ -639,7 +508,7 @@ implementation
         wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
         wrapperpd.skpara:=pd;
         { also create procvar type that we can use in the implementation }
-        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal));
+        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal,''));
         wrapperpv.calcparas;
         { no use in creating a callback wrapper here, this procvar type isn't
           for public consumption }
@@ -667,7 +536,7 @@ implementation
         { wrapper is part of the same symtable as the original procdef }
         symtablestack.push(pd.owner);
         { get a copy of the constructor }
-        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc));
+        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc,''));
         { this one is a class method rather than a constructor }
         include(wrapperpd.procoptions,po_classmethod);
         wrapperpd.proctypeoption:=potype_function;

+ 3 - 3
compiler/jvm/symcpu.pas

@@ -221,7 +221,7 @@ implementation
   uses
     verbose,cutils,cclasses,globals,
     symconst,symbase,symtable,symcreat,jvmdef,
-    pdecsub,pjvm,
+    pdecsub,pparautl,pjvm,
     paramgr;
 
 
@@ -489,9 +489,9 @@ implementation
           begin
             { calling convention, self, ... }
             if obj.typ=recorddef then
-              handle_calling_convention(pd,[hcc_check])
+              handle_calling_convention(pd,[hcc_declaration,hcc_check])
             else
-              handle_calling_convention(pd,hcc_all);
+              handle_calling_convention(pd,hcc_default_actions_intf);
             { register forward declaration with procsym }
             proc_add_definition(pd);
           end;

+ 8 - 1
compiler/llvm/hlcgllvm.pas

@@ -47,6 +47,7 @@ uses
       procedure getcpuregister(list: TAsmList; r: Tregister); override;
       procedure ungetcpuregister(list: TAsmList; r: Tregister); override;
       procedure alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset); override;
+      procedure allocallcpuregisters(list: TAsmList); override;
       procedure deallocallcpuregisters(list: TAsmList); override;
 
       procedure a_bit_test_reg_reg_reg(list: TAsmList; bitnumbersize, valuesize, destsize: tdef; bitnumber, value, destreg: tregister); override;
@@ -333,6 +334,12 @@ implementation
     end;
 
 
+  procedure thlcgllvm.allocallcpuregisters(list: TAsmList);
+    begin
+      { don't do anything }
+    end;
+
+
   procedure thlcgllvm.deallocallcpuregisters(list: TAsmList);
     begin
       { don't do anything }
@@ -1037,7 +1044,7 @@ implementation
     begin
       { since all comparisons return their results in a register, we'll often
         get comparisons against true/false -> optimise }
-      if (size=pasbool8type) and
+      if (size=pasbool1type) and
          (cmp_op in [OC_EQ,OC_NE]) then
         begin
           { convert to an llvmbool1type and use directly }

+ 2 - 1
compiler/llvm/llvmdef.pas

@@ -347,7 +347,7 @@ implementation
                 encodedstr:=encodedstr+'void'
               { mainly required because comparison operations return i1, and
                 we need a way to represent the i1 type in Pascal. We don't
-                reuse pasbool8type, because putting an i1 in a record or
+                reuse pasbool1type, because putting an i1 in a record or
                 passing it as a parameter may result in unexpected behaviour }
               else if def=llvmbool1type then
                 encodedstr:=encodedstr+'i1'
@@ -824,6 +824,7 @@ implementation
                 case torddef(hdef).ordtype of
                   s8bit,
                   u8bit,
+                  pasbool1,
                   pasbool8:
                     typename:=typename+'i8';
                   s16bit,

+ 1 - 1
compiler/llvm/nllvmcnv.pas

@@ -180,7 +180,7 @@ procedure tllvmtypeconvnode.second_proc_to_procvar;
         if location.loc<>LOC_REFERENCE then
           internalerror(2015111902);
         hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,
-          cpointerdef.getreusable(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal)),
+          cpointerdef.getreusable(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal,'')),
           cpointerdef.getreusable(resultdef),
           location.reference);
       end;

+ 1 - 1
compiler/llvm/nllvmld.pas

@@ -90,7 +90,7 @@ procedure tllvmloadnode.pass_generate_code;
             (resultdef.typ in [symconst.procdef,procvardef]) and
              not tabstractprocdef(resultdef).is_addressonly then
             begin
-              pvdef:=tprocvardef(procdef.getcopyas(procvardef,pc_normal));
+              pvdef:=tprocvardef(procdef.getcopyas(procvardef,pc_normal,''));
               { on little endian, location.register contains proc and
                 location.registerhi contains self; on big endian, it's the
                 other way around }

+ 1 - 1
compiler/m68k/cgcpu.pas

@@ -1829,7 +1829,7 @@ unit cgcpu;
         if not ((def.typ=pointerdef) or
                ((def.typ=orddef) and
                 (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                          pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                                          pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
           cond:=C_VC
         else
           begin

+ 2 - 2
compiler/m68k/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AmigaOS/MorphOS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

+ 12 - 0
compiler/msg/errore.msg

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

+ 3 - 2
compiler/msgidx.inc

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

La diferencia del archivo ha sido suprimido porque es demasiado grande
+ 379 - 370
compiler/msgtxt.inc


+ 38 - 38
compiler/nadd.pas

@@ -548,17 +548,17 @@ implementation
                  else
                    t:=cordconstnode.create(lv and rv,resultdef,true);
                ltn :
-                 t:=cordconstnode.create(ord(lv<rv),pasbool8type,true);
+                 t:=cordconstnode.create(ord(lv<rv),pasbool1type,true);
                lten :
-                 t:=cordconstnode.create(ord(lv<=rv),pasbool8type,true);
+                 t:=cordconstnode.create(ord(lv<=rv),pasbool1type,true);
                gtn :
-                 t:=cordconstnode.create(ord(lv>rv),pasbool8type,true);
+                 t:=cordconstnode.create(ord(lv>rv),pasbool1type,true);
                gten :
-                 t:=cordconstnode.create(ord(lv>=rv),pasbool8type,true);
+                 t:=cordconstnode.create(ord(lv>=rv),pasbool1type,true);
                equaln :
-                 t:=cordconstnode.create(ord(lv=rv),pasbool8type,true);
+                 t:=cordconstnode.create(ord(lv=rv),pasbool1type,true);
                unequaln :
-                 t:=cordconstnode.create(ord(lv<>rv),pasbool8type,true);
+                 t:=cordconstnode.create(ord(lv<>rv),pasbool1type,true);
                slashn :
                  begin
                    { int/int becomes a real }
@@ -576,9 +576,9 @@ implementation
         else if cmp_of_disjunct_ranges(res) then
           begin
             if res then
-              t:=Cordconstnode.create(1,pasbool8type,true)
+              t:=Cordconstnode.create(1,pasbool1type,true)
             else
-              t:=Cordconstnode.create(0,pasbool8type,true);
+              t:=Cordconstnode.create(0,pasbool1type,true);
             { don't do this optimization, if the variable expression might
               have a side effect }
             if (is_constintnode(left) and might_have_sideeffects(right)) or
@@ -684,17 +684,17 @@ implementation
                 slashn :
                   t:=crealconstnode.create(lvd/rvd,resultrealdef);
                 ltn :
-                  t:=cordconstnode.create(ord(lvd<rvd),pasbool8type,true);
+                  t:=cordconstnode.create(ord(lvd<rvd),pasbool1type,true);
                 lten :
-                  t:=cordconstnode.create(ord(lvd<=rvd),pasbool8type,true);
+                  t:=cordconstnode.create(ord(lvd<=rvd),pasbool1type,true);
                 gtn :
-                  t:=cordconstnode.create(ord(lvd>rvd),pasbool8type,true);
+                  t:=cordconstnode.create(ord(lvd>rvd),pasbool1type,true);
                 gten :
-                  t:=cordconstnode.create(ord(lvd>=rvd),pasbool8type,true);
+                  t:=cordconstnode.create(ord(lvd>=rvd),pasbool1type,true);
                 equaln :
-                  t:=cordconstnode.create(ord(lvd=rvd),pasbool8type,true);
+                  t:=cordconstnode.create(ord(lvd=rvd),pasbool1type,true);
                 unequaln :
-                  t:=cordconstnode.create(ord(lvd<>rvd),pasbool8type,true);
+                  t:=cordconstnode.create(ord(lvd<>rvd),pasbool1type,true);
                 else
                   internalerror(2008022102);
              end;
@@ -771,17 +771,17 @@ implementation
                      t:=cstringconstnode.createunistr(ws1);
                   end;
                 ltn :
-                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),pasbool1type,true);
                 lten :
-                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),pasbool1type,true);
                 gtn :
-                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),pasbool1type,true);
                 gten :
-                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),pasbool1type,true);
                 equaln :
-                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),pasbool1type,true);
                 unequaln :
-                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),pasbool1type,true);
                 else
                   internalerror(2008022103);
              end;
@@ -849,17 +849,17 @@ implementation
                       tstringconstnode(t).changestringtype(getansistringdef)
                   end;
                 ltn :
-                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),pasbool1type,true);
                 lten :
-                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),pasbool1type,true);
                 gtn :
-                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),pasbool1type,true);
                 gten :
-                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),pasbool1type,true);
                 equaln :
-                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),pasbool1type,true);
                 unequaln :
-                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),pasbool8type,true);
+                  t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),pasbool1type,true);
                 else
                   internalerror(2008022104);
              end;
@@ -897,22 +897,22 @@ implementation
                unequaln :
                   begin
                     b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^;
-                    t:=cordconstnode.create(byte(b),pasbool8type,true);
+                    t:=cordconstnode.create(byte(b),pasbool1type,true);
                   end;
                equaln :
                   begin
                     b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^;
-                    t:=cordconstnode.create(byte(b),pasbool8type,true);
+                    t:=cordconstnode.create(byte(b),pasbool1type,true);
                   end;
                lten :
                   begin
                     b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^;
-                    t:=cordconstnode.create(byte(b),pasbool8type,true);
+                    t:=cordconstnode.create(byte(b),pasbool1type,true);
                   end;
                gten :
                   begin
                     b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^;
-                    t:=cordconstnode.create(byte(b),pasbool8type,true);
+                    t:=cordconstnode.create(byte(b),pasbool1type,true);
                   end;
                 else
                   internalerror(2008022105);
@@ -1512,12 +1512,12 @@ implementation
                 begin
                   if not is_boolean(ld) then
                     begin
-                      inserttypeconv(left,pasbool8type);
+                      inserttypeconv(left,pasbool1type);
                       ld := left.resultdef;
                     end;
                   if not is_boolean(rd) then
                     begin
-                      inserttypeconv(right,pasbool8type);
+                      inserttypeconv(right,pasbool1type);
                       rd := right.resultdef;
                     end;
                 end;
@@ -1554,8 +1554,8 @@ implementation
                       { convert both to pasbool to perform the comparison (so
                         that longbool(4) = longbool(2), since both represent
                         "true" }
-                      inserttypeconv(left,pasbool8type);
-                      inserttypeconv(right,pasbool8type);
+                      inserttypeconv(left,pasbool1type);
+                      inserttypeconv(right,pasbool1type);
                     end;
                   unequaln,
                   equaln:
@@ -1599,8 +1599,8 @@ implementation
                        end;
                       { Delphi-compatibility: convert both to pasbool to
                         perform the equality comparison }
-                      inserttypeconv(left,pasbool8type);
-                      inserttypeconv(right,pasbool8type);
+                      inserttypeconv(left,pasbool1type);
+                      inserttypeconv(right,pasbool1type);
                     end;
                   else
                     begin
@@ -2410,7 +2410,7 @@ implementation
           begin
              case nodetype of
                 ltn,lten,gtn,gten,equaln,unequaln :
-                  resultdef:=pasbool8type;
+                  resultdef:=pasbool1type;
                 slashn :
                   resultdef:=resultrealdef;
                 addn:
@@ -3399,7 +3399,7 @@ implementation
         if not(target_info.system in systems_wince) then
           begin
             if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
-              resultdef:=pasbool8type;
+              resultdef:=pasbool1type;
             result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
                 ctypeconvnode.create_internal(right,fdef),
                 ccallparanode.create(

+ 4 - 2
compiler/ncal.pas

@@ -3197,12 +3197,12 @@ implementation
                 else
                  if vo_is_range_check in para.parasym.varoptions then
                    begin
-                     para.left:=cordconstnode.create(Ord(cs_check_range in current_settings.localswitches),pasbool8type,false);
+                     para.left:=cordconstnode.create(Ord(cs_check_range in current_settings.localswitches),pasbool1type,false);
                    end
                 else
                  if vo_is_overflow_check in para.parasym.varoptions then
                    begin
-                     para.left:=cordconstnode.create(Ord(cs_check_overflow in current_settings.localswitches),pasbool8type,false);
+                     para.left:=cordconstnode.create(Ord(cs_check_overflow in current_settings.localswitches),pasbool1type,false);
                    end
                 else
                   if vo_is_msgsel in para.parasym.varoptions then
@@ -4605,6 +4605,8 @@ implementation
         { this is just to play it safe, there are more safe situations }
         if (n.nodetype = derefn) or
            ((n.nodetype = loadn) and
+            { can be nil in case of internally generated labels like $raiseaddr }
+            assigned(tloadnode(n).symtable) and
             { globals and fields of (possibly global) objects could always be changed in the callee }
             ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or
             { statics can only be modified by functions in the same unit }

+ 1 - 1
compiler/ncgcnv.pas

@@ -574,7 +574,7 @@ interface
                     begin
                       location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
                       { code field is the first one }
-                      hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(tprocvardef(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal))),cpointerdef.getreusable(resultdef),left.location.reference);
+                      hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(tprocvardef(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal,''))),cpointerdef.getreusable(resultdef),left.location.reference);
                       hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,left.location.reference,location.register);
                     end;
                   LOC_REGISTER,LOC_CREGISTER:

+ 5 - 1
compiler/ncgld.pas

@@ -420,6 +420,7 @@ implementation
         href : treference;
         newsize : tcgsize;
         vd : tdef;
+        alignment: longint;
         indirect : boolean;
         name : TSymStr;
       begin
@@ -529,7 +530,10 @@ implementation
                     { assume packed records may always be unaligned }
                     if not(resultdef.typ in [recorddef,objectdef]) or
                        (tabstractrecordsymtable(tabstractrecorddef(resultdef).symtable).usefieldalignment<>1) then
-                      location_reset_ref(location,LOC_REFERENCE,newsize,resultdef.alignment,[])
+                      begin
+                        alignment:=min(min(min(resultdef.alignment,current_settings.alignment.localalignmax),current_settings.alignment.constalignmax),current_settings.alignment.varalignmax);
+                        location_reset_ref(location,LOC_REFERENCE,newsize,alignment,[]);
+                      end
                     else
                       location_reset_ref(location,LOC_REFERENCE,newsize,1,[]);
                     hlcg.reference_reset_base(location.reference,voidpointertype,hregister,0,ctempposinvalid,location.reference.alignment,[]);

+ 0 - 18
compiler/ncgmem.pas

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

+ 6 - 11
compiler/ncgnstld.pas

@@ -59,7 +59,7 @@ implementation
       defutil,defcmp,
       htypechk,pass_1,procinfo,paramgr,
       cpuinfo,
-      symconst,symbase,symsym,symdef,symtable,symcreat,
+      symconst,symbase,symsym,symdef,symtable,pparautl,symcreat,
       ncon,ninl,ncnv,nmem,ncal,nutils,nbas,
       pass_2,cgbase
       ;
@@ -106,8 +106,8 @@ implementation
                      the parentfpstruct inside the routine in which they were
                      originally declared, except in the initialisation code for
                      the parentfpstruct (nf_internal flag) }
-                  (tabstractnormalvarsym(symtableentry).inparentfpstruct and
-                   not(nf_internal in flags))) then
+                  tabstractnormalvarsym(symtableentry).inparentfpstruct) and
+                   not(nf_internal in flags) then
                 begin
                   { get struct holding all locals accessed by nested routines }
                   nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
@@ -142,7 +142,6 @@ implementation
       var
         thissym,
         nestedvars: tsym;
-        nestedvarsdef: tdef;
       begin
         result:=inherited;
         if assigned(result) then
@@ -153,11 +152,8 @@ implementation
             begin
               { Nested variable? Then we have to move it to a structure that
                 can be passed by reference to nested routines }
-              if assigned(current_procinfo) and
-                 (symtable.symtabletype in [localsymtable,parasymtable]) and
-                 ((symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) or
-                  (tabstractnormalvarsym(symtableentry).inparentfpstruct and
-                   not(nf_internal in flags))) then
+              if assigned(left) and
+                 not(nf_internal in flags) then
                 begin
                   { get struct holding all locals accessed by nested routines }
                   nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
@@ -167,7 +163,6 @@ implementation
                       build_parentfpstruct(tprocdef(symtable.defowner));
                       nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
                     end;
-                  nestedvarsdef:=tlocalvarsym(nestedvars).vardef;
                   if nestedvars<>symtableentry then
                     thissym:=nestsym
                   else
@@ -185,7 +180,7 @@ implementation
                   left:=csubscriptnode.create(thissym,cderefnode.create(left));
                   firstpass(left);
                   include(flags,nf_internal);
-                 end;
+                end;
             end;
         end;
       end;

+ 2 - 2
compiler/ncgnstmm.pas

@@ -40,9 +40,9 @@ implementation
     uses
       systems,
       cutils,cclasses,verbose,globals,constexp,
-      symconst,symdef,symsym,symtable,symcreat,defutil,paramgr,
+      symconst,symdef,symsym,symtable,defutil,procdefutil,pparautl,symcreat,
       aasmbase,aasmtai,aasmdata,
-      procinfo,pass_2,parabase,
+      procinfo,pass_2,parabase,paramgr,
       pass_1,ncnv,nmem,nld,ncon,nadd,nutils,
       cgutils,cgobj,hlcgobj,
       tgobj,ncgutil,objcgutl

+ 2 - 1
compiler/ncgrtti.pas

@@ -1001,7 +1001,7 @@ implementation
                 (otUByte{otNone},
                  otUByte,otUWord,otULong,otUQWord,otUByte{otNone},
                  otSByte,otSWord,otSLong,otSQWord,otUByte{otNone},
-                 otUByte,otUWord,otULong,otUQWord,
+                 otUByte,otUByte,otUWord,otULong,otUQWord,
                  otSByte,otSWord,otSLong,otSQWord,
                  otUByte,otUWord,otUByte);
             var
@@ -1059,6 +1059,7 @@ implementation
                 dointeger(tkInt64);
             u64bit :
                 dointeger(tkQWord);
+            pasbool1,
             pasbool8,
             pasbool16,
             pasbool32,

+ 6 - 12
compiler/ncnv.pas

@@ -1098,7 +1098,7 @@ implementation
             addstatement(newstat,restemp);
             addstatement(newstat,ccallnode.createintern('fpc_'+chartype+'array_to_shortstr',
               ccallparanode.create(cordconstnode.create(
-                ord(tarraydef(left.resultdef).lowrange=0),pasbool8type,false),
+                ord(tarraydef(left.resultdef).lowrange=0),pasbool1type,false),
               ccallparanode.create(left,ccallparanode.create(
               ctemprefnode.create(restemp),nil)))));
             addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
@@ -1112,7 +1112,7 @@ implementation
                       ccallparanode.create(
                         cordconstnode.create(
                           ord(tarraydef(left.resultdef).lowrange=0),
-                          pasbool8type,
+                          pasbool1type,
                           false
                         ),
                         ccallparanode.create(
@@ -1131,7 +1131,7 @@ implementation
           result:=ccallnode.createinternres(
             'fpc_'+chartype+'array_to_'+tstringdef(resultdef).stringtypname,
             ccallparanode.create(cordconstnode.create(
-               ord(tarraydef(left.resultdef).lowrange=0),pasbool8type,false),
+               ord(tarraydef(left.resultdef).lowrange=0),pasbool1type,false),
              ccallparanode.create(left,nil)),resultdef);
         left:=nil;
       end;
@@ -1636,12 +1636,6 @@ implementation
              fcc:=(pb[0] shl 24) or (pb[1] shl 16) or (pb[2] shl 8) or pb[3];
              result:=cordconstnode.create(fcc,u32inttype,false);
            end
-         else if is_widechar(resultdef) and
-            (tstringconstnode(left).cst_type=cst_unicodestring) and
-            (pcompilerwidestring(tstringconstnode(left).value_str)^.len=1) then
-           begin
-             result:=cordconstnode.create(pcompilerwidestring(tstringconstnode(left).value_str)^.data[0], resultdef, false);
-           end
          else
            CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
       end;
@@ -2275,7 +2269,7 @@ implementation
              copytype:=pc_address_only
            else
              copytype:=pc_normal;
-           resultdef:=pd.getcopyas(procvardef,copytype);
+           resultdef:=pd.getcopyas(procvardef,copytype,'');
          end;
       end;
 
@@ -4240,7 +4234,7 @@ implementation
               CGMessage1(type_e_class_or_cominterface_type_expected,left.resultdef.typename);
             case nodetype of
               isn:
-                resultdef:=pasbool8type;
+                resultdef:=pasbool1type;
               asn:
                 resultdef:=tclassrefdef(right.resultdef).pointeddef;
             end;
@@ -4251,7 +4245,7 @@ implementation
           begin
            case nodetype of
              isn:
-               resultdef:=pasbool8type;
+               resultdef:=pasbool1type;
              asn:
                resultdef:=right.resultdef;
            end;

+ 6 - 55
compiler/nflw.pas

@@ -29,7 +29,7 @@ interface
     uses
       cclasses,
       node,cpubase,
-      symtype,symbase,symdef,symsym,
+      symconst,symtype,symbase,symdef,symsym,
       optloop;
 
     type
@@ -197,7 +197,6 @@ interface
           function pass_1 : tnode;override;
           function simplify(forinline:boolean): tnode;override;
        protected
-          function create_finalizer_procdef: tprocdef;
           procedure adjust_estimated_stack_size; virtual;
        end;
        ttryfinallynodeclass = class of ttryfinallynode;
@@ -243,9 +242,8 @@ implementation
     uses
       globtype,systems,constexp,compinnr,
       cutils,verbose,globals,
-      symconst,symtable,paramgr,defcmp,defutil,htypechk,pass_1,
+      symtable,paramgr,defcmp,defutil,htypechk,pass_1,
       ncal,nadd,ncon,nmem,nld,ncnv,nbas,nutils,ninl,nset,ngenutil,
-      pdecsub,
     {$ifdef state_tracking}
       nstate,
     {$endif}
@@ -472,7 +470,7 @@ implementation
           one }
         hp:=cwhilerepeatnode.create(
           { repeat .. until false }
-          cordconstnode.create(0,pasbool8type,false),innerloop,false,true);
+          cordconstnode.create(0,pasbool1type,false),innerloop,false,true);
         addstatement(outerloopbodystatement,hp);
 
         { create the outer repeat/until and add it to the the main body }
@@ -1105,7 +1103,7 @@ implementation
 
          if not(is_boolean(left.resultdef)) and
            not(is_typeparam(left.resultdef)) then
-             inserttypeconv(left,pasbool8type);
+             inserttypeconv(left,pasbool1type);
 
          { Give warnings for code that will never be executed for
            while false do }
@@ -1339,7 +1337,7 @@ implementation
             end;
         if not is_constboolnode(condition) then
             aktstate.store_fact(condition,
-             cordconstnode.create(byte(checknegate),pasbool8type,true))
+             cordconstnode.create(byte(checknegate),pasbool1type,true))
         else
             condition.destroy;
     end;
@@ -1420,7 +1418,7 @@ implementation
 
          if not(is_boolean(left.resultdef)) and
            not(is_typeparam(left.resultdef)) then
-             inserttypeconv(left,pasbool8type);
+             inserttypeconv(left,pasbool1type);
 
          result:=internalsimplify(not(nf_internal in flags));
       end;
@@ -2360,53 +2358,6 @@ implementation
      end;
 
 
-    var
-      seq: longint=0;
-
-    function ttryfinallynode.create_finalizer_procdef: tprocdef;
-      var
-        st:TSymTable;
-        checkstack: psymtablestackitem;
-        oldsymtablestack: tsymtablestack;
-        sym:tprocsym;
-      begin
-        { get actual procedure symtable (skip withsymtables, etc.) }
-        st:=nil;
-        checkstack:=symtablestack.stack;
-        while assigned(checkstack) do
-          begin
-            st:=checkstack^.symtable;
-            if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
-              break;
-            checkstack:=checkstack^.next;
-          end;
-        { Create a nested procedure, even from main_program_level.
-          Furthermore, force procdef and procsym into the same symtable
-          (by default, defs are registered with symtablestack.top which may be
-          something temporary like exceptsymtable - in that case, procdef can be
-          destroyed before procsym, leaving invalid pointers). }
-        oldsymtablestack:=symtablestack;
-        symtablestack:=nil;
-        result:=cprocdef.create(max(normal_function_level,st.symtablelevel)+1,true);
-        symtablestack:=oldsymtablestack;
-        st.insertdef(result);
-        result.struct:=current_procinfo.procdef.struct;
-        { tabstractprocdef constructor sets po_delphi_nested_cc whenever
-          nested procvars modeswitch is active. We must be independent of this switch. }
-        exclude(result.procoptions,po_delphi_nested_cc);
-        result.proctypeoption:=potype_exceptfilter;
-        handle_calling_convention(result);
-        sym:=cprocsym.create('$fin$'+tostr(seq));
-        st.insert(sym);
-        inc(seq);
-
-        result.procsym:=sym;
-        proc_add_definition(result);
-        result.forwarddef:=false;
-        result.aliasnames.insert(result.mangledname);
-      end;
-
-
     procedure ttryfinallynode.adjust_estimated_stack_size;
       begin
         inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size);

+ 1 - 1
compiler/ngenutil.pas

@@ -57,7 +57,7 @@ interface
         all local (static) typed consts }
       class procedure static_syms_finalize(p: TObject; arg: pointer);
       class procedure sym_maybe_finalize(var stat: tstatementnode; sym: tsym);
-      class procedure append_struct_initfinis(u: tmodule; initfini: tstructinifinipotype; var stat: tstatementnode);
+      class procedure append_struct_initfinis(u: tmodule; initfini: tstructinifinipotype; var stat: tstatementnode); virtual;
      public
       class procedure procdef_block_add_implicit_initialize_nodes(pd: tprocdef; var stat: tstatementnode);
       class procedure procdef_block_add_implicit_finalize_nodes(pd: tprocdef; var stat: tstatementnode);

+ 6 - 3
compiler/ngtcon.pas

@@ -613,6 +613,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
 
       begin
         case def.ordtype of
+           pasbool1,
            pasbool8,
            bool8bit,
            pasbool16,
@@ -915,9 +916,11 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                        case hp.nodetype of
                          vecn :
                            begin
-                             if is_constintnode(tvecnode(hp).right) and
-                                not is_ansistring(tvecnode(hp).left.resultdef) and
-                                not is_wide_or_unicode_string(tvecnode(hp).left.resultdef) then
+                             if (is_constintnode(tvecnode(hp).right) or
+                                 is_constenumnode(tvecnode(hp).right) or
+                                 is_constcharnode(tvecnode(hp).right) or
+                                 is_constboolnode(tvecnode(hp).right)) and
+                                not is_implicit_array_pointer(tvecnode(hp).left.resultdef) then
                                ftcb.queue_vecn(tvecnode(hp).left.resultdef,get_ordinal_value(tvecnode(hp).right))
                              else
                                Message(parser_e_illegal_expression);

+ 8 - 6
compiler/ninl.pas

@@ -393,7 +393,7 @@ implementation
           procname:=procname+'enum'
         else
           case torddef(source.resultdef).ordtype of
-            pasbool8,pasbool16,pasbool32,pasbool64,
+            pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
             bool8bit,bool16bit,bool32bit,bool64bit:
               procname := procname + 'bool';
             else
@@ -807,6 +807,7 @@ implementation
                       readfunctype:=s64currencytype;
                       is_real:=true;
                     end;
+                  pasbool1,
                   pasbool8,
                   pasbool16,
                   pasbool32,
@@ -823,7 +824,7 @@ implementation
                     else
                       begin
                         name := procprefixes[do_read]+'boolean';
-                        readfunctype:=pasbool8type;
+                        readfunctype:=pasbool1type;
                       end
                   else
                     begin
@@ -1044,7 +1045,7 @@ implementation
                   { in case of writing a chararray, add whether it's zero-based }
                   if para.left.resultdef.typ=arraydef then
                     para := ccallparanode.create(cordconstnode.create(
-                      ord(tarraydef(para.left.resultdef).lowrange=0),pasbool8type,false),para)
+                      ord(tarraydef(para.left.resultdef).lowrange=0),pasbool1type,false),para)
                   else
                   { in case of reading an ansistring pass a codepage argument }
                   if do_read and is_ansistring(para.left.resultdef) then
@@ -2218,7 +2219,7 @@ implementation
                    else
                      hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline);
                  in_const_odd :
-                   hp:=cordconstnode.create(qword(odd(int64(vl))),pasbool8type,true);
+                   hp:=cordconstnode.create(qword(odd(int64(vl))),pasbool1type,true);
                  in_const_swap_word :
                    hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resultdef,true);
                  in_const_swap_long :
@@ -2280,6 +2281,7 @@ implementation
                     orddef :
                       begin
                         case torddef(left.resultdef).ordtype of
+                          pasbool1,
                           pasbool8,
                           uchar:
                             begin
@@ -3070,7 +3072,7 @@ implementation
                   { Postpone conversion into addnode until firstpass, so targets
                     may override first_assigned and insert specific code. }
                   set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]);
-                  resultdef:=pasbool8type;
+                  resultdef:=pasbool1type;
                 end;
 
               in_ofs_x :
@@ -4286,7 +4288,7 @@ implementation
 
          addstatement(newstatement,cassignmentnode.create(resultnode,hpp));
 
-         { force pass 1, so copied tries get first pass'ed as well and flags like nf_write, nf_call_unique
+         { force pass 1, so copied trees get first pass'ed as well and flags like nf_write, nf_call_unique
            get set right }
          node_reset_flags(newstatement.statement,[nf_pass1_done]);
          { firstpass it }

+ 1 - 0
compiler/nmat.pas

@@ -1200,6 +1200,7 @@ implementation
              v:=tordconstnode(left).value;
              def:=left.resultdef;
              case torddef(left.resultdef).ordtype of
+               pasbool1,
                pasbool8,
                pasbool16,
                pasbool32,

+ 0 - 73
compiler/nmem.pas

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

+ 11 - 1
compiler/nobj.pas

@@ -511,6 +511,7 @@ implementation
         hclass : tobjectdef;
         hashedid : THashedIDString;
         srsym      : tsym;
+        overload: boolean;
       begin
         result:=nil;
         hashedid.id:=name;
@@ -519,11 +520,16 @@ implementation
           begin
             srsym:=tsym(hclass.symtable.FindWithHash(hashedid));
             if assigned(srsym) and
-               (srsym.typ=procsym) then
+               (srsym.typ=procsym) and
+               ((hclass=_class) or
+                is_visible_for_object(srsym,_class)) then
               begin
+                overload:=false;
                 for i:=0 to Tprocsym(srsym).ProcdefList.Count-1 do
                   begin
                     implprocdef:=tprocdef(tprocsym(srsym).ProcdefList[i]);
+                    if po_overload in implprocdef.procoptions then
+                      overload:=true;
                     if (implprocdef.procsym=tprocsym(srsym)) and
                        (compare_paras(proc.paras,implprocdef.paras,cp_all,[cpo_ignorehidden,cpo_ignoreuniv])>=te_equal) and
                        (compare_defs(proc.returndef,implprocdef.returndef,nothingn)>=te_equal) and
@@ -544,6 +550,10 @@ implementation
                         exit;
                       end;
                   end;
+                { like with normal procdef resolution (in htypechk), stop if
+                  we encounter a proc without the overload directive }
+                if not overload then
+                  exit;
               end;
             hclass:=hclass.childof;
           end;

+ 0 - 2
compiler/node.pas

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

+ 7 - 7
compiler/nset.pas

@@ -215,7 +215,7 @@ implementation
 
       begin
          result:=nil;
-         resultdef:=pasbool8type;
+         resultdef:=pasbool1type;
          typecheckpass(right);
          set_varstate(right,vs_read,[vsf_must_be_valid]);
          if codegenerror then
@@ -239,7 +239,7 @@ implementation
            internalerror(20021126);
 
          t:=self;
-         if isbinaryoverloaded(t,[]) then
+         if isbinaryoverloaded(t,[]) then
            begin
              result:=t;
              exit;
@@ -258,7 +258,7 @@ implementation
              }
              if  (
                    (left.resultdef.typ = orddef) and not
-                   (torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,pasbool8,bool8bit])
+                   (torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,pasbool1,pasbool8,bool8bit])
                  )
                 or
                  (
@@ -296,7 +296,7 @@ implementation
             ((right.nodetype = setconstn) and
              (tnormalset(tsetconstnode(right).value_set^) = [])) then
           begin
-            t:=cordconstnode.create(0,pasbool8type,false);
+            t:=cordconstnode.create(0,pasbool1type,false);
             typecheckpass(t);
             result:=t;
             exit;
@@ -323,10 +323,10 @@ implementation
                  { into account                                             }
                  if Tordconstnode(left).value.signed then
                    t:=cordconstnode.create(byte(tordconstnode(left).value.svalue in Tsetconstnode(right).value_set^),
-                     pasbool8type,true)
+                     pasbool1type,true)
                  else
                    t:=cordconstnode.create(byte(tordconstnode(left).value.uvalue in Tsetconstnode(right).value_set^),
-                     pasbool8type,true);
+                     pasbool1type,true);
                  typecheckpass(t);
                  result:=t;
                  exit;
@@ -336,7 +336,7 @@ implementation
                  if (Tordconstnode(left).value<int64(tsetdef(right.resultdef).setbase)) or
                     (Tordconstnode(left).value>int64(Tsetdef(right.resultdef).setmax)) then
                    begin
-                     t:=cordconstnode.create(0, pasbool8type, true);
+                     t:=cordconstnode.create(0, pasbool1type, true);
                      typecheckpass(t);
                      result:=t;
                      exit;

+ 10 - 0
compiler/nutils.pas

@@ -153,6 +153,10 @@ interface
     { include or exclude cs from p.localswitches }
     procedure node_change_local_switch(p : tnode;cs : tlocalswitch;enable : boolean);
 
+    { returns true, if p is a node which shall be short boolean evaluated,
+      if it is not an orn/andn with boolean operans, the result is undefined }
+    function doshortbooleval(p : tnode) : Boolean;
+
 implementation
 
     uses
@@ -1466,4 +1470,10 @@ implementation
         foreachnodestatic(p,@do_change_local_settings,@lsc);
       end;
 
+
+    function doshortbooleval(p : tnode) : Boolean;
+      begin
+        Result:=(p.nodetype in [orn,andn]) and ((nf_short_bool in taddnode(p).flags) or not(cs_full_boolean_eval in p.localswitches));
+      end;
+
 end.

+ 1 - 1
compiler/optconstprop.pas

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

+ 16 - 2
compiler/optcse.pas

@@ -298,14 +298,14 @@ unit optcse;
             if not(csedomain) then
               begin
                 { try to transform the tree to get better cse domains, consider:
-                       +
+                       +    (1)
                       / \
                      +   C
                     / \
                    A   B
 
                   if A is not cse'able but B and C are, then the compiler cannot do cse so the tree is transformed into
-                       +
+                 (2)   +
                       / \
                      A   +
                         / \
@@ -329,6 +329,9 @@ unit optcse;
                    (is_set(n.resultdef))
                    ) then
                   while (n.nodetype=tbinarynode(n).left.nodetype) and
+                    { if node (1) is fully boolean evaluated and node (2) not, we cannot do the swap as this might result in B being evaluated always,
+                      the other way round is no problem, C is still evaluated only if needed }
+                    (not(is_boolean(n.resultdef)) or not(n.nodetype in [andn,orn]) or doshortbooleval(n) or not(doshortbooleval(tbinarynode(n).left))) and
                         { the resulttypes of the operands we'll swap must be equal,
                           required in case of a 32x32->64 multiplication, then we
                           cannot swap out one of the 32 bit operands for a 64 bit one
@@ -344,6 +347,17 @@ unit optcse;
                           foreachnodestatic(pm_postprocess,tbinarynode(tbinarynode(n).left).right,@searchsubdomain,@csedomain);
                           if csedomain then
                             begin
+                              { move the full boolean evaluation of (2) to (1), if it was there (so it again applies to A and
+                                what follows) }
+                              if not(doshortbooleval(tbinarynode(n).left)) and
+                                 doshortbooleval(n) then
+                                begin
+                                  n.localswitches:=n.localswitches+(tbinarynode(n).left.localswitches*[cs_full_boolean_eval]);
+                                  exclude(tbinarynode(n).left.localswitches,cs_full_boolean_eval);
+                                  tbinarynode(n).left.flags:=tbinarynode(n).left.flags+(n.flags*[nf_short_bool]);
+                                  exclude(n.Flags,nf_short_bool);
+                                end;
+
                               hp2:=tbinarynode(tbinarynode(n).left).left;
                               tbinarynode(tbinarynode(n).left).left:=tbinarynode(tbinarynode(n).left).right;
                               tbinarynode(tbinarynode(n).left).right:=tbinarynode(n).right;

+ 0 - 1
compiler/optutils.pas

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

+ 0 - 1
compiler/pass_2.pas

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

+ 3 - 3
compiler/pdecl.pas

@@ -61,7 +61,7 @@ implementation
        ninl,ncon,nobj,ngenutil,
        { parser }
        scanner,
-       pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,pgenutil,
+       pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,pgenutil,pparautl,
 {$ifdef jvm}
        pjvm,
 {$endif}
@@ -310,7 +310,7 @@ implementation
                           parse_var_proc_directives(sym);
                        end;
                       { add default calling convention }
-                      handle_calling_convention(tabstractprocdef(hdef));
+                      handle_calling_convention(tabstractprocdef(hdef),hcc_default_actions_intf);
                     end;
                    if not skipequal then
                     begin
@@ -864,7 +864,7 @@ implementation
                                  Comment(V_Error,'Function references are not yet supported, only C blocks (add "cdecl;" at the end)');
                              end
                          end;
-                       handle_calling_convention(tprocvardef(hdef));
+                       handle_calling_convention(tprocvardef(hdef),hcc_default_actions_intf);
                        if try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg) then
                          consume(_SEMICOLON);
                      end;

+ 5 - 5
compiler/pdecobj.pas

@@ -49,9 +49,9 @@ implementation
       symbase,symsym,symtable,symcreat,defcmp,
       node,ncon,
       fmodule,scanner,
-      pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,ppu
+      pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,pparautl,ppu
 {$ifdef jvm}
-      ,pjvm;
+      ,jvmdef,pjvm;
 {$else}
       ;
 {$endif}
@@ -75,12 +75,12 @@ implementation
               // we can't add hidden params here because record is not yet defined
               // and therefore record size which has influence on paramter passing rules may change too
               // look at record_dec to see where calling conventions are applied (issue #0021044)
-              handle_calling_convention(pd,[hcc_check]);
+              handle_calling_convention(pd,[hcc_declaration,hcc_check]);
             end;
           objectdef:
             begin
               parse_object_proc_directives(pd);
-              handle_calling_convention(pd);
+              handle_calling_convention(pd,hcc_default_actions_intf);
             end
           else
             internalerror(2011040502);
@@ -923,7 +923,7 @@ implementation
                      is_classdef and not (po_staticmethod in result.procoptions) then
                     MessagePos(result.fileinfo,parser_e_class_methods_only_static_in_records);
 
-                  handle_calling_convention(result);
+                  handle_calling_convention(result,hcc_default_actions_intf);
 
                   { add definition to procsym }
                   proc_add_definition(result);

+ 5 - 666
compiler/pdecsub.pas

@@ -55,23 +55,11 @@ interface
       );
       tpdflags=set of tpdflag;
 
-      // flags of handle_calling_convention routine
-      thccflag=(
-        hcc_check,                // perform checks and outup errors if found
-        hcc_insert_hidden_paras   // insert hidden parameters
-      );
-      thccflags=set of thccflag;
-    const
-      hcc_all=[hcc_check,hcc_insert_hidden_paras];
-
     function  check_proc_directive(isprocvar:boolean):boolean;
 
-    function  proc_add_definition(var currpd:tprocdef):boolean;
     function  proc_get_importname(pd:tprocdef):string;
     procedure proc_set_mangledname(pd:tprocdef);
 
-    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
-
     procedure parse_parameter_dec(pd:tabstractprocdef);
     procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
     procedure parse_var_proc_directives(sym:tsym);
@@ -84,8 +72,6 @@ interface
     { parse a record method declaration (not a (class) constructor/destructor) }
     function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean;hadgeneric:boolean): tprocdef;
 
-    procedure insert_record_hidden_paras(astruct: trecorddef);
-
     { helper functions - they insert nested objects hierarchy to the symtablestack
       with object hierarchy
     }
@@ -107,7 +93,7 @@ implementation
        { assembler }
        aasmbase,
        { symtable }
-       symbase,symcpu,symtable,defutil,defcmp,
+       symbase,symcpu,symtable,symutil,defutil,defcmp,
        { parameter handling }
        paramgr,cpupara,
        { pass 1 }
@@ -128,25 +114,6 @@ implementation
         Declaring it as string here results in an error when compiling (PFV) }
       current_procinfo = 'error';
 
-    { get_first_proc_str - returns the token string of the first option that
-      appears in the list }
-    function get_first_proc_str(Options: TProcOptions): ShortString;
-      var
-        X: TProcOption;
-      begin
-        if Options = [] then
-          InternalError(2018051700);
-
-        get_first_proc_str := '';
-
-        for X := Low(TProcOption) to High(TProcOption) do
-          if X in Options then
-            begin
-              get_first_proc_str := ProcOptionKeywords[X];
-              Exit;
-            end;
-      end;
-
     function push_child_hierarchy(obj:tabstractrecorddef):integer;
       var
         _class,hp : tobjectdef;
@@ -223,19 +190,6 @@ implementation
       end;
 
 
-    procedure set_addr_param_regable(p:TObject;arg:pointer);
-      begin
-        if (tsym(p).typ<>paravarsym) then
-         exit;
-        with tparavarsym(p) do
-         begin
-           if (not needs_finalization) and
-              paramanager.push_addr_param(varspez,vardef,tprocdef(arg).proccalloption) then
-             varregable:=vr_addr;
-         end;
-      end;
-
-
     procedure parse_parameter_dec(pd:tabstractprocdef);
       {
         handle_procvar needs the same changes
@@ -403,7 +357,7 @@ implementation
                   dummytype.free;
                end;
              { Add implicit hidden parameters and function result }
-             handle_calling_convention(pv);
+             handle_calling_convention(pv,hcc_default_actions_intf);
 {$ifdef jvm}
              { anonymous -> no name }
              jvm_create_procvar_class('',pv);
@@ -1735,7 +1689,7 @@ implementation
             // we can't add hidden params here because record is not yet defined
             // and therefore record size which has influence on paramter passing rules may change too
             // look at record_dec to see where calling conventions are applied (issue #0021044)
-            handle_calling_convention(result,[hcc_check]);
+            handle_calling_convention(result,[hcc_declaration,hcc_check]);
 
             { add definition to procsym }
             proc_add_definition(result);
@@ -1750,33 +1704,6 @@ implementation
       end;
 
 
-    procedure insert_record_hidden_paras(astruct: trecorddef);
-      var
-        pd: tdef;
-        i: longint;
-        oldpos : tfileposinfo;
-        oldparse_only: boolean;
-      begin
-        // handle calling conventions of record methods
-        oldpos:=current_filepos;
-        oldparse_only:=parse_only;
-        parse_only:=true;
-        { don't keep track of procdefs in a separate list, because the
-          compiler may add additional procdefs (e.g. property wrappers for
-          the jvm backend) }
-        for i := 0 to astruct.symtable.deflist.count - 1 do
-          begin
-            pd:=tdef(astruct.symtable.deflist[i]);
-            if pd.typ<>procdef then
-              continue;
-            current_filepos:=tprocdef(pd).fileinfo;
-            handle_calling_convention(tprocdef(pd),[hcc_insert_hidden_paras]);
-          end;
-        parse_only:=oldparse_only;
-        current_filepos:=oldpos;
-      end;
-
-
 {****************************************************************************
                         Procedure directive handlers
 ****************************************************************************}
@@ -2793,7 +2720,7 @@ const
       pooption : [po_virtualmethod];
       mutexclpocall : [pocall_internproc];
       mutexclpotype : [potype_class_constructor,potype_class_destructor];
-      mutexclpo     : [po_interrupt,po_exports,po_overridingmethod,po_inline,po_staticmethod]
+      mutexclpo     : PD_VIRTUAL_MUTEXCLPO
     ),(
       idtok:_CPPDECL;
       pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
@@ -3147,7 +3074,6 @@ const
       end;
 
 
-
     function proc_get_importname(pd:tprocdef):string;
       var
         dllname, importname : string;
@@ -3202,12 +3128,6 @@ const
       end;
 
 
-    procedure compilerproc_set_symbol_name(pd: tprocdef);
-      begin
-        pd.procsym.realname:='$'+lower(pd.procsym.name);
-      end;
-
-
     procedure proc_set_mangledname(pd:tprocdef);
       var
         s : string;
@@ -3231,7 +3151,7 @@ const
                       implementation that needs to match the original symbol
                       again -> immediately convert here }
                     if po_compilerproc in pd.procoptions then
-                      compilerproc_set_symbol_name(pd);
+                      pd.setcompilerprocname;
                   end
               end
             else
@@ -3276,117 +3196,6 @@ const
       end;
 
 
-    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
-      begin
-        if hcc_check in flags then
-          begin
-            { set the default calling convention if none provided }
-            if (pd.typ=procdef) and
-               (is_objc_class_or_protocol(tprocdef(pd).struct) or
-                is_cppclass(tprocdef(pd).struct)) then
-              begin
-                { none of the explicit calling conventions should be allowed }
-                if (po_hascallingconvention in pd.procoptions) then
-                  internalerror(2009032501);
-                if is_cppclass(tprocdef(pd).struct) then
-                  pd.proccalloption:=pocall_cppdecl
-                else
-                  pd.proccalloption:=pocall_cdecl;
-              end
-            else if not(po_hascallingconvention in pd.procoptions) then
-              pd.proccalloption:=current_settings.defproccall
-            else
-              begin
-                if pd.proccalloption=pocall_none then
-                  internalerror(200309081);
-              end;
-
-            { handle proccall specific settings }
-            case pd.proccalloption of
-              pocall_cdecl,
-              pocall_cppdecl,
-              pocall_sysv_abi_cdecl,
-              pocall_ms_abi_cdecl:
-                begin
-                  { check C cdecl para types }
-                  check_c_para(pd);
-                end;
-              pocall_far16 :
-                begin
-                  { Temporary stub, must be rewritten to support OS/2 far16 }
-                  Message1(parser_w_proc_directive_ignored,'FAR16');
-                end;
-            end;
-
-            { Inlining is enabled and supported? }
-            if (po_inline in pd.procoptions) and
-               not(cs_do_inline in current_settings.localswitches) then
-              begin
-                { Give an error if inline is not supported by the compiler mode,
-                  otherwise only give a hint that this procedure will not be inlined }
-                if not(m_default_inline in current_settings.modeswitches) then
-                  Message(parser_e_proc_inline_not_supported)
-                else
-                  Message(parser_h_inlining_disabled);
-                exclude(pd.procoptions,po_inline);
-              end;
-
-            { For varargs directive also cdecl and external must be defined }
-            if (po_varargs in pd.procoptions) then
-             begin
-               { check first for external in the interface, if available there
-                 then the cdecl must also be there since there is no implementation
-                 available to contain it }
-               if parse_only then
-                begin
-                  { if external is available, then cdecl must also be available,
-                    procvars don't need external }
-                  if not((po_external in pd.procoptions) or
-                         (pd.typ=procvardef) or
-                         { for objcclasses this is checked later, because the entire
-                           class may be external.  }
-                         is_objc_class_or_protocol(tprocdef(pd).struct)) and
-                     not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
-                    Message(parser_e_varargs_need_cdecl_and_external);
-                end
-               else
-                begin
-                  { both must be defined now }
-                  if not((po_external in pd.procoptions) or
-                         (pd.typ=procvardef)) or
-                     not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
-                    Message(parser_e_varargs_need_cdecl_and_external);
-                end;
-             end;
-          end;
-
-        if hcc_insert_hidden_paras in flags then
-          begin
-            { insert hidden high parameters }
-            pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
-
-            { insert hidden self parameter }
-            insert_self_and_vmt_para(pd);
-
-            { insert funcret parameter if required }
-            insert_funcret_para(pd);
-
-            { Make var parameters regable, this must be done after the calling
-              convention is set. }
-            { this must be done before parentfp is insert, because getting all cases
-              where parentfp must be in a memory location isn't catched properly so
-              we put parentfp never in a register }
-            pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
-
-            { insert parentfp parameter if required }
-            insert_parentfp_para(pd);
-          end;
-
-        { Calculate parameter tlist }
-        pd.calcparas;
-      end;
-
-
     procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
       {
         Parse the procedure directives. It does not matter if procedure directives
@@ -3537,474 +3346,4 @@ const
         parse_proc_directives(pd,pdflags);
       end;
 
-    function proc_add_definition(var currpd:tprocdef):boolean;
-
-
-      function check_generic_parameters(fwpd,currpd:tprocdef):boolean;
-        var
-          i : longint;
-          fwtype,
-          currtype : ttypesym;
-        begin
-          result:=true;
-          if fwpd.genericparas.count<>currpd.genericparas.count then
-            internalerror(2018090101);
-          for i:=0 to fwpd.genericparas.count-1 do
-            begin
-              fwtype:=ttypesym(fwpd.genericparas[i]);
-              currtype:=ttypesym(currpd.genericparas[i]);
-              if fwtype.name<>currtype.name then
-                begin
-                  messagepos1(currtype.fileinfo,sym_e_generic_type_param_mismatch,currtype.realname);
-                  messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
-                  result:=false;
-                end;
-            end;
-        end;
-
-
-      function equal_generic_procdefs(fwpd,currpd:tprocdef):boolean;
-        var
-          i : longint;
-          fwtype,
-          currtype : ttypesym;
-          foundretdef : boolean;
-        begin
-          result:=false;
-          if fwpd.genericparas.count<>currpd.genericparas.count then
-            exit;
-          { comparing generic declarations is a bit more cumbersome as the
-            defs of the generic parameter types are not equal, especially if the
-            declaration contains constraints; essentially we have two cases:
-            - proc declared in interface of unit (or in class/record/object)
-              and defined in implementation; here the fwpd might contain
-              constraints while currpd must only contain undefineddefs
-            - forward declaration in implementation }
-          foundretdef:=false;
-          for i:=0 to fwpd.genericparas.count-1 do
-            begin
-              fwtype:=ttypesym(fwpd.genericparas[i]);
-              currtype:=ttypesym(currpd.genericparas[i]);
-              { if the type in the currpd isn't a pure undefineddef, then we can
-                stop right there }
-              if (currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions) then
-                exit;
-              if not foundretdef then
-                begin
-                  { if the returndef is the same as this parameter's def then this
-                    needs to be the case for both procdefs }
-                  foundretdef:=fwpd.returndef=fwtype.typedef;
-                  if foundretdef xor (currpd.returndef=currtype.typedef) then
-                    exit;
-                end;
-            end;
-          if compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv,cpo_generic])<>te_exact then
-            exit;
-          if not foundretdef then
-            begin
-              if (df_specialization in tstoreddef(fwpd.returndef).defoptions) and (df_specialization in tstoreddef(currpd.returndef).defoptions) then
-                { for specializations we're happy with equal defs instead of exactly the same defs }
-                result:=equal_defs(fwpd.returndef,currpd.returndef)
-              else
-                { the returndef isn't a type parameter, so compare as usual }
-                result:=compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact;
-            end
-          else
-            result:=true;
-        end;
-
-      {
-        Add definition aprocdef to the overloaded definitions of aprocsym. If a
-        forwarddef is found and reused it returns true
-      }
-      var
-        fwpd    : tprocdef;
-        currparasym,
-        fwparasym : tsym;
-        currparacnt,
-        fwparacnt,
-        curridx,
-        fwidx,
-        virtualdirinfo,
-        i       : longint;
-        po_comp : tprocoptions;
-        paracompopt: tcompare_paras_options;
-        forwardfound : boolean;
-        symentry: TSymEntry;
-        item : tlinkedlistitem;
-      begin
-        virtualdirinfo:=-1;
-        forwardfound:=false;
-
-        { check overloaded functions if the same function already exists }
-        for i:=0 to tprocsym(currpd.procsym).ProcdefList.Count-1 do
-         begin
-           fwpd:=tprocdef(tprocsym(currpd.procsym).ProcdefList[i]);
-
-           { can happen for internally generated routines }
-           if (fwpd=currpd) then
-             begin
-               result:=true;
-               exit;
-             end;
-
-           { Skip overloaded definitions that are declared in other units }
-           if fwpd.procsym<>currpd.procsym then
-             continue;
-
-           { check the parameters, for delphi/tp it is possible to
-             leave the parameters away in the implementation (forwarddef=false).
-             But for an overload declared function this is not allowed }
-           if { check if empty implementation arguments match is allowed }
-              (
-               not(m_repeat_forward in current_settings.modeswitches) and
-               not(currpd.forwarddef) and
-               is_bareprocdef(currpd) and
-               not(po_overload in fwpd.procoptions)
-              ) or
-              (
-                fwpd.is_generic and
-                currpd.is_generic and
-                equal_generic_procdefs(fwpd,currpd)
-              ) or
-              { check arguments, we need to check only the user visible parameters. The hidden parameters
-                can be in a different location because of the calling convention, eg. L-R vs. R-L order (PFV)
-
-                don't check default values here, because routines that are the same except for their default
-                values should be reported as mismatches (since you can't overload based on different default
-                parameter values) }
-              (
-               (compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and
-               (compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact)
-              ) then
-             begin
-               { Check if we've found the forwarddef, if found then
-                 we need to update the forward def with the current
-                 implementation settings }
-               if fwpd.forwarddef then
-                 begin
-                   forwardfound:=true;
-
-                   if not(m_repeat_forward in current_settings.modeswitches) and
-                      (fwpd.proccalloption<>currpd.proccalloption) then
-                     paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv]
-                   else
-                     paracompopt:=[cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv];
-
-                   { Check calling convention }
-                   if (fwpd.proccalloption<>currpd.proccalloption) then
-                    begin
-                      { In delphi it is possible to specify the calling
-                        convention in the interface or implementation if
-                        there was no convention specified in the other
-                        part }
-                      if (m_delphi in current_settings.modeswitches) then
-                        begin
-                          if not(po_hascallingconvention in currpd.procoptions) then
-                            currpd.proccalloption:=fwpd.proccalloption
-                          else
-                            if not(po_hascallingconvention in fwpd.procoptions) then
-                              fwpd.proccalloption:=currpd.proccalloption
-                          else
-                            begin
-                              MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
-                              tprocsym(currpd.procsym).write_parameter_lists(currpd);
-                              { restore interface settings }
-                              currpd.proccalloption:=fwpd.proccalloption;
-                            end;
-                        end
-                      else
-                        begin
-                          MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
-                          tprocsym(currpd.procsym).write_parameter_lists(currpd);
-                          { restore interface settings }
-                          currpd.proccalloption:=fwpd.proccalloption;
-                        end;
-                    end;
-
-                   { Check static }
-                   if (po_staticmethod in fwpd.procoptions) then
-                    begin
-                      if not (po_staticmethod in currpd.procoptions) then
-                       begin
-                         include(currpd.procoptions, po_staticmethod);
-                         if (po_classmethod in currpd.procoptions) then
-                          begin
-                           { remove self from the hidden paras }
-                           symentry:=currpd.parast.Find('self');
-                           if symentry<>nil then
-                            begin
-                              currpd.parast.Delete(symentry);
-                              currpd.calcparas;
-                            end;
-                          end;
-                       end;
-                    end;
-
-                   { Check if the procedure type and return type are correct,
-                     also the parameters must match also with the type and that
-                     if the implementation has default parameters, the interface
-                     also has them and that if they both have them, that they
-                     have the same value }
-                   if ((m_repeat_forward in current_settings.modeswitches) or
-                       not is_bareprocdef(currpd)) and
-                       (
-                         (
-                           fwpd.is_generic and
-                           currpd.is_generic and
-                           not equal_generic_procdefs(fwpd,currpd)
-                         ) or
-                         (
-                           (
-                             not fwpd.is_generic or
-                             not currpd.is_generic
-                           ) and
-                           (
-                             (compare_paras(fwpd.paras,currpd.paras,cp_all,paracompopt)<>te_exact) or
-                             (compare_defs(fwpd.returndef,currpd.returndef,nothingn)<>te_exact)
-                           )
-                         )
-                       ) then
-                     begin
-                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
-                                   fwpd.fullprocname(false));
-                       tprocsym(currpd.procsym).write_parameter_lists(currpd);
-                       break;
-                     end;
-
-                   { Check if both are declared forward }
-                   if fwpd.forwarddef and currpd.forwarddef then
-                    begin
-                      MessagePos1(currpd.fileinfo,parser_e_function_already_declared_public_forward,
-                                  currpd.fullprocname(false));
-                    end;
-
-                   { internconst or internproc only need to be defined once }
-                   if (fwpd.proccalloption=pocall_internproc) then
-                    currpd.proccalloption:=fwpd.proccalloption
-                   else
-                    if (currpd.proccalloption=pocall_internproc) then
-                     fwpd.proccalloption:=currpd.proccalloption;
-
-                   { Check procedure options, Delphi requires that class is
-                     repeated in the implementation for class methods }
-                   if (m_fpc in current_settings.modeswitches) then
-                     po_comp:=[po_classmethod,po_varargs,po_methodpointer,po_interrupt]
-                   else
-                     po_comp:=[po_classmethod,po_methodpointer];
-
-                   if ((po_comp * fwpd.procoptions)<>(po_comp * currpd.procoptions)) or
-                      (fwpd.proctypeoption <> currpd.proctypeoption) or
-                      { if the implementation version has an "overload" modifier,
-                        the interface version must also have it (otherwise we can
-                        get annoying crashes due to interface crc changes) }
-                      (not(po_overload in fwpd.procoptions) and
-                       (po_overload in currpd.procoptions)) then
-                     begin
-                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
-                                   fwpd.fullprocname(false));
-                       tprocsym(fwpd.procsym).write_parameter_lists(fwpd);
-                       { This error is non-fatal, we can recover }
-                     end;
-
-                   { Forward declaration is external? }
-                   if (po_external in fwpd.procoptions) then
-                     MessagePos(currpd.fileinfo,parser_e_proc_already_external);
-
-                   { check for conflicts with "virtual" if this is a virtual
-                     method, as "virtual" cannot be repeated in the
-                     implementation and hence does not get checked against }
-                   if (po_virtualmethod in fwpd.procoptions) then
-                     begin
-                       if virtualdirinfo=-1 then
-                         begin
-                           virtualdirinfo:=find_proc_directive_index(_VIRTUAL);
-                           if virtualdirinfo=-1 then
-                             internalerror(2018010101);
-                         end;
-                       po_comp := (proc_direcdata[virtualdirinfo].mutexclpo * currpd.procoptions);
-                       if po_comp<>[] then
-                         MessagePos2(currpd.fileinfo,parser_e_proc_dir_conflict,tokeninfo^[_VIRTUAL].str,get_first_proc_str(po_comp));
-                     end;
-                    { Check parameters }
-                   if (m_repeat_forward in current_settings.modeswitches) or
-                      (currpd.minparacount>0) then
-                    begin
-                      { If mangled names are equal then they have the same amount of arguments }
-                      { We can check the names of the arguments }
-                      { both symtables are in the same order from left to right }
-                      curridx:=0;
-                      fwidx:=0;
-                      currparacnt:=currpd.parast.SymList.Count;
-                      fwparacnt:=fwpd.parast.SymList.Count;
-                      repeat
-                        { skip default parameter constsyms }
-                        while (curridx<currparacnt) and
-                              (tsym(currpd.parast.SymList[curridx]).typ<>paravarsym) do
-                          inc(curridx);
-                        while (fwidx<fwparacnt) and
-                              (tsym(fwpd.parast.SymList[fwidx]).typ<>paravarsym) do
-                          inc(fwidx);
-                        { stop when one of the two lists is at the end }
-                        if (fwidx>=fwparacnt) or (curridx>=currparacnt) then
-                          break;
-                        { compare names of parameters, ignore implictly
-                          renamed parameters }
-                        currparasym:=tsym(currpd.parast.SymList[curridx]);
-                        fwparasym:=tsym(fwpd.parast.SymList[fwidx]);
-                        if not(sp_implicitrename in currparasym.symoptions) and
-                           not(sp_implicitrename in fwparasym.symoptions) then
-                          begin
-                            if (currparasym.name<>fwparasym.name) then
-                              begin
-                                MessagePos3(currpd.fileinfo,parser_e_header_different_var_names,
-                                            tprocsym(currpd.procsym).realname,fwparasym.realname,currparasym.realname);
-                                break;
-                              end;
-                          end;
-                        { next parameter }
-                        inc(curridx);
-                        inc(fwidx);
-                      until false;
-                    end;
-                   { check that the type parameter names for generic methods match;
-                     we check this here and not in equal_generic_procdefs as the defs
-                     might still be different due to their parameters, so we'd generate
-                     errors without any need }
-                   if currpd.is_generic and fwpd.is_generic then
-                     { an error here is recoverable, so we simply continue }
-                     check_generic_parameters(fwpd,currpd);
-                   { Everything is checked, now we can update the forward declaration
-                     with the new data from the implementation }
-                   fwpd.forwarddef:=currpd.forwarddef;
-                   fwpd.hasforward:=true;
-                   fwpd.procoptions:=fwpd.procoptions+currpd.procoptions;
-
-                   { marked as local but exported from unit? }
-                   if (po_kylixlocal in fwpd.procoptions) and (fwpd.owner.symtabletype=globalsymtable) then
-                     MessagePos(fwpd.fileinfo,type_e_cant_export_local);
-
-                   if fwpd.extnumber=$ffff then
-                     fwpd.extnumber:=currpd.extnumber;
-                   while not currpd.aliasnames.empty do
-                     fwpd.aliasnames.insert(currpd.aliasnames.getfirst);
-                   { update fileinfo so position references the implementation,
-                     also update funcretsym if it is already generated }
-                   fwpd.fileinfo:=currpd.fileinfo;
-                   if assigned(fwpd.funcretsym) then
-                     fwpd.funcretsym.fileinfo:=currpd.fileinfo;
-                   if assigned(currpd.deprecatedmsg) then
-                     begin
-                       stringdispose(fwpd.deprecatedmsg);
-                       fwpd.deprecatedmsg:=stringdup(currpd.deprecatedmsg^);
-                     end;
-                   { import names }
-                   if assigned(currpd.import_dll) then
-                     begin
-                       stringdispose(fwpd.import_dll);
-                       fwpd.import_dll:=stringdup(currpd.import_dll^);
-                     end;
-                   if assigned(currpd.import_name) then
-                     begin
-                       stringdispose(fwpd.import_name);
-                       fwpd.import_name:=stringdup(currpd.import_name^);
-                     end;
-                   fwpd.import_nr:=currpd.import_nr;
-                   { for compilerproc defines we need to rename and update the
-                     symbolname to lowercase so users can' access it (can't do
-                     it immediately, because then the implementation symbol
-                     won't be matched) }
-                   if po_compilerproc in fwpd.procoptions then
-                     begin
-                       compilerproc_set_symbol_name(fwpd);
-                       current_module.add_public_asmsym(fwpd.procsym.realname,AB_GLOBAL,AT_FUNCTION);
-                     end;
-                   if po_public in fwpd.procoptions then
-                     begin
-                       item:=fwpd.aliasnames.first;
-                       while assigned(item) do
-                         begin
-                           current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
-                           item:=item.next;
-                         end;
-                     end;
-
-                   { Release current procdef }
-                   currpd.owner.deletedef(currpd);
-                   currpd:=fwpd;
-                 end
-               else
-                begin
-                  { abstract methods aren't forward defined, but this }
-                  { needs another error message                   }
-                  if (po_abstractmethod in fwpd.procoptions) then
-                    MessagePos(currpd.fileinfo,parser_e_abstract_no_definition)
-                  else
-                    begin
-                      MessagePos(currpd.fileinfo,parser_e_overloaded_have_same_parameters);
-                      tprocsym(currpd.procsym).write_parameter_lists(currpd);
-                    end;
-                 end;
-
-               { we found one proc with the same arguments, there are no others
-                 so we can stop }
-               break;
-             end;
-
-           { check for allowing overload directive }
-           if not(m_fpc in current_settings.modeswitches) then
-            begin
-              { overload directive turns on overloading }
-              if ((po_overload in currpd.procoptions) or
-                  (po_overload in fwpd.procoptions)) then
-               begin
-                 { check if all procs have overloading, but not if the proc is a method or
-                   already declared forward, then the check is already done }
-                 if not(fwpd.hasforward or
-                        assigned(currpd.struct) or
-                        (currpd.forwarddef<>fwpd.forwarddef) or
-                        ((po_overload in currpd.procoptions) and
-                         (po_overload in fwpd.procoptions))) then
-                  begin
-                    MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
-                    break;
-                  end
-               end
-              else
-               begin
-                 if not(fwpd.forwarddef) then
-                  begin
-                    if (m_tp7 in current_settings.modeswitches) then
-                      MessagePos(currpd.fileinfo,parser_e_procedure_overloading_is_off)
-                    else
-                      MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
-                    break;
-                  end;
-               end;
-            end; { equal arguments }
-         end;
-
-        { if we didn't reuse a forwarddef then we add the procdef to the overloaded
-          list }
-        if not forwardfound then
-          begin
-            { can happen in Delphi mode }
-            if (currpd.proctypeoption = potype_function) and
-               is_void(currpd.returndef) then
-              MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
-            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
-            if not currpd.forwarddef and (po_public in currpd.procoptions) then
-              begin
-                item:=currpd.aliasnames.first;
-                while assigned(item) do
-                  begin
-                    current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
-                    item:=item.next;
-                  end;
-              end;
-          end;
-
-        proc_add_definition:=forwardfound;
-      end;
-
 end.

+ 10 - 10
compiler/pdecvar.pas

@@ -56,7 +56,7 @@ implementation
        globtype,globals,tokens,verbose,constexp,
        systems,
        { symtable }
-       symconst,symbase,defutil,defcmp,symcreat,
+       symconst,symbase,defutil,defcmp,symutil,symcreat,
 {$if defined(i386) or defined(i8086)}
        symcpu,
 {$endif}
@@ -68,7 +68,7 @@ implementation
        ngenutil,
        { parser }
        scanner,
-       pbase,pexpr,ptype,ptconst,pdecsub;
+       pbase,pexpr,ptype,ptconst,pdecsub,pparautl;
 
 
     function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
@@ -258,7 +258,7 @@ implementation
             var
               sym: tprocsym;
             begin
-              handle_calling_convention(pd);
+              handle_calling_convention(pd,hcc_default_actions_intf);
               sym:=cprocsym.create(prefix+lower(p.realname));
               symtablestack.top.insert(sym);
               pd.procsym:=sym;
@@ -537,7 +537,7 @@ implementation
                       begin
                         readprocdef.returndef:=p.propdef;
                         { Insert hidden parameters }
-                        handle_calling_convention(readprocdef);
+                        handle_calling_convention(readprocdef,hcc_default_actions_intf);
                       end;
                     p.add_getter_or_setter_for_sym(palt_read,sym,def,readprocdef);
                   end;
@@ -560,7 +560,7 @@ implementation
                         hparavs:=cparavarsym.create('$value',10*paranr,vs_value,p.propdef,[]);
                         writeprocdef.parast.insert(hparavs);
                         { Insert hidden parameters }
-                        handle_calling_convention(writeprocdef);
+                        handle_calling_convention(writeprocdef,hcc_default_actions_intf);
                       end;
                     p.add_getter_or_setter_for_sym(palt_write,sym,def,writeprocdef);
                   end;
@@ -639,7 +639,7 @@ implementation
                                  storedprocdef:=cprocvardef.create(normal_function_level);
                                  include(storedprocdef.procoptions,po_methodpointer);
                                  { Return type must be boolean }
-                                 storedprocdef.returndef:=pasbool8type;
+                                 storedprocdef.returndef:=pasbool1type;
                                  { Add index parameter if needed }
                                  if ppo_indexed in p.propoptions then
                                    begin
@@ -648,7 +648,7 @@ implementation
                                    end;
 
                                  { Insert hidden parameters }
-                                 handle_calling_convention(storedprocdef);
+                                 handle_calling_convention(storedprocdef,hcc_default_actions_intf);
                                  p.propaccesslist[palt_stored].procdef:=Tprocsym(sym).Find_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
                                  if not assigned(p.propaccesslist[palt_stored].procdef) then
                                    message(parser_e_ill_property_storage_sym);
@@ -1457,7 +1457,7 @@ implementation
                  { Add calling convention for procvar }
                  if (hdef.typ=procvardef) and
                     (hdef.typesym=nil) then
-                   handle_calling_convention(tprocvardef(hdef));
+                   handle_calling_convention(tprocvardef(hdef),hcc_default_actions_intf);
                  read_default_value(sc);
                  hasdefaultvalue:=true;
                end
@@ -1475,7 +1475,7 @@ implementation
                  { Parse procvar directives after ; }
                  maybe_parse_proc_directives(hdef);
                  { Add calling convention for procvar }
-                 handle_calling_convention(tprocvardef(hdef));
+                 handle_calling_convention(tprocvardef(hdef),hcc_default_actions_intf);
                  { Handling of Delphi typed const = initialized vars }
                  if (token=_EQ) and
                     not(m_tp7 in current_settings.modeswitches) and
@@ -1766,7 +1766,7 @@ implementation
              { Add calling convention for procvar }
              if (hdef.typ=procvardef) and
                 (hdef.typesym=nil) then
-               handle_calling_convention(tprocvardef(hdef));
+               handle_calling_convention(tprocvardef(hdef),hcc_default_actions_intf);
 
              if (vd_object in options) then
                begin

+ 46 - 7
compiler/pexpr.pas

@@ -1280,6 +1280,7 @@ implementation
       var
         isclassref:boolean;
         isrecordtype:boolean;
+        isobjecttype:boolean;
       begin
          if sym=nil then
            begin
@@ -1300,11 +1301,13 @@ implementation
                    do_typecheckpass(p1);
                  isclassref:=(p1.resultdef.typ=classrefdef);
                  isrecordtype:=(p1.nodetype=typen) and (p1.resultdef.typ=recorddef);
+                 isobjecttype:=(p1.nodetype=typen) and is_object(p1.resultdef);
                end
               else
                 begin
                   isclassref:=false;
                   isrecordtype:=false;
+                  isobjecttype:=false;
                 end;
 
               if assigned(spezcontext) and not (sym.typ=procsym) then
@@ -1324,16 +1327,47 @@ implementation
                       if (
                             isclassref or
                             (
-                              isrecordtype and
+                              (isobjecttype or
+                               isrecordtype) and
                               not (cnf_inherited in callflags)
                             )
                           ) and
                          (p1.nodetype=calln) and
                          assigned(tcallnode(p1).procdefinition) then
                         begin
-                          if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
-                             not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
-                            Message(parser_e_only_class_members_via_class_ref);
+                          if not isobjecttype then
+                            begin
+                              if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
+                                 not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
+                                Message(parser_e_only_class_members_via_class_ref);
+                            end
+                          else
+                            begin
+                              { with objects, you can also do this:
+                                  type
+                                    tparent = object
+                                      procedure test;
+                                    end;
+
+                                    tchild = object(tchild)
+                                      procedure test;
+                                    end;
+
+                                    procedure tparent.test;
+                                      begin
+                                      end;
+
+                                    procedure tchild.test;
+                                      begin
+                                        tparent.test;
+                                      end;
+                              }
+                              if (tcallnode(p1).procdefinition.proctypeoption<>potype_constructor) and
+                                 not(po_staticmethod in tcallnode(p1).procdefinition.procoptions) and
+                                 (not assigned(current_structdef) or
+                                  not def_is_related(current_structdef,structh)) then
+                                Message(parser_e_only_static_members_via_object_type);
+                            end;
                           { in Java, constructors are not automatically inherited
                             -> calling a constructor from a parent type will create
                                an instance of that parent type! }
@@ -1351,7 +1385,7 @@ implementation
                               assigned(tcallnode(p1).methodpointer) and
                               (tcallnode(p1).methodpointer.nodetype=loadvmtaddrn) then
                             Message1(type_w_instance_abstract_class,structh.RttiName);
-                        end;
+                        end
                    end;
                  fieldvarsym:
                    begin
@@ -1365,7 +1399,9 @@ implementation
                                 (current_procinfo.procdef.struct=structh))) then
                               Message(parser_e_only_class_members)
                             else
-                              Message(parser_e_only_class_members_via_class_ref);
+                              Message(parser_e_only_class_members_via_class_ref)
+                          else if isobjecttype then
+                            Message(parser_e_only_static_members_via_object_type);
                           p1:=csubscriptnode.create(sym,p1);
                         end;
                    end;
@@ -3800,7 +3836,10 @@ implementation
 
              _CWSTRING:
                begin
-                 p1:=cstringconstnode.createunistr(patternw);
+                 if getlengthwidestring(patternw)=1 then
+                   p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true)
+                 else
+                   p1:=cstringconstnode.createunistr(patternw);
                  consume(_CWSTRING);
                  if token in postfixoperator_tokens then
                    begin

+ 6 - 3
compiler/pgenutil.pas

@@ -73,7 +73,7 @@ uses
   node,nobj,
   { parser }
   scanner,
-  pbase,pexpr,pdecsub,ptype,psub;
+  pbase,pexpr,pdecsub,ptype,psub,pparautl;
 
 
     procedure maybe_add_waiting_unit(tt:tdef);
@@ -1077,7 +1077,7 @@ uses
                         end;
                       if replaydepth>current_scanner.replay_stack_depth then
                         parse_var_proc_directives(ttypesym(srsym));
-                      handle_calling_convention(tprocvardef(result));
+                      handle_calling_convention(tprocvardef(result),hcc_default_actions_intf);
                       if not hintsprocessed and (replaydepth>current_scanner.replay_stack_depth) then
                         begin
                           try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
@@ -1095,7 +1095,10 @@ uses
                       parse_proc_directives(pd,pdflags);
                       while try_consume_hintdirective(pd.symoptions,pd.deprecatedmsg) do
                         consume(_SEMICOLON);
-                      handle_calling_convention(tprocdef(result),hcc_all);
+                      if parse_generic then
+                        handle_calling_convention(tprocdef(result),hcc_default_actions_intf)
+                      else
+                        handle_calling_convention(tprocdef(result),hcc_default_actions_impl);
                       proc_add_definition(tprocdef(result));
                       { for partial specializations we implicitely declare the routine as
                         having its implementation although we'll not specialize it in reality }

+ 2 - 2
compiler/pmodules.pas

@@ -46,7 +46,7 @@ implementation
        objcgutl,
        pkgutil,
        wpobase,
-       scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,ncgvmt,ncgrtti,
+       scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,pparautl,ncgvmt,ncgrtti,
        cpuinfo;
 
 
@@ -676,7 +676,7 @@ implementation
           pd.proccalloption:=pocall_stdcall
         else
           pd.proccalloption:=pocall_cdecl;
-        handle_calling_convention(pd);
+        handle_calling_convention(pd,hcc_default_actions_impl);
         { set procinfo and current_procinfo.procdef }
         result:=tcgprocinfo(cprocinfo.create(nil));
         result.procdef:=pd;

+ 2 - 2
compiler/powerpc/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AmigaOS/MorphOS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

+ 690 - 5
compiler/pparautl.pas

@@ -26,7 +26,7 @@ unit pparautl;
 interface
 
     uses
-      symdef;
+      symconst,symdef;
 
     procedure insert_funcret_para(pd:tabstractprocdef);
     procedure insert_parentfp_para(pd:tabstractprocdef);
@@ -34,12 +34,42 @@ interface
     procedure insert_funcret_local(pd:tprocdef);
     procedure insert_hidden_para(p:TObject;arg:pointer);
     procedure check_c_para(pd:Tabstractprocdef);
+    procedure insert_record_hidden_paras(astruct: trecorddef);
+
+    type
+      // flags of the *handle_calling_convention routines
+      thccflag=(
+        hcc_declaration,          // declaration (as opposed to definition, i.e. interface rather than implementation)
+        hcc_check,                // perform checks and outup errors if found
+        hcc_insert_hidden_paras   // insert hidden parameters
+      );
+      thccflags=set of thccflag;
+
+    const
+      hcc_default_actions_intf=[hcc_declaration,hcc_check,hcc_insert_hidden_paras];
+      hcc_default_actions_impl=[hcc_check,hcc_insert_hidden_paras];
+      hcc_default_actions_parse=[hcc_check,hcc_insert_hidden_paras];
+      PD_VIRTUAL_MUTEXCLPO = [po_interrupt,po_exports,po_overridingmethod,po_inline,po_staticmethod];
+
+    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags);
+    function proc_add_definition(var currpd:tprocdef):boolean;
+
+    { create "parent frame pointer" record skeleton for procdef, in which local
+      variables and parameters from pd accessed from nested routines can be
+      stored }
+    procedure build_parentfpstruct(pd: tprocdef);
 
 implementation
 
     uses
-      globals,globtype,verbose,systems,
-      symconst,symtype,symbase,symsym,symtable,symcreat,defutil,blockutl,
+      globals,globtype,cclasses,cutils,verbose,systems,fmodule,
+      tokens,
+      symtype,symbase,symsym,symtable,symutil,defutil,defcmp,blockutl,
+{$ifdef jvm}
+      jvmdef,
+{$endif jvm}
+      node,nbas,
+      aasmbase,
       paramgr;
 
 
@@ -128,8 +158,8 @@ implementation
               begin
                 if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
                   build_parentfpstruct(tprocdef(pd.owner.defowner));
-                vs:=cparavarsym.create('$parentfp',paranr,vs_value
-                      ,tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
+                vs:=cparavarsym.create('$parentfp',paranr,vs_value,
+                      tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
               end;
             pd.parast.insert(vs);
 
@@ -418,4 +448,659 @@ implementation
       end;
 
 
+    procedure insert_record_hidden_paras(astruct: trecorddef);
+      var
+        pd: tdef;
+        i: longint;
+        oldpos: tfileposinfo;
+      begin
+        // handle calling conventions of record methods
+        oldpos:=current_filepos;
+        { don't keep track of procdefs in a separate list, because the
+          compiler may add additional procdefs (e.g. property wrappers for
+          the jvm backend) }
+        for i := 0 to astruct.symtable.deflist.count - 1 do
+          begin
+            pd:=tdef(astruct.symtable.deflist[i]);
+            if pd.typ<>procdef then
+              continue;
+            current_filepos:=tprocdef(pd).fileinfo;
+            handle_calling_convention(tprocdef(pd),[hcc_declaration,hcc_insert_hidden_paras]);
+          end;
+        current_filepos:=oldpos;
+      end;
+
+
+    procedure set_addr_param_regable(p:TObject;arg:pointer);
+      begin
+        if (tsym(p).typ<>paravarsym) then
+         exit;
+        with tparavarsym(p) do
+         begin
+           if (not needs_finalization) and
+              paramanager.push_addr_param(varspez,vardef,tprocdef(arg).proccalloption) then
+             varregable:=vr_addr;
+         end;
+      end;
+
+
+    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags);
+      begin
+        if hcc_check in flags then
+          begin
+            { set the default calling convention if none provided }
+            if (pd.typ=procdef) and
+               (is_objc_class_or_protocol(tprocdef(pd).struct) or
+                is_cppclass(tprocdef(pd).struct)) then
+              begin
+                { none of the explicit calling conventions should be allowed }
+                if (po_hascallingconvention in pd.procoptions) then
+                  internalerror(2009032501);
+                if is_cppclass(tprocdef(pd).struct) then
+                  pd.proccalloption:=pocall_cppdecl
+                else
+                  pd.proccalloption:=pocall_cdecl;
+              end
+            else if not(po_hascallingconvention in pd.procoptions) then
+              pd.proccalloption:=current_settings.defproccall
+            else
+              begin
+                if pd.proccalloption=pocall_none then
+                  internalerror(200309081);
+              end;
+
+            { handle proccall specific settings }
+            case pd.proccalloption of
+              pocall_cdecl,
+              pocall_cppdecl,
+              pocall_sysv_abi_cdecl,
+              pocall_ms_abi_cdecl:
+                begin
+                  { check C cdecl para types }
+                  check_c_para(pd);
+                end;
+              pocall_far16 :
+                begin
+                  { Temporary stub, must be rewritten to support OS/2 far16 }
+                  Message1(parser_w_proc_directive_ignored,'FAR16');
+                end;
+            end;
+
+            { Inlining is enabled and supported? }
+            if (po_inline in pd.procoptions) and
+               not(cs_do_inline in current_settings.localswitches) then
+              begin
+                { Give an error if inline is not supported by the compiler mode,
+                  otherwise only give a hint that this procedure will not be inlined }
+                if not(m_default_inline in current_settings.modeswitches) then
+                  Message(parser_e_proc_inline_not_supported)
+                else
+                  Message(parser_h_inlining_disabled);
+                exclude(pd.procoptions,po_inline);
+              end;
+
+            { For varargs directive also cdecl and external must be defined }
+            if (po_varargs in pd.procoptions) then
+             begin
+               { check first for external in the interface, if available there
+                 then the cdecl must also be there since there is no implementation
+                 available to contain it }
+               if hcc_declaration in flags then
+                begin
+                  { if external is available, then cdecl must also be available,
+                    procvars don't need external }
+                  if not((po_external in pd.procoptions) or
+                         (pd.typ=procvardef) or
+                         { for objcclasses this is checked later, because the entire
+                           class may be external.  }
+                         is_objc_class_or_protocol(tprocdef(pd).struct)) and
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
+                    Message(parser_e_varargs_need_cdecl_and_external);
+                end
+               else
+                begin
+                  { both must be defined now }
+                  if not((po_external in pd.procoptions) or
+                         (pd.typ=procvardef)) or
+                     not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
+                    Message(parser_e_varargs_need_cdecl_and_external);
+                end;
+             end;
+          end;
+
+        if hcc_insert_hidden_paras in flags then
+          begin
+            { insert hidden high parameters }
+            pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
+
+            { insert hidden self parameter }
+            insert_self_and_vmt_para(pd);
+
+            { insert funcret parameter if required }
+            insert_funcret_para(pd);
+
+            { Make var parameters regable, this must be done after the calling
+              convention is set. }
+            { this must be done before parentfp is insert, because getting all cases
+              where parentfp must be in a memory location isn't catched properly so
+              we put parentfp never in a register }
+            pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
+
+            { insert parentfp parameter if required }
+            insert_parentfp_para(pd);
+          end;
+
+        { Calculate parameter tlist }
+        pd.calcparas;
+      end;
+
+
+    function proc_add_definition(var currpd:tprocdef):boolean;
+
+      function check_generic_parameters(fwpd,currpd:tprocdef):boolean;
+        var
+          i : longint;
+          fwtype,
+          currtype : ttypesym;
+        begin
+          result:=true;
+          if fwpd.genericparas.count<>currpd.genericparas.count then
+            internalerror(2018090101);
+          for i:=0 to fwpd.genericparas.count-1 do
+            begin
+              fwtype:=ttypesym(fwpd.genericparas[i]);
+              currtype:=ttypesym(currpd.genericparas[i]);
+              if fwtype.name<>currtype.name then
+                begin
+                  messagepos1(currtype.fileinfo,sym_e_generic_type_param_mismatch,currtype.realname);
+                  messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
+                  result:=false;
+                end;
+            end;
+        end;
+
+
+      function equal_generic_procdefs(fwpd,currpd:tprocdef):boolean;
+        var
+          i : longint;
+          fwtype,
+          currtype : ttypesym;
+          foundretdef : boolean;
+        begin
+          result:=false;
+          if fwpd.genericparas.count<>currpd.genericparas.count then
+            exit;
+          { comparing generic declarations is a bit more cumbersome as the
+            defs of the generic parameter types are not equal, especially if the
+            declaration contains constraints; essentially we have two cases:
+            - proc declared in interface of unit (or in class/record/object)
+              and defined in implementation; here the fwpd might contain
+              constraints while currpd must only contain undefineddefs
+            - forward declaration in implementation }
+          foundretdef:=false;
+          for i:=0 to fwpd.genericparas.count-1 do
+            begin
+              fwtype:=ttypesym(fwpd.genericparas[i]);
+              currtype:=ttypesym(currpd.genericparas[i]);
+              { if the type in the currpd isn't a pure undefineddef, then we can
+                stop right there }
+              if (currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions) then
+                exit;
+              if not foundretdef then
+                begin
+                  { if the returndef is the same as this parameter's def then this
+                    needs to be the case for both procdefs }
+                  foundretdef:=fwpd.returndef=fwtype.typedef;
+                  if foundretdef xor (currpd.returndef=currtype.typedef) then
+                    exit;
+                end;
+            end;
+          if compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv,cpo_generic])<>te_exact then
+            exit;
+          if not foundretdef then
+            begin
+              if (df_specialization in tstoreddef(fwpd.returndef).defoptions) and (df_specialization in tstoreddef(currpd.returndef).defoptions) then
+                { for specializations we're happy with equal defs instead of exactly the same defs }
+                result:=equal_defs(fwpd.returndef,currpd.returndef)
+              else
+                { the returndef isn't a type parameter, so compare as usual }
+                result:=compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact;
+            end
+          else
+            result:=true;
+        end;
+
+      {
+        Add definition aprocdef to the overloaded definitions of aprocsym. If a
+        forwarddef is found and reused it returns true
+      }
+      var
+        fwpd    : tprocdef;
+        currparasym,
+        fwparasym : tsym;
+        currparacnt,
+        fwparacnt,
+        curridx,
+        fwidx,
+        i       : longint;
+        po_comp : tprocoptions;
+        paracompopt: tcompare_paras_options;
+        forwardfound : boolean;
+        symentry: TSymEntry;
+        item : tlinkedlistitem;
+      begin
+        forwardfound:=false;
+
+        { check overloaded functions if the same function already exists }
+        for i:=0 to tprocsym(currpd.procsym).ProcdefList.Count-1 do
+         begin
+           fwpd:=tprocdef(tprocsym(currpd.procsym).ProcdefList[i]);
+
+           { can happen for internally generated routines }
+           if (fwpd=currpd) then
+             begin
+               result:=true;
+               exit;
+             end;
+
+           { Skip overloaded definitions that are declared in other units }
+           if fwpd.procsym<>currpd.procsym then
+             continue;
+
+           { check the parameters, for delphi/tp it is possible to
+             leave the parameters away in the implementation (forwarddef=false).
+             But for an overload declared function this is not allowed }
+           if { check if empty implementation arguments match is allowed }
+              (
+               not(m_repeat_forward in current_settings.modeswitches) and
+               not(currpd.forwarddef) and
+               is_bareprocdef(currpd) and
+               not(po_overload in fwpd.procoptions)
+              ) or
+              (
+                fwpd.is_generic and
+                currpd.is_generic and
+                equal_generic_procdefs(fwpd,currpd)
+              ) or
+              { check arguments, we need to check only the user visible parameters. The hidden parameters
+                can be in a different location because of the calling convention, eg. L-R vs. R-L order (PFV)
+
+                don't check default values here, because routines that are the same except for their default
+                values should be reported as mismatches (since you can't overload based on different default
+                parameter values) }
+              (
+               (compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and
+               (compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact)
+              ) then
+             begin
+               { Check if we've found the forwarddef, if found then
+                 we need to update the forward def with the current
+                 implementation settings }
+               if fwpd.forwarddef then
+                 begin
+                   forwardfound:=true;
+
+                   if not(m_repeat_forward in current_settings.modeswitches) and
+                      (fwpd.proccalloption<>currpd.proccalloption) then
+                     paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv]
+                   else
+                     paracompopt:=[cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv];
+
+                   { Check calling convention }
+                   if (fwpd.proccalloption<>currpd.proccalloption) then
+                    begin
+                      { In delphi it is possible to specify the calling
+                        convention in the interface or implementation if
+                        there was no convention specified in the other
+                        part }
+                      if (m_delphi in current_settings.modeswitches) then
+                        begin
+                          if not(po_hascallingconvention in currpd.procoptions) then
+                            currpd.proccalloption:=fwpd.proccalloption
+                          else
+                            if not(po_hascallingconvention in fwpd.procoptions) then
+                              fwpd.proccalloption:=currpd.proccalloption
+                          else
+                            begin
+                              MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
+                              tprocsym(currpd.procsym).write_parameter_lists(currpd);
+                              { restore interface settings }
+                              currpd.proccalloption:=fwpd.proccalloption;
+                            end;
+                        end
+                      else
+                        begin
+                          MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
+                          tprocsym(currpd.procsym).write_parameter_lists(currpd);
+                          { restore interface settings }
+                          currpd.proccalloption:=fwpd.proccalloption;
+                        end;
+                    end;
+
+                   { Check static }
+                   if (po_staticmethod in fwpd.procoptions) then
+                    begin
+                      if not (po_staticmethod in currpd.procoptions) then
+                       begin
+                         include(currpd.procoptions, po_staticmethod);
+                         if (po_classmethod in currpd.procoptions) then
+                          begin
+                           { remove self from the hidden paras }
+                           symentry:=currpd.parast.Find('self');
+                           if symentry<>nil then
+                            begin
+                              currpd.parast.Delete(symentry);
+                              currpd.calcparas;
+                            end;
+                          end;
+                       end;
+                    end;
+
+                   { Check if the procedure type and return type are correct,
+                     also the parameters must match also with the type and that
+                     if the implementation has default parameters, the interface
+                     also has them and that if they both have them, that they
+                     have the same value }
+                   if ((m_repeat_forward in current_settings.modeswitches) or
+                       not is_bareprocdef(currpd)) and
+                       (
+                         (
+                           fwpd.is_generic and
+                           currpd.is_generic and
+                           not equal_generic_procdefs(fwpd,currpd)
+                         ) or
+                         (
+                           (
+                             not fwpd.is_generic or
+                             not currpd.is_generic
+                           ) and
+                           (
+                             (compare_paras(fwpd.paras,currpd.paras,cp_all,paracompopt)<>te_exact) or
+                             (compare_defs(fwpd.returndef,currpd.returndef,nothingn)<>te_exact)
+                           )
+                         )
+                       ) then
+                     begin
+                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
+                                   fwpd.fullprocname(false));
+                       tprocsym(currpd.procsym).write_parameter_lists(currpd);
+                       break;
+                     end;
+
+                   { Check if both are declared forward }
+                   if fwpd.forwarddef and currpd.forwarddef then
+                    begin
+                      MessagePos1(currpd.fileinfo,parser_e_function_already_declared_public_forward,
+                                  currpd.fullprocname(false));
+                    end;
+
+                   { internconst or internproc only need to be defined once }
+                   if (fwpd.proccalloption=pocall_internproc) then
+                    currpd.proccalloption:=fwpd.proccalloption
+                   else
+                    if (currpd.proccalloption=pocall_internproc) then
+                     fwpd.proccalloption:=currpd.proccalloption;
+
+                   { Check procedure options, Delphi requires that class is
+                     repeated in the implementation for class methods }
+                   if (m_fpc in current_settings.modeswitches) then
+                     po_comp:=[po_classmethod,po_varargs,po_methodpointer,po_interrupt]
+                   else
+                     po_comp:=[po_classmethod,po_methodpointer];
+
+                   if ((po_comp * fwpd.procoptions)<>(po_comp * currpd.procoptions)) or
+                      (fwpd.proctypeoption <> currpd.proctypeoption) or
+                      { if the implementation version has an "overload" modifier,
+                        the interface version must also have it (otherwise we can
+                        get annoying crashes due to interface crc changes) }
+                      (not(po_overload in fwpd.procoptions) and
+                       (po_overload in currpd.procoptions)) then
+                     begin
+                       MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
+                                   fwpd.fullprocname(false));
+                       tprocsym(fwpd.procsym).write_parameter_lists(fwpd);
+                       { This error is non-fatal, we can recover }
+                     end;
+
+                   { Forward declaration is external? }
+                   if (po_external in fwpd.procoptions) then
+                     MessagePos(currpd.fileinfo,parser_e_proc_already_external);
+
+                   { check for conflicts with "virtual" if this is a virtual
+                     method, as "virtual" cannot be repeated in the
+                     implementation and hence does not get checked against }
+                   if (po_virtualmethod in fwpd.procoptions) then
+                     begin
+                       po_comp:=currpd.procoptions*PD_VIRTUAL_MUTEXCLPO;
+                       if po_comp<>[] then
+                         MessagePos2(currpd.fileinfo,parser_e_proc_dir_conflict,tokeninfo^[_VIRTUAL].str,get_first_proc_str(po_comp));
+                     end;
+                    { Check parameters }
+                   if (m_repeat_forward in current_settings.modeswitches) or
+                      (currpd.minparacount>0) then
+                    begin
+                      { If mangled names are equal then they have the same amount of arguments }
+                      { We can check the names of the arguments }
+                      { both symtables are in the same order from left to right }
+                      curridx:=0;
+                      fwidx:=0;
+                      currparacnt:=currpd.parast.SymList.Count;
+                      fwparacnt:=fwpd.parast.SymList.Count;
+                      repeat
+                        { skip default parameter constsyms }
+                        while (curridx<currparacnt) and
+                              (tsym(currpd.parast.SymList[curridx]).typ<>paravarsym) do
+                          inc(curridx);
+                        while (fwidx<fwparacnt) and
+                              (tsym(fwpd.parast.SymList[fwidx]).typ<>paravarsym) do
+                          inc(fwidx);
+                        { stop when one of the two lists is at the end }
+                        if (fwidx>=fwparacnt) or (curridx>=currparacnt) then
+                          break;
+                        { compare names of parameters, ignore implictly
+                          renamed parameters }
+                        currparasym:=tsym(currpd.parast.SymList[curridx]);
+                        fwparasym:=tsym(fwpd.parast.SymList[fwidx]);
+                        if not(sp_implicitrename in currparasym.symoptions) and
+                           not(sp_implicitrename in fwparasym.symoptions) then
+                          begin
+                            if (currparasym.name<>fwparasym.name) then
+                              begin
+                                MessagePos3(currpd.fileinfo,parser_e_header_different_var_names,
+                                            tprocsym(currpd.procsym).realname,fwparasym.realname,currparasym.realname);
+                                break;
+                              end;
+                          end;
+                        { next parameter }
+                        inc(curridx);
+                        inc(fwidx);
+                      until false;
+                    end;
+                   { check that the type parameter names for generic methods match;
+                     we check this here and not in equal_generic_procdefs as the defs
+                     might still be different due to their parameters, so we'd generate
+                     errors without any need }
+                   if currpd.is_generic and fwpd.is_generic then
+                     { an error here is recoverable, so we simply continue }
+                     check_generic_parameters(fwpd,currpd);
+                   { Everything is checked, now we can update the forward declaration
+                     with the new data from the implementation }
+                   fwpd.forwarddef:=currpd.forwarddef;
+                   fwpd.hasforward:=true;
+                   fwpd.procoptions:=fwpd.procoptions+currpd.procoptions;
+
+                   { marked as local but exported from unit? }
+                   if (po_kylixlocal in fwpd.procoptions) and (fwpd.owner.symtabletype=globalsymtable) then
+                     MessagePos(fwpd.fileinfo,type_e_cant_export_local);
+
+                   if fwpd.extnumber=$ffff then
+                     fwpd.extnumber:=currpd.extnumber;
+                   while not currpd.aliasnames.empty do
+                     fwpd.aliasnames.insert(currpd.aliasnames.getfirst);
+                   { update fileinfo so position references the implementation,
+                     also update funcretsym if it is already generated }
+                   fwpd.fileinfo:=currpd.fileinfo;
+                   if assigned(fwpd.funcretsym) then
+                     fwpd.funcretsym.fileinfo:=currpd.fileinfo;
+                   if assigned(currpd.deprecatedmsg) then
+                     begin
+                       stringdispose(fwpd.deprecatedmsg);
+                       fwpd.deprecatedmsg:=stringdup(currpd.deprecatedmsg^);
+                     end;
+                   { import names }
+                   if assigned(currpd.import_dll) then
+                     begin
+                       stringdispose(fwpd.import_dll);
+                       fwpd.import_dll:=stringdup(currpd.import_dll^);
+                     end;
+                   if assigned(currpd.import_name) then
+                     begin
+                       stringdispose(fwpd.import_name);
+                       fwpd.import_name:=stringdup(currpd.import_name^);
+                     end;
+                   fwpd.import_nr:=currpd.import_nr;
+                   { for compilerproc defines we need to rename and update the
+                     symbolname to lowercase so users can' access it (can't do
+                     it immediately, because then the implementation symbol
+                     won't be matched) }
+                   if po_compilerproc in fwpd.procoptions then
+                     begin
+                       fwpd.setcompilerprocname;
+                       current_module.add_public_asmsym(fwpd.procsym.realname,AB_GLOBAL,AT_FUNCTION);
+                     end;
+                   if po_public in fwpd.procoptions then
+                     begin
+                       item:=fwpd.aliasnames.first;
+                       while assigned(item) do
+                         begin
+                           current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
+                           item:=item.next;
+                         end;
+                     end;
+
+                   { Release current procdef }
+                   currpd.owner.deletedef(currpd);
+                   currpd:=fwpd;
+                 end
+               else
+                begin
+                  { abstract methods aren't forward defined, but this }
+                  { needs another error message                   }
+                  if (po_abstractmethod in fwpd.procoptions) then
+                    MessagePos(currpd.fileinfo,parser_e_abstract_no_definition)
+                  else
+                    begin
+                      MessagePos(currpd.fileinfo,parser_e_overloaded_have_same_parameters);
+                      tprocsym(currpd.procsym).write_parameter_lists(currpd);
+                    end;
+                 end;
+
+               { we found one proc with the same arguments, there are no others
+                 so we can stop }
+               break;
+             end;
+
+           { check for allowing overload directive }
+           if not(m_fpc in current_settings.modeswitches) then
+            begin
+              { overload directive turns on overloading }
+              if ((po_overload in currpd.procoptions) or
+                  (po_overload in fwpd.procoptions)) then
+               begin
+                 { check if all procs have overloading, but not if the proc is a method or
+                   already declared forward, then the check is already done }
+                 if not(fwpd.hasforward or
+                        assigned(currpd.struct) or
+                        (currpd.forwarddef<>fwpd.forwarddef) or
+                        ((po_overload in currpd.procoptions) and
+                         (po_overload in fwpd.procoptions))) then
+                  begin
+                    MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
+                    break;
+                  end
+               end
+              else
+               begin
+                 if not(fwpd.forwarddef) then
+                  begin
+                    if (m_tp7 in current_settings.modeswitches) then
+                      MessagePos(currpd.fileinfo,parser_e_procedure_overloading_is_off)
+                    else
+                      MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
+                    break;
+                  end;
+               end;
+            end; { equal arguments }
+         end;
+
+        { if we didn't reuse a forwarddef then we add the procdef to the overloaded
+          list }
+        if not forwardfound then
+          begin
+            { can happen in Delphi mode }
+            if (currpd.proctypeoption = potype_function) and
+               is_void(currpd.returndef) then
+              MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
+            tprocsym(currpd.procsym).ProcdefList.Add(currpd);
+            if not currpd.forwarddef and (po_public in currpd.procoptions) then
+              begin
+                item:=currpd.aliasnames.first;
+                while assigned(item) do
+                  begin
+                    current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
+                    item:=item.next;
+                  end;
+              end;
+          end;
+
+        proc_add_definition:=forwardfound;
+      end;
+
+
+    procedure build_parentfpstruct(pd: tprocdef);
+      var
+        nestedvars: tsym;
+        nestedvarsst: tsymtable;
+        pnestedvarsdef,
+        nestedvarsdef: tdef;
+        old_symtablestack: tsymtablestack;
+      begin
+        { make sure the defs are not registered in the current symtablestack,
+          because they may be for a parent procdef (changeowner does remove a def
+          from the symtable in which it was originally created, so that by itself
+          is not enough) }
+        old_symtablestack:=symtablestack;
+        symtablestack:=old_symtablestack.getcopyuntil(current_module.localsymtable);
+        { create struct to hold local variables and parameters that are
+          accessed from within nested routines (start with extra dollar to prevent
+          the JVM from thinking this is a nested class in the unit) }
+        nestedvarsst:=trecordsymtable.create('$'+current_module.realmodulename^+'$$_fpc_nestedvars$'+pd.unique_id_str,
+          current_settings.alignment.localalignmax,current_settings.alignment.localalignmin,current_settings.alignment.maxCrecordalign);
+        nestedvarsdef:=crecorddef.create(nestedvarsst.name^,nestedvarsst);
+  {$ifdef jvm}
+        maybe_guarantee_record_typesym(nestedvarsdef,nestedvarsdef.owner);
+        { don't add clone/FpcDeepCopy, because the field names are not all
+          representable in source form and we don't need them anyway }
+        symtablestack.push(trecorddef(nestedvarsdef).symtable);
+        maybe_add_public_default_java_constructor(trecorddef(nestedvarsdef));
+        insert_record_hidden_paras(trecorddef(nestedvarsdef));
+        symtablestack.pop(trecorddef(nestedvarsdef).symtable);
+  {$endif}
+        symtablestack.free;
+        symtablestack:=old_symtablestack.getcopyuntil(pd.localst);
+        pnestedvarsdef:=cpointerdef.getreusable(nestedvarsdef);
+        if not(po_assembler in pd.procoptions) then
+          begin
+            nestedvars:=clocalvarsym.create('$nestedvars',vs_var,nestedvarsdef,[],true);
+            include(nestedvars.symoptions,sp_internal);
+            pd.localst.insert(nestedvars);
+            pd.parentfpstruct:=nestedvars;
+            pd.parentfpinitblock:=cblocknode.create(nil);
+          end;
+        symtablestack.free;
+        pd.parentfpstructptrtype:=pnestedvarsdef;
+
+        symtablestack:=old_symtablestack;
+      end;
+
 end.

+ 1 - 1
compiler/ppcgen/cgppc.pas

@@ -673,7 +673,7 @@ unit cgppc;
       if not ((def.typ=pointerdef) or
              ((def.typ=orddef) and
               (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                        pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                                        pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
         begin
           if (current_settings.optimizecputype >= cpu_ppc970) or
              (current_settings.cputype >= cpu_ppc970) then

+ 2 - 2
compiler/ppcgen/ngppcadd.pas

@@ -199,8 +199,8 @@ implementation
         firstcomplex(self);
 
         cmpop:=false;
-        if (torddef(left.resultdef).ordtype in [pasbool8,bool8bit]) or
-           (torddef(right.resultdef).ordtype in [pasbool8,bool8bit]) then
+        if (torddef(left.resultdef).ordtype in [pasbool1,pasbool8,bool8bit]) or
+           (torddef(right.resultdef).ordtype in [pasbool1,pasbool8,bool8bit]) then
           cgsize:=OS_8
         else if (torddef(left.resultdef).ordtype in [pasbool16,bool16bit]) or
            (torddef(right.resultdef).ordtype in [pasbool16,bool16bit]) then

+ 1 - 1
compiler/ppu.pas

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

+ 88 - 0
compiler/procdefutil.pas

@@ -0,0 +1,88 @@
+{
+    Copyright (c) 2018 by Jonas Maebe
+
+    This unit provides helpers for creating procdefs
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{$i fpcdefs.inc}
+unit procdefutil;
+
+interface
+
+uses
+  symconst,symtype,symdef;
+
+{ create a nested procdef that will be used to outline code from a procedure;
+  astruct should usually be nil, except in special cases like the Windows SEH
+  exception handling funclets }
+function create_outline_procdef(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef): tprocdef;
+
+implementation
+
+  uses
+    cutils,
+    symbase,symsym,symtable,pparautl;
+
+
+  function create_outline_procdef(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef): tprocdef;
+    var
+      st:TSymTable;
+      checkstack: psymtablestackitem;
+      oldsymtablestack: tsymtablestack;
+      sym:tprocsym;
+    begin
+      { get actual procedure symtable (skip withsymtables, etc.) }
+      st:=nil;
+      checkstack:=symtablestack.stack;
+      while assigned(checkstack) do
+        begin
+          st:=checkstack^.symtable;
+          if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then
+            break;
+          checkstack:=checkstack^.next;
+        end;
+      { Create a nested procedure, even from main_program_level.
+        Furthermore, force procdef and procsym into the same symtable
+        (by default, defs are registered with symtablestack.top which may be
+        something temporary like exceptsymtable - in that case, procdef can be
+        destroyed before procsym, leaving invalid pointers). }
+      oldsymtablestack:=symtablestack;
+      symtablestack:=nil;
+      result:=cprocdef.create(max(normal_function_level,st.symtablelevel)+1,true);
+      result.returndef:=resultdef;
+      symtablestack:=oldsymtablestack;
+      st.insertdef(result);
+      result.struct:=astruct;
+      { tabstractprocdef constructor sets po_delphi_nested_cc whenever
+        nested procvars modeswitch is active. We must be independent of this switch. }
+      exclude(result.procoptions,po_delphi_nested_cc);
+      result.proctypeoption:=potype;
+      handle_calling_convention(result,hcc_default_actions_impl);
+      sym:=cprocsym.create(basesymname+result.unique_id_str);
+      st.insert(sym);
+
+      result.procsym:=sym;
+      proc_add_definition(result);
+      { the code will be assigned directly to the "code" field later }
+      result.forwarddef:=false;
+      result.aliasnames.insert(result.mangledname);
+    end;
+
+
+end.
+

+ 17 - 2
compiler/procinfo.pas

@@ -31,7 +31,8 @@ unit procinfo;
       { global }
       globtype,
       { symtable }
-      symconst,symdef,symsym,
+      symconst,symtype,symdef,symsym,
+      node,
       { aasm }
       cpubase,cgbase,cgutils,
       aasmbase,aasmdata;
@@ -160,6 +161,8 @@ unit procinfo;
           function has_nestedprocs: boolean;
           function get_normal_proc: tprocinfo;
 
+          function create_for_outlining(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef; entrynodeinfo: tnode): tprocinfo;
+
           { Add to parent's list of nested procedures even if parent is a 'main' procedure }
           procedure force_nested;
 
@@ -181,7 +184,8 @@ unit procinfo;
 implementation
 
     uses
-      cutils,systems;
+      globals,cutils,systems,
+      procdefutil;
 
 {****************************************************************************
                                  TProcInfo
@@ -265,6 +269,17 @@ implementation
           result:=result.parent;
       end;
 
+    function tprocinfo.create_for_outlining(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef; entrynodeinfo: tnode): tprocinfo;
+      begin
+        result:=cprocinfo.create(self);
+        result.force_nested;
+        result.procdef:=create_outline_procdef(basesymname,astruct,potype,resultdef);
+        result.entrypos:=entrynodeinfo.fileinfo;
+        result.entryswitches:=entrynodeinfo.localswitches;
+        result.exitpos:=current_filepos; // filepos of last node?
+        result.exitswitches:=current_settings.localswitches; // localswitches of last node?
+      end;
+
     procedure tprocinfo.allocate_push_parasize(size:longint);
       begin
         if size>maxpushedparasize then

+ 0 - 2
compiler/pstatmnt.pas

@@ -776,8 +776,6 @@ implementation
               symtablestack.pop(TSymtable(withsymtablelist[i]));
             withsymtablelist.free;
 
-//            p:=cwithnode.create(right,twithsymtable(withsymtable),levelcount,refnode);
-
             { Finalize complex withnode with destroy of temp }
             if assigned(newblock) then
              begin

+ 20 - 10
compiler/psub.pas

@@ -895,6 +895,18 @@ implementation
         addstatement(newstatement,entry_asmnode);
         cnodeutils.procdef_block_add_implicit_initialize_nodes(procdef,newstatement);
         addstatement(newstatement,init_asmnode);
+        if assigned(procdef.parentfpinitblock) then
+          begin
+            if assigned(tblocknode(procdef.parentfpinitblock).left) then
+              begin
+                { could be an asmn in case of a pure assembler procedure,
+                  but those shouldn't access nested variables }
+                addstatement(newstatement,procdef.parentfpinitblock);
+              end
+            else
+              procdef.parentfpinitblock.free;
+            procdef.parentfpinitblock:=nil;
+          end;
         addstatement(newstatement,bodyentrycode);
 
         if (cs_implicit_exceptions in current_settings.moduleswitches) and
@@ -1812,6 +1824,7 @@ implementation
          old_current_structdef: tabstractrecorddef;
          old_current_genericdef,
          old_current_specializedef: tstoreddef;
+         parentfpinitblock: tnode;
          old_parse_generic: boolean;
          recordtokens : boolean;
 
@@ -1924,16 +1937,10 @@ implementation
                begin
                  if assigned(tblocknode(procdef.parentfpinitblock).left) then
                    begin
-                     { could be an asmn in case of a pure assembler procedure,
-                       but those shouldn't access nested variables }
-                     if code.nodetype<>blockn then
-                       internalerror(2015122601);
-                     tblocknode(code).left:=cstatementnode.create(procdef.parentfpinitblock,tblocknode(code).left);
-                     do_typecheckpass(tblocknode(code).left);
+                     parentfpinitblock:=procdef.parentfpinitblock;
+                     do_typecheckpass(parentfpinitblock);
+                     procdef.parentfpinitblock:=parentfpinitblock;
                    end
-                 else
-                   procdef.parentfpinitblock.free;
-                 procdef.parentfpinitblock:=nil;
                end;
 
            end;
@@ -2187,7 +2194,10 @@ implementation
               Consume(_SEMICOLON);
 
              { Set calling convention }
-             handle_calling_convention(pd);
+             if parse_only then
+               handle_calling_convention(pd,hcc_default_actions_intf)
+             else
+               handle_calling_convention(pd,hcc_default_actions_impl)
            end;
 
          { search for forward declarations }

+ 10 - 7
compiler/psystem.pas

@@ -110,8 +110,8 @@ implementation
         systemunit.insert(csyssym.create('Insert',in_insert_x_y_z));
         systemunit.insert(csyssym.create('Delete',in_delete_x_y_z));
         systemunit.insert(csyssym.create('GetTypeKind',in_gettypekind_x));
-        systemunit.insert(cconstsym.create_ord('False',constord,0,pasbool8type));
-        systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool8type));
+        systemunit.insert(cconstsym.create_ord('False',constord,0,pasbool1type));
+        systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool1type));
       end;
 
 
@@ -271,6 +271,7 @@ implementation
           implement overflow checking }
         u128inttype:=corddef.create(u128bit,0,0,true);
         s128inttype:=corddef.create(s128bit,0,0,true);
+        pasbool1type:=corddef.create(pasbool1,0,1,true);
         pasbool8type:=corddef.create(pasbool8,0,1,true);
         pasbool16type:=corddef.create(pasbool16,0,1,true);
         pasbool32type:=corddef.create(pasbool32,0,1,true);
@@ -280,7 +281,7 @@ implementation
         bool32type:=corddef.create(bool32bit,low(int64),high(int64),true);
         bool64type:=corddef.create(bool64bit,low(int64),high(int64),true);
 {$ifdef llvm}
-        llvmbool1type:=corddef.create(pasbool8,0,1,true);
+        llvmbool1type:=corddef.create(pasbool1,0,1,true);
 {$endif llvm}
         cansichartype:=corddef.create(uchar,0,255,true);
         cwidechartype:=corddef.create(uwidechar,0,65535,true);
@@ -451,7 +452,8 @@ implementation
         addtype('UnicodeString',cunicodestringtype);
 
         addtype('OpenString',openshortstringtype);
-        addtype('Boolean',pasbool8type);
+        addtype('Boolean',pasbool1type);
+        addtype('Boolean8',pasbool8type);
         addtype('Boolean16',pasbool16type);
         addtype('Boolean32',pasbool32type);
         addtype('Boolean64',pasbool64type);
@@ -503,7 +505,8 @@ implementation
         addtype('$widestring',cwidestringtype);
         addtype('$unicodestring',cunicodestringtype);
         addtype('$openshortstring',openshortstringtype);
-        addtype('$boolean',pasbool8type);
+        addtype('$boolean',pasbool1type);
+        addtype('$boolean8',pasbool8type);
         addtype('$boolean16',pasbool16type);
         addtype('$boolean32',pasbool32type);
         addtype('$boolean64',pasbool64type);
@@ -649,7 +652,8 @@ implementation
             loadtype('sc80real',sc80floattype);
           end;
         loadtype('s64currency',s64currencytype);
-        loadtype('boolean',pasbool8type);
+        loadtype('boolean',pasbool1type);
+        loadtype('boolean8',pasbool8type);
         loadtype('boolean16',pasbool16type);
         loadtype('boolean32',pasbool32type);
         loadtype('boolean64',pasbool64type);
@@ -761,7 +765,6 @@ implementation
         nodeclass[whilerepeatn]:=cwhilerepeatnode;
         nodeclass[forn]:=cfornode;
         nodeclass[exitn]:=cexitnode;
-        nodeclass[withn]:=cwithnode;
         nodeclass[casen]:=ccasenode;
         nodeclass[labeln]:=clabelnode;
         nodeclass[goton]:=cgotonode;

+ 4 - 4
compiler/ptype.pas

@@ -82,7 +82,7 @@ implementation
        nset,ncnv,ncon,nld,
        { parser }
        scanner,
-       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil
+       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil,pparautl
 {$ifdef jvm}
        ,pjvm
 {$endif}
@@ -1129,7 +1129,7 @@ implementation
                                def:=corddef.create(uchar,lv,hv,true)
                              else
                                if is_boolean(pt1.resultdef) then
-                                 def:=corddef.create(pasbool8,lv,hv,true)
+                                 def:=corddef.create(pasbool1,lv,hv,true)
                                else if is_signed(pt1.resultdef) then
                                  def:=corddef.create(range_to_basetype(lv,hv),lv,hv,true)
                                else
@@ -1335,7 +1335,7 @@ implementation
 {$ifdef cpu64bitaddr}
                     u32bit,s64bit,
 {$endif cpu64bitaddr}
-                    pasbool8,pasbool16,pasbool32,pasbool64,
+                    pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
                     bool8bit,bool16bit,bool32bit,bool64bit,
                     uwidechar] then
                     begin
@@ -1596,7 +1596,7 @@ implementation
                     newtype.free;
                   end;
                 { Add implicit hidden parameters and function result }
-                handle_calling_convention(pd);
+                handle_calling_convention(pd,hcc_default_actions_intf);
               end;
             { restore old state }
             parse_generic:=old_parse_generic;

+ 1 - 1
compiler/scanner.pas

@@ -925,7 +925,7 @@ type
         that we use the base types instead of the cpu-specific ones. }
       sintdef:=torddef.create(s64bit,low(int64),high(int64),false);
       uintdef:=torddef.create(u64bit,low(qword),high(qword),false);
-      booldef:=torddef.create(pasbool8,0,1,false);
+      booldef:=torddef.create(pasbool1,0,1,false);
       strdef:=tstringdef.createansi(0,false);
       setdef:=tsetdef.create(sintdef,0,255,false);
       realdef:=tfloatdef.create(s80real,false);

+ 1 - 1
compiler/sparcgen/cgsparc.pas

@@ -960,7 +960,7 @@ implementation
               if not((def.typ=pointerdef) or
                     ((def.typ=orddef) and
                      (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                               pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                                               pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
                 begin
                   ai:=TAiCpu.Op_sym(A_Bxx,hl);
                   ai.SetCondition(C_VC);

+ 1 - 1
compiler/symconst.pas

@@ -269,7 +269,7 @@ type
     uvoid,
     u8bit,u16bit,u32bit,u64bit,u128bit,
     s8bit,s16bit,s32bit,s64bit,s128bit,
-    pasbool8,pasbool16,pasbool32,pasbool64,
+    pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
     bool8bit,bool16bit,bool32bit,bool64bit,
     uchar,uwidechar,scurrency
   );

+ 22 - 84
compiler/symcreat.pas

@@ -97,10 +97,6 @@ interface
     tprocdef.getcopyas(procdef,pc_bareproc) }
   procedure finish_copied_procdef(var pd: tprocdef; const realname: string; newparentst: tsymtable; newstruct: tabstractrecorddef);
 
-  { create "parent frame pointer" record skeleton for procdef, in which local
-    variables and parameters from pd accessed from nested routines can be
-    stored }
-  procedure build_parentfpstruct(pd: tprocdef);
   { checks whether sym (a local or para of pd) already has a counterpart in
     pd's parentfpstruct, and if not adds a new field to the struct with type
     "vardef" (can be different from sym's type in case it's a call-by-reference
@@ -118,8 +114,6 @@ interface
   { finalises the parentfpstruct (alignment padding, ...) }
   procedure finish_parentfpstruct(pd: tprocdef);
 
-  procedure maybe_guarantee_record_typesym(var def: tdef; st: tsymtable);
-
   { turns a fieldvarsym into a class/static field definition, and returns the
     created staticvarsym that is responsible for allocating the global storage }
   function make_field_static(recst: tsymtable; fieldvs: tfieldvarsym): tstaticvarsym;
@@ -131,11 +125,13 @@ interface
 
   function generate_pkg_stub(pd:tprocdef):tnode;
 
+
+
 implementation
 
   uses
     cutils,cclasses,globals,verbose,systems,comphook,fmodule,constexp,
-    symtable,defutil,
+    symtable,defutil,symutil,
     pbase,pdecobj,pdecsub,psub,ptconst,pparautl,
 {$ifdef jvm}
     pjvm,jvmdef,
@@ -515,7 +511,7 @@ implementation
     end;
 
 
-  procedure addvisibibleparameters(var str: ansistring; pd: tprocdef);
+  procedure addvisibleparameters(var str: ansistring; pd: tprocdef);
     var
       currpara: tparavarsym;
       i: longint;
@@ -530,7 +526,7 @@ implementation
               if not firstpara then
                 str:=str+',';
               firstpara:=false;
-              str:=str+currpara.realname;
+              str:=str+'&'+currpara.realname;
             end;
         end;
     end;
@@ -554,7 +550,7 @@ implementation
         mnetion this program/unit name to avoid accidentally calling other
         same-named routines that may be in scope }
       str:=str+def_unit_name_prefix_if_toplevel(callpd)+callpd.procsym.realname+'(';
-      addvisibibleparameters(str,pd);
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       str_parse_method_impl(str,pd,isclassmethod);
     end;
@@ -862,7 +858,7 @@ implementation
          not is_void(pd.returndef) then
         str:=str+'result:=';
       str:=str+'pv(';
-      addvisibibleparameters(str,pd);
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       str_parse_method_impl(str,pd,true)
     end;
@@ -964,7 +960,7 @@ implementation
       if pd.returndef<>voidtype then
         str:=str+'result:=';
       str:=str+'__FPC_BLOCK_INVOKE_PV_TYPE(PFPC_Block_literal_complex_procvar(FPC_Block_Self)^.pv)(';
-      addvisibibleparameters(str,pd);
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       str_parse_method_impl(str,pd,false);
     end;
@@ -988,8 +984,8 @@ implementation
       { now call through to the actual method }
       if pd.returndef<>voidtype then
         str:=str+'result:=';
-      str:=str+callthroughpd.procsym.realname+'(';
-      addvisibibleparameters(str,callthroughpd);
+      str:=str+'&'+callthroughpd.procsym.realname+'(';
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       { add dummy file info so we can step in/through it }
       if pd.owner.iscurrentunit then
@@ -1147,8 +1143,11 @@ implementation
   function create_procdef_alias(pd: tprocdef; const newrealname: string; const newmangledname: TSymStr; newparentst: tsymtable; newstruct: tabstractrecorddef;
       sk: tsynthetickind; skpara: pointer): tprocdef;
     begin
-      { bare copy so we don't copy the aliasnames }
-      result:=tprocdef(pd.getcopyas(procdef,pc_bareproc));
+      { bare copy so we don't copy the aliasnames (specify prefix for
+        parameter names so we don't get issues in the body in case
+        we e.g. reference system.initialize and one of the parameters
+        is called "system") }
+      result:=tprocdef(pd.getcopyas(procdef,pc_bareproc,'__FPCW_'));
       { set the mangled name to the wrapper name }
       result.setmangledname(newmangledname);
       { finish creating the copy }
@@ -1225,52 +1224,6 @@ implementation
     end;
 
 
-  procedure build_parentfpstruct(pd: tprocdef);
-    var
-      nestedvars: tsym;
-      nestedvarsst: tsymtable;
-      pnestedvarsdef,
-      nestedvarsdef: tdef;
-      old_symtablestack: tsymtablestack;
-    begin
-      { make sure the defs are not registered in the current symtablestack,
-        because they may be for a parent procdef (changeowner does remove a def
-        from the symtable in which it was originally created, so that by itself
-        is not enough) }
-      old_symtablestack:=symtablestack;
-      symtablestack:=old_symtablestack.getcopyuntil(current_module.localsymtable);
-      { create struct to hold local variables and parameters that are
-        accessed from within nested routines (start with extra dollar to prevent
-        the JVM from thinking this is a nested class in the unit) }
-      nestedvarsst:=trecordsymtable.create('$'+current_module.realmodulename^+'$$_fpc_nestedvars$'+pd.unique_id_str,
-        current_settings.alignment.localalignmax,current_settings.alignment.localalignmin,current_settings.alignment.maxCrecordalign);
-      nestedvarsdef:=crecorddef.create(nestedvarsst.name^,nestedvarsst);
-{$ifdef jvm}
-      maybe_guarantee_record_typesym(nestedvarsdef,nestedvarsdef.owner);
-      { don't add clone/FpcDeepCopy, because the field names are not all
-        representable in source form and we don't need them anyway }
-      symtablestack.push(trecorddef(nestedvarsdef).symtable);
-      maybe_add_public_default_java_constructor(trecorddef(nestedvarsdef));
-      insert_record_hidden_paras(trecorddef(nestedvarsdef));
-      symtablestack.pop(trecorddef(nestedvarsdef).symtable);
-{$endif}
-      symtablestack.free;
-      symtablestack:=old_symtablestack.getcopyuntil(pd.localst);
-      pnestedvarsdef:=cpointerdef.getreusable(nestedvarsdef);
-      if not(po_assembler in pd.procoptions) then
-        begin
-          nestedvars:=clocalvarsym.create('$nestedvars',vs_var,nestedvarsdef,[],true);
-          pd.localst.insert(nestedvars);
-          pd.parentfpstruct:=nestedvars;
-          pd.parentfpinitblock:=cblocknode.create(nil);
-        end;
-      symtablestack.free;
-      pd.parentfpstructptrtype:=pnestedvarsdef;
-
-      symtablestack:=old_symtablestack;
-    end;
-
-
   function maybe_add_sym_to_parentfpstruct(pd: tprocdef; sym: tsym; vardef: tdef; addrparam: boolean): tsym;
     var
       fieldvardef,
@@ -1396,26 +1349,6 @@ implementation
     end;
 
 
-  procedure maybe_guarantee_record_typesym(var def: tdef; st: tsymtable);
-    var
-      ts: ttypesym;
-    begin
-      { create a dummy typesym for the JVM target, because the record
-        has to be wrapped by a class }
-      if (target_info.system in systems_jvm) and
-         (def.typ=recorddef) and
-         not assigned(def.typesym) then
-        begin
-          ts:=ctypesym.create(trecorddef(def).symtable.realname^,def,true);
-          st.insert(ts);
-          ts.visibility:=vis_strictprivate;
-          { this typesym can't be used by any Pascal code, so make sure we don't
-            print a hint about it being unused }
-          addsymref(ts);
-        end;
-    end;
-
-
   function make_field_static(recst: tsymtable; fieldvs: tfieldvarsym): tstaticvarsym;
     var
       static_name: string;
@@ -1481,7 +1414,10 @@ implementation
         because there may already be references to the mangled name for the
         non-external "test".
       }
-      newpd:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc));
+
+      { prefixing the parameters here is useless, because the new procdef will
+        just be an external declaration without a body }
+      newpd:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,''));
       insert_funcret_para(newpd);
       newpd.procoptions:=newpd.procoptions+orgpd.procoptions*[po_external,po_has_importname,po_has_importdll];
       newpd.import_name:=orgpd.import_name;
@@ -1493,6 +1429,9 @@ implementation
       newpd.setmangledname(newname);
       finish_copied_procdef(newpd,'__FPC_IMPL_EXTERNAL_REDIRECT_'+newname,current_module.localsymtable,nil);
       newpd.forwarddef:=false;
+      { ideally we would prefix the parameters of the original routine here, but since it
+        can be an interface definition, we cannot do that without risking to change the
+        interface crc }
       orgpd.skpara:=newpd;
       orgpd.synthetickind:=tsk_callthrough;
       orgpd.procoptions:=orgpd.procoptions-[po_external,po_has_importname,po_has_importdll];
@@ -1514,6 +1453,5 @@ implementation
         result:=cnothingnode.create;
     end;
 
-
 end.
 

+ 60 - 22
compiler/symdef.pas

@@ -158,6 +158,7 @@ interface
           function  getmangledparaname:TSymStr;override;
           function  size:asizeint;override;
           procedure setsize;
+          function alignment: shortint; override;
        end;
        tfiledefclass = class of tfiledef;
 
@@ -629,7 +630,7 @@ interface
           function  is_addressonly:boolean;virtual;
           function  no_self_node:boolean;
           { get either a copy as a procdef or procvardef }
-          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp): tstoreddef; virtual;
+          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef; virtual;
           function  compatible_with_pointerdef_size(ptr: tpointerdef): boolean; virtual;
           procedure check_mark_as_nested;
           procedure init_paraloc_info(side: tcallercallee);
@@ -667,7 +668,7 @@ interface
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           function  getmangledparaname:TSymStr;override;
-          function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+          function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
        end;
        tprocvardefclass = class of tprocvardef;
 
@@ -812,11 +813,12 @@ interface
                 needs to be finalised afterwards by calling
                 symcreat.finish_copied_procdef() afterwards
           }
-          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp): tstoreddef; override;
+          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef; override;
           function  getcopy: tstoreddef; override;
           function  GetTypeName : string;override;
           function  mangledname : TSymStr; virtual;
           procedure setmangledname(const s : TSymStr);
+          procedure setcompilerprocname;
           function  fullprocname(showhidden:boolean):string;
           function  customprocname(pno: tprocnameoptions):ansistring;
           function  defaultmangledname: TSymStr;
@@ -956,6 +958,7 @@ interface
           procedure deref;override;
           function  GetTypeName:string;override;
           function  is_publishable : boolean;override;
+          function alignment: shortint; override;
        end;
        tsetdefclass = class of tsetdef;
 
@@ -1039,7 +1042,8 @@ interface
        voidtype,                  { Void (procedure) }
        cansichartype,             { Char }
        cwidechartype,             { WideChar }
-       pasbool8type,              { boolean type }
+       pasbool1type,              { boolean type }
+       pasbool8type,
        pasbool16type,
        pasbool32type,
        pasbool64type,
@@ -2704,8 +2708,8 @@ implementation
             if (minval>=0) then
               sizeval:=maxval
             else
-              { don't count 0 twice }
-              sizeval:=(cutils.max(-minval,maxval)*2)-1;
+             { don't count 0 twice, but take into account that range goes from -n-1..n }
+              sizeval:=(cutils.max(-minval,maxval+1)*2)-1;
             { 256 must become 512 etc. }
             nextpowerof2(sizeval+1,power);
             result := power;
@@ -2886,7 +2890,7 @@ implementation
           0,
           1,2,4,8,16,
           1,2,4,8,16,
-          1,2,4,8,
+          1,1,2,4,8,
           1,2,4,8,
           1,2,8
         );
@@ -2917,7 +2921,7 @@ implementation
             (low >= 0) and
             (high <= 1)
            ) or (
-             ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]
+             ordtype in [pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]
            ) then
           result := 1
         else
@@ -2925,8 +2929,8 @@ implementation
             if (low>=0) then
               sizeval:=high
             else
-              { don't count 0 twice }
-              sizeval:=(cutils.max(-low,high)*2)-1;
+              { don't count 0 twice, but take into account that range goes from -n-1..n }
+              sizeval:=(cutils.max(-low,high+1)*2)-1;
             { 256 must become 512 etc. }
             nextpowerof2(sizeval+1,power);
             result := power;
@@ -2940,7 +2944,7 @@ implementation
           varUndefined,
           varbyte,varword,varlongword,varqword,varUndefined,
           varshortint,varsmallint,varinteger,varint64,varUndefined,
-          varboolean,varboolean,varboolean,varboolean,
+          varboolean,varboolean,varboolean,varboolean,varboolean,
           varboolean,varboolean,varUndefined,varUndefined,
           varUndefined,varUndefined,varCurrency);
       begin
@@ -2970,7 +2974,7 @@ implementation
           'untyped',
           'Byte','Word','DWord','QWord','UInt128',
           'ShortInt','SmallInt','LongInt','Int64','Int128',
-          'Boolean','Boolean16','Boolean32','Boolean64',
+          'Boolean','Boolean8','Boolean16','Boolean32','Boolean64',
           'ByteBool','WordBool','LongBool','QWordBool',
           'Char','WideChar','Currency');
 
@@ -3201,6 +3205,20 @@ implementation
       end;
 
 
+    function tfiledef.alignment: shortint;
+      begin
+        case filetyp of
+          ft_text:
+            result:=search_system_type('TEXTREC').typedef.alignment;
+          ft_typed,
+          ft_untyped:
+            result:=search_system_type('FILEREC').typedef.alignment;
+          else
+            internalerror(2018120101);
+          end;
+      end;
+
+
     procedure tfiledef.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwrite(ppufile);
@@ -3654,6 +3672,13 @@ implementation
          is_publishable:=savesize in [1,2,4];
       end;
 
+    function tsetdef.alignment: shortint;
+      begin
+        Result:=inherited;
+        if result>sizeof(aint) then
+          result:=sizeof(aint);
+      end;
+
 
     function tsetdef.GetTypeName : string;
       begin
@@ -5120,7 +5145,7 @@ implementation
       end;
 
 
-    function tabstractprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp): tstoreddef;
+    function tabstractprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef;
       var
         j, nestinglevel: longint;
         pvs, npvs: tparavarsym;
@@ -5153,8 +5178,15 @@ implementation
                   if (copytyp=pc_bareproc) and
                      (([vo_is_self,vo_is_vmt,vo_is_parentfp,vo_is_result,vo_is_funcret]*pvs.varoptions)<>[]) then
                     continue;
-                  npvs:=cparavarsym.create(pvs.realname,pvs.paranr,pvs.varspez,
-                    pvs.vardef,pvs.varoptions);
+                  if paraprefix='' then
+                    npvs:=cparavarsym.create(pvs.realname,pvs.paranr,pvs.varspez,
+                      pvs.vardef,pvs.varoptions)
+                  else if not(vo_is_high_para in pvs.varoptions) then
+                    npvs:=cparavarsym.create(paraprefix+pvs.realname,pvs.paranr,pvs.varspez,
+                      pvs.vardef,pvs.varoptions)
+                  else
+                    npvs:=cparavarsym.create('$high'+paraprefix+copy(pvs.name,5,length(pvs.name)),pvs.paranr,pvs.varspez,
+                      pvs.vardef,pvs.varoptions);
                   npvs.defaultconstsym:=pvs.defaultconstsym;
                   tabstractprocdef(result).parast.insert(npvs);
                 end;
@@ -6036,11 +6068,11 @@ implementation
       end;
 
 
-    function tprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+    function tprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
       var
         j : longint;
       begin
-        result:=inherited getcopyas(newtyp,copytyp);
+        result:=inherited;
         if newtyp=procvardef then
           begin
             { create new paralist }
@@ -6107,7 +6139,7 @@ implementation
 
     function tprocdef.getcopy: tstoreddef;
       begin
-        result:=getcopyas(procdef,pc_normal);
+        result:=getcopyas(procdef,pc_normal,'');
       end;
 
 
@@ -6231,14 +6263,14 @@ implementation
              '',
              'Uc','Us','Ui','Us','',
              'Sc','s','i','x','',
-             'b','b','b','b','b',
+             'b','b','b','b','b','b',
              'c','w','x');
 {$else NAMEMANGLING_GCC2}
            ordtype2str : array[tordtype] of string[1] = (
              'v',
              'h','t','j','y','',
              'a','s','i','x','',
-             'b','b','b','b',
+             'b','b','b','b','b',
              'b','b','b','b',
              'c','w','x');
 
@@ -6437,6 +6469,12 @@ implementation
       end;
 
 
+    procedure tprocdef.setcompilerprocname;
+      begin
+        procsym.realname:='$'+lower(procsym.name);
+      end;
+
+
 {***************************************************************************
                                  TPROCVARDEF
 ***************************************************************************}
@@ -6466,7 +6504,7 @@ implementation
             { do not simply push/pop current_module.localsymtable, because
               that can have side-effects (e.g., it removes helpers) }
             symtablestack:=nil;
-            result:=tprocvardef(def.getcopyas(procvardef,pc_address_only));
+            result:=tprocvardef(def.getcopyas(procvardef,pc_address_only,''));
             setup_reusable_def(def,result,res,oldsymtablestack);
             { res^.Data may still be nil -> don't overwrite result }
             exit;
@@ -6605,7 +6643,7 @@ implementation
       end;
 
 
-    function tprocvardef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+    function tprocvardef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
       begin
         result:=inherited;
         tabstractprocdef(result).calcparas;

+ 49 - 3
compiler/symutil.pas

@@ -26,18 +26,24 @@ unit symutil;
 interface
 
     uses
-       symbase,symsym;
+       symconst,symbase,symtype,symsym;
 
     function is_funcret_sym(p:TSymEntry):boolean;
 
     function equal_constsym(sym1,sym2:tconstsym; nanequal: boolean):boolean;
 
+    function get_first_proc_str(Options: TProcOptions): ShortString;
+
+    procedure maybe_guarantee_record_typesym(var def: tdef; st: tsymtable);
+
 
 implementation
 
     uses
-       globtype,cpuinfo,constexp,
-       symconst,widestr;
+       systems,
+       globtype,cpuinfo,constexp,verbose,
+       widestr,
+       symdef;
 
 
     function is_funcret_sym(p:TSymEntry):boolean;
@@ -95,5 +101,45 @@ implementation
         end;
       end;
 
+
+    { get_first_proc_str - returns the token string of the first option that
+      appears in the list }
+    function get_first_proc_str(Options: TProcOptions): ShortString;
+      var
+        X: TProcOption;
+      begin
+        if Options = [] then
+          InternalError(2018051700);
+
+        get_first_proc_str := '';
+
+        for X in Options do
+          begin
+            get_first_proc_str := ProcOptionKeywords[X];
+            Exit;
+          end;
+      end;
+
+
+    procedure maybe_guarantee_record_typesym(var def: tdef; st: tsymtable);
+      var
+        ts: ttypesym;
+      begin
+        { create a dummy typesym for the JVM target, because the record
+          has to be wrapped by a class }
+        if (target_info.system in systems_jvm) and
+           (def.typ=recorddef) and
+           not assigned(def.typesym) then
+          begin
+            ts:=ctypesym.create(trecorddef(def).symtable.realname^,def,true);
+            st.insert(ts);
+            ts.visibility:=vis_strictprivate;
+            { this typesym can't be used by any Pascal code, so make sure we don't
+              print a hint about it being unused }
+            include(ts.symoptions,sp_internal);
+          end;
+      end;
+
+
 end.
 

+ 3 - 3
compiler/systems/i_android.pas

@@ -145,7 +145,7 @@ unit i_android;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -211,7 +211,7 @@ unit i_android;
                  loopalign       : 4;
                  jumpalign       : 0;
                  constalignmin   : 0;
-                 constalignmax   : 8;
+                 constalignmax   : 16;
                  varalignmin     : 0;
                  varalignmax     : 16;
                  localalignmin   : 4;
@@ -277,7 +277,7 @@ unit i_android;
                  loopalign       : 8;
                  jumpalign       : 0;
                  constalignmin   : 0;
-                 constalignmax   : 8;
+                 constalignmax   : 16;
                  varalignmin     : 0;
                  varalignmax     : 16;
                  localalignmin   : 4;

+ 3 - 3
compiler/systems/i_aros.pas

@@ -76,7 +76,7 @@ unit i_aros;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 0;
@@ -139,7 +139,7 @@ unit i_aros;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -201,7 +201,7 @@ unit i_aros;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 0;

+ 12 - 12
compiler/systems/i_bsd.pas

@@ -174,7 +174,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -241,7 +241,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -305,7 +305,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -368,7 +368,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -435,7 +435,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -629,7 +629,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -820,7 +820,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 0;
@@ -885,11 +885,11 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 0;
-                localalignmax   : 8;
+                localalignmax   : 16;
                 recordalignmin  : 0;
                 recordalignmax  : 16;
                 maxCrecordalign : 16
@@ -1015,7 +1015,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -1079,7 +1079,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -1208,7 +1208,7 @@ unit i_bsd;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;

+ 2 - 2
compiler/systems/i_embed.pas

@@ -275,7 +275,7 @@ unit i_embed;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -339,7 +339,7 @@ unit i_embed;
                 loopalign       : 8;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;

+ 3 - 3
compiler/systems/i_linux.pas

@@ -82,7 +82,7 @@ unit i_linux;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -408,7 +408,7 @@ unit i_linux;
                 loopalign       : 8;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -879,7 +879,7 @@ unit i_linux;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;

+ 2 - 2
compiler/systems/i_sunos.pas

@@ -79,7 +79,7 @@ unit i_sunos;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -148,7 +148,7 @@ unit i_sunos;
                 loopalign       : 4;
                 jumpalign       : 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;

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

@@ -3068,6 +3068,12 @@ begin
                    orddef.OrdType:=otSInt;
                    orddef.Size:=16;
                  end;
+               pasbool1:
+                 begin
+                   writeln('pasbool1');
+                   orddef.OrdType:=otPasBool;
+                   orddef.Size:=1;
+                 end;
                pasbool8:
                  begin
                    writeln('pasbool8');

+ 1 - 1
compiler/x86/cgx86.pas

@@ -3633,7 +3633,7 @@ unit cgx86;
          if not ((def.typ=pointerdef) or
                 ((def.typ=orddef) and
                  (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                           pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                                           pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
            cond:=C_NO
          else
            cond:=C_NB;

+ 1 - 1
compiler/x86_64/cpupara.pas

@@ -181,7 +181,7 @@ unit cpupara;
                  as per the x86-64 ABI -> do the same }
                if not assigned(cl.def) or
                   not is_pasbool(cl.def) or
-                  (size>1) then
+                  (torddef(cl.def).ordtype<>pasbool1) then
                  cl.def:=u32inttype;
              end
            else

+ 3 - 17
compiler/x86_64/nx64flw.pas

@@ -158,16 +158,9 @@ constructor tx64tryfinallynode.create(l, r: TNode);
         behavior causes compilation errors because real nested procedures
         aren't allowed for generics. Not creating them doesn't harm because
         generic node tree is discarded without generating code. }
-       not (df_generic in current_procinfo.procdef.defoptions)
-       then
+       not (df_generic in current_procinfo.procdef.defoptions) then
       begin
-        finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
-        finalizepi.force_nested;
-        finalizepi.procdef:=create_finalizer_procdef;
-        finalizepi.entrypos:=r.fileinfo;
-        finalizepi.entryswitches:=r.localswitches;
-        finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
-        finalizepi.exitswitches:=current_settings.localswitches;
+        finalizepi:=tcgprocinfo(current_procinfo.create_for_outlining('$fin$',current_procinfo.procdef.struct,potype_exceptfilter,voidtype,r));
         { the init/final code is messing with asm nodes, so inform the compiler about this }
         include(finalizepi.flags,pi_has_assembler_block);
         { Regvar optimization for symbols is suppressed when using exceptions, but
@@ -184,14 +177,7 @@ constructor tx64tryfinallynode.create_implicit(l, r: TNode);
         if df_generic in current_procinfo.procdef.defoptions then
           InternalError(2013012501);
 
-        finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
-        finalizepi.force_nested;
-        finalizepi.procdef:=create_finalizer_procdef;
-
-        finalizepi.entrypos:=current_filepos;
-        finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
-        finalizepi.entryswitches:=r.localswitches;
-        finalizepi.exitswitches:=current_settings.localswitches;
+        finalizepi:=tcgprocinfo(current_procinfo.create_for_outlining('$fin$',current_procinfo.procdef.struct,potype_exceptfilter,voidtype,r));
         include(finalizepi.flags,pi_do_call);
         { the init/final code is messing with asm nodes, so inform the compiler about this }
         include(finalizepi.flags,pi_has_assembler_block);

+ 2 - 2
compiler/x86_64/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AROS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

+ 2 - 2
packages/cocoaint/src/CocoaAll.pas

@@ -85,8 +85,8 @@ type
 function NSSTR (inString: PChar): NSString;
 function NSMakeRange (loc: NSUInteger; len: NSUInteger): NSRange;
 function NSMaxRange (range: NSRange): NSUInteger;
-function NSLocationInRange (loc: NSUInteger; range: NSRange): boolean;
-function NSEqualRanges (range1, range2: NSRange): boolean;
+function NSLocationInRange (loc: NSUInteger; range: NSRange): BOOL;
+function NSEqualRanges (range1, range2: NSRange): BOOL;
 function NSMakePoint (x: CGFloat; y: CGFloat): NSPoint;
 function NSMakeSize(w: CGFloat; h: CGFloat): NSSize;
 function NSMakeRect(x, y: CGFloat; w, h: CGFloat): NSRect;

+ 2 - 2
packages/cocoaint/src/Foundation.pas

@@ -54,8 +54,8 @@ type
 function NSSTR (inString: PChar): NSString;
 function NSMakeRange (loc: NSUInteger; len: NSUInteger): NSRange;
 function NSMaxRange (range: NSRange): NSUInteger;
-function NSLocationInRange (loc: NSUInteger; range: NSRange): boolean;
-function NSEqualRanges (range1, range2: NSRange): boolean;
+function NSLocationInRange (loc: NSUInteger; range: NSRange): BOOL;
+function NSEqualRanges (range1, range2: NSRange): BOOL;
 function NSMakePoint (x: CGFloat; y: CGFloat): NSPoint;
 function NSMakeSize(w: CGFloat; h: CGFloat): NSSize;
 function NSMakeRect(x, y: CGFloat; w, h: CGFloat): NSRect;

+ 2 - 2
packages/cocoaint/src/InlineFunctions.inc

@@ -10,7 +10,7 @@ begin
  result := range.location + range.length;
 end;
 
-function NSLocationInRange (loc: NSUInteger; range: NSRange): boolean;
+function NSLocationInRange (loc: NSUInteger; range: NSRange): BOOL;
 begin
  if (loc <= range.location + range.length) and (loc >= range.location) then
   result := true
@@ -18,7 +18,7 @@ begin
   result := false;
 end;
 
-function NSEqualRanges (range1, range2: NSRange): boolean;
+function NSEqualRanges (range1, range2: NSRange): BOOL;
 begin
  if (range1.location = range2.location) and (range1.length = range2.length) then
   result := true

+ 10 - 10
packages/cocoaint/src/appkit/NSATSTypesetter.inc

@@ -66,8 +66,8 @@
 
 { NSPrimitiveInterfaceCategory }
   NSPrimitiveInterfaceCategory = objccategory external (NSATSTypesetter)
-    function usesFontLeading: Boolean; message 'usesFontLeading';
-    procedure setUsesFontLeading(flag: Boolean); message 'setUsesFontLeading:';
+    function usesFontLeading: BOOL; message 'usesFontLeading';
+    procedure setUsesFontLeading(flag: BOOL); message 'setUsesFontLeading:';
     function typesetterBehavior: NSTypesetterBehavior; message 'typesetterBehavior';
     procedure setTypesetterBehavior(behavior: NSTypesetterBehavior); message 'setTypesetterBehavior:';
     function hyphenationFactor: single; message 'hyphenationFactor';
@@ -76,8 +76,8 @@
     procedure setLineFragmentPadding(padding: CGFloat); message 'setLineFragmentPadding:';
     function substituteFontForFont(originalFont: NSFont): NSFont; message 'substituteFontForFont:';
     function textTabForGlyphLocation_writingDirection_maxLocation(glyphLocation: CGFloat; direction: NSWritingDirection; maxLocation: CGFloat): NSTextTab; message 'textTabForGlyphLocation:writingDirection:maxLocation:';
-    function bidiProcessingEnabled: Boolean; message 'bidiProcessingEnabled';
-    procedure setBidiProcessingEnabled(flag: Boolean); message 'setBidiProcessingEnabled:';
+    function bidiProcessingEnabled: BOOL; message 'bidiProcessingEnabled';
+    procedure setBidiProcessingEnabled(flag: BOOL); message 'setBidiProcessingEnabled:';
     procedure setAttributedString(attrString: NSAttributedString); message 'setAttributedString:';
     function attributedString: NSAttributedString; message 'attributedString';
     procedure setParagraphGlyphRange_separatorGlyphRange(paragraphRange: NSRange; paragraphSeparatorRange: NSRange); message 'setParagraphGlyphRange:separatorGlyphRange:';
@@ -89,15 +89,15 @@
     function paragraphSpacingAfterGlyphAtIndex_withProposedLineFragmentRect(glyphIndex: NSUInteger; rect: NSRect): CGFloat; message 'paragraphSpacingAfterGlyphAtIndex:withProposedLineFragmentRect:';
     function layoutManager: NSLayoutManager; message 'layoutManager';
     function currentTextContainer: NSTextContainer; message 'currentTextContainer';
-    procedure setHardInvalidation_forGlyphRange(flag: Boolean; glyphRange: NSRange); message 'setHardInvalidation:forGlyphRange:';
+    procedure setHardInvalidation_forGlyphRange(flag: BOOL; glyphRange: NSRange); message 'setHardInvalidation:forGlyphRange:';
     procedure getLineFragmentRect_usedRect_forParagraphSeparatorGlyphRange_atProposedOrigin(lineFragmentRect: NSRectPtr; lineFragmentUsedRect: NSRectPtr; paragraphSeparatorGlyphRange_: NSRange; lineOrigin: NSPoint); message 'getLineFragmentRect:usedRect:forParagraphSeparatorGlyphRange:atProposedOrigin:';
   end;
 
 { NSLayoutPhaseInterface_NSATSTypesetterCategory }
   NSLayoutPhaseInterface_NSATSTypesetterCategory = objccategory external name 'NSLayoutPhaseInterface' (NSATSTypesetter)
     procedure willSetLineFragmentRect_forGlyphRange_usedRect_baselineOffset(lineRect: NSRectPtr; glyphRange: NSRange; usedRect: NSRectPtr; baselineOffset: CGFloatPtr); message 'willSetLineFragmentRect:forGlyphRange:usedRect:baselineOffset:';
-    function shouldBreakLineByWordBeforeCharacterAtIndex(charIndex: NSUInteger): Boolean; message 'shouldBreakLineByWordBeforeCharacterAtIndex:';
-    function shouldBreakLineByHyphenatingBeforeCharacterAtIndex(charIndex: NSUInteger): Boolean; message 'shouldBreakLineByHyphenatingBeforeCharacterAtIndex:';
+    function shouldBreakLineByWordBeforeCharacterAtIndex(charIndex: NSUInteger): BOOL; message 'shouldBreakLineByWordBeforeCharacterAtIndex:';
+    function shouldBreakLineByHyphenatingBeforeCharacterAtIndex(charIndex: NSUInteger): BOOL; message 'shouldBreakLineByHyphenatingBeforeCharacterAtIndex:';
     function hyphenationFactorForGlyphAtIndex(glyphIndex: NSUInteger): single; message 'hyphenationFactorForGlyphAtIndex:';
     function hyphenCharacterForGlyphAtIndex(glyphIndex: NSUInteger): UTF32Char; message 'hyphenCharacterForGlyphAtIndex:';
     function boundingBoxForControlGlyphAtIndex_forTextContainer_proposedLineFragment_glyphPosition_characterIndex(glyphIndex: NSUInteger; textContainer: NSTextContainer; proposedRect: NSRect; glyphPosition: NSPoint; charIndex: NSUInteger): NSRect; message 'boundingBoxForControlGlyphAtIndex:forTextContainer:proposedLineFragment:glyphPosition:characterIndex:';
@@ -107,13 +107,13 @@
   NSGlyphStorageInterface_NSATSTypesetterCategory = objccategory external name 'NSGlyphStorageInterface' (NSATSTypesetter)
     function characterRangeForGlyphRange_actualGlyphRange(glyphRange: NSRange; actualGlyphRange: NSRangePointer): NSRange; message 'characterRangeForGlyphRange:actualGlyphRange:';
     function glyphRangeForCharacterRange_actualCharacterRange(charRange: NSRange; actualCharRange: NSRangePointer): NSRange; message 'glyphRangeForCharacterRange:actualCharacterRange:';
-    function getGlyphsInRange_glyphs_characterIndexes_glyphInscriptions_elasticBits(glyphsRange: NSRange; glyphBuffer: NSGlyphPtr; charIndexBuffer: NSUIntegerPtr; inscribeBuffer: NSGlyphInscriptionPtr; elasticBuffer: pboolean): NSUInteger; message 'getGlyphsInRange:glyphs:characterIndexes:glyphInscriptions:elasticBits:';
+    function getGlyphsInRange_glyphs_characterIndexes_glyphInscriptions_elasticBits(glyphsRange: NSRange; glyphBuffer: NSGlyphPtr; charIndexBuffer: NSUIntegerPtr; inscribeBuffer: NSGlyphInscriptionPtr; elasticBuffer: pBOOL): NSUInteger; message 'getGlyphsInRange:glyphs:characterIndexes:glyphInscriptions:elasticBits:';
     procedure setLineFragmentRect_forGlyphRange_usedRect_baselineOffset(fragmentRect: NSRect; glyphRange: NSRange; usedRect: NSRect; baselineOffset: CGFloat); message 'setLineFragmentRect:forGlyphRange:usedRect:baselineOffset:';
     procedure substituteGlyphsInRange_withGlyphs(glyphRange: NSRange; glyphs: NSGlyphPtr); message 'substituteGlyphsInRange:withGlyphs:';
     procedure insertGlyph_atGlyphIndex_characterIndex(glyph: NSGlyph; glyphIndex: NSUInteger; characterIndex: NSUInteger); message 'insertGlyph:atGlyphIndex:characterIndex:';
     procedure deleteGlyphsInRange(glyphRange: NSRange); message 'deleteGlyphsInRange:';
-    procedure setNotShownAttribute_forGlyphRange(flag: Boolean; glyphRange: NSRange); message 'setNotShownAttribute:forGlyphRange:';
-    procedure setDrawsOutsideLineFragment_forGlyphRange(flag: Boolean; glyphRange: NSRange); message 'setDrawsOutsideLineFragment:forGlyphRange:';
+    procedure setNotShownAttribute_forGlyphRange(flag: BOOL; glyphRange: NSRange); message 'setNotShownAttribute:forGlyphRange:';
+    procedure setDrawsOutsideLineFragment_forGlyphRange(flag: BOOL; glyphRange: NSRange); message 'setDrawsOutsideLineFragment:forGlyphRange:';
     procedure setLocation_withAdvancements_forStartOfGlyphRange(location: NSPoint; advancements: CGFloatPtr; glyphRange: NSRange); message 'setLocation:withAdvancements:forStartOfGlyphRange:';
     procedure setAttachmentSize_forGlyphRange(attachmentSize: NSSize; glyphRange: NSRange); message 'setAttachmentSize:forGlyphRange:';
     procedure setBidiLevels_forGlyphRange(levels: pbyte; glyphRange: NSRange); message 'setBidiLevels:forGlyphRange:';

+ 3 - 3
packages/cocoaint/src/appkit/NSAccessibility.inc

@@ -338,14 +338,14 @@ var
   NSAccessibilityCategory = objccategory external (NSObject)
     function accessibilityAttributeNames: NSArray; message 'accessibilityAttributeNames';
     function accessibilityAttributeValue(attribute: NSString): id; message 'accessibilityAttributeValue:';
-    function accessibilityIsAttributeSettable(attribute: NSString): Boolean; message 'accessibilityIsAttributeSettable:';
+    function accessibilityIsAttributeSettable(attribute: NSString): BOOL; message 'accessibilityIsAttributeSettable:';
     procedure accessibilitySetValue_forAttribute(value: id; attribute: NSString); message 'accessibilitySetValue:forAttribute:';
     function accessibilityParameterizedAttributeNames: NSArray; message 'accessibilityParameterizedAttributeNames';
     function accessibilityAttributeValue_forParameter(attribute: NSString; parameter: id): id; message 'accessibilityAttributeValue:forParameter:';
     function accessibilityActionNames: NSArray; message 'accessibilityActionNames';
     function accessibilityActionDescription(action: NSString): NSString; message 'accessibilityActionDescription:';
     procedure accessibilityPerformAction(action: NSString); message 'accessibilityPerformAction:';
-    function accessibilityIsIgnored: Boolean; message 'accessibilityIsIgnored';
+    function accessibilityIsIgnored: BOOL; message 'accessibilityIsIgnored';
     function accessibilityHitTest(point: NSPoint): id; message 'accessibilityHitTest:';
     function accessibilityFocusedUIElement: id; message 'accessibilityFocusedUIElement';
     function accessibilityIndexOfChild(child: id): NSUInteger; message 'accessibilityIndexOfChild:';
@@ -355,7 +355,7 @@ var
 
 { NSAccessibilityAdditionsCategory }
   NSAccessibilityAdditionsCategory = objccategory external (NSObject)
-    function accessibilitySetOverrideValue_forAttribute(value: id; attribute: NSString): Boolean; message 'accessibilitySetOverrideValue:forAttribute:';
+    function accessibilitySetOverrideValue_forAttribute(value: id; attribute: NSString): BOOL; message 'accessibilitySetOverrideValue:forAttribute:';
   end;
 
 {$endif}

+ 9 - 9
packages/cocoaint/src/appkit/NSAlert.inc

@@ -84,10 +84,10 @@ type
     _delegate: id;
     _alertStyle: NSAlertStyle;
     _helpAnchor: id;
-    _layoutDone: Boolean;
-    _showsHelp: Boolean;
-    _showsSuppressionButton: Boolean;
-    reserved: Boolean;
+    _layoutDone: BOOL;
+    _showsHelp: BOOL;
+    _showsSuppressionButton: BOOL;
+    reserved: BOOL;
     _suppressionButton: id;
     _accessoryView: id;
     
@@ -102,16 +102,16 @@ type
     function icon: NSImage; message 'icon';
     function addButtonWithTitle(title: NSString): NSButton; message 'addButtonWithTitle:';
     function buttons: NSArray; message 'buttons';
-    procedure setShowsHelp(showsHelp_: Boolean); message 'setShowsHelp:';
-    function showsHelp: Boolean; message 'showsHelp';
+    procedure setShowsHelp(showsHelp_: BOOL); message 'setShowsHelp:';
+    function showsHelp: BOOL; message 'showsHelp';
     procedure setHelpAnchor(anchor: NSString); message 'setHelpAnchor:';
     function helpAnchor: NSString; message 'helpAnchor';
     procedure setAlertStyle(style: NSAlertStyle); message 'setAlertStyle:';
     function alertStyle: NSAlertStyle; message 'alertStyle';
     procedure setDelegate(delegate_: NSAlertDelegateProtocol); message 'setDelegate:';
     function delegate: NSAlertDelegateProtocol; message 'delegate';
-    procedure setShowsSuppressionButton(flag: Boolean); message 'setShowsSuppressionButton:';
-    function showsSuppressionButton: Boolean; message 'showsSuppressionButton';
+    procedure setShowsSuppressionButton(flag: BOOL); message 'setShowsSuppressionButton:';
+    function showsSuppressionButton: BOOL; message 'showsSuppressionButton';
     function suppressionButton: NSButton; message 'suppressionButton';
     procedure setAccessoryView(view: NSView); message 'setAccessoryView:';
     function accessoryView: NSView; message 'accessoryView';
@@ -131,7 +131,7 @@ type
 { NSAlertDelegate Protocol }
   NSAlertDelegateProtocol = objcprotocol external name 'NSAlertDelegate'
   optional
-    function alertShowHelp(alert: NSAlert): Boolean; message 'alertShowHelp:';
+    function alertShowHelp(alert: NSAlert): BOOL; message 'alertShowHelp:';
   end;
 {$endif}
 {$endif}

+ 2 - 2
packages/cocoaint/src/appkit/NSAnimation.inc

@@ -126,7 +126,7 @@ var
     function initWithDuration_animationCurve(duration_: NSTimeInterval; animationCurve_: NSAnimationCurve): id; message 'initWithDuration:animationCurve:';
     procedure startAnimation; message 'startAnimation';
     procedure stopAnimation; message 'stopAnimation';
-    function isAnimating: Boolean; message 'isAnimating';
+    function isAnimating: BOOL; message 'isAnimating';
     function currentProgress: NSAnimationProgress; message 'currentProgress';
     procedure setCurrentProgress(progress: NSAnimationProgress); message 'setCurrentProgress:';
     procedure setDuration(duration_: NSTimeInterval); message 'setDuration:';
@@ -193,7 +193,7 @@ var
 { NSAnimationDelegate Protocol }
   NSAnimationDelegateProtocol = objcprotocol external name 'NSAnimationDelegate'
   optional
-    function animationShouldStart(animation: NSAnimation): Boolean; message 'animationShouldStart:';
+    function animationShouldStart(animation: NSAnimation): BOOL; message 'animationShouldStart:';
     procedure animationDidStop(animation: NSAnimation); message 'animationDidStop:';
     procedure animationDidEnd(animation: NSAnimation); message 'animationDidEnd:';
     function animation_valueForProgress(animation: NSAnimation; progress: NSAnimationProgress): single; message 'animation:valueForProgress:';

+ 31 - 31
packages/cocoaint/src/appkit/NSApplication.inc

@@ -108,11 +108,11 @@ type
 
 { Functions }
 function NSApplicationMain(argc: cint; argv: PPChar {array of PChar}): cint; cdecl; external;
-function NSApplicationLoad: Boolean; cdecl; external;
-function NSShowsServicesMenuItem(itemName: NSString): Boolean; cdecl; external;
-function NSSetShowsServicesMenuItem(itemName: NSString; enabled: Boolean): NSInteger; cdecl; external;
+function NSApplicationLoad: BOOL; cdecl; external;
+function NSShowsServicesMenuItem(itemName: NSString): BOOL; cdecl; external;
+function NSSetShowsServicesMenuItem(itemName: NSString; enabled: BOOL): NSInteger; cdecl; external;
 procedure NSUpdateDynamicServices; cdecl; external;
-function NSPerformService(itemName: NSString; pboard: NSPasteboard): Boolean; cdecl; external;
+function NSPerformService(itemName: NSString; pboard: NSPasteboard): BOOL; cdecl; external;
 procedure NSRegisterServicesProvider(provider: id; name: NSString); cdecl; external;
 procedure NSUnregisterServicesProvider(name: NSString); cdecl; external;
 
@@ -229,11 +229,11 @@ var
     function windowWithWindowNumber(windowNum: NSInteger): NSWindow; message 'windowWithWindowNumber:';
     function mainWindow: NSWindow; message 'mainWindow';
     function keyWindow: NSWindow; message 'keyWindow';
-    function isActive: Boolean; message 'isActive';
-    function isHidden: Boolean; message 'isHidden';
-    function isRunning: Boolean; message 'isRunning';
+    function isActive: BOOL; message 'isActive';
+    function isHidden: BOOL; message 'isHidden';
+    function isRunning: BOOL; message 'isRunning';
     procedure deactivate; message 'deactivate';
-    procedure activateIgnoringOtherApps(flag: Boolean); message 'activateIgnoringOtherApps:';
+    procedure activateIgnoringOtherApps(flag: BOOL); message 'activateIgnoringOtherApps:';
     procedure hideOtherApplications(sender: id); message 'hideOtherApplications:';
     procedure unhideAllApplications(sender: id); message 'unhideAllApplications:';
     procedure finishLaunching; message 'finishLaunching';
@@ -253,15 +253,15 @@ var
     procedure beginSheet_modalForWindow_modalDelegate_didEndSelector_contextInfo(sheet: NSWindow; docWindow: NSWindow; modalDelegate: id; didEndSelector: SEL; contextInfo: Pointer); message 'beginSheet:modalForWindow:modalDelegate:didEndSelector:contextInfo:';
     procedure endSheet(sheet: NSWindow); message 'endSheet:';
     procedure endSheet_returnCode(sheet: NSWindow; returnCode: NSInteger); message 'endSheet:returnCode:';
-    function nextEventMatchingMask_untilDate_inMode_dequeue(mask: NSUInteger; expiration: NSDate; mode: NSString; deqFlag: Boolean): NSEvent; message 'nextEventMatchingMask:untilDate:inMode:dequeue:';
+    function nextEventMatchingMask_untilDate_inMode_dequeue(mask: NSUInteger; expiration: NSDate; mode: NSString; deqFlag: BOOL): NSEvent; message 'nextEventMatchingMask:untilDate:inMode:dequeue:';
     procedure discardEventsMatchingMask_beforeEvent(mask: NSUInteger; lastEvent: NSEvent); message 'discardEventsMatchingMask:beforeEvent:';
-    procedure postEvent_atStart(event: NSEvent; flag: Boolean); message 'postEvent:atStart:';
+    procedure postEvent_atStart(event: NSEvent; flag: BOOL); message 'postEvent:atStart:';
     function currentEvent: NSEvent; message 'currentEvent';
     procedure sendEvent(theEvent: NSEvent); message 'sendEvent:';
     procedure preventWindowOrdering; message 'preventWindowOrdering';
-    function makeWindowsPerform_inOrder(aSelector: SEL; flag: Boolean): NSWindow; message 'makeWindowsPerform:inOrder:';
+    function makeWindowsPerform_inOrder(aSelector: SEL; flag: BOOL): NSWindow; message 'makeWindowsPerform:inOrder:';
     function windows: NSArray; message 'windows';
-    procedure setWindowsNeedUpdate(needUpdate: Boolean); message 'setWindowsNeedUpdate:';
+    procedure setWindowsNeedUpdate(needUpdate: BOOL); message 'setWindowsNeedUpdate:';
     procedure updateWindows; message 'updateWindows';
     procedure setMainMenu(aMenu: NSMenu); message 'setMainMenu:';
     function mainMenu: NSMenu; message 'mainMenu';
@@ -270,16 +270,16 @@ var
     procedure setApplicationIconImage(image: NSImage); message 'setApplicationIconImage:';
     function applicationIconImage: NSImage; message 'applicationIconImage';
     function activationPolicy: NSApplicationActivationPolicy; message 'activationPolicy';
-    function setActivationPolicy(activationPolicy_: NSApplicationActivationPolicy): Boolean; message 'setActivationPolicy:';
+    function setActivationPolicy(activationPolicy_: NSApplicationActivationPolicy): BOOL; message 'setActivationPolicy:';
     function dockTile: NSDockTile; message 'dockTile';
-    function sendAction_to_from(theAction: SEL; theTarget: id; sender: id): Boolean; message 'sendAction:to:from:';
+    function sendAction_to_from(theAction: SEL; theTarget: id; sender: id): BOOL; message 'sendAction:to:from:';
     function targetForAction(theAction: SEL): id; message 'targetForAction:';
     function targetForAction_to_from(theAction: SEL; theTarget: id; sender: id): id; message 'targetForAction:to:from:';
-    function tryToPerform_with(anAction: SEL; anObject: id): Boolean; message 'tryToPerform:with:';
+    function tryToPerform_with(anAction: SEL; anObject: id): BOOL; message 'tryToPerform:with:';
     function validRequestorForSendType_returnType(sendType: NSString; returnType: NSString): id; message 'validRequestorForSendType:returnType:';
     procedure reportException(theException: NSException); message 'reportException:';
     class procedure detachDrawingThread_toTarget_withObject(selector: SEL; target: id; argument: id); message 'detachDrawingThread:toTarget:withObject:';
-    procedure replyToApplicationShouldTerminate(shouldTerminate: Boolean); message 'replyToApplicationShouldTerminate:';
+    procedure replyToApplicationShouldTerminate(shouldTerminate: BOOL); message 'replyToApplicationShouldTerminate:';
     procedure replyToOpenOrPrint(reply: NSApplicationDelegateReply); message 'replyToOpenOrPrint:';
     procedure orderFrontCharacterPalette(sender: id); message 'orderFrontCharacterPalette:';
     function presentationOptions: NSApplicationPresentationOptions; message 'presentationOptions';
@@ -287,7 +287,7 @@ var
     function currentSystemPresentationOptions: NSApplicationPresentationOptions; message 'currentSystemPresentationOptions';
 
     { Adopted Protocols }
-    function validateUserInterfaceItem(anItem: NSValidatedUserInterfaceItemProtocol): Boolean;
+    function validateUserInterfaceItem(anItem: NSValidatedUserInterfaceItemProtocol): BOOL;
   end;
 
 { NSWindowsMenuCategory }
@@ -296,15 +296,15 @@ var
     function windowsMenu: NSMenu; message 'windowsMenu';
     procedure arrangeInFront(sender: id); message 'arrangeInFront:';
     procedure removeWindowsItem(win: NSWindow); message 'removeWindowsItem:';
-    procedure addWindowsItem_title_filename(win: NSWindow; aString: NSString; isFilename: Boolean); message 'addWindowsItem:title:filename:';
-    procedure changeWindowsItem_title_filename(win: NSWindow; aString: NSString; isFilename: Boolean); message 'changeWindowsItem:title:filename:';
+    procedure addWindowsItem_title_filename(win: NSWindow; aString: NSString; isFilename: BOOL); message 'addWindowsItem:title:filename:';
+    procedure changeWindowsItem_title_filename(win: NSWindow; aString: NSString; isFilename: BOOL); message 'changeWindowsItem:title:filename:';
     procedure updateWindowsItem(win: NSWindow); message 'updateWindowsItem:';
     procedure miniaturizeAll(sender: id); message 'miniaturizeAll:';
   end;
 
 { NSFullKeyboardAccessCategory }
   NSFullKeyboardAccessCategory = objccategory external (NSApplication)
-    function isFullKeyboardAccessEnabled: Boolean; message 'isFullKeyboardAccessEnabled';
+    function isFullKeyboardAccessEnabled: BOOL; message 'isFullKeyboardAccessEnabled';
   end;
 
 { NSServicesMenuCategory }
@@ -316,8 +316,8 @@ var
 
 { NSServicesRequestsCategory }
   NSServicesRequestsCategory = objccategory external (NSObject)
-    function writeSelectionToPasteboard_types(pboard: NSPasteboard; types: NSArray): Boolean; message 'writeSelectionToPasteboard:types:';
-    function readSelectionFromPasteboard(pboard: NSPasteboard): Boolean; message 'readSelectionFromPasteboard:';
+    function writeSelectionToPasteboard_types(pboard: NSPasteboard; types: NSArray): BOOL; message 'writeSelectionToPasteboard:types:';
+    function readSelectionFromPasteboard(pboard: NSPasteboard): BOOL; message 'readSelectionFromPasteboard:';
   end;
 
 { NSServicesHandlingCategory }
@@ -354,16 +354,16 @@ var
   NSApplicationDelegateProtocol = objcprotocol external name 'NSApplicationDelegate'
   optional
     function applicationShouldTerminate(sender: NSApplication): NSApplicationTerminateReply; message 'applicationShouldTerminate:';
-    function application_openFile(sender: NSApplication; filename: NSString): Boolean; message 'application:openFile:';
+    function application_openFile(sender: NSApplication; filename: NSString): BOOL; message 'application:openFile:';
     procedure application_openFiles(sender: NSApplication; filenames: NSArray); message 'application:openFiles:';
-    function application_openTempFile(sender: NSApplication; filename: NSString): Boolean; message 'application:openTempFile:';
-    function applicationShouldOpenUntitledFile(sender: NSApplication): Boolean; message 'applicationShouldOpenUntitledFile:';
-    function applicationOpenUntitledFile(sender: NSApplication): Boolean; message 'applicationOpenUntitledFile:';
-    function application_openFileWithoutUI(sender: id; filename: NSString): Boolean; message 'application:openFileWithoutUI:';
-    function application_printFile(sender: NSApplication; filename: NSString): Boolean; message 'application:printFile:';
-    function application_printFiles_withSettings_showPrintPanels(application: NSApplication; fileNames: NSArray; printSettings: NSDictionary; showPrintPanels: Boolean): NSApplicationPrintReply; message 'application:printFiles:withSettings:showPrintPanels:';
-    function applicationShouldTerminateAfterLastWindowClosed(sender: NSApplication): Boolean; message 'applicationShouldTerminateAfterLastWindowClosed:';
-    function applicationShouldHandleReopen_hasVisibleWindows(sender: NSApplication; flag: Boolean): Boolean; message 'applicationShouldHandleReopen:hasVisibleWindows:';
+    function application_openTempFile(sender: NSApplication; filename: NSString): BOOL; message 'application:openTempFile:';
+    function applicationShouldOpenUntitledFile(sender: NSApplication): BOOL; message 'applicationShouldOpenUntitledFile:';
+    function applicationOpenUntitledFile(sender: NSApplication): BOOL; message 'applicationOpenUntitledFile:';
+    function application_openFileWithoutUI(sender: id; filename: NSString): BOOL; message 'application:openFileWithoutUI:';
+    function application_printFile(sender: NSApplication; filename: NSString): BOOL; message 'application:printFile:';
+    function application_printFiles_withSettings_showPrintPanels(application: NSApplication; fileNames: NSArray; printSettings: NSDictionary; showPrintPanels: BOOL): NSApplicationPrintReply; message 'application:printFiles:withSettings:showPrintPanels:';
+    function applicationShouldTerminateAfterLastWindowClosed(sender: NSApplication): BOOL; message 'applicationShouldTerminateAfterLastWindowClosed:';
+    function applicationShouldHandleReopen_hasVisibleWindows(sender: NSApplication; flag: BOOL): BOOL; message 'applicationShouldHandleReopen:hasVisibleWindows:';
     function applicationDockMenu(sender: NSApplication): NSMenu; message 'applicationDockMenu:';
     function application_willPresentError(application: NSApplication; error: NSError): NSError; message 'application:willPresentError:';
     procedure applicationWillFinishLaunching(notification: NSNotification); message 'applicationWillFinishLaunching:';

+ 1 - 1
packages/cocoaint/src/appkit/NSApplicationScripting.inc

@@ -44,7 +44,7 @@
 
 { NSApplicationScriptingDelegationCategory }
   NSApplicationScriptingDelegationCategory = objccategory external (NSObject)
-    function application_delegateHandlesKey(sender: NSApplication; key: NSString): Boolean; message 'application:delegateHandlesKey:';
+    function application_delegateHandlesKey(sender: NSApplication; key: NSString): BOOL; message 'application:delegateHandlesKey:';
   end;
 
 {$endif}

Algunos archivos no se mostraron porque demasiados archivos cambiaron en este cambio