Prechádzať zdrojové kódy

* rest of the previous accidental partial commit

git-svn-id: branches/fixes_3_2@41250 -
Jonas Maebe 6 rokov pred
rodič
commit
3ac703506c
100 zmenil súbory, kde vykonal 1972 pridanie a 1844 odobranie
  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/hlcgobj.pas svneol=native#text/plain
 compiler/html/i386/readme.txt svneol=native#text/plain
 compiler/html/i386/readme.txt svneol=native#text/plain
 compiler/html/powerpc/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/aoptcpu.pas svneol=native#text/plain
 compiler/i386/aoptcpub.pas svneol=native#text/plain
 compiler/i386/aoptcpub.pas svneol=native#text/plain
 compiler/i386/aoptcpud.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/nobjc.pas svneol=native#text/plain
 compiler/node.pas svneol=native#text/plain
 compiler/node.pas svneol=native#text/plain
 compiler/nopt.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/nutils.pas svneol=native#text/plain
 compiler/objcasm.pas svneol=native#text/plain
 compiler/objcasm.pas svneol=native#text/plain
 compiler/objcdef.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/ppcx64llvm.lpi svneol=native#text/plain
 compiler/ppheap.pas svneol=native#text/plain
 compiler/ppheap.pas svneol=native#text/plain
 compiler/ppu.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/procinfo.pas svneol=native#text/plain
 compiler/pstatmnt.pas svneol=native#text/plain
 compiler/pstatmnt.pas svneol=native#text/plain
 compiler/psub.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
               if not((def.typ=pointerdef) or
                     ((def.typ=orddef) and
                     ((def.typ=orddef) and
                      (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
                      (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                               pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                                               pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
                  ai.SetCondition(C_VC)
                  ai.SetCondition(C_VC)
               else
               else
                 if TAiCpu(List.Last).opcode in [A_RSB,A_RSC,A_SBC,A_SUB] then
                 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;
                   end;
 
 
                   if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
                   if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
-                    resultdef:=pasbool8type;
+                    resultdef:=pasbool1type;
                   result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
                   result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create(
                       ctypeconvnode.create_internal(right,fdef),
                       ctypeconvnode.create_internal(right,fdef),
                       ccallparanode.create(
                       ccallparanode.create(

+ 2 - 2
compiler/arm/symcpu.pas

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

+ 1 - 1
compiler/avr/cgcpu.pas

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

+ 1 - 1
compiler/blockutl.pas

@@ -207,7 +207,7 @@ implementation
           exit;
           exit;
         end;
         end;
       { bare copy, so that self etc are not inserted }
       { 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 }
       { will be called accoding to the ABI conventions }
       result.proccalloption:=pocall_cdecl;
       result.proccalloption:=pocall_cdecl;
       { add po_is_block so that a block "self" pointer gets added (of the type
       { 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;
               finish_entry;
             end;
             end;
-          pasbool8 :
+          pasbool1 :
             begin
             begin
               append_entry(DW_TAG_base_type,false,[
               append_entry(DW_TAG_base_type,false,[
                 DW_AT_name,DW_FORM_string,'Boolean'#0,
                 DW_AT_name,DW_FORM_string,'Boolean'#0,
@@ -1605,6 +1605,15 @@ implementation
                 ]);
                 ]);
               finish_entry;
               finish_entry;
             end;
             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 :
           bool8bit :
             begin
             begin
               append_entry(DW_TAG_base_type,false,[
               append_entry(DW_TAG_base_type,false,[

+ 2 - 0
compiler/dbgstabs.pas

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

+ 7 - 8
compiler/defcmp.pas

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

+ 7 - 4
compiler/defutil.pas

@@ -478,7 +478,7 @@ implementation
                is_ordinal:=dt in [uchar,uwidechar,
                is_ordinal:=dt in [uchar,uwidechar,
                                   u8bit,u16bit,u32bit,u64bit,
                                   u8bit,u16bit,u32bit,u64bit,
                                   s8bit,s16bit,s32bit,s64bit,
                                   s8bit,s16bit,s32bit,s64bit,
-                                  pasbool8,pasbool16,pasbool32,pasbool64,
+                                  pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
                                   bool8bit,bool16bit,bool32bit,bool64bit];
                                   bool8bit,bool16bit,bool32bit,bool64bit];
              end;
              end;
            enumdef :
            enumdef :
@@ -558,14 +558,14 @@ implementation
     function is_boolean(def : tdef) : boolean;
     function is_boolean(def : tdef) : boolean;
       begin
       begin
         result:=(def.typ=orddef) and
         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;
       end;
 
 
 
 
     function is_pasbool(def : tdef) : boolean;
     function is_pasbool(def : tdef) : boolean;
       begin
       begin
         result:=(def.typ=orddef) and
         result:=(def.typ=orddef) and
-                    (torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64]);
+                    (torddef(def).ordtype in [pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]);
       end;
       end;
 
 
     { true if def is a C-style boolean (non-zero value = true, zero = false) }
     { 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 }
     { true, if def is a 8 bit ordinal type }
     function is_8bit(def : tdef) : boolean;
     function is_8bit(def : tdef) : boolean;
       begin
       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;
       end;
 
 
     { true, if def is a 16 bit int type }
     { true, if def is a 16 bit int type }
@@ -1146,6 +1146,8 @@ implementation
                      range_to_type(torddef(def).low,torddef(def).high,result);
                      range_to_type(torddef(def).low,torddef(def).high,result);
                  end
                  end
                else case torddef(def).ordtype of
                else case torddef(def).ordtype of
+                 pasbool1:
+                   result:=pasbool1type;
                  pasbool8:
                  pasbool8:
                    result:=pasbool8type;
                    result:=pasbool8type;
                  pasbool16:
                  pasbool16:
@@ -1601,6 +1603,7 @@ implementation
                 result:=tkQWord;
                 result:=tkQWord;
               s64bit:
               s64bit:
                 result:=tkInt64;
                 result:=tkInt64;
+              pasbool1,
               pasbool8,
               pasbool8,
               pasbool16,
               pasbool16,
               pasbool32,
               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_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_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 location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override;
 
 
           procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel); override;
           procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel); override;
@@ -1250,7 +1250,7 @@ implementation
       end;
       end;
     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
     var
       reg : tregister;
       reg : tregister;
       href : treference;
       href : treference;
@@ -1297,6 +1297,7 @@ implementation
                reg:=getmmregister(list,newsize);
                reg:=getmmregister(list,newsize);
                a_loadmm_loc_reg(list,size,newsize,l,reg,mms_movescalar);
                a_loadmm_loc_reg(list,size,newsize,l,reg,mms_movescalar);
                l.size:=def_cgsize(newsize);
                l.size:=def_cgsize(newsize);
+               size:=newsize;
              end;
              end;
           location_freetemp(list,l);
           location_freetemp(list,l);
           location_reset(l,LOC_MMREGISTER,l.size);
           location_reset(l,LOC_MMREGISTER,l.size);

+ 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_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_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_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;
 //          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
           { Retrieve the location of the data pointed to in location l, when the location is
@@ -4089,7 +4089,7 @@ implementation
       end;
       end;
     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
     var
       reg : tregister;
       reg : tregister;
       href : treference;
       href : treference;
@@ -4134,6 +4134,7 @@ implementation
           l.size:=def_cgsize(newsize);
           l.size:=def_cgsize(newsize);
           location_freetemp(list,l);
           location_freetemp(list,l);
           location_reset(l,LOC_MMREGISTER,l.size);
           location_reset(l,LOC_MMREGISTER,l.size);
+          size:=newsize;
           l.register:=reg;
           l.register:=reg;
         end;
         end;
     end;
     end;
@@ -4983,8 +4984,6 @@ implementation
                 end
                 end
               else
               else
                 begin
                 begin
-                  { pass proper alignment info }
-                  localcopyloc.reference.alignment:=tparavarsym(p).vardef.alignment;
                   g_concatcopy(list,tparavarsym(p).vardef,href,localcopyloc.reference);
                   g_concatcopy(list,tparavarsym(p).vardef,href,localcopyloc.reference);
                 end;
                 end;
               { update localloc of varsym }
               { update localloc of varsym }

+ 67 - 72
compiler/htypechk.pas

@@ -152,22 +152,22 @@ interface
     function token2managementoperator(optoken:ttoken):tmanagementoperator;
     function token2managementoperator(optoken:ttoken):tmanagementoperator;
 
 
     { check operator args and result type }
     { 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 isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
     function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : 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 }
     { Register Allocation }
     procedure make_not_regable(p : tnode; how: tregableinfoflags);
     procedure make_not_regable(p : tnode; how: tregableinfoflags);
@@ -515,9 +515,9 @@ implementation
                     end;
                     end;
 
 
                  { <dyn. array> + <dyn. array> is handled by the compiler }
                  { <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
                     begin
                       allowed:=false;
                       allowed:=false;
                       exit;
                       exit;
@@ -720,7 +720,7 @@ implementation
       end;
       end;
 
 
 
 
-    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
       var
       var
         ld      : tdef;
         ld      : tdef;
         optoken : ttoken;
         optoken : ttoken;
@@ -742,11 +742,11 @@ implementation
         else
         else
           inlinenumber:=in_none;
           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;
           exit;
 
 
         { operator overload is possible }
         { operator overload is possible }
-        result:=not (ocf_check_only in ocf);
+        result:=not (ocf_check_only in ocf);
 
 
         optoken:=NOTOKEN;
         optoken:=NOTOKEN;
         case t.nodetype of
         case t.nodetype of
@@ -766,11 +766,11 @@ implementation
         end;
         end;
         if (optoken=NOTOKEN) then
         if (optoken=NOTOKEN) then
           begin
           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;
             exit;
           end;
           end;
 
 
@@ -790,11 +790,11 @@ implementation
           begin
           begin
             candidates.free;
             candidates.free;
             ppn.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;
             exit;
           end;
           end;
 
 
@@ -811,16 +811,16 @@ implementation
           begin
           begin
             candidates.free;
             candidates.free;
             ppn.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;
             exit;
           end;
           end;
 
 
         { Multiple candidates left? }
         { 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
           begin
             CGMessage(type_e_cant_choose_overload_function);
             CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
@@ -833,13 +833,13 @@ implementation
           end;
           end;
         candidates.free;
         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);
         addsymref(operpd.procsym);
 
 
         { the nil as symtable signs firstcalln that this is
         { the nil as symtable signs firstcalln that this is
@@ -852,7 +852,7 @@ implementation
       end;
       end;
 
 
 
 
-    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
       var
       var
         rd,ld   : tdef;
         rd,ld   : tdef;
         optoken : ttoken;
         optoken : ttoken;
@@ -945,14 +945,14 @@ implementation
         { load easier access variables }
         { load easier access variables }
         ld:=tbinarynode(t).left.resultdef;
         ld:=tbinarynode(t).left.resultdef;
         rd:=tbinarynode(t).right.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;
           exit;
 
 
         { operator overload is possible }
         { 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
         case t.nodetype of
            equaln:
            equaln:
@@ -997,19 +997,19 @@ implementation
              optoken:=_OP_IN;
              optoken:=_OP_IN;
            else
            else
              begin
              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;
                exit;
              end;
              end;
         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 }
         { 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
           begin
             ppn.free;
             ppn.free;
             ppn:=nil;
             ppn:=nil;
@@ -1021,15 +1021,15 @@ implementation
         if (cand_cnt=0) then
         if (cand_cnt=0) then
           begin
           begin
             ppn.free;
             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;
             exit;
           end;
           end;
 
 
@@ -1964,7 +1964,7 @@ implementation
               { all types can be passed to a formaldef,
               { all types can be passed to a formaldef,
                 but it is not the prefered way }
                 but it is not the prefered way }
               if not is_constnode(fromnode) then
               if not is_constnode(fromnode) then
-                eq:=te_convert_l2
+                eq:=te_convert_l6
               else
               else
                 eq:=te_incompatible;
                 eq:=te_incompatible;
             end;
             end;
@@ -2037,11 +2037,6 @@ implementation
       begin
       begin
         { Note: eq must be already valid, it will only be updated! }
         { Note: eq must be already valid, it will only be updated! }
         case def_to.typ of
         case def_to.typ of
-          formaldef :
-            begin
-              { all types can be passed to a formaldef }
-              eq:=te_equal;
-            end;
           stringdef :
           stringdef :
             begin
             begin
               { to support ansi/long/wide strings in a proper way }
               { to support ansi/long/wide strings in a proper way }
@@ -3122,7 +3117,7 @@ implementation
         variantorddef_cl: array[tordtype] of tvariantequaltype =
         variantorddef_cl: array[tordtype] of tvariantequaltype =
           (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,tve_incompatible,
           (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,tve_incompatible,
            tve_shortint,tve_smallint,tve_longint,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_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_chari64,tve_chari64,tve_dblcurrency);
            tve_chari64,tve_chari64,tve_dblcurrency);
 { TODO: fixme for 128 bit floats }
 { TODO: fixme for 128 bit floats }

+ 3 - 15
compiler/i386/n386flw.pas

@@ -58,7 +58,7 @@ implementation
     symconst,symbase,symtable,symsym,symdef,
     symconst,symbase,symtable,symsym,symdef,
     cgbase,cgobj,cgcpu,cgutils,tgobj,
     cgbase,cgobj,cgcpu,cgutils,tgobj,
     cpubase,htypechk,
     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;
     aasmbase,aasmtai,aasmdata,aasmcpu,procinfo,cpupi;
 
 
   var
   var
@@ -168,13 +168,7 @@ constructor ti386tryfinallynode.create(l, r: TNode);
       (df_generic in current_procinfo.procdef.defoptions)
       (df_generic in current_procinfo.procdef.defoptions)
       then
       then
       exit;
       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
     { Regvar optimization for symbols is suppressed when using exceptions, but
       temps may be still placed into registers. This must be fixed. }
       temps may be still placed into registers. This must be fixed. }
     foreachnodestatic(r,@reset_regvars,finalizepi);
     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
     if df_generic in current_procinfo.procdef.defoptions then
       InternalError(2013012501);
       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_has_assembler_block);
     include(finalizepi.flags,pi_do_call);
     include(finalizepi.flags,pi_do_call);
     include(finalizepi.flags,pi_uses_exceptions);
     include(finalizepi.flags,pi_uses_exceptions);

+ 2 - 2
compiler/i386/symcpu.pas

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

+ 6 - 6
compiler/i8086/n8086add.pas

@@ -149,17 +149,17 @@ interface
                     internalerror(2014040606);
                     internalerror(2014040606);
                 end;
                 end;
               ltn:
               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:
               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:
               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:
               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:
               equaln:
-                t:=cordconstnode.create(ord(lv=rv),pasbool8type,true);
+                t:=cordconstnode.create(ord(lv=rv),pasbool1type,true);
               unequaln:
               unequaln:
-                t:=cordconstnode.create(ord(lv<>rv),pasbool8type,true);
+                t:=cordconstnode.create(ord(lv<>rv),pasbool1type,true);
               else
               else
                 internalerror(2014040605);
                 internalerror(2014040605);
             end;
             end;

+ 4 - 4
compiler/i8086/symcpu.pas

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

+ 3 - 3
compiler/jvm/hlcgcpu.pas

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

+ 141 - 2
compiler/jvm/jvmdef.pas

@@ -30,7 +30,7 @@ interface
     uses
     uses
       globtype,
       globtype,
       node,
       node,
-      symbase,symtype;
+      symbase,symtype,symdef;
 
 
     { returns whether a def can make use of an extra type signature (for
     { 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
       Java-style generics annotations; not use for FPC-style generics or their
@@ -90,6 +90,10 @@ interface
       array }
       array }
     procedure jvmgetarraydimdef(arrdef: tdef; out eledef: tdef; out ndim: longint);
     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
 implementation
 
 
@@ -97,7 +101,8 @@ implementation
     cutils,cclasses,constexp,
     cutils,cclasses,constexp,
     verbose,systems,
     verbose,systems,
     fmodule,
     fmodule,
-    symtable,symconst,symsym,symdef,symcpu,symcreat,
+    symtable,symconst,symsym,symcpu,symcreat,
+    pparautl,
     defutil,paramgr;
     defutil,paramgr;
 
 
 {******************************************************************
 {******************************************************************
@@ -539,6 +544,7 @@ implementation
           orddef:
           orddef:
             begin
             begin
               case torddef(def).ordtype of
               case torddef(def).ordtype of
+                pasbool1,
                 pasbool8:
                 pasbool8:
                   begin
                   begin
                     objdef:=tobjectdef(search_system_type('JLBOOLEAN').typedef);
                     objdef:=tobjectdef(search_system_type('JLBOOLEAN').typedef);
@@ -622,6 +628,7 @@ implementation
           orddef:
           orddef:
             begin
             begin
               case torddef(def).ordtype of
               case torddef(def).ordtype of
+                pasbool1,
                 pasbool8:
                 pasbool8:
                   result:='BOOLEANVALUE';
                   result:='BOOLEANVALUE';
                 s8bit,
                 s8bit,
@@ -784,6 +791,7 @@ implementation
           orddef:
           orddef:
             begin
             begin
               case torddef(def).ordtype of
               case torddef(def).ordtype of
+                pasbool1,
                 pasbool8:
                 pasbool8:
                   begin
                   begin
                     result:=tobjectdef(search_system_type('FPCBOOLEANTHREADVAR').typedef);
                     result:=tobjectdef(search_system_type('FPCBOOLEANTHREADVAR').typedef);
@@ -1021,4 +1029,135 @@ implementation
       end;
       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.
 end.

+ 1 - 1
compiler/jvm/njvmcnv.pas

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

+ 1 - 1
compiler/jvm/njvminl.pas

@@ -487,7 +487,7 @@ implementation
         { prepend new }
         { prepend new }
         newparas:=ccallparanode.create(newnode,newparas);
         newparas:=ccallparanode.create(newnode,newparas);
         { prepend deepcopy }
         { 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 }
         { call the right setlenght helper }
         if ndims>1 then
         if ndims>1 then
           begin
           begin

+ 9 - 2
compiler/jvm/njvmutil.pas

@@ -28,7 +28,7 @@ interface
   uses
   uses
     cclasses,
     cclasses,
     node,nbas,
     node,nbas,
-    ngenutil,
+    fmodule,ngenutil,
     symtype,symconst,symsym,symdef;
     symtype,symconst,symsym,symdef;
 
 
 
 
@@ -36,6 +36,7 @@ interface
     tjvmnodeutils = class(tnodeutils)
     tjvmnodeutils = class(tnodeutils)
       class function initialize_data_node(p:tnode; force: boolean):tnode; override;
       class function initialize_data_node(p:tnode; force: boolean):tnode; override;
       class function finalize_data_node(p:tnode):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 function force_init: boolean; override;
       class procedure insertbssdata(sym: tstaticvarsym); override;
       class procedure insertbssdata(sym: tstaticvarsym); override;
       class function create_main_procdef(const name: string; potype: tproctypeoption; ps: tprocsym): tdef; override;
       class function create_main_procdef(const name: string; potype: tproctypeoption; ps: tprocsym): tdef; override;
@@ -63,7 +64,7 @@ interface
 implementation
 implementation
 
 
     uses
     uses
-      verbose,cutils,globtype,globals,constexp,fmodule,compinnr,
+      verbose,cutils,globtype,globals,constexp,compinnr,
       aasmdata,aasmtai,cpubase,aasmbase,aasmcpu,
       aasmdata,aasmtai,cpubase,aasmbase,aasmcpu,
       symbase,symcpu,symtable,defutil,jvmdef,
       symbase,symcpu,symtable,defutil,jvmdef,
       ncnv,ncon,ninl,ncal,nld,nmem,
       ncnv,ncon,ninl,ncal,nld,nmem,
@@ -172,6 +173,12 @@ implementation
     end;
     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;
   class function tjvmnodeutils.force_init: boolean;
     begin
     begin
       { we need an initialisation in case the al_globals list is not empty
       { 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,
       globtype,
       symconst,symtype,symbase,symdef,symsym;
       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
     { records are emulated via Java classes. They require a default constructor
       to initialise temps, a deep copy helper for assignments, and clone()
       to initialise temps, a deep copy helper for assignments, and clone()
       to initialse dynamic arrays }
       to initialse dynamic arrays }
@@ -56,138 +52,11 @@ implementation
     verbose,globals,systems,
     verbose,globals,systems,
     fmodule,
     fmodule,
     parabase,aasmdata,
     parabase,aasmdata,
-    pdecsub,ngenutil,pparautl,
+    ngenutil,pparautl,
     symtable,symcreat,defcmp,jvmdef,symcpu,nobj,
     symtable,symcreat,defcmp,jvmdef,symcpu,nobj,
     defutil,paramgr;
     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);
     procedure add_java_default_record_methods_intf(def: trecorddef);
       var
       var
         sstate: tscannerstate;
         sstate: tscannerstate;
@@ -505,7 +374,7 @@ implementation
 
 
         { add a method to call the procvar using unwrapped arguments, which
         { add a method to call the procvar using unwrapped arguments, which
           then wraps them and calls through to JLRMethod.invoke }
           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);
         finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass);
         insert_self_and_vmt_para(methoddef);
         insert_self_and_vmt_para(methoddef);
         insert_funcret_para(methoddef);
         insert_funcret_para(methoddef);
@@ -540,7 +409,7 @@ implementation
             { add a method prototype matching the procvar (like the invoke
             { add a method prototype matching the procvar (like the invoke
               in the procvarclass itself) }
               in the procvarclass itself) }
             symtablestack.push(pvintf.symtable);
             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);
             finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf);
             insert_self_and_vmt_para(methoddef);
             insert_self_and_vmt_para(methoddef);
             insert_funcret_para(methoddef);
             insert_funcret_para(methoddef);
@@ -639,7 +508,7 @@ implementation
         wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
         wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
         wrapperpd.skpara:=pd;
         wrapperpd.skpara:=pd;
         { also create procvar type that we can use in the implementation }
         { 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;
         wrapperpv.calcparas;
         { no use in creating a callback wrapper here, this procvar type isn't
         { no use in creating a callback wrapper here, this procvar type isn't
           for public consumption }
           for public consumption }
@@ -667,7 +536,7 @@ implementation
         { wrapper is part of the same symtable as the original procdef }
         { wrapper is part of the same symtable as the original procdef }
         symtablestack.push(pd.owner);
         symtablestack.push(pd.owner);
         { get a copy of the constructor }
         { 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 }
         { this one is a class method rather than a constructor }
         include(wrapperpd.procoptions,po_classmethod);
         include(wrapperpd.procoptions,po_classmethod);
         wrapperpd.proctypeoption:=potype_function;
         wrapperpd.proctypeoption:=potype_function;

+ 3 - 3
compiler/jvm/symcpu.pas

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

+ 8 - 1
compiler/llvm/hlcgllvm.pas

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

+ 2 - 1
compiler/llvm/llvmdef.pas

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

+ 1 - 1
compiler/llvm/nllvmcnv.pas

@@ -180,7 +180,7 @@ procedure tllvmtypeconvnode.second_proc_to_procvar;
         if location.loc<>LOC_REFERENCE then
         if location.loc<>LOC_REFERENCE then
           internalerror(2015111902);
           internalerror(2015111902);
         hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,
         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),
           cpointerdef.getreusable(resultdef),
           location.reference);
           location.reference);
       end;
       end;

+ 1 - 1
compiler/llvm/nllvmld.pas

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

+ 1 - 1
compiler/m68k/cgcpu.pas

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

+ 2 - 2
compiler/m68k/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AmigaOS/MorphOS }
     { library symbol for AmigaOS/MorphOS }
     libsym : tsym;
     libsym : tsym;
     libsymderef : tderef;
     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 buildderef; override;
     procedure deref; override;
     procedure deref; override;
   end;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
     end;
 
 
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
     begin
       result:=inherited;
       result:=inherited;
       if newtyp=procdef then
       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}).
 % (in case of dynamic arrays that is the modeswitch \var{ArrayOperators}).
 parser_e_threadvar_must_be_class=03348_E_Thread variables inside classes or records must be class variables
 parser_e_threadvar_must_be_class=03348_E_Thread variables inside classes or records must be class variables
 % A \var{threadvar} section inside a class or record was started without it being prefixed by \var{class}.
 % A \var{threadvar} section inside a class or record was started without it being prefixed by \var{class}.
+parser_e_only_static_members_via_object_type=03349_E_Only static methods and static variables can be referenced through an object type
+% This error occurs in a situation like the following:
+% \begin{verbatim}
+% Type
+%    TObj = object
+%      procedure test;
+%    end;
+%
+% begin
+%   TObj.test;
+% \end{verbatim}
+% \var{test} is not a static method and hence cannot be called through a type, but only using an instance.
 %
 %
 %
 %
 % \end{description}
 % \end{description}

+ 3 - 2
compiler/msgidx.inc

@@ -459,6 +459,7 @@ const
   parser_e_invalid_internal_function_index=03346;
   parser_e_invalid_internal_function_index=03346;
   parser_w_operator_overloaded_hidden_3=03347;
   parser_w_operator_overloaded_hidden_3=03347;
   parser_e_threadvar_must_be_class=03348;
   parser_e_threadvar_must_be_class=03348;
+  parser_e_only_static_members_via_object_type=03349;
   type_e_mismatch=04000;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
   type_e_not_equal_types=04002;
@@ -1105,9 +1106,9 @@ const
   option_info=11024;
   option_info=11024;
   option_help_pages=11025;
   option_help_pages=11025;
 
 
-  MsgTxtSize = 82541;
+  MsgTxtSize = 82631;
 
 
   MsgIdxMax : array[1..20] of longint=(
   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
     62,20,30,1,1,1,1,1,1,1
   );
   );

Rozdielové dáta súboru neboli zobrazené, pretože súbor je príliš veľký
+ 379 - 370
compiler/msgtxt.inc


+ 38 - 38
compiler/nadd.pas

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

+ 4 - 2
compiler/ncal.pas

@@ -3197,12 +3197,12 @@ implementation
                 else
                 else
                  if vo_is_range_check in para.parasym.varoptions then
                  if vo_is_range_check in para.parasym.varoptions then
                    begin
                    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
                    end
                 else
                 else
                  if vo_is_overflow_check in para.parasym.varoptions then
                  if vo_is_overflow_check in para.parasym.varoptions then
                    begin
                    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
                    end
                 else
                 else
                   if vo_is_msgsel in para.parasym.varoptions then
                   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 }
         { this is just to play it safe, there are more safe situations }
         if (n.nodetype = derefn) or
         if (n.nodetype = derefn) or
            ((n.nodetype = loadn) and
            ((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 }
             { globals and fields of (possibly global) objects could always be changed in the callee }
             ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or
             ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or
             { statics can only be modified by functions in the same unit }
             { statics can only be modified by functions in the same unit }

+ 1 - 1
compiler/ncgcnv.pas

@@ -574,7 +574,7 @@ interface
                     begin
                     begin
                       location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
                       location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
                       { code field is the first one }
                       { 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);
                       hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,left.location.reference,location.register);
                     end;
                     end;
                   LOC_REGISTER,LOC_CREGISTER:
                   LOC_REGISTER,LOC_CREGISTER:

+ 5 - 1
compiler/ncgld.pas

@@ -420,6 +420,7 @@ implementation
         href : treference;
         href : treference;
         newsize : tcgsize;
         newsize : tcgsize;
         vd : tdef;
         vd : tdef;
+        alignment: longint;
         indirect : boolean;
         indirect : boolean;
         name : TSymStr;
         name : TSymStr;
       begin
       begin
@@ -529,7 +530,10 @@ implementation
                     { assume packed records may always be unaligned }
                     { assume packed records may always be unaligned }
                     if not(resultdef.typ in [recorddef,objectdef]) or
                     if not(resultdef.typ in [recorddef,objectdef]) or
                        (tabstractrecordsymtable(tabstractrecorddef(resultdef).symtable).usefieldalignment<>1) then
                        (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
                     else
                       location_reset_ref(location,LOC_REFERENCE,newsize,1,[]);
                       location_reset_ref(location,LOC_REFERENCE,newsize,1,[]);
                     hlcg.reference_reset_base(location.reference,voidpointertype,hregister,0,ctempposinvalid,location.reference.alignment,[]);
                     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;
           procedure pass_generate_code;override;
        end;
        end;
 
 
-       tcgwithnode = class(twithnode)
-          procedure pass_generate_code;override;
-       end;
-
        tcgvecnode = class(tvecnode)
        tcgvecnode = class(tvecnode)
          function get_mul_size : asizeint;
          function get_mul_size : asizeint;
        private
        private
@@ -607,19 +603,6 @@ implementation
       end;
       end;
 
 
 
 
-{*****************************************************************************
-                            TCGWITHNODE
-*****************************************************************************}
-
-    procedure tcgwithnode.pass_generate_code;
-      begin
-        location_reset(location,LOC_VOID,OS_NO);
-
-        if assigned(left) then
-          secondpass(left);
-       end;
-
-
 {*****************************************************************************
 {*****************************************************************************
                             TCGVECNODE
                             TCGVECNODE
 *****************************************************************************}
 *****************************************************************************}
@@ -1109,6 +1092,5 @@ begin
    caddrnode:=tcgaddrnode;
    caddrnode:=tcgaddrnode;
    cderefnode:=tcgderefnode;
    cderefnode:=tcgderefnode;
    csubscriptnode:=tcgsubscriptnode;
    csubscriptnode:=tcgsubscriptnode;
-   cwithnode:=tcgwithnode;
    cvecnode:=tcgvecnode;
    cvecnode:=tcgvecnode;
 end.
 end.

+ 6 - 11
compiler/ncgnstld.pas

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

+ 2 - 2
compiler/ncgnstmm.pas

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

+ 2 - 1
compiler/ncgrtti.pas

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

+ 6 - 12
compiler/ncnv.pas

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

+ 6 - 55
compiler/nflw.pas

@@ -29,7 +29,7 @@ interface
     uses
     uses
       cclasses,
       cclasses,
       node,cpubase,
       node,cpubase,
-      symtype,symbase,symdef,symsym,
+      symconst,symtype,symbase,symdef,symsym,
       optloop;
       optloop;
 
 
     type
     type
@@ -197,7 +197,6 @@ interface
           function pass_1 : tnode;override;
           function pass_1 : tnode;override;
           function simplify(forinline:boolean): tnode;override;
           function simplify(forinline:boolean): tnode;override;
        protected
        protected
-          function create_finalizer_procdef: tprocdef;
           procedure adjust_estimated_stack_size; virtual;
           procedure adjust_estimated_stack_size; virtual;
        end;
        end;
        ttryfinallynodeclass = class of ttryfinallynode;
        ttryfinallynodeclass = class of ttryfinallynode;
@@ -243,9 +242,8 @@ implementation
     uses
     uses
       globtype,systems,constexp,compinnr,
       globtype,systems,constexp,compinnr,
       cutils,verbose,globals,
       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,
       ncal,nadd,ncon,nmem,nld,ncnv,nbas,nutils,ninl,nset,ngenutil,
-      pdecsub,
     {$ifdef state_tracking}
     {$ifdef state_tracking}
       nstate,
       nstate,
     {$endif}
     {$endif}
@@ -472,7 +470,7 @@ implementation
           one }
           one }
         hp:=cwhilerepeatnode.create(
         hp:=cwhilerepeatnode.create(
           { repeat .. until false }
           { repeat .. until false }
-          cordconstnode.create(0,pasbool8type,false),innerloop,false,true);
+          cordconstnode.create(0,pasbool1type,false),innerloop,false,true);
         addstatement(outerloopbodystatement,hp);
         addstatement(outerloopbodystatement,hp);
 
 
         { create the outer repeat/until and add it to the the main body }
         { 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
          if not(is_boolean(left.resultdef)) and
            not(is_typeparam(left.resultdef)) then
            not(is_typeparam(left.resultdef)) then
-             inserttypeconv(left,pasbool8type);
+             inserttypeconv(left,pasbool1type);
 
 
          { Give warnings for code that will never be executed for
          { Give warnings for code that will never be executed for
            while false do }
            while false do }
@@ -1339,7 +1337,7 @@ implementation
             end;
             end;
         if not is_constboolnode(condition) then
         if not is_constboolnode(condition) then
             aktstate.store_fact(condition,
             aktstate.store_fact(condition,
-             cordconstnode.create(byte(checknegate),pasbool8type,true))
+             cordconstnode.create(byte(checknegate),pasbool1type,true))
         else
         else
             condition.destroy;
             condition.destroy;
     end;
     end;
@@ -1420,7 +1418,7 @@ implementation
 
 
          if not(is_boolean(left.resultdef)) and
          if not(is_boolean(left.resultdef)) and
            not(is_typeparam(left.resultdef)) then
            not(is_typeparam(left.resultdef)) then
-             inserttypeconv(left,pasbool8type);
+             inserttypeconv(left,pasbool1type);
 
 
          result:=internalsimplify(not(nf_internal in flags));
          result:=internalsimplify(not(nf_internal in flags));
       end;
       end;
@@ -2360,53 +2358,6 @@ implementation
      end;
      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;
     procedure ttryfinallynode.adjust_estimated_stack_size;
       begin
       begin
         inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size);
         inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size);

+ 1 - 1
compiler/ngenutil.pas

@@ -57,7 +57,7 @@ interface
         all local (static) typed consts }
         all local (static) typed consts }
       class procedure static_syms_finalize(p: TObject; arg: pointer);
       class procedure static_syms_finalize(p: TObject; arg: pointer);
       class procedure sym_maybe_finalize(var stat: tstatementnode; sym: tsym);
       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
      public
       class procedure procdef_block_add_implicit_initialize_nodes(pd: tprocdef; var stat: tstatementnode);
       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);
       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
       begin
         case def.ordtype of
         case def.ordtype of
+           pasbool1,
            pasbool8,
            pasbool8,
            bool8bit,
            bool8bit,
            pasbool16,
            pasbool16,
@@ -915,9 +916,11 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                        case hp.nodetype of
                        case hp.nodetype of
                          vecn :
                          vecn :
                            begin
                            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))
                                ftcb.queue_vecn(tvecnode(hp).left.resultdef,get_ordinal_value(tvecnode(hp).right))
                              else
                              else
                                Message(parser_e_illegal_expression);
                                Message(parser_e_illegal_expression);

+ 8 - 6
compiler/ninl.pas

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

+ 1 - 0
compiler/nmat.pas

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

+ 0 - 73
compiler/nmem.pas

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

+ 11 - 1
compiler/nobj.pas

@@ -511,6 +511,7 @@ implementation
         hclass : tobjectdef;
         hclass : tobjectdef;
         hashedid : THashedIDString;
         hashedid : THashedIDString;
         srsym      : tsym;
         srsym      : tsym;
+        overload: boolean;
       begin
       begin
         result:=nil;
         result:=nil;
         hashedid.id:=name;
         hashedid.id:=name;
@@ -519,11 +520,16 @@ implementation
           begin
           begin
             srsym:=tsym(hclass.symtable.FindWithHash(hashedid));
             srsym:=tsym(hclass.symtable.FindWithHash(hashedid));
             if assigned(srsym) and
             if assigned(srsym) and
-               (srsym.typ=procsym) then
+               (srsym.typ=procsym) and
+               ((hclass=_class) or
+                is_visible_for_object(srsym,_class)) then
               begin
               begin
+                overload:=false;
                 for i:=0 to Tprocsym(srsym).ProcdefList.Count-1 do
                 for i:=0 to Tprocsym(srsym).ProcdefList.Count-1 do
                   begin
                   begin
                     implprocdef:=tprocdef(tprocsym(srsym).ProcdefList[i]);
                     implprocdef:=tprocdef(tprocsym(srsym).ProcdefList[i]);
+                    if po_overload in implprocdef.procoptions then
+                      overload:=true;
                     if (implprocdef.procsym=tprocsym(srsym)) and
                     if (implprocdef.procsym=tprocsym(srsym)) and
                        (compare_paras(proc.paras,implprocdef.paras,cp_all,[cpo_ignorehidden,cpo_ignoreuniv])>=te_equal) 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
                        (compare_defs(proc.returndef,implprocdef.returndef,nothingn)>=te_equal) and
@@ -544,6 +550,10 @@ implementation
                         exit;
                         exit;
                       end;
                       end;
                   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;
               end;
             hclass:=hclass.childof;
             hclass:=hclass.childof;
           end;
           end;

+ 0 - 2
compiler/node.pas

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

+ 7 - 7
compiler/nset.pas

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

+ 10 - 0
compiler/nutils.pas

@@ -153,6 +153,10 @@ interface
     { include or exclude cs from p.localswitches }
     { include or exclude cs from p.localswitches }
     procedure node_change_local_switch(p : tnode;cs : tlocalswitch;enable : boolean);
     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
 implementation
 
 
     uses
     uses
@@ -1466,4 +1470,10 @@ implementation
         foreachnodestatic(p,@do_change_local_settings,@lsc);
         foreachnodestatic(p,@do_change_local_settings,@lsc);
       end;
       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.
 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 }
           iterate manually here so we have full controll how all nodes are processed }
 
 
         { We cannot analyze beyond those nodes, so we terminate to be on the safe side }
         { We cannot analyze beyond those nodes, so we terminate to be on the safe side }
-        if (n.nodetype in [addrn,derefn,asmn,withn,casen,whilerepeatn,labeln,continuen,breakn,
+        if (n.nodetype in [addrn,derefn,asmn,casen,whilerepeatn,labeln,continuen,breakn,
                            tryexceptn,raisen,tryfinallyn,onn,loadparentfpn,loadvmtaddrn,guidconstn,rttin,addoptn,asn,goton,
                            tryexceptn,raisen,tryfinallyn,onn,loadparentfpn,loadvmtaddrn,guidconstn,rttin,addoptn,asn,goton,
                            objcselectorn,objcprotocoln]) then
                            objcselectorn,objcprotocoln]) then
           exit(false)
           exit(false)

+ 16 - 2
compiler/optcse.pas

@@ -298,14 +298,14 @@ unit optcse;
             if not(csedomain) then
             if not(csedomain) then
               begin
               begin
                 { try to transform the tree to get better cse domains, consider:
                 { try to transform the tree to get better cse domains, consider:
-                       +
+                       +    (1)
                       / \
                       / \
                      +   C
                      +   C
                     / \
                     / \
                    A   B
                    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
                   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   +
                      A   +
                         / \
                         / \
@@ -329,6 +329,9 @@ unit optcse;
                    (is_set(n.resultdef))
                    (is_set(n.resultdef))
                    ) then
                    ) then
                   while (n.nodetype=tbinarynode(n).left.nodetype) and
                   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,
                         { the resulttypes of the operands we'll swap must be equal,
                           required in case of a 32x32->64 multiplication, then we
                           required in case of a 32x32->64 multiplication, then we
                           cannot swap out one of the 32 bit operands for a 64 bit one
                           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);
                           foreachnodestatic(pm_postprocess,tbinarynode(tbinarynode(n).left).right,@searchsubdomain,@csedomain);
                           if csedomain then
                           if csedomain then
                             begin
                             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;
                               hp2:=tbinarynode(tbinarynode(n).left).left;
                               tbinarynode(tbinarynode(n).left).left:=tbinarynode(tbinarynode(n).left).right;
                               tbinarynode(tbinarynode(n).left).left:=tbinarynode(tbinarynode(n).left).right;
                               tbinarynode(tbinarynode(n).left).right:=tbinarynode(n).right;
                               tbinarynode(tbinarynode(n).left).right:=tbinarynode(n).right;

+ 0 - 1
compiler/optutils.pas

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

+ 0 - 1
compiler/pass_2.pas

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

+ 3 - 3
compiler/pdecl.pas

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

+ 5 - 5
compiler/pdecobj.pas

@@ -49,9 +49,9 @@ implementation
       symbase,symsym,symtable,symcreat,defcmp,
       symbase,symsym,symtable,symcreat,defcmp,
       node,ncon,
       node,ncon,
       fmodule,scanner,
       fmodule,scanner,
-      pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,ppu
+      pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,pparautl,ppu
 {$ifdef jvm}
 {$ifdef jvm}
-      ,pjvm;
+      ,jvmdef,pjvm;
 {$else}
 {$else}
       ;
       ;
 {$endif}
 {$endif}
@@ -75,12 +75,12 @@ implementation
               // we can't add hidden params here because record is not yet defined
               // 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
               // 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)
               // 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;
             end;
           objectdef:
           objectdef:
             begin
             begin
               parse_object_proc_directives(pd);
               parse_object_proc_directives(pd);
-              handle_calling_convention(pd);
+              handle_calling_convention(pd,hcc_default_actions_intf);
             end
             end
           else
           else
             internalerror(2011040502);
             internalerror(2011040502);
@@ -923,7 +923,7 @@ implementation
                      is_classdef and not (po_staticmethod in result.procoptions) then
                      is_classdef and not (po_staticmethod in result.procoptions) then
                     MessagePos(result.fileinfo,parser_e_class_methods_only_static_in_records);
                     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 }
                   { add definition to procsym }
                   proc_add_definition(result);
                   proc_add_definition(result);

+ 5 - 666
compiler/pdecsub.pas

@@ -55,23 +55,11 @@ interface
       );
       );
       tpdflags=set of tpdflag;
       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  check_proc_directive(isprocvar:boolean):boolean;
 
 
-    function  proc_add_definition(var currpd:tprocdef):boolean;
     function  proc_get_importname(pd:tprocdef):string;
     function  proc_get_importname(pd:tprocdef):string;
     procedure proc_set_mangledname(pd:tprocdef);
     procedure proc_set_mangledname(pd:tprocdef);
 
 
-    procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
-
     procedure parse_parameter_dec(pd:tabstractprocdef);
     procedure parse_parameter_dec(pd:tabstractprocdef);
     procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
     procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
     procedure parse_var_proc_directives(sym:tsym);
     procedure parse_var_proc_directives(sym:tsym);
@@ -84,8 +72,6 @@ interface
     { parse a record method declaration (not a (class) constructor/destructor) }
     { parse a record method declaration (not a (class) constructor/destructor) }
     function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean;hadgeneric:boolean): tprocdef;
     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
     { helper functions - they insert nested objects hierarchy to the symtablestack
       with object hierarchy
       with object hierarchy
     }
     }
@@ -107,7 +93,7 @@ implementation
        { assembler }
        { assembler }
        aasmbase,
        aasmbase,
        { symtable }
        { symtable }
-       symbase,symcpu,symtable,defutil,defcmp,
+       symbase,symcpu,symtable,symutil,defutil,defcmp,
        { parameter handling }
        { parameter handling }
        paramgr,cpupara,
        paramgr,cpupara,
        { pass 1 }
        { pass 1 }
@@ -128,25 +114,6 @@ implementation
         Declaring it as string here results in an error when compiling (PFV) }
         Declaring it as string here results in an error when compiling (PFV) }
       current_procinfo = 'error';
       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;
     function push_child_hierarchy(obj:tabstractrecorddef):integer;
       var
       var
         _class,hp : tobjectdef;
         _class,hp : tobjectdef;
@@ -223,19 +190,6 @@ implementation
       end;
       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);
     procedure parse_parameter_dec(pd:tabstractprocdef);
       {
       {
         handle_procvar needs the same changes
         handle_procvar needs the same changes
@@ -403,7 +357,7 @@ implementation
                   dummytype.free;
                   dummytype.free;
                end;
                end;
              { Add implicit hidden parameters and function result }
              { Add implicit hidden parameters and function result }
-             handle_calling_convention(pv);
+             handle_calling_convention(pv,hcc_default_actions_intf);
 {$ifdef jvm}
 {$ifdef jvm}
              { anonymous -> no name }
              { anonymous -> no name }
              jvm_create_procvar_class('',pv);
              jvm_create_procvar_class('',pv);
@@ -1735,7 +1689,7 @@ implementation
             // we can't add hidden params here because record is not yet defined
             // 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
             // 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)
             // 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 }
             { add definition to procsym }
             proc_add_definition(result);
             proc_add_definition(result);
@@ -1750,33 +1704,6 @@ implementation
       end;
       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
                         Procedure directive handlers
 ****************************************************************************}
 ****************************************************************************}
@@ -2793,7 +2720,7 @@ const
       pooption : [po_virtualmethod];
       pooption : [po_virtualmethod];
       mutexclpocall : [pocall_internproc];
       mutexclpocall : [pocall_internproc];
       mutexclpotype : [potype_class_constructor,potype_class_destructor];
       mutexclpotype : [potype_class_constructor,potype_class_destructor];
-      mutexclpo     : [po_interrupt,po_exports,po_overridingmethod,po_inline,po_staticmethod]
+      mutexclpo     : PD_VIRTUAL_MUTEXCLPO
     ),(
     ),(
       idtok:_CPPDECL;
       idtok:_CPPDECL;
       pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
       pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
@@ -3147,7 +3074,6 @@ const
       end;
       end;
 
 
 
 
-
     function proc_get_importname(pd:tprocdef):string;
     function proc_get_importname(pd:tprocdef):string;
       var
       var
         dllname, importname : string;
         dllname, importname : string;
@@ -3202,12 +3128,6 @@ const
       end;
       end;
 
 
 
 
-    procedure compilerproc_set_symbol_name(pd: tprocdef);
-      begin
-        pd.procsym.realname:='$'+lower(pd.procsym.name);
-      end;
-
-
     procedure proc_set_mangledname(pd:tprocdef);
     procedure proc_set_mangledname(pd:tprocdef);
       var
       var
         s : string;
         s : string;
@@ -3231,7 +3151,7 @@ const
                       implementation that needs to match the original symbol
                       implementation that needs to match the original symbol
                       again -> immediately convert here }
                       again -> immediately convert here }
                     if po_compilerproc in pd.procoptions then
                     if po_compilerproc in pd.procoptions then
-                      compilerproc_set_symbol_name(pd);
+                      pd.setcompilerprocname;
                   end
                   end
               end
               end
             else
             else
@@ -3276,117 +3196,6 @@ const
       end;
       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);
     procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
       {
       {
         Parse the procedure directives. It does not matter if procedure directives
         Parse the procedure directives. It does not matter if procedure directives
@@ -3537,474 +3346,4 @@ const
         parse_proc_directives(pd,pdflags);
         parse_proc_directives(pd,pdflags);
       end;
       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.
 end.

+ 10 - 10
compiler/pdecvar.pas

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

+ 46 - 7
compiler/pexpr.pas

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

+ 6 - 3
compiler/pgenutil.pas

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

+ 2 - 2
compiler/pmodules.pas

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

+ 2 - 2
compiler/powerpc/symcpu.pas

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

+ 690 - 5
compiler/pparautl.pas

@@ -26,7 +26,7 @@ unit pparautl;
 interface
 interface
 
 
     uses
     uses
-      symdef;
+      symconst,symdef;
 
 
     procedure insert_funcret_para(pd:tabstractprocdef);
     procedure insert_funcret_para(pd:tabstractprocdef);
     procedure insert_parentfp_para(pd:tabstractprocdef);
     procedure insert_parentfp_para(pd:tabstractprocdef);
@@ -34,12 +34,42 @@ interface
     procedure insert_funcret_local(pd:tprocdef);
     procedure insert_funcret_local(pd:tprocdef);
     procedure insert_hidden_para(p:TObject;arg:pointer);
     procedure insert_hidden_para(p:TObject;arg:pointer);
     procedure check_c_para(pd:Tabstractprocdef);
     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
 implementation
 
 
     uses
     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;
       paramgr;
 
 
 
 
@@ -128,8 +158,8 @@ implementation
               begin
               begin
                 if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
                 if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
                   build_parentfpstruct(tprocdef(pd.owner.defowner));
                   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;
               end;
             pd.parast.insert(vs);
             pd.parast.insert(vs);
 
 
@@ -418,4 +448,659 @@ implementation
       end;
       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.
 end.

+ 1 - 1
compiler/ppcgen/cgppc.pas

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

+ 2 - 2
compiler/ppcgen/ngppcadd.pas

@@ -199,8 +199,8 @@ implementation
         firstcomplex(self);
         firstcomplex(self);
 
 
         cmpop:=false;
         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
           cgsize:=OS_8
         else if (torddef(left.resultdef).ordtype in [pasbool16,bool16bit]) or
         else if (torddef(left.resultdef).ordtype in [pasbool16,bool16bit]) or
            (torddef(right.resultdef).ordtype in [pasbool16,bool16bit]) then
            (torddef(right.resultdef).ordtype in [pasbool16,bool16bit]) then

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 {$endif Test_Double_checksum}
 
 
 const
 const
-  CurrentPPUVersion = 204;
+  CurrentPPUVersion = 206;
 
 
 { unit flags }
 { unit flags }
   uf_init                = $000001; { unit has initialization section }
   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 }
       { global }
       globtype,
       globtype,
       { symtable }
       { symtable }
-      symconst,symdef,symsym,
+      symconst,symtype,symdef,symsym,
+      node,
       { aasm }
       { aasm }
       cpubase,cgbase,cgutils,
       cpubase,cgbase,cgutils,
       aasmbase,aasmdata;
       aasmbase,aasmdata;
@@ -160,6 +161,8 @@ unit procinfo;
           function has_nestedprocs: boolean;
           function has_nestedprocs: boolean;
           function get_normal_proc: tprocinfo;
           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 }
           { Add to parent's list of nested procedures even if parent is a 'main' procedure }
           procedure force_nested;
           procedure force_nested;
 
 
@@ -181,7 +184,8 @@ unit procinfo;
 implementation
 implementation
 
 
     uses
     uses
-      cutils,systems;
+      globals,cutils,systems,
+      procdefutil;
 
 
 {****************************************************************************
 {****************************************************************************
                                  TProcInfo
                                  TProcInfo
@@ -265,6 +269,17 @@ implementation
           result:=result.parent;
           result:=result.parent;
       end;
       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);
     procedure tprocinfo.allocate_push_parasize(size:longint);
       begin
       begin
         if size>maxpushedparasize then
         if size>maxpushedparasize then

+ 0 - 2
compiler/pstatmnt.pas

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

+ 20 - 10
compiler/psub.pas

@@ -895,6 +895,18 @@ implementation
         addstatement(newstatement,entry_asmnode);
         addstatement(newstatement,entry_asmnode);
         cnodeutils.procdef_block_add_implicit_initialize_nodes(procdef,newstatement);
         cnodeutils.procdef_block_add_implicit_initialize_nodes(procdef,newstatement);
         addstatement(newstatement,init_asmnode);
         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);
         addstatement(newstatement,bodyentrycode);
 
 
         if (cs_implicit_exceptions in current_settings.moduleswitches) and
         if (cs_implicit_exceptions in current_settings.moduleswitches) and
@@ -1812,6 +1824,7 @@ implementation
          old_current_structdef: tabstractrecorddef;
          old_current_structdef: tabstractrecorddef;
          old_current_genericdef,
          old_current_genericdef,
          old_current_specializedef: tstoreddef;
          old_current_specializedef: tstoreddef;
+         parentfpinitblock: tnode;
          old_parse_generic: boolean;
          old_parse_generic: boolean;
          recordtokens : boolean;
          recordtokens : boolean;
 
 
@@ -1924,16 +1937,10 @@ implementation
                begin
                begin
                  if assigned(tblocknode(procdef.parentfpinitblock).left) then
                  if assigned(tblocknode(procdef.parentfpinitblock).left) then
                    begin
                    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
                    end
-                 else
-                   procdef.parentfpinitblock.free;
-                 procdef.parentfpinitblock:=nil;
                end;
                end;
 
 
            end;
            end;
@@ -2187,7 +2194,10 @@ implementation
               Consume(_SEMICOLON);
               Consume(_SEMICOLON);
 
 
              { Set calling convention }
              { 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;
            end;
 
 
          { search for forward declarations }
          { 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('Insert',in_insert_x_y_z));
         systemunit.insert(csyssym.create('Delete',in_delete_x_y_z));
         systemunit.insert(csyssym.create('Delete',in_delete_x_y_z));
         systemunit.insert(csyssym.create('GetTypeKind',in_gettypekind_x));
         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;
       end;
 
 
 
 
@@ -271,6 +271,7 @@ implementation
           implement overflow checking }
           implement overflow checking }
         u128inttype:=corddef.create(u128bit,0,0,true);
         u128inttype:=corddef.create(u128bit,0,0,true);
         s128inttype:=corddef.create(s128bit,0,0,true);
         s128inttype:=corddef.create(s128bit,0,0,true);
+        pasbool1type:=corddef.create(pasbool1,0,1,true);
         pasbool8type:=corddef.create(pasbool8,0,1,true);
         pasbool8type:=corddef.create(pasbool8,0,1,true);
         pasbool16type:=corddef.create(pasbool16,0,1,true);
         pasbool16type:=corddef.create(pasbool16,0,1,true);
         pasbool32type:=corddef.create(pasbool32,0,1,true);
         pasbool32type:=corddef.create(pasbool32,0,1,true);
@@ -280,7 +281,7 @@ implementation
         bool32type:=corddef.create(bool32bit,low(int64),high(int64),true);
         bool32type:=corddef.create(bool32bit,low(int64),high(int64),true);
         bool64type:=corddef.create(bool64bit,low(int64),high(int64),true);
         bool64type:=corddef.create(bool64bit,low(int64),high(int64),true);
 {$ifdef llvm}
 {$ifdef llvm}
-        llvmbool1type:=corddef.create(pasbool8,0,1,true);
+        llvmbool1type:=corddef.create(pasbool1,0,1,true);
 {$endif llvm}
 {$endif llvm}
         cansichartype:=corddef.create(uchar,0,255,true);
         cansichartype:=corddef.create(uchar,0,255,true);
         cwidechartype:=corddef.create(uwidechar,0,65535,true);
         cwidechartype:=corddef.create(uwidechar,0,65535,true);
@@ -451,7 +452,8 @@ implementation
         addtype('UnicodeString',cunicodestringtype);
         addtype('UnicodeString',cunicodestringtype);
 
 
         addtype('OpenString',openshortstringtype);
         addtype('OpenString',openshortstringtype);
-        addtype('Boolean',pasbool8type);
+        addtype('Boolean',pasbool1type);
+        addtype('Boolean8',pasbool8type);
         addtype('Boolean16',pasbool16type);
         addtype('Boolean16',pasbool16type);
         addtype('Boolean32',pasbool32type);
         addtype('Boolean32',pasbool32type);
         addtype('Boolean64',pasbool64type);
         addtype('Boolean64',pasbool64type);
@@ -503,7 +505,8 @@ implementation
         addtype('$widestring',cwidestringtype);
         addtype('$widestring',cwidestringtype);
         addtype('$unicodestring',cunicodestringtype);
         addtype('$unicodestring',cunicodestringtype);
         addtype('$openshortstring',openshortstringtype);
         addtype('$openshortstring',openshortstringtype);
-        addtype('$boolean',pasbool8type);
+        addtype('$boolean',pasbool1type);
+        addtype('$boolean8',pasbool8type);
         addtype('$boolean16',pasbool16type);
         addtype('$boolean16',pasbool16type);
         addtype('$boolean32',pasbool32type);
         addtype('$boolean32',pasbool32type);
         addtype('$boolean64',pasbool64type);
         addtype('$boolean64',pasbool64type);
@@ -649,7 +652,8 @@ implementation
             loadtype('sc80real',sc80floattype);
             loadtype('sc80real',sc80floattype);
           end;
           end;
         loadtype('s64currency',s64currencytype);
         loadtype('s64currency',s64currencytype);
-        loadtype('boolean',pasbool8type);
+        loadtype('boolean',pasbool1type);
+        loadtype('boolean8',pasbool8type);
         loadtype('boolean16',pasbool16type);
         loadtype('boolean16',pasbool16type);
         loadtype('boolean32',pasbool32type);
         loadtype('boolean32',pasbool32type);
         loadtype('boolean64',pasbool64type);
         loadtype('boolean64',pasbool64type);
@@ -761,7 +765,6 @@ implementation
         nodeclass[whilerepeatn]:=cwhilerepeatnode;
         nodeclass[whilerepeatn]:=cwhilerepeatnode;
         nodeclass[forn]:=cfornode;
         nodeclass[forn]:=cfornode;
         nodeclass[exitn]:=cexitnode;
         nodeclass[exitn]:=cexitnode;
-        nodeclass[withn]:=cwithnode;
         nodeclass[casen]:=ccasenode;
         nodeclass[casen]:=ccasenode;
         nodeclass[labeln]:=clabelnode;
         nodeclass[labeln]:=clabelnode;
         nodeclass[goton]:=cgotonode;
         nodeclass[goton]:=cgotonode;

+ 4 - 4
compiler/ptype.pas

@@ -82,7 +82,7 @@ implementation
        nset,ncnv,ncon,nld,
        nset,ncnv,ncon,nld,
        { parser }
        { parser }
        scanner,
        scanner,
-       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil
+       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil,pparautl
 {$ifdef jvm}
 {$ifdef jvm}
        ,pjvm
        ,pjvm
 {$endif}
 {$endif}
@@ -1129,7 +1129,7 @@ implementation
                                def:=corddef.create(uchar,lv,hv,true)
                                def:=corddef.create(uchar,lv,hv,true)
                              else
                              else
                                if is_boolean(pt1.resultdef) then
                                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
                                else if is_signed(pt1.resultdef) then
                                  def:=corddef.create(range_to_basetype(lv,hv),lv,hv,true)
                                  def:=corddef.create(range_to_basetype(lv,hv),lv,hv,true)
                                else
                                else
@@ -1335,7 +1335,7 @@ implementation
 {$ifdef cpu64bitaddr}
 {$ifdef cpu64bitaddr}
                     u32bit,s64bit,
                     u32bit,s64bit,
 {$endif cpu64bitaddr}
 {$endif cpu64bitaddr}
-                    pasbool8,pasbool16,pasbool32,pasbool64,
+                    pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
                     bool8bit,bool16bit,bool32bit,bool64bit,
                     bool8bit,bool16bit,bool32bit,bool64bit,
                     uwidechar] then
                     uwidechar] then
                     begin
                     begin
@@ -1596,7 +1596,7 @@ implementation
                     newtype.free;
                     newtype.free;
                   end;
                   end;
                 { Add implicit hidden parameters and function result }
                 { Add implicit hidden parameters and function result }
-                handle_calling_convention(pd);
+                handle_calling_convention(pd,hcc_default_actions_intf);
               end;
               end;
             { restore old state }
             { restore old state }
             parse_generic:=old_parse_generic;
             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. }
         that we use the base types instead of the cpu-specific ones. }
       sintdef:=torddef.create(s64bit,low(int64),high(int64),false);
       sintdef:=torddef.create(s64bit,low(int64),high(int64),false);
       uintdef:=torddef.create(u64bit,low(qword),high(qword),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);
       strdef:=tstringdef.createansi(0,false);
       setdef:=tsetdef.create(sintdef,0,255,false);
       setdef:=tsetdef.create(sintdef,0,255,false);
       realdef:=tfloatdef.create(s80real,false);
       realdef:=tfloatdef.create(s80real,false);

+ 1 - 1
compiler/sparcgen/cgsparc.pas

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

+ 1 - 1
compiler/symconst.pas

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

+ 22 - 84
compiler/symcreat.pas

@@ -97,10 +97,6 @@ interface
     tprocdef.getcopyas(procdef,pc_bareproc) }
     tprocdef.getcopyas(procdef,pc_bareproc) }
   procedure finish_copied_procdef(var pd: tprocdef; const realname: string; newparentst: tsymtable; newstruct: tabstractrecorddef);
   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
   { 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
     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
     "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, ...) }
   { finalises the parentfpstruct (alignment padding, ...) }
   procedure finish_parentfpstruct(pd: tprocdef);
   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
   { turns a fieldvarsym into a class/static field definition, and returns the
     created staticvarsym that is responsible for allocating the global storage }
     created staticvarsym that is responsible for allocating the global storage }
   function make_field_static(recst: tsymtable; fieldvs: tfieldvarsym): tstaticvarsym;
   function make_field_static(recst: tsymtable; fieldvs: tfieldvarsym): tstaticvarsym;
@@ -131,11 +125,13 @@ interface
 
 
   function generate_pkg_stub(pd:tprocdef):tnode;
   function generate_pkg_stub(pd:tprocdef):tnode;
 
 
+
+
 implementation
 implementation
 
 
   uses
   uses
     cutils,cclasses,globals,verbose,systems,comphook,fmodule,constexp,
     cutils,cclasses,globals,verbose,systems,comphook,fmodule,constexp,
-    symtable,defutil,
+    symtable,defutil,symutil,
     pbase,pdecobj,pdecsub,psub,ptconst,pparautl,
     pbase,pdecobj,pdecsub,psub,ptconst,pparautl,
 {$ifdef jvm}
 {$ifdef jvm}
     pjvm,jvmdef,
     pjvm,jvmdef,
@@ -515,7 +511,7 @@ implementation
     end;
     end;
 
 
 
 
-  procedure addvisibibleparameters(var str: ansistring; pd: tprocdef);
+  procedure addvisibleparameters(var str: ansistring; pd: tprocdef);
     var
     var
       currpara: tparavarsym;
       currpara: tparavarsym;
       i: longint;
       i: longint;
@@ -530,7 +526,7 @@ implementation
               if not firstpara then
               if not firstpara then
                 str:=str+',';
                 str:=str+',';
               firstpara:=false;
               firstpara:=false;
-              str:=str+currpara.realname;
+              str:=str+'&'+currpara.realname;
             end;
             end;
         end;
         end;
     end;
     end;
@@ -554,7 +550,7 @@ implementation
         mnetion this program/unit name to avoid accidentally calling other
         mnetion this program/unit name to avoid accidentally calling other
         same-named routines that may be in scope }
         same-named routines that may be in scope }
       str:=str+def_unit_name_prefix_if_toplevel(callpd)+callpd.procsym.realname+'(';
       str:=str+def_unit_name_prefix_if_toplevel(callpd)+callpd.procsym.realname+'(';
-      addvisibibleparameters(str,pd);
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       str:=str+') end;';
       str_parse_method_impl(str,pd,isclassmethod);
       str_parse_method_impl(str,pd,isclassmethod);
     end;
     end;
@@ -862,7 +858,7 @@ implementation
          not is_void(pd.returndef) then
          not is_void(pd.returndef) then
         str:=str+'result:=';
         str:=str+'result:=';
       str:=str+'pv(';
       str:=str+'pv(';
-      addvisibibleparameters(str,pd);
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       str:=str+') end;';
       str_parse_method_impl(str,pd,true)
       str_parse_method_impl(str,pd,true)
     end;
     end;
@@ -964,7 +960,7 @@ implementation
       if pd.returndef<>voidtype then
       if pd.returndef<>voidtype then
         str:=str+'result:=';
         str:=str+'result:=';
       str:=str+'__FPC_BLOCK_INVOKE_PV_TYPE(PFPC_Block_literal_complex_procvar(FPC_Block_Self)^.pv)(';
       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:=str+') end;';
       str_parse_method_impl(str,pd,false);
       str_parse_method_impl(str,pd,false);
     end;
     end;
@@ -988,8 +984,8 @@ implementation
       { now call through to the actual method }
       { now call through to the actual method }
       if pd.returndef<>voidtype then
       if pd.returndef<>voidtype then
         str:=str+'result:=';
         str:=str+'result:=';
-      str:=str+callthroughpd.procsym.realname+'(';
-      addvisibibleparameters(str,callthroughpd);
+      str:=str+'&'+callthroughpd.procsym.realname+'(';
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       str:=str+') end;';
       { add dummy file info so we can step in/through it }
       { add dummy file info so we can step in/through it }
       if pd.owner.iscurrentunit then
       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;
   function create_procdef_alias(pd: tprocdef; const newrealname: string; const newmangledname: TSymStr; newparentst: tsymtable; newstruct: tabstractrecorddef;
       sk: tsynthetickind; skpara: pointer): tprocdef;
       sk: tsynthetickind; skpara: pointer): tprocdef;
     begin
     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 }
       { set the mangled name to the wrapper name }
       result.setmangledname(newmangledname);
       result.setmangledname(newmangledname);
       { finish creating the copy }
       { finish creating the copy }
@@ -1225,52 +1224,6 @@ implementation
     end;
     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;
   function maybe_add_sym_to_parentfpstruct(pd: tprocdef; sym: tsym; vardef: tdef; addrparam: boolean): tsym;
     var
     var
       fieldvardef,
       fieldvardef,
@@ -1396,26 +1349,6 @@ implementation
     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 }
-          addsymref(ts);
-        end;
-    end;
-
-
   function make_field_static(recst: tsymtable; fieldvs: tfieldvarsym): tstaticvarsym;
   function make_field_static(recst: tsymtable; fieldvs: tfieldvarsym): tstaticvarsym;
     var
     var
       static_name: string;
       static_name: string;
@@ -1481,7 +1414,10 @@ implementation
         because there may already be references to the mangled name for the
         because there may already be references to the mangled name for the
         non-external "test".
         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);
       insert_funcret_para(newpd);
       newpd.procoptions:=newpd.procoptions+orgpd.procoptions*[po_external,po_has_importname,po_has_importdll];
       newpd.procoptions:=newpd.procoptions+orgpd.procoptions*[po_external,po_has_importname,po_has_importdll];
       newpd.import_name:=orgpd.import_name;
       newpd.import_name:=orgpd.import_name;
@@ -1493,6 +1429,9 @@ implementation
       newpd.setmangledname(newname);
       newpd.setmangledname(newname);
       finish_copied_procdef(newpd,'__FPC_IMPL_EXTERNAL_REDIRECT_'+newname,current_module.localsymtable,nil);
       finish_copied_procdef(newpd,'__FPC_IMPL_EXTERNAL_REDIRECT_'+newname,current_module.localsymtable,nil);
       newpd.forwarddef:=false;
       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.skpara:=newpd;
       orgpd.synthetickind:=tsk_callthrough;
       orgpd.synthetickind:=tsk_callthrough;
       orgpd.procoptions:=orgpd.procoptions-[po_external,po_has_importname,po_has_importdll];
       orgpd.procoptions:=orgpd.procoptions-[po_external,po_has_importname,po_has_importdll];
@@ -1514,6 +1453,5 @@ implementation
         result:=cnothingnode.create;
         result:=cnothingnode.create;
     end;
     end;
 
 
-
 end.
 end.
 
 

+ 60 - 22
compiler/symdef.pas

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

+ 49 - 3
compiler/symutil.pas

@@ -26,18 +26,24 @@ unit symutil;
 interface
 interface
 
 
     uses
     uses
-       symbase,symsym;
+       symconst,symbase,symtype,symsym;
 
 
     function is_funcret_sym(p:TSymEntry):boolean;
     function is_funcret_sym(p:TSymEntry):boolean;
 
 
     function equal_constsym(sym1,sym2:tconstsym; nanequal: boolean):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
 implementation
 
 
     uses
     uses
-       globtype,cpuinfo,constexp,
-       symconst,widestr;
+       systems,
+       globtype,cpuinfo,constexp,verbose,
+       widestr,
+       symdef;
 
 
 
 
     function is_funcret_sym(p:TSymEntry):boolean;
     function is_funcret_sym(p:TSymEntry):boolean;
@@ -95,5 +101,45 @@ implementation
         end;
         end;
       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.
 end.
 
 

+ 3 - 3
compiler/systems/i_android.pas

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

+ 3 - 3
compiler/systems/i_aros.pas

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

+ 12 - 12
compiler/systems/i_bsd.pas

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

+ 2 - 2
compiler/systems/i_embed.pas

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

+ 3 - 3
compiler/systems/i_linux.pas

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

+ 2 - 2
compiler/systems/i_sunos.pas

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

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

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

+ 1 - 1
compiler/x86/cgx86.pas

@@ -3633,7 +3633,7 @@ unit cgx86;
          if not ((def.typ=pointerdef) or
          if not ((def.typ=pointerdef) or
                 ((def.typ=orddef) and
                 ((def.typ=orddef) and
                  (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
                  (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                           pasbool8,pasbool16,pasbool32,pasbool64]))) then
+                                           pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then
            cond:=C_NO
            cond:=C_NO
          else
          else
            cond:=C_NB;
            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 }
                  as per the x86-64 ABI -> do the same }
                if not assigned(cl.def) or
                if not assigned(cl.def) or
                   not is_pasbool(cl.def) or
                   not is_pasbool(cl.def) or
-                  (size>1) then
+                  (torddef(cl.def).ordtype<>pasbool1) then
                  cl.def:=u32inttype;
                  cl.def:=u32inttype;
              end
              end
            else
            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
         behavior causes compilation errors because real nested procedures
         aren't allowed for generics. Not creating them doesn't harm because
         aren't allowed for generics. Not creating them doesn't harm because
         generic node tree is discarded without generating code. }
         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
       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 }
         { the init/final code is messing with asm nodes, so inform the compiler about this }
         include(finalizepi.flags,pi_has_assembler_block);
         include(finalizepi.flags,pi_has_assembler_block);
         { Regvar optimization for symbols is suppressed when using exceptions, but
         { 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
         if df_generic in current_procinfo.procdef.defoptions then
           InternalError(2013012501);
           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);
         include(finalizepi.flags,pi_do_call);
         { the init/final code is messing with asm nodes, so inform the compiler about this }
         { the init/final code is messing with asm nodes, so inform the compiler about this }
         include(finalizepi.flags,pi_has_assembler_block);
         include(finalizepi.flags,pi_has_assembler_block);

+ 2 - 2
compiler/x86_64/symcpu.pas

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

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

@@ -85,8 +85,8 @@ type
 function NSSTR (inString: PChar): NSString;
 function NSSTR (inString: PChar): NSString;
 function NSMakeRange (loc: NSUInteger; len: NSUInteger): NSRange;
 function NSMakeRange (loc: NSUInteger; len: NSUInteger): NSRange;
 function NSMaxRange (range: NSRange): NSUInteger;
 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 NSMakePoint (x: CGFloat; y: CGFloat): NSPoint;
 function NSMakeSize(w: CGFloat; h: CGFloat): NSSize;
 function NSMakeSize(w: CGFloat; h: CGFloat): NSSize;
 function NSMakeRect(x, y: CGFloat; w, h: CGFloat): NSRect;
 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 NSSTR (inString: PChar): NSString;
 function NSMakeRange (loc: NSUInteger; len: NSUInteger): NSRange;
 function NSMakeRange (loc: NSUInteger; len: NSUInteger): NSRange;
 function NSMaxRange (range: NSRange): NSUInteger;
 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 NSMakePoint (x: CGFloat; y: CGFloat): NSPoint;
 function NSMakeSize(w: CGFloat; h: CGFloat): NSSize;
 function NSMakeSize(w: CGFloat; h: CGFloat): NSSize;
 function NSMakeRect(x, y: CGFloat; w, h: CGFloat): NSRect;
 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;
  result := range.location + range.length;
 end;
 end;
 
 
-function NSLocationInRange (loc: NSUInteger; range: NSRange): boolean;
+function NSLocationInRange (loc: NSUInteger; range: NSRange): BOOL;
 begin
 begin
  if (loc <= range.location + range.length) and (loc >= range.location) then
  if (loc <= range.location + range.length) and (loc >= range.location) then
   result := true
   result := true
@@ -18,7 +18,7 @@ begin
   result := false;
   result := false;
 end;
 end;
 
 
-function NSEqualRanges (range1, range2: NSRange): boolean;
+function NSEqualRanges (range1, range2: NSRange): BOOL;
 begin
 begin
  if (range1.location = range2.location) and (range1.length = range2.length) then
  if (range1.location = range2.location) and (range1.length = range2.length) then
   result := true
   result := true

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

@@ -66,8 +66,8 @@
 
 
 { NSPrimitiveInterfaceCategory }
 { NSPrimitiveInterfaceCategory }
   NSPrimitiveInterfaceCategory = objccategory external (NSATSTypesetter)
   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';
     function typesetterBehavior: NSTypesetterBehavior; message 'typesetterBehavior';
     procedure setTypesetterBehavior(behavior: NSTypesetterBehavior); message 'setTypesetterBehavior:';
     procedure setTypesetterBehavior(behavior: NSTypesetterBehavior); message 'setTypesetterBehavior:';
     function hyphenationFactor: single; message 'hyphenationFactor';
     function hyphenationFactor: single; message 'hyphenationFactor';
@@ -76,8 +76,8 @@
     procedure setLineFragmentPadding(padding: CGFloat); message 'setLineFragmentPadding:';
     procedure setLineFragmentPadding(padding: CGFloat); message 'setLineFragmentPadding:';
     function substituteFontForFont(originalFont: NSFont): NSFont; message 'substituteFontForFont:';
     function substituteFontForFont(originalFont: NSFont): NSFont; message 'substituteFontForFont:';
     function textTabForGlyphLocation_writingDirection_maxLocation(glyphLocation: CGFloat; direction: NSWritingDirection; maxLocation: CGFloat): NSTextTab; message 'textTabForGlyphLocation:writingDirection:maxLocation:';
     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:';
     procedure setAttributedString(attrString: NSAttributedString); message 'setAttributedString:';
     function attributedString: NSAttributedString; message 'attributedString';
     function attributedString: NSAttributedString; message 'attributedString';
     procedure setParagraphGlyphRange_separatorGlyphRange(paragraphRange: NSRange; paragraphSeparatorRange: NSRange); message 'setParagraphGlyphRange:separatorGlyphRange:';
     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 paragraphSpacingAfterGlyphAtIndex_withProposedLineFragmentRect(glyphIndex: NSUInteger; rect: NSRect): CGFloat; message 'paragraphSpacingAfterGlyphAtIndex:withProposedLineFragmentRect:';
     function layoutManager: NSLayoutManager; message 'layoutManager';
     function layoutManager: NSLayoutManager; message 'layoutManager';
     function currentTextContainer: NSTextContainer; message 'currentTextContainer';
     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:';
     procedure getLineFragmentRect_usedRect_forParagraphSeparatorGlyphRange_atProposedOrigin(lineFragmentRect: NSRectPtr; lineFragmentUsedRect: NSRectPtr; paragraphSeparatorGlyphRange_: NSRange; lineOrigin: NSPoint); message 'getLineFragmentRect:usedRect:forParagraphSeparatorGlyphRange:atProposedOrigin:';
   end;
   end;
 
 
 { NSLayoutPhaseInterface_NSATSTypesetterCategory }
 { NSLayoutPhaseInterface_NSATSTypesetterCategory }
   NSLayoutPhaseInterface_NSATSTypesetterCategory = objccategory external name 'NSLayoutPhaseInterface' (NSATSTypesetter)
   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:';
     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 hyphenationFactorForGlyphAtIndex(glyphIndex: NSUInteger): single; message 'hyphenationFactorForGlyphAtIndex:';
     function hyphenCharacterForGlyphAtIndex(glyphIndex: NSUInteger): UTF32Char; message 'hyphenCharacterForGlyphAtIndex:';
     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:';
     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)
   NSGlyphStorageInterface_NSATSTypesetterCategory = objccategory external name 'NSGlyphStorageInterface' (NSATSTypesetter)
     function characterRangeForGlyphRange_actualGlyphRange(glyphRange: NSRange; actualGlyphRange: NSRangePointer): NSRange; message 'characterRangeForGlyphRange:actualGlyphRange:';
     function characterRangeForGlyphRange_actualGlyphRange(glyphRange: NSRange; actualGlyphRange: NSRangePointer): NSRange; message 'characterRangeForGlyphRange:actualGlyphRange:';
     function glyphRangeForCharacterRange_actualCharacterRange(charRange: NSRange; actualCharRange: NSRangePointer): NSRange; message 'glyphRangeForCharacterRange:actualCharacterRange:';
     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 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 substituteGlyphsInRange_withGlyphs(glyphRange: NSRange; glyphs: NSGlyphPtr); message 'substituteGlyphsInRange:withGlyphs:';
     procedure insertGlyph_atGlyphIndex_characterIndex(glyph: NSGlyph; glyphIndex: NSUInteger; characterIndex: NSUInteger); message 'insertGlyph:atGlyphIndex:characterIndex:';
     procedure insertGlyph_atGlyphIndex_characterIndex(glyph: NSGlyph; glyphIndex: NSUInteger; characterIndex: NSUInteger); message 'insertGlyph:atGlyphIndex:characterIndex:';
     procedure deleteGlyphsInRange(glyphRange: NSRange); message 'deleteGlyphsInRange:';
     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 setLocation_withAdvancements_forStartOfGlyphRange(location: NSPoint; advancements: CGFloatPtr; glyphRange: NSRange); message 'setLocation:withAdvancements:forStartOfGlyphRange:';
     procedure setAttachmentSize_forGlyphRange(attachmentSize: NSSize; glyphRange: NSRange); message 'setAttachmentSize:forGlyphRange:';
     procedure setAttachmentSize_forGlyphRange(attachmentSize: NSSize; glyphRange: NSRange); message 'setAttachmentSize:forGlyphRange:';
     procedure setBidiLevels_forGlyphRange(levels: pbyte; glyphRange: NSRange); message 'setBidiLevels: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)
   NSAccessibilityCategory = objccategory external (NSObject)
     function accessibilityAttributeNames: NSArray; message 'accessibilityAttributeNames';
     function accessibilityAttributeNames: NSArray; message 'accessibilityAttributeNames';
     function accessibilityAttributeValue(attribute: NSString): id; message 'accessibilityAttributeValue:';
     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:';
     procedure accessibilitySetValue_forAttribute(value: id; attribute: NSString); message 'accessibilitySetValue:forAttribute:';
     function accessibilityParameterizedAttributeNames: NSArray; message 'accessibilityParameterizedAttributeNames';
     function accessibilityParameterizedAttributeNames: NSArray; message 'accessibilityParameterizedAttributeNames';
     function accessibilityAttributeValue_forParameter(attribute: NSString; parameter: id): id; message 'accessibilityAttributeValue:forParameter:';
     function accessibilityAttributeValue_forParameter(attribute: NSString; parameter: id): id; message 'accessibilityAttributeValue:forParameter:';
     function accessibilityActionNames: NSArray; message 'accessibilityActionNames';
     function accessibilityActionNames: NSArray; message 'accessibilityActionNames';
     function accessibilityActionDescription(action: NSString): NSString; message 'accessibilityActionDescription:';
     function accessibilityActionDescription(action: NSString): NSString; message 'accessibilityActionDescription:';
     procedure accessibilityPerformAction(action: NSString); message 'accessibilityPerformAction:';
     procedure accessibilityPerformAction(action: NSString); message 'accessibilityPerformAction:';
-    function accessibilityIsIgnored: Boolean; message 'accessibilityIsIgnored';
+    function accessibilityIsIgnored: BOOL; message 'accessibilityIsIgnored';
     function accessibilityHitTest(point: NSPoint): id; message 'accessibilityHitTest:';
     function accessibilityHitTest(point: NSPoint): id; message 'accessibilityHitTest:';
     function accessibilityFocusedUIElement: id; message 'accessibilityFocusedUIElement';
     function accessibilityFocusedUIElement: id; message 'accessibilityFocusedUIElement';
     function accessibilityIndexOfChild(child: id): NSUInteger; message 'accessibilityIndexOfChild:';
     function accessibilityIndexOfChild(child: id): NSUInteger; message 'accessibilityIndexOfChild:';
@@ -355,7 +355,7 @@ var
 
 
 { NSAccessibilityAdditionsCategory }
 { NSAccessibilityAdditionsCategory }
   NSAccessibilityAdditionsCategory = objccategory external (NSObject)
   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;
   end;
 
 
 {$endif}
 {$endif}

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

@@ -84,10 +84,10 @@ type
     _delegate: id;
     _delegate: id;
     _alertStyle: NSAlertStyle;
     _alertStyle: NSAlertStyle;
     _helpAnchor: id;
     _helpAnchor: id;
-    _layoutDone: Boolean;
-    _showsHelp: Boolean;
-    _showsSuppressionButton: Boolean;
-    reserved: Boolean;
+    _layoutDone: BOOL;
+    _showsHelp: BOOL;
+    _showsSuppressionButton: BOOL;
+    reserved: BOOL;
     _suppressionButton: id;
     _suppressionButton: id;
     _accessoryView: id;
     _accessoryView: id;
     
     
@@ -102,16 +102,16 @@ type
     function icon: NSImage; message 'icon';
     function icon: NSImage; message 'icon';
     function addButtonWithTitle(title: NSString): NSButton; message 'addButtonWithTitle:';
     function addButtonWithTitle(title: NSString): NSButton; message 'addButtonWithTitle:';
     function buttons: NSArray; message 'buttons';
     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:';
     procedure setHelpAnchor(anchor: NSString); message 'setHelpAnchor:';
     function helpAnchor: NSString; message 'helpAnchor';
     function helpAnchor: NSString; message 'helpAnchor';
     procedure setAlertStyle(style: NSAlertStyle); message 'setAlertStyle:';
     procedure setAlertStyle(style: NSAlertStyle); message 'setAlertStyle:';
     function alertStyle: NSAlertStyle; message 'alertStyle';
     function alertStyle: NSAlertStyle; message 'alertStyle';
     procedure setDelegate(delegate_: NSAlertDelegateProtocol); message 'setDelegate:';
     procedure setDelegate(delegate_: NSAlertDelegateProtocol); message 'setDelegate:';
     function delegate: NSAlertDelegateProtocol; message 'delegate';
     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';
     function suppressionButton: NSButton; message 'suppressionButton';
     procedure setAccessoryView(view: NSView); message 'setAccessoryView:';
     procedure setAccessoryView(view: NSView); message 'setAccessoryView:';
     function accessoryView: NSView; message 'accessoryView';
     function accessoryView: NSView; message 'accessoryView';
@@ -131,7 +131,7 @@ type
 { NSAlertDelegate Protocol }
 { NSAlertDelegate Protocol }
   NSAlertDelegateProtocol = objcprotocol external name 'NSAlertDelegate'
   NSAlertDelegateProtocol = objcprotocol external name 'NSAlertDelegate'
   optional
   optional
-    function alertShowHelp(alert: NSAlert): Boolean; message 'alertShowHelp:';
+    function alertShowHelp(alert: NSAlert): BOOL; message 'alertShowHelp:';
   end;
   end;
 {$endif}
 {$endif}
 {$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:';
     function initWithDuration_animationCurve(duration_: NSTimeInterval; animationCurve_: NSAnimationCurve): id; message 'initWithDuration:animationCurve:';
     procedure startAnimation; message 'startAnimation';
     procedure startAnimation; message 'startAnimation';
     procedure stopAnimation; message 'stopAnimation';
     procedure stopAnimation; message 'stopAnimation';
-    function isAnimating: Boolean; message 'isAnimating';
+    function isAnimating: BOOL; message 'isAnimating';
     function currentProgress: NSAnimationProgress; message 'currentProgress';
     function currentProgress: NSAnimationProgress; message 'currentProgress';
     procedure setCurrentProgress(progress: NSAnimationProgress); message 'setCurrentProgress:';
     procedure setCurrentProgress(progress: NSAnimationProgress); message 'setCurrentProgress:';
     procedure setDuration(duration_: NSTimeInterval); message 'setDuration:';
     procedure setDuration(duration_: NSTimeInterval); message 'setDuration:';
@@ -193,7 +193,7 @@ var
 { NSAnimationDelegate Protocol }
 { NSAnimationDelegate Protocol }
   NSAnimationDelegateProtocol = objcprotocol external name 'NSAnimationDelegate'
   NSAnimationDelegateProtocol = objcprotocol external name 'NSAnimationDelegate'
   optional
   optional
-    function animationShouldStart(animation: NSAnimation): Boolean; message 'animationShouldStart:';
+    function animationShouldStart(animation: NSAnimation): BOOL; message 'animationShouldStart:';
     procedure animationDidStop(animation: NSAnimation); message 'animationDidStop:';
     procedure animationDidStop(animation: NSAnimation); message 'animationDidStop:';
     procedure animationDidEnd(animation: NSAnimation); message 'animationDidEnd:';
     procedure animationDidEnd(animation: NSAnimation); message 'animationDidEnd:';
     function animation_valueForProgress(animation: NSAnimation; progress: NSAnimationProgress): single; message 'animation:valueForProgress:';
     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 }
 { Functions }
 function NSApplicationMain(argc: cint; argv: PPChar {array of PChar}): cint; cdecl; external;
 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;
 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 NSRegisterServicesProvider(provider: id; name: NSString); cdecl; external;
 procedure NSUnregisterServicesProvider(name: NSString); cdecl; external;
 procedure NSUnregisterServicesProvider(name: NSString); cdecl; external;
 
 
@@ -229,11 +229,11 @@ var
     function windowWithWindowNumber(windowNum: NSInteger): NSWindow; message 'windowWithWindowNumber:';
     function windowWithWindowNumber(windowNum: NSInteger): NSWindow; message 'windowWithWindowNumber:';
     function mainWindow: NSWindow; message 'mainWindow';
     function mainWindow: NSWindow; message 'mainWindow';
     function keyWindow: NSWindow; message 'keyWindow';
     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 deactivate; message 'deactivate';
-    procedure activateIgnoringOtherApps(flag: Boolean); message 'activateIgnoringOtherApps:';
+    procedure activateIgnoringOtherApps(flag: BOOL); message 'activateIgnoringOtherApps:';
     procedure hideOtherApplications(sender: id); message 'hideOtherApplications:';
     procedure hideOtherApplications(sender: id); message 'hideOtherApplications:';
     procedure unhideAllApplications(sender: id); message 'unhideAllApplications:';
     procedure unhideAllApplications(sender: id); message 'unhideAllApplications:';
     procedure finishLaunching; message 'finishLaunching';
     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 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(sheet: NSWindow); message 'endSheet:';
     procedure endSheet_returnCode(sheet: NSWindow; returnCode: NSInteger); message 'endSheet:returnCode:';
     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 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';
     function currentEvent: NSEvent; message 'currentEvent';
     procedure sendEvent(theEvent: NSEvent); message 'sendEvent:';
     procedure sendEvent(theEvent: NSEvent); message 'sendEvent:';
     procedure preventWindowOrdering; message 'preventWindowOrdering';
     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';
     function windows: NSArray; message 'windows';
-    procedure setWindowsNeedUpdate(needUpdate: Boolean); message 'setWindowsNeedUpdate:';
+    procedure setWindowsNeedUpdate(needUpdate: BOOL); message 'setWindowsNeedUpdate:';
     procedure updateWindows; message 'updateWindows';
     procedure updateWindows; message 'updateWindows';
     procedure setMainMenu(aMenu: NSMenu); message 'setMainMenu:';
     procedure setMainMenu(aMenu: NSMenu); message 'setMainMenu:';
     function mainMenu: NSMenu; message 'mainMenu';
     function mainMenu: NSMenu; message 'mainMenu';
@@ -270,16 +270,16 @@ var
     procedure setApplicationIconImage(image: NSImage); message 'setApplicationIconImage:';
     procedure setApplicationIconImage(image: NSImage); message 'setApplicationIconImage:';
     function applicationIconImage: NSImage; message 'applicationIconImage';
     function applicationIconImage: NSImage; message 'applicationIconImage';
     function activationPolicy: NSApplicationActivationPolicy; message 'activationPolicy';
     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 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(theAction: SEL): id; message 'targetForAction:';
     function targetForAction_to_from(theAction: SEL; theTarget: id; sender: id): id; message 'targetForAction:to:from:';
     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:';
     function validRequestorForSendType_returnType(sendType: NSString; returnType: NSString): id; message 'validRequestorForSendType:returnType:';
     procedure reportException(theException: NSException); message 'reportException:';
     procedure reportException(theException: NSException); message 'reportException:';
     class procedure detachDrawingThread_toTarget_withObject(selector: SEL; target: id; argument: id); message 'detachDrawingThread:toTarget:withObject:';
     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 replyToOpenOrPrint(reply: NSApplicationDelegateReply); message 'replyToOpenOrPrint:';
     procedure orderFrontCharacterPalette(sender: id); message 'orderFrontCharacterPalette:';
     procedure orderFrontCharacterPalette(sender: id); message 'orderFrontCharacterPalette:';
     function presentationOptions: NSApplicationPresentationOptions; message 'presentationOptions';
     function presentationOptions: NSApplicationPresentationOptions; message 'presentationOptions';
@@ -287,7 +287,7 @@ var
     function currentSystemPresentationOptions: NSApplicationPresentationOptions; message 'currentSystemPresentationOptions';
     function currentSystemPresentationOptions: NSApplicationPresentationOptions; message 'currentSystemPresentationOptions';
 
 
     { Adopted Protocols }
     { Adopted Protocols }
-    function validateUserInterfaceItem(anItem: NSValidatedUserInterfaceItemProtocol): Boolean;
+    function validateUserInterfaceItem(anItem: NSValidatedUserInterfaceItemProtocol): BOOL;
   end;
   end;
 
 
 { NSWindowsMenuCategory }
 { NSWindowsMenuCategory }
@@ -296,15 +296,15 @@ var
     function windowsMenu: NSMenu; message 'windowsMenu';
     function windowsMenu: NSMenu; message 'windowsMenu';
     procedure arrangeInFront(sender: id); message 'arrangeInFront:';
     procedure arrangeInFront(sender: id); message 'arrangeInFront:';
     procedure removeWindowsItem(win: NSWindow); message 'removeWindowsItem:';
     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 updateWindowsItem(win: NSWindow); message 'updateWindowsItem:';
     procedure miniaturizeAll(sender: id); message 'miniaturizeAll:';
     procedure miniaturizeAll(sender: id); message 'miniaturizeAll:';
   end;
   end;
 
 
 { NSFullKeyboardAccessCategory }
 { NSFullKeyboardAccessCategory }
   NSFullKeyboardAccessCategory = objccategory external (NSApplication)
   NSFullKeyboardAccessCategory = objccategory external (NSApplication)
-    function isFullKeyboardAccessEnabled: Boolean; message 'isFullKeyboardAccessEnabled';
+    function isFullKeyboardAccessEnabled: BOOL; message 'isFullKeyboardAccessEnabled';
   end;
   end;
 
 
 { NSServicesMenuCategory }
 { NSServicesMenuCategory }
@@ -316,8 +316,8 @@ var
 
 
 { NSServicesRequestsCategory }
 { NSServicesRequestsCategory }
   NSServicesRequestsCategory = objccategory external (NSObject)
   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;
   end;
 
 
 { NSServicesHandlingCategory }
 { NSServicesHandlingCategory }
@@ -354,16 +354,16 @@ var
   NSApplicationDelegateProtocol = objcprotocol external name 'NSApplicationDelegate'
   NSApplicationDelegateProtocol = objcprotocol external name 'NSApplicationDelegate'
   optional
   optional
     function applicationShouldTerminate(sender: NSApplication): NSApplicationTerminateReply; message 'applicationShouldTerminate:';
     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:';
     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 applicationDockMenu(sender: NSApplication): NSMenu; message 'applicationDockMenu:';
     function application_willPresentError(application: NSApplication; error: NSError): NSError; message 'application:willPresentError:';
     function application_willPresentError(application: NSApplication; error: NSError): NSError; message 'application:willPresentError:';
     procedure applicationWillFinishLaunching(notification: NSNotification); message 'applicationWillFinishLaunching:';
     procedure applicationWillFinishLaunching(notification: NSNotification); message 'applicationWillFinishLaunching:';

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

@@ -44,7 +44,7 @@
 
 
 { NSApplicationScriptingDelegationCategory }
 { NSApplicationScriptingDelegationCategory }
   NSApplicationScriptingDelegationCategory = objccategory external (NSObject)
   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;
   end;
 
 
 {$endif}
 {$endif}

Niektoré súbory nie sú zobrazené, pretože je v týchto rozdielových dátach zmenené mnoho súborov