Pārlūkot izejas kodu

* calling convention rewrite

peter 24 gadi atpakaļ
vecāks
revīzija
e37dbf904d

+ 14 - 8
compiler/globals.pas

@@ -159,7 +159,7 @@ interface
        initasmmode        : tasmmode;
        initinterfacetype  : tinterfacetypes;
        initoutputformat   : tasm;
-       initdefproccall    : TDefProcCall;
+       initdefproccall    : tproccalloption;
 
      { current state values }
        aktglobalswitches  : tglobalswitches;
@@ -179,7 +179,7 @@ interface
        aktasmmode         : tasmmode;
        aktinterfacetype   : tinterfacetypes;
        aktoutputformat    : tasm;
-       aktdefproccall     : TDefProcCall;
+       aktdefproccall     : tproccalloption;
 
      { Memory sizes }
        heapsize,
@@ -1148,24 +1148,27 @@ implementation
 
     function SetAktProcCall(const s:string; changeInit:boolean):boolean;
       const
-        DefProcCallName : array[TDefProcCall] of string[12] = (
+        DefProcCallName : array[tproccalloption] of string[12] = ('',
          'CDECL',
          'CPPDECL',
+         '', { compilerproc }
          'FAR16',
          'FPCCALL',
          'INLINE',
+         '', { internconst }
+         '', { internproc }
+         '', { palmossyscall }
          'PASCAL',
-         'POPSTACK',
          'REGISTER',
          'SAFECALL',
          'STDCALL',
          'SYSTEM'
         );
       var
-        t : TDefProcCall;
+        t : tproccalloption;
       begin
         SetAktProcCall:=false;
-        for t:=low(TDefProcCall) to high(TDefProcCall) do
+        for t:=low(tproccalloption) to high(tproccalloption) do
          if DefProcCallName[t]=s then
           begin
             AktDefProcCall:=t;
@@ -1423,7 +1426,7 @@ implementation
   {$endif m68k}
 {$endif i386}
         initinterfacetype:=it_interfacecom;
-        initdefproccall:=dpc_fpccall;
+        initdefproccall:=pocall_none;
         initdefines:=TStringList.Create;
 
       { memory sizes, will be overriden by parameter or default for target
@@ -1449,7 +1452,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.48  2001-10-23 21:49:42  peter
+  Revision 1.49  2001-10-25 21:22:32  peter
+    * calling convention rewrite
+
+  Revision 1.48  2001/10/23 21:49:42  peter
     * $calling directive and -Cc commandline patch added
       from Pavel Ozerski
 

+ 39 - 14
compiler/globtype.pas

@@ -163,20 +163,42 @@ interface
          bt_general,bt_type,bt_const,bt_except
        );
 
-       { Default calling convention }
-       TDefProcCall = (
-         dpc_cdecl,
-         dpc_cppdecl,
-         dpc_far16,
-         dpc_fpccall,
-         dpc_inline,
-         dpc_pascal,
-         dpc_popstack,
-         dpc_register,
-         dpc_safecall,
-         dpc_stdcall,
-         dpc_system
+       { calling convention for tprocdef and tprocvardef }
+       tproccalloption=(pocall_none,
+         pocall_cdecl,         { procedure uses C styled calling }
+         pocall_cppdecl,       { C++ calling conventions }
+         pocall_compilerproc,  { Procedure is used for internal compiler calls }
+         pocall_far16,         { Far16 for OS/2 }
+         pocall_fpccall,       { FPC default calling }
+         pocall_inline,        { Procedure is an assembler macro }
+         pocall_internconst,   { procedure has constant evaluator intern }
+         pocall_internproc,    { Procedure has compiler magic}
+         pocall_palmossyscall, { procedure is a PalmOS system call }
+         pocall_pascal,        { pascal standard left to right }
+         pocall_register,      { procedure uses register (fastcall) calling }
+         pocall_safecall,      { safe call calling conventions }
+         pocall_stdcall,       { procedure uses stdcall call }
+         pocall_system         { system call }
        );
+       tproccalloptions = set of tproccalloption;
+
+     const
+       proccalloptionStr : array[tproccalloption] of string[14]=('',
+           'CDecl',
+           'CPPDecl',
+           'CompilerProc',
+           'Far16',
+           'FPCCall',
+           'Inline',
+           'InternConst',
+           'InternProc',
+           'PalmOSSysCall',
+           'Pascal',
+           'Register',
+           'SafeCall',
+           'StdCall',
+           'System'
+         );
 
     type
        stringid = string[maxidlen];
@@ -223,7 +245,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.18  2001-10-24 11:46:06  marco
+  Revision 1.19  2001-10-25 21:22:32  peter
+    * calling convention rewrite
+
+  Revision 1.18  2001/10/24 11:46:06  marco
    * Opt Align fix.
 
   Revision 1.17  2001/10/23 21:49:42  peter

+ 7 - 4
compiler/i386/cga.pas

@@ -2300,7 +2300,7 @@ implementation
 
       { generate copies of call by value parameters }
       if not(po_assembler in aktprocsym.definition.procoptions) and
-         (([pocall_cdecl,pocall_cppdecl]*aktprocsym.definition.proccalloptions)=[]) then
+         not(aktprocsym.definition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_palmossyscall,pocall_system]) then
         aktprocsym.definition.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas);
 
       if assigned( aktprocsym.definition.parast) then
@@ -2769,7 +2769,7 @@ implementation
 
       { parameters are limited to 65535 bytes because }
       { ret allows only imm16                    }
-      if (parasize>65535) and not(pocall_clearstack in aktprocsym.definition.proccalloptions) then
+      if (parasize>65535) and not(po_clearstack in aktprocsym.definition.procoptions) then
        CGMessage(cg_e_parasize_too_big);
 
       { at last, the return is generated }
@@ -2795,7 +2795,7 @@ implementation
        begin
        {Routines with the poclearstack flag set use only a ret.}
        { also routines with parasize=0     }
-         if (pocall_clearstack in aktprocsym.definition.proccalloptions) then
+         if (po_clearstack in aktprocsym.definition.procoptions) then
            begin
 {$ifndef OLD_C_STACK}
              { complex return values are removed from stack in C code PM }
@@ -2974,7 +2974,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2001-10-20 17:22:57  peter
+  Revision 1.8  2001-10-25 21:22:41  peter
+    * calling convention rewrite
+
+  Revision 1.7  2001/10/20 17:22:57  peter
     * concatcopy could release a wrong reference because the offset was
       increased without restoring the original before the release of
       a temp

+ 11 - 8
compiler/i386/n386cal.pas

@@ -309,7 +309,7 @@ implementation
          unusedregisters:=unused;
          usablecount:=usablereg32;
 
-         if ([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*procdefinition.proccalloptions)<>[] then
+         if (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_stdcall]) then
           para_alignment:=4
          else
           para_alignment:=aktalignment.paraalign;
@@ -322,7 +322,7 @@ implementation
            params:=left.getcopy
          else params := nil;
 
-         if (pocall_inline in procdefinition.proccalloptions) then
+         if (procdefinition.proccalloption=pocall_inline) then
            begin
               inlined:=true;
               inlinecode:=tprocinlinenode(right);
@@ -481,13 +481,13 @@ implementation
               if not(inlined) and
                  assigned(right) then
                 tcallparanode(params).secondcallparan(TParaItem(tabstractprocdef(right.resulttype.def).Para.first),
-                  (pocall_leftright in procdefinition.proccalloptions),inlined,
-                  (([pocall_cdecl,pocall_cppdecl]*procdefinition.proccalloptions)<>[]),
+                  (po_leftright in procdefinition.procoptions),inlined,
+                  (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
                   para_alignment,para_offset)
               else
                 tcallparanode(params).secondcallparan(TParaItem(procdefinition.Para.first),
-                  (pocall_leftright in procdefinition.proccalloptions),inlined,
-                  (([pocall_cdecl,pocall_cppdecl]*procdefinition.proccalloptions)<>[]),
+                  (po_leftright in procdefinition.procoptions),inlined,
+                  (procdefinition.proccalloption in [pocall_cdecl,pocall_cppdecl]),
                   para_alignment,para_offset);
            end;
          if inlined then
@@ -1073,7 +1073,7 @@ implementation
            { this was only for normal functions
              displaced here so we also get
              it to work for procvars PM }
-           if (not inlined) and (pocall_clearstack in procdefinition.proccalloptions) then
+           if (not inlined) and (po_clearstack in procdefinition.procoptions) then
              begin
                 { we also add the pop_size which is included in pushedparasize }
                 pop_size:=0;
@@ -1597,7 +1597,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.34  2001-10-21 12:33:07  peter
+  Revision 1.35  2001-10-25 21:22:41  peter
+    * calling convention rewrite
+
+  Revision 1.34  2001/10/21 12:33:07  peter
     * array access for properties added
 
   Revision 1.33  2001/09/09 08:50:15  jonas

+ 5 - 2
compiler/i386/n386obj.pas

@@ -171,7 +171,7 @@ begin
   adjustselfvalue(ioffset);
 
   { case 1  or 2 }
-  if (pocall_clearstack in procdef.proccalloptions) then
+  if (po_clearstack in procdef.procoptions) then
     begin
       if po_virtualmethod in procdef.procoptions then
         begin { case 2 }
@@ -223,7 +223,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.3  2001-09-19 11:04:41  michael
+  Revision 1.4  2001-10-25 21:22:41  peter
+    * calling convention rewrite
+
+  Revision 1.3  2001/09/19 11:04:41  michael
   * Smartlinking with interfaces fixed
   * Better smartlinking for rtti and init tables
 

+ 3 - 0
compiler/msg/errore.msg

@@ -938,6 +938,9 @@ parser_e_interface_has_no_guid=03180_E_Interface "$1" has no interface identific
 % must have a GUID value set.
 parser_e_illegal_field_or_method=03181_E_Unknown class field or method identifier "$1"
 % Properties must refer to a field or method in the same class.
+parser_w_proc_overriding_calling=03182_W_Overriding calling convention "$1" with "$2"
+% There are two directives in the procedure declaration that specify a calling
+% convention. Only the last directive will be used
 % \end{description}
 #
 # Type Checking

+ 3 - 2
compiler/msgidx.inc

@@ -260,6 +260,7 @@ const
   parser_e_self_call_by_value=03179;
   parser_e_interface_has_no_guid=03180;
   parser_e_illegal_field_or_method=03181;
+  parser_w_proc_overriding_calling=03182;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -602,9 +603,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 33666;
+  MsgTxtSize = 33719;
 
   MsgIdxMax : array[1..20] of longint=(
-    17,62,182,38,41,41,98,17,35,42,
+    17,62,183,38,41,41,98,17,35,42,
     30,1,1,1,1,1,1,1,1,1
   );

+ 186 - 184
compiler/msgtxt.inc

@@ -295,364 +295,366 @@ const msgtxt : array[0..000140,1..240] of char=(
   '03179_E_Self must be a normal (call-by-value) parameter'#000+
   '03180_E_Interface "$1" has n','o interface identification'#000+
   '03181_E_Unknown class field or method identifier "$1"'#000+
+  '03182_W_Overriding calling convention "$1" with "$2"'#000+
   '04000_E_Type mismatch'#000+
   '04001_E_Incompatible types: got "$1" expected "$2"'#000+
-  '04002_E_Type mismatch between "$1" and "$2"'#000+
+  '04002_E_Type mismatch between "$1','" and "$2"'#000+
   '04003_E_Type identifier expected'#000+
-  '04004_E_V','ariable identifier expected'#000+
+  '04004_E_Variable identifier expected'#000+
   '04005_E_Integer expression expected, but got "$1"'#000+
   '04006_E_Boolean expression expected, but got "$1"'#000+
   '04007_E_Ordinal expression expected'#000+
-  '04008_E_pointer type expected, but got "$1"'#000+
-  '04009_E_class type expected, but',' got "$1"'#000+
+  '04008_E_pointer type ex','pected, but got "$1"'#000+
+  '04009_E_class type expected, but got "$1"'#000+
   '04010_E_Variable or type indentifier expected'#000+
   '04011_E_Can'#039't evaluate constant expression'#000+
   '04012_E_Set elements are not compatible'#000+
   '04013_E_Operation not implemented for sets'#000+
-  '04014_W_Automatic type conversion from floating type to CO','MP which i'+
+  '04014','_W_Automatic type conversion from floating type to COMP which i'+
   's an integer type'#000+
   '04015_H_use DIV instead to get an integer result'#000+
   '04016_E_string types doesn'#039't match, because of $V+ mode'#000+
-  '04017_E_succ or pred on enums with assignments not possible'#000+
-  '04018_E_Can'#039't read or write variables of this t','ype'#000+
+  '04017_E_succ or pred on enums with assignments not pos','sible'#000+
+  '04018_E_Can'#039't read or write variables of this type'#000+
   '04019_E_Can'#039't use readln or writeln on typed file'#000+
   '04020_E_Can'#039't use read or write on untyped file.'#000+
   '04021_E_Type conflict between set elements'#000+
-  '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+
-  '04023_E_Integer or real expressi','on expected'#000+
+  '04022_W_lo/hi(dword/qword) returns the up','per/lower word/dword'#000+
+  '04023_E_Integer or real expression expected'#000+
   '04024_E_Wrong type "$1" in array constructor'#000+
   '04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+
-  '04026_E_Method (variable) and Procedure (variable) are not compatible'#000+
-  '04027_E_Illegal constant passed to internal mat','h function'#000+
+  '04026_E_Method (variable) and Procedure (variable) are not compa','tibl'+
+  'e'#000+
+  '04027_E_Illegal constant passed to internal math function'#000+
   '04028_E_Can'#039't get the address of constants'#000+
   '04029_E_Argument can'#039't be assigned to'#000+
   '04030_E_Can'#039't assign local procedure/function to procedure variabl'+
   'e'#000+
-  '04031_E_Can'#039't assign values to an address'#000+
-  '04032_E_Can'#039't assign values to const v','ariable'#000+
+  '04031_E_Can'#039't assign values',' to an address'#000+
+  '04032_E_Can'#039't assign values to const variable'#000+
   '04033_E_Array type required'#000+
   '04034_E_interface type expected, but got "$1"'#000+
   '04035_W_Mixing signed expressions and cardinals gives a 64bit result'#000+
-  '04036_W_Mixing signed expressions and cardinals here may cause a range'+
-  ' check error'#000+
-  '04037_','E_Typecast has different size ($1 -> $2) in assignment'#000+
+  '04036_W_Mixing signed expressions an','d cardinals here may cause a ran'+
+  'ge check error'#000+
+  '04037_E_Typecast has different size ($1 -> $2) in assignment'#000+
   '05000_E_Identifier not found "$1"'#000+
   '05001_F_Internal Error in SymTableStack()'#000+
   '05002_E_Duplicate identifier "$1"'#000+
-  '05003_H_Identifier already defined in $1 at line $2'#000+
-  '05004_E_Unknown identif','ier "$1"'#000+
+  '05003_H_Identifier alr','eady defined in $1 at line $2'#000+
+  '05004_E_Unknown identifier "$1"'#000+
   '05005_E_Forward declaration not solved "$1"'#000+
   '05006_F_Identifier type already defined as type'#000+
   '05007_E_Error in type definition'#000+
   '05008_E_Type identifier not defined'#000+
-  '05009_E_Forward type not resolved "$1"'#000+
-  '05010_E_Only static variables c','an be used in static methods or outsi'+
-  'de methods'#000+
+  '05009_E_Forward t','ype not resolved "$1"'#000+
+  '05010_E_Only static variables can be used in static methods or outside'+
+  ' methods'#000+
   '05011_E_Invalid call to tvarsym.mangledname()'#000+
   '05012_F_record or class type expected'#000+
-  '05013_E_Instances of classes or objects with an abstract method are no'+
-  't allowed'#000+
-  '05014_W_Label not defined "$','1"'#000+
+  '05013_E_Instances of classes or objects with an abstrac','t method are '+
+  'not allowed'#000+
+  '05014_W_Label not defined "$1"'#000+
   '05015_E_Label used but not defined "$1"'#000+
   '05016_E_Illegal label declaration'#000+
   '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+
   '05018_E_Label not found'#000+
-  '05019_E_identifier isn'#039't a label'#000+
+  '05019_E_identifier isn'#039't a l','abel'#000+
   '05020_E_label already defined'#000+
-  '05021_E_illegal ty','pe declaration of set elements'#000+
+  '05021_E_illegal type declaration of set elements'#000+
   '05022_E_Forward class definition not resolved "$1"'#000+
   '05023_H_Unit "$1" not used in $2'#000+
   '05024_H_Parameter "$1" not used'#000+
   '05025_N_Local variable "$1" not used'#000+
-  '05026_H_Value parameter "$1" is assigned but never used'#000,
+  '050','26_H_Value parameter "$1" is assigned but never used'#000+
   '05027_N_Local variable "$1" is assigned but never used'#000+
   '05028_H_Local $1 "$2" is not used'#000+
   '05029_N_Private field "$1.$2" is never used'#000+
-  '05030_N_Private field "$1.$2" is assigned but never used'#000+
+  '05030_N_Private field "$1.$2" is assigned but never us','ed'#000+
   '05031_N_Private method "$1.$2" never used'#000+
-  '05032_E_','Set type expected'#000+
+  '05032_E_Set type expected'#000+
   '05033_W_Function result does not seem to be set'#000+
   '05034_W_Type "$1" is not aligned correctly in current record for C'#000+
   '05035_E_Unknown record field identifier "$1"'#000+
-  '05036_W_Local variable "$1" does not seem to be initialized'#000+
-  '05','037_W_Variable "$1" does not seem to be initialized'#000+
+  '05036_W_L','ocal variable "$1" does not seem to be initialized'#000+
+  '05037_W_Variable "$1" does not seem to be initialized'#000+
   '05038_E_identifier idents no member "$1"'#000+
   '05039_B_Found declaration: $1'#000+
   '05040_E_Data segment too large (max. 2GB)'#000+
-  '06000_E_BREAK not allowed'#000+
+  '06000_E_BREAK not allo','wed'#000+
   '06001_E_CONTINUE not allowed'#000+
-  '06002_E_Expression t','oo complicated - FPU stack overflow'#000+
+  '06002_E_Expression too complicated - FPU stack overflow'#000+
   '06003_E_Illegal expression'#000+
   '06004_E_Invalid integer expression'#000+
   '06005_E_Illegal qualifier'#000+
   '06006_E_High range limit < low range limit'#000+
-  '06007_E_Illegal counter variable'#000+
-  '06008_E_Can'#039't determine which overloaded',' function to call'#000+
+  '06007_E_Illegal coun','ter variable'#000+
+  '06008_E_Can'#039't determine which overloaded function to call'#000+
   '06009_E_Parameter list size exceeds 65535 bytes'#000+
   '06010_E_Illegal type conversion'#000+
   '06011_D_Conversion between ordinals and pointers is not portable acros'+
   's platforms'#000+
-  '06012_E_File types must be var parameters'#000+
-  '06013_E_The use of',' a far pointer isn'#039't allowed there'#000+
+  '06012_E','_File types must be var parameters'#000+
+  '06013_E_The use of a far pointer isn'#039't allowed there'#000+
   '06014_E_illegal call by reference parameters'#000+
   '06015_E_EXPORT declared functions can'#039't be called'#000+
-  '06016_W_Possible illegal call of constructor or destructor (doesn'#039't'+
-  ' match to this context)'#000+
-  '06017_N_Inefficient',' code'#000+
+  '06016_W_Possible illegal call of constructor or destructo','r (doesn'#039+
+  't match to this context)'#000+
+  '06017_N_Inefficient code'#000+
   '06018_W_unreachable code'#000+
   '06019_E_procedure call with stackframe ESP/SP'#000+
   '06020_E_Abstract methods can'#039't be called directly'#000+
-  '06021_F_Internal Error in getfloatreg(), allocation failure'#000+
+  '06021_F_Internal Error in getfloatreg(), allocation failure'#000,
   '06022_F_Unknown float type'#000+
-  '06023_F_SecondVecn() base ','defined twice'#000+
+  '06023_F_SecondVecn() base defined twice'#000+
   '06024_F_Extended cg68k not supported'#000+
   '06025_F_32-bit unsigned not supported in MC68000 mode'#000+
   '06026_F_Internal Error in secondinline()'#000+
   '06027_D_Register $1 weight $2 $3'#000+
-  '06028_E_Stack limit excedeed in local routine'#000+
-  '06029_D_Stack f','rame is omitted'#000+
+  '06028_E_','Stack limit excedeed in local routine'#000+
+  '06029_D_Stack frame is omitted'#000+
   '06031_E_Object or class methods can'#039't be inline.'#000+
   '06032_E_Procvar calls can'#039't be inline.'#000+
   '06033_E_No code for inline procedure stored'#000+
-  '06034_E_Direct call of interrupt procedure "$1" is not possible'#000+
-  '06035_E_Element zero of an a','nsi/wide- or longstring can'#039't be acc'+
-  'essed, use (set)length instead'#000+
+  '06034_E_Direct call of interrupt proced','ure "$1" is not possible'#000+
+  '06035_E_Element zero of an ansi/wide- or longstring can'#039't be acces'+
+  'sed, use (set)length instead'#000+
   '06036_E_Include and exclude not implemented in this case'#000+
-  '06037_E_Constructors or destructors can not be called inside a '#039'wi'+
+  '06037_E_Constructors or destructors can not be called inside a ',#039'wi'+
   'th'#039' clause'#000+
-  '06038_E_Cannot call message handler met','hod directly'#000+
+  '06038_E_Cannot call message handler method directly'#000+
   '06039_E_Jump in or outside of an exception block'#000+
   '06040_E_Control flow statements aren'#039't allowed in a finally block'#000+
   '07000_D_Starting $1 styled assembler parsing'#000+
-  '07001_D_Finished $1 styled assembler parsing'#000+
-  '07002_E_Non-label patt','ern contains @'#000+
+  '07001_D_Finish','ed $1 styled assembler parsing'#000+
+  '07002_E_Non-label pattern contains @'#000+
   '07003_W_Override operator not supported'#000+
   '07004_E_Error building record offset'#000+
   '07005_E_OFFSET used without identifier'#000+
   '07006_E_TYPE used without identifier'#000+
-  '07007_E_Cannot use local variable or parameters here'#000+
-  '07008_E_need to use',' OFFSET here'#000+
+  '07007_E_Cannot use ','local variable or parameters here'#000+
+  '07008_E_need to use OFFSET here'#000+
   '07009_E_need to use $ here'#000+
   '07010_E_Cannot use multiple relocatable symbols'#000+
   '07011_E_Relocatable symbol can only be added'#000+
   '07012_E_Invalid constant expression'#000+
-  '07013_E_Relocatable symbol is not allowed'#000+
-  '07014_E_Invalid reference syn','tax'#000+
+  '07013_E_Relocatabl','e symbol is not allowed'#000+
+  '07014_E_Invalid reference syntax'#000+
   '07015_E_You can not reach $1 from that code'#000+
   '07016_E_Local symbols/labels aren'#039't allowed as references'#000+
   '07017_E_Invalid base and index register usage'#000+
-  '07018_W_Possible error in object field handling'#000+
+  '07018_W_Possible error in object fi','eld handling'#000+
   '07019_E_Wrong scale factor specified'#000+
-  '070','20_E_Multiple index register usage'#000+
+  '07020_E_Multiple index register usage'#000+
   '07021_E_Invalid operand type'#000+
   '07022_E_Invalid string as opcode operand: $1'#000+
   '07023_W_@CODE and @DATA not supported'#000+
-  '07024_E_Null label references are not allowed'#000+
+  '07024_E_Null label references are not al','lowed'#000+
   '07025_E_Divide by zero in asm evaluator'#000+
-  '07026_E','_Illegal expression'#000+
+  '07026_E_Illegal expression'#000+
   '07027_E_escape sequence ignored: $1'#000+
   '07028_E_Invalid symbol reference'#000+
   '07029_W_Fwait can cause emulation problems with emu387'#000+
-  '07030_W_$1 without operand translated into $1P'#000+
-  '07031_W_ENTER instruction is not supported by Lin','ux kernel'#000+
+  '07030_W_$1 without operand translated into ','$1P'#000+
+  '07031_W_ENTER instruction is not supported by Linux kernel'#000+
   '07032_W_Calling an overload function in assembler'#000+
   '07033_E_Unsupported symbol type for operand'#000+
   '07034_E_Constant value out of bounds'#000+
   '07035_E_Error converting decimal $1'#000+
-  '07036_E_Error converting octal $1'#000+
-  '07037_E_Error converting bina','ry $1'#000+
+  '07036_E_Er','ror converting octal $1'#000+
+  '07037_E_Error converting binary $1'#000+
   '07038_E_Error converting hexadecimal $1'#000+
   '07039_H_$1 translated to $2'#000+
   '07040_W_$1 is associated to an overloaded function'#000+
   '07041_E_Cannot use SELF outside a method'#000+
-  '07042_E_Cannot use OLDEBP outside a nested procedure'#000+
-  '07043_W_Procedures ca','n'#039't return any value in asm code'#000+
+  '07042_E_Cannot use OL','DEBP outside a nested procedure'#000+
+  '07043_W_Procedures can'#039't return any value in asm code'#000+
   '07044_E_SEG not supported'#000+
   '07045_E_Size suffix and destination or source size do not match'#000+
-  '07046_W_Size suffix and destination or source size do not match'#000+
+  '07046_W_Size suffix and destination or source size do not match'#000,
   '07047_E_Assembler syntax error'#000+
-  '07048_E_Invalid combin','ation of opcode and operands'#000+
+  '07048_E_Invalid combination of opcode and operands'#000+
   '07049_E_Assembler syntax error in operand'#000+
   '07050_E_Assembler syntax error in constant'#000+
   '07051_E_Invalid String expression'#000+
-  '07052_W_constant with symbol $1 for not 32bit address'#000+
+  '07052_W_constant with symbol $1 for not',' 32bit address'#000+
   '07053_E_Unrecognized opcode $1'#000+
-  '07054_E','_Invalid or missing opcode'#000+
+  '07054_E_Invalid or missing opcode'#000+
   '07055_E_Invalid combination of prefix and opcode: $1'#000+
   '07056_E_Invalid combination of override and opcode: $1'#000+
   '07057_E_Too many operands on line'#000+
-  '07058_W_NEAR ignored'#000+
+  '07058_W_NEAR ignor','ed'#000+
   '07059_W_FAR ignored'#000+
-  '07060_E_Duplicate local symbol',' $1'#000+
+  '07060_E_Duplicate local symbol $1'#000+
   '07061_E_Undefined local symbol $1'#000+
   '07062_E_Unknown label identifier $1'#000+
   '07063_E_Invalid register name'#000+
   '07064_E_Invalid floating point register name'#000+
   '07065_E_NOR not supported'#000+
-  '07066_W_Modulo not supported'#000+
-  '07067_E_Invalid floating point const','ant $1'#000+
+  '07066_W_Modu','lo not supported'#000+
+  '07067_E_Invalid floating point constant $1'#000+
   '07068_E_Invalid floating point expression'#000+
   '07069_E_Wrong symbol type'#000+
   '07070_E_Cannot index a local var or parameter with a register'#000+
   '07071_E_Invalid segment override expression'#000+
-  '07072_W_Identifier $1 supposed external'#000+
-  '07073_E_Strings not',' allowed as constants'#000+
+  '07072_','W_Identifier $1 supposed external'#000+
+  '07073_E_Strings not allowed as constants'#000+
   '07074_No type of variable specified'#000+
   '07075_E_assembler code not returned to text section'#000+
   '07076_E_Not a directive or local symbol $1'#000+
-  '07077_E_Using a defined name as a local label'#000+
-  '07078_E_Dollar token is used without an i','dentifier'#000+
+  '07077_E_Using a defined name as a ','local label'#000+
+  '07078_E_Dollar token is used without an identifier'#000+
   '07079_W_32bit constant created for address'#000+
   '07080_N_.align is target specific, use .balign or .p2align'#000+
   '07081_E_Can'#039't access fields directly for parameters'#000+
-  '07082_E_Can'#039't access fields of objects/classes directly'#000+
-  '07083_E_No size spec','ified and unable to determine the size of the op'+
-  'erands'#000+
+  '07082_E_Can'#039't access fi','elds of objects/classes directly'#000+
+  '07083_E_No size specified and unable to determine the size of the oper'+
+  'ands'#000+
   '07084_E_Cannot use RESULT in this function'#000+
   '07085_H_RESULT is register $1'#000+
-  '07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+
-  '07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"',#000+
+  '07086_W_"$1" without operand translated into "$1 %st,%st(1)','"'#000+
+  '07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"'#000+
   '07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+
   '07089_E_Char < not allowed here'#000+
   '07090_E_Char > not allowed here'#000+
   '07091_W_XDEF not supported'#000+
   '07092_E_Invalid XDEF syntax'#000+
-  '07093_W_ALIGN not supported'#000+
+  '07093_W_ALIGN n','ot supported'#000+
   '07094_E_Inc and Dec cannot be together'#000+
-  '0','7095_E_Invalid reglist for movem'#000+
+  '07095_E_Invalid reglist for movem'#000+
   '07096_E_Reglist invalid for opcode'#000+
   '07097_E_68020 mode required'#000+
   '08000_F_Too many assembler files'#000+
   '08001_F_Selected assembler output not supported'#000+
-  '08002_F_Comp not supported'#000+
-  '08003_F_Direct not support for binar','y writers'#000+
+  '08002_F_Co','mp not supported'#000+
+  '08003_F_Direct not support for binary writers'#000+
   '08004_E_Allocating of data is only allowed in bss section'#000+
   '08005_F_No binary writer selected'#000+
   '08006_E_Asm: Opcode $1 not in table'#000+
-  '08007_E_Asm: $1 invalid combination of opcode and operands'#000+
-  '08008_E_Asm: 16 Bit references not supporte','d'#000+
+  '08007_E_Asm: $1 invalid combination of opcode and',' operands'#000+
+  '08008_E_Asm: 16 Bit references not supported'#000+
   '08009_E_Asm: Invalid effective address'#000+
   '08010_E_Asm: Immediate or reference expected'#000+
   '08011_E_Asm: $1 value exceeds bounds $2'#000+
   '08012_E_Asm: Short jump is out of range $1'#000+
-  '08013_E_Asm: Undefined label $1'#000+
-  '08014_E_Asm: Comp type not supported fo','r this target'#000+
+  '08013_E_Asm: Undef','ined label $1'#000+
+  '08014_E_Asm: Comp type not supported for this target'#000+
   '08015_E_Asm: Extended type not supported for this target'#000+
   '08016_E_Asm: Duplicate label $1'#000+
   '09000_W_Source operating system redefined'#000+
   '09001_I_Assembling (pipe) $1'#000+
-  '09002_E_Can'#039't create assember file: $1'#000+
-  '09003_E_Can'#039't create object',' file: $1'#000+
+  '09002_E_Can'#039't',' create assember file: $1'#000+
+  '09003_E_Can'#039't create object file: $1'#000+
   '09004_E_Can'#039't create archive file: $1'#000+
   '09005_E_Assembler $1 not found, switching to external assembling'#000+
   '09006_T_Using assembler: $1'#000+
   '09007_E_Error while assembling exitcode $1'#000+
-  '09008_E_Can'#039't call the assembler, error $1 switching to ','external'+
+  '090','08_E_Can'#039't call the assembler, error $1 switching to external'+
   ' assembling'#000+
   '09009_I_Assembling $1'#000+
   '09010_I_Assembling smartlink $1'#000+
   '09011_W_Object $1 not found, Linking may fail !'#000+
   '09012_W_Library $1 not found, Linking may fail !'#000+
-  '09013_E_Error while linking'#000+
-  '09014_E_Can'#039't call the linker, switching ','to external linking'#000+
+  '09013_E_Error wh','ile linking'#000+
+  '09014_E_Can'#039't call the linker, switching to external linking'#000+
   '09015_I_Linking $1'#000+
   '09016_E_Util $1 not found, switching to external linking'#000+
   '09017_T_Using util $1'#000+
   '09018_E_Creation of Executables not supported'#000+
-  '09019_E_Creation of Dynamic/Shared Libraries not supported'#000+
-  '09020_I_Closing s','cript $1'#000+
+  '09019_E_Creation of Dyn','amic/Shared Libraries not supported'#000+
+  '09020_I_Closing script $1'#000+
   '09021_E_resource compiler not found, switching to external mode'#000+
   '09022_I_Compiling resource $1'#000+
   '09023_T_unit $1 can'#039't be static linked, switching to smart linking'+
   #000+
-  '09024_T_unit $1 can'#039't be smart linked, switching to static linking'+
-  #000+
-  '090','25_T_unit $1 can'#039't be shared linked, switching to static link'+
-  'ing'#000+
+  '09024_T_unit $1 c','an'#039't be smart linked, switching to static linki'+
+  'ng'#000+
+  '09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+
+  'g'#000+
   '09026_E_unit $1 can'#039't be smart or static linked'#000+
   '09027_E_unit $1 can'#039't be shared or static linked'#000+
-  '09028_F_Can'#039't post process executable $1'#000+
+  '09028_F_Can'#039't post proces','s executable $1'#000+
   '09029_F_Can'#039't open executable $1'#000+
-  '0903','0_X_Size of Code: $1 bytes'#000+
+  '09030_X_Size of Code: $1 bytes'#000+
   '09031_X_Size of initialized data: $1 bytes'#000+
   '09032_X_Size of uninitialized data: $1 bytes'#000+
   '09033_X_Stack space reserved: $1 bytes'#000+
-  '09034_X_Stack space commited: $1 bytes'#000+
+  '09034_X_Stack space commited: $1 ','bytes'#000+
   '10000_T_Unitsearch: $1'#000+
   '10001_T_PPU Loading $1'#000+
-  '1','0002_U_PPU Name: $1'#000+
+  '10002_U_PPU Name: $1'#000+
   '10003_U_PPU Flags: $1'#000+
   '10004_U_PPU Crc: $1'#000+
   '10005_U_PPU Time: $1'#000+
   '10006_U_PPU File too short'#000+
   '10007_U_PPU Invalid Header (no PPU at the begin)'#000+
-  '10008_U_PPU Invalid Version $1'#000+
+  '10008_U_PPU Invalid Version ','$1'#000+
   '10009_U_PPU is compiled for an other processor'#000+
-  '100','10_U_PPU is compiled for an other target'#000+
+  '10010_U_PPU is compiled for an other target'#000+
   '10011_U_PPU Source: $1'#000+
   '10012_U_Writing $1'#000+
   '10013_F_Can'#039't Write PPU-File'#000+
   '10014_F_Error reading PPU-File'#000+
   '10015_F_unexpected end of PPU-File'#000+
-  '10016_F_Invalid PPU-File entry: $1'#000+
-  '10017_F_PPU Dbx count probl','em'#000+
+  '10016_F_I','nvalid PPU-File entry: $1'#000+
+  '10017_F_PPU Dbx count problem'#000+
   '10018_E_Illegal unit name: $1'#000+
   '10019_F_Too much units'#000+
   '10020_F_Circular unit reference between $1 and $2'#000+
   '10021_F_Can'#039't compile unit $1, no sources available'#000+
   '10022_F_Can'#039't find unit $1'#000+
-  '10023_W_Unit $1 was not found but $2 exists'#000+
-  '10024_F_Uni','t $1 searched but $2 found'#000+
+  '10','023_W_Unit $1 was not found but $2 exists'#000+
+  '10024_F_Unit $1 searched but $2 found'#000+
   '10025_W_Compiling the system unit requires the -Us switch'#000+
   '10026_F_There were $1 errors compiling module, stopping'#000+
   '10027_U_Load from $1 ($2) unit $3'#000+
-  '10028_U_Recompiling $1, checksum changed for $2'#000+
-  '10029_U_Recompili','ng $1, source found only'#000+
+  '10028_U_Reco','mpiling $1, checksum changed for $2'#000+
+  '10029_U_Recompiling $1, source found only'#000+
   '10030_U_Recompiling unit, static lib is older than ppufile'#000+
   '10031_U_Recompiling unit, shared lib is older than ppufile'#000+
-  '10032_U_Recompiling unit, obj and asm are older than ppufile'#000+
-  '10033_U_Recompiling unit, obj is old','er than asm'#000+
+  '10032_U_Recompiling unit, obj and asm are ol','der than ppufile'#000+
+  '10033_U_Recompiling unit, obj is older than asm'#000+
   '10034_U_Parsing interface of $1'#000+
   '10035_U_Parsing implementation of $1'#000+
   '10036_U_Second load for unit $1'#000+
   '10037_U_PPU Check file $1 time $2'#000+
-  '10038_H_Conditional $1 was not set at startup in last compilation of $'+
-  '2'#000+
-  '10039_H_Conditional $','1 was set at startup in last compilation of $2'#000+
+  '10038_H_Conditional $1 was not set at st','artup in last compilation of'+
+  ' $2'#000+
+  '10039_H_Conditional $1 was set at startup in last compilation of $2'#000+
   '10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+
   '10041_H_File $1 is newer than Release PPU file $2'#000+
-  '11000_$1 [options] <inputfile> [options]'#000+
-  '11001_W_Only one source file supporte','d'#000+
+  '11000_$1 [options] <input','file> [options]'#000+
+  '11001_W_Only one source file supported'#000+
   '11002_W_DEF file can be created only for OS/2'#000+
   '11003_E_nested response files are not supported'#000+
   '11004_F_No source file name in command line'#000+
   '11005_N_No option inside $1 config file'#000+
-  '11006_E_Illegal parameter: $1'#000+
+  '11006_E','_Illegal parameter: $1'#000+
   '11007_H_-? writes help pages'#000+
-  '1','1008_F_Too many config files nested'#000+
+  '11008_F_Too many config files nested'#000+
   '11009_F_Unable to open file $1'#000+
   '11010_D_Reading further options from $1'#000+
   '11011_W_Target is already set to: $1'#000+
-  '11012_W_Shared libs not supported on DOS platform, reverting to static'+
-  #000+
-  '11013_F_too many IF(N)DEF','s'#000+
+  '11012_W_Shared libs not supported on DOS pl','atform, reverting to stat'+
+  'ic'#000+
+  '11013_F_too many IF(N)DEFs'#000+
   '11014_F_too many ENDIFs'#000+
   '11015_F_open conditional at the end of the file'#000+
   '11016_W_Debug information generation is not supported by this executab'+
   'le'#000+
   '11017_H_Try recompiling with -dGDB'#000+
-  '11018_E_You are using the obsolete switch $1'#000+
-  '11019_E_You a','re using the obsolete switch $1, please use $2'#000+
+  '11018','_E_You are using the obsolete switch $1'#000+
+  '11019_E_You are using the obsolete switch $1, please use $2'#000+
   '11020_N_Switching assembler to default source writing assembler'#000+
   '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
-  '11022_W_"$1" assembler use forced'#000+
-  '11026_T_Reading options from',' file $1'#000+
+  '11022_W_"','$1" assembler use forced'#000+
+  '11026_T_Reading options from file $1'#000+
   '11027_T_Reading options from environment $1'#000+
   '11028_D_Handling option "$1"'#000+
   '11029__*** press enter ***'#000+
   '11023_Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#010+
-  'Copyright (c) 1993-2000 by Florian Klaempfl'#000+
-  '11024_Free Pascal ','Compiler version $FPCVER'#010+
+  'Copyright',' (c) 1993-2000 by Florian Klaempfl'#000+
+  '11024_Free Pascal Compiler version $FPCVER'#010+
   #010+
   'Compiler Date  : $FPCDATE'#010+
   'Compiler Target: $FPCTARGET'#010+
@@ -661,166 +663,166 @@ const msgtxt : array[0..000140,1..240] of char=(
   '  $OSTARGETS'#010+
   #010+
   'This program comes under the GNU General Public Licence'#010+
-  'For more information read COPYING.FPC'#010+
+  'For more informat','ion read COPYING.FPC'#010+
   #010+
-  'Report bugs,suggestions etc to:',#010+
+  'Report bugs,suggestions etc to:'#010+
   '                 [email protected]'#000+
   '11025_**0*_put + after a boolean switch option to enable it, - to disa'+
   'ble it'#010+
   '**1a_the compiler doesn'#039't delete the generated assembler file'#010+
-  '**2al_list sourcecode lines in assembler file'#010+
-  '**2ar_list regi','ster allocation/release info in assembler file'#010+
+  '**2al_li','st sourcecode lines in assembler file'#010+
+  '**2ar_list register allocation/release info in assembler file'#010+
   '**2at_list temp allocation/release info in assembler file'#010+
   '**1b_generate browser info'#010+
   '**2bl_generate local symbol info'#010+
-  '**1B_build all modules'#010+
+  '**1B_build all modules',#010+
   '**1C<x>_code generation options:'#010+
-  '**2CD_create also d','ynamic library (not supported)'#010+
+  '**2CD_create also dynamic library (not supported)'#010+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
   '**2Ci_IO-checking'#010+
   '**2Cn_omit linking stage'#010+
   '**2Co_check overflow of integer operations'#010+
-  '**2Cr_range checking'#010+
+  '**2Cr_range checki','ng'#010+
   '**2Cs<n>_set stack size to <n>'#010+
-  '**2Ct_stack checkin','g'#010+
+  '**2Ct_stack checking'#010+
   '**2CX_create also smartlinked library'#010+
   '**1d<x>_defines the symbol <x>'#010+
   '*O1D_generate a DEF file'#010+
   '*O2Dd<x>_set description to <x>'#010+
   '*O2Dw_PM application'#010+
   '**1e<x>_set path to executable'#010+
-  '**1E_same as -Cn'#010+
+  '**1E_sa','me as -Cn'#010+
   '**1F<x>_set file names and paths:'#010+
-  '**2FD<x>_','sets the directory where to search for compiler utilities'#010+
+  '**2FD<x>_sets the directory where to search for compiler utilities'#010+
   '**2Fe<x>_redirect error output to <x>'#010+
   '**2FE<x>_set exe/unit output path to <x>'#010+
   '**2Fi<x>_adds <x> to include path'#010+
-  '**2Fl<x>_adds <x> to library path'#010+
-  '*L2FL<x>_uses <x> as dynamic linker',#010+
+  '**2Fl<x>_adds <x','> to library path'#010+
+  '*L2FL<x>_uses <x> as dynamic linker'#010+
   '**2Fo<x>_adds <x> to object path'#010+
   '**2Fr<x>_load error message file <x>'#010+
   '**2Fu<x>_adds <x> to unit path'#010+
   '**2FU<x>_set unit output path to <x>, overrides -FE'#010+
-  '*g1g_generate debugger information:'#010+
+  '*g1g_generate debugger informatio','n:'#010+
   '*g2gg_use gsym'#010+
   '*g2gd_use dbx'#010+
-  '*g2gh_use heap trace ','unit (for memory leak debugging)'#010+
+  '*g2gh_use heap trace unit (for memory leak debugging)'#010+
   '*g2gl_use line info unit to show more info for backtraces'#010+
   '*g2gc_generate checks for pointers'#010+
   '**1i_information'#010+
   '**2iD_return compiler date'#010+
-  '**2iV_return compiler version'#010+
+  '**2iV_return comp','iler version'#010+
   '**2iSO_return compiler OS'#010+
-  '**2iSP_return ','compiler processor'#010+
+  '**2iSP_return compiler processor'#010+
   '**2iTO_return target OS'#010+
   '**2iTP_return target processor'#010+
   '**1I<x>_adds <x> to include path'#010+
   '**1k<x>_Pass <x> to the linker'#010+
   '**1l_write logo'#010+
-  '**1n_don'#039't read the default config file'#010+
-  '**1o<x>_change the name of the executable prod','uced to <x>'#010+
+  '**1n_don'#039't read the default confi','g file'#010+
+  '**1o<x>_change the name of the executable produced to <x>'#010+
   '**1pg_generate profile code for gprof (defines FPC_PROFILE)'#010+
   '*L1P_use pipes instead of creating temporary assembler files'#010+
   '**1S<x>_syntax options:'#010+
-  '**2S2_switch some Delphi 2 extensions on'#010+
-  '**2Sc_supports operators like C (*=,+=,/= ','and -=)'#010+
+  '**2S2_switch some Delphi 2 ext','ensions on'#010+
+  '**2Sc_supports operators like C (*=,+=,/= and -=)'#010+
   '**2Sa_include assertion code.'#010+
   '**2Sd_tries to be Delphi compatible'#010+
   '**2Se<x>_compiler stops after the <x> errors (default is 1)'#010+
   '**2Sg_allow LABEL and GOTO'#010+
   '**2Sh_Use ansistrings'#010+
-  '**2Si_support C++ styled INLINE'#010+
-  '**2Sm_support macros like',' C (global)'#010+
+  '**2S','i_support C++ styled INLINE'#010+
+  '**2Sm_support macros like C (global)'#010+
   '**2So_tries to be TP/BP 7.0 compatible'#010+
   '**2Sp_tries to be gpc compatible'#010+
   '**2Ss_constructor name must be init (destructor must be done)'#010+
   '**2St_allow static keyword in objects'#010+
-  '**1s_don'#039't call assembler and linker (only with -a)'#010+
-  '**1u','<x>_undefines the symbol <x>'#010+
+  '**1','s_don'#039't call assembler and linker (only with -a)'#010+
+  '**1u<x>_undefines the symbol <x>'#010+
   '**1U_unit options:'#010+
   '**2Un_don'#039't check the unit name'#010+
   '**2Ur_generate release unit files'#010+
   '**2Us_compile a system unit'#010+
-  '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
-  '**2*_e : Show errors (default) ','      d : Show debug info'#010+
+  '**1v<x>_Be verbose. <x> is a combination of t','he following letters:'#010+
+  '**2*_e : Show errors (default)       d : Show debug info'#010+
   '**2*_w : Show warnings               u : Show unit info'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
-  '**2*_h : Show hints                  m : Show defined macros'#010+
-  '**2*_i : Show general info        ','   p : Show compiled procedures'#010+
+  '**2*_h : Show hints                  m : S','how defined macros'#010+
+  '**2*_i : Show general info           p : Show compiled procedures'#010+
   '**2*_l : Show linenumbers            c : Show conditionals'#010+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#010+
-  '**2*_b : Show all procedure          r : Rhide/GCC compatibility mode'#010+
-  '**2*_    ','declarations if an error    x : Executable info (Win32 only'+
-  ')'#010+
+  '**2*_b : Show all procedur','e          r : Rhide/GCC compatibility mod'+
+  'e'#010+
+  '**2*_    declarations if an error    x : Executable info (Win32 only)'#010+
   '**2*_    occurs'#010+
   '**1X_executable options:'#010+
   '*L2Xc_link with the c library'#010+
   '**2Xs_strip all symbols from executable'#010+
-  '**2XD_try to link dynamic          (defines FPC_LINK_DYNAMIC)'#010+
-  '**2XS_','try to link static (default) (defines FPC_LINK_STATIC)'#010+
+  '**2XD_try to li','nk dynamic          (defines FPC_LINK_DYNAMIC)'#010+
+  '**2XS_try to link static (default) (defines FPC_LINK_STATIC)'#010+
   '**2XX_try to link smart            (defines FPC_LINK_SMART)'#010+
   '**0*_Processor specific options:'#010+
   '3*1A<x>_output format:'#010+
-  '3*2Aas_assemble using GNU AS'#010+
-  '3*2Aasaout_assemble using GNU AS for aou','t (Go32v1)'#010+
+  '3*2Aas_assemble ','using GNU AS'#010+
+  '3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#010+
   '3*2Anasmcoff_coff (Go32v2) file using Nasm'#010+
   '3*2Anasmelf_elf32 (Linux) file using Nasm'#010+
   '3*2Anasmobj_obj file using Nasm'#010+
   '3*2Amasm_obj file using Masm (Microsoft)'#010+
-  '3*2Atasm_obj file using Tasm (Borland)'#010+
-  '3*2Acoff_coff (Go32v2) using int','ernal writer'#010+
+  '3*2Atasm_obj file ','using Tasm (Borland)'#010+
+  '3*2Acoff_coff (Go32v2) using internal writer'#010+
   '3*2Apecoff_pecoff (Win32) using internal writer'#010+
   '3*1R<x>_assembler reading style:'#010+
   '3*2Ratt_read AT&T style assembler'#010+
   '3*2Rintel_read Intel style assembler'#010+
-  '3*2Rdirect_copy assembler text directly to assembler file'#010+
-  '3*1O<x>_optimizat','ions:'#010+
+  '3*2Rdirect_copy assemb','ler text directly to assembler file'#010+
+  '3*1O<x>_optimizations:'#010+
   '3*2Og_generate smaller code'#010+
   '3*2OG_generate faster code (default)'#010+
   '3*2Or_keep certain variables in registers'#010+
   '3*2Ou_enable uncertain optimizations (see docs)'#010+
-  '3*2O1_level 1 optimizations (quick optimizations)'#010+
-  '3*2O2_level 2 optimizations (','-O1 + slower optimizations)'#010+
+  '3*2O1_level 1 optimization','s (quick optimizations)'#010+
+  '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#010+
   '3*2O3_level 3 optimizations (-O2 repeatedly, max 5 times)'#010+
   '3*2Op<x>_target processor:'#010+
   '3*3Op1_set target processor to 386/486'#010+
-  '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+
-  '3*3Op3_set target processor to PP','ro/PII/c6x86/K6 (tm)'#010+
+  '3*3Op2_set target processor to Pent','ium/PentiumMMX (tm)'#010+
+  '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+
   '3*1T<x>_Target operating system:'#010+
   '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#010+
   '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#010+
   '3*2TLINUX_Linux'#010+
-  '3*2Tnetware_Novell Netware Module (experimental)'#010+
+  '3*2Tnetware_Novell Ne','tware Module (experimental)'#010+
   '3*2TOS2_OS/2 2.x'#010+
-  '3*2TSUNO','S_SunOS/Solaris'#010+
+  '3*2TSUNOS_SunOS/Solaris'#010+
   '3*2TWin32_Windows 32 Bit'#010+
   '3*1W<x>_Win32 target options'#010+
   '3*2WB<x>_Set Image base to Hexadecimal <x> value'#010+
   '3*2WC_Specify console type application'#010+
-  '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
-  '3*2WF_Specify full-screen type',' application (OS/2 only)'#010+
+  '3*2WD_Use DEFFILE to export f','unctions of DLL or EXE'#010+
+  '3*2WF_Specify full-screen type application (OS/2 only)'#010+
   '3*2WG_Specify graphic type application'#010+
   '3*2WN_Do not generate relocation code (necessary for debugging)'#010+
   '3*2WR_Generate relocation code'#010+
   '6*1A<x>_output format'#010+
-  '6*2Aas_Unix o-file using GNU AS'#010+
-  '6*2Agas_GNU Motorola assemb','ler'#010+
+  '6*2Aas','_Unix o-file using GNU AS'#010+
+  '6*2Agas_GNU Motorola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
   '6*2Amot_Standard Motorola assembler'#010+
   '6*1O_optimizations:'#010+
   '6*2Oa_turn on the optimizer'#010+
   '6*2Og_generate smaller code'#010+
   '6*2OG_generate faster code (default)'#010+
-  '6*2Ox_optimize maximum (still BUGGY!!!)'#010+
-  '6*2O2_set target p','rocessor to a MC68020+'#010+
+  '6*2Ox','_optimize maximum (still BUGGY!!!)'#010+
+  '6*2O2_set target processor to a MC68020+'#010+
   '6*1R<x>_assembler reading style:'#010+
   '6*2RMOT_read motorola style assembler'#010+
   '6*1T<x>_Target operating system:'#010+
   '6*2TAMIGA_Commodore Amiga'#010+
   '6*2TATARI_Atari ST/STe/TT'#010+
-  '6*2TMACOS_Macintosh m68k'#010+
+  '6*2TMACO','S_Macintosh m68k'#010+
   '6*2TLINUX_Linux-68k'#010+
-  '6*2TPALMOS_PalmO','S'#010+
+  '6*2TPALMOS_PalmOS'#010+
   '**1*_'#010+
   '**1?_shows this help'#010+
   '**1h_shows this help without waiting'#000

+ 12 - 9
compiler/ncal.pas

@@ -275,7 +275,7 @@ implementation
             if is_array_of_const(defcoll.paratype.def) then
              begin
                if assigned(aktcallprocsym) and
-                  (([pocall_cppdecl,pocall_cdecl]*aktcallprocsym.definition.proccalloptions)<>[]) and
+                  (aktcallprocsym.definition.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
                   (po_external in aktcallprocsym.definition.procoptions) then
                  include(left.flags,nf_cargs);
                { force variant array }
@@ -296,7 +296,7 @@ implementation
 
          { generate the high() value tree }
          if not(assigned(aktcallprocsym) and
-                (([pocall_cppdecl,pocall_cdecl]*aktcallprocsym.definition.proccalloptions)<>[]) and
+                (aktcallprocsym.definition.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
                 (po_external in aktcallprocsym.definition.procoptions)) and
             push_high_param(defcoll.paratype.def) then
            gen_high_tree(is_open_string(defcoll.paratype.def));
@@ -1339,10 +1339,10 @@ implementation
            end;
 
           { handle predefined procedures }
-          is_const:=(pocall_internconst in procdefinition.proccalloptions) and
+          is_const:=(procdefinition.proccalloption=pocall_internconst) and
                     ((block_type in [bt_const,bt_type]) or
                      (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
-          if (pocall_internproc in procdefinition.proccalloptions) or is_const then
+          if (procdefinition.proccalloption=pocall_internproc) or is_const then
            begin
              if assigned(left) then
               begin
@@ -1445,7 +1445,7 @@ implementation
            tcallparanode(left).det_registers;
 
          if assigned(procdefinition) and
-            (pocall_inline in procdefinition.proccalloptions) then
+            (procdefinition.proccalloption=pocall_inline) then
            begin
               inlinecode:=right;
               if assigned(inlinecode) then
@@ -1477,7 +1477,7 @@ implementation
 
               { calc the correture value for the register }
               { handle predefined procedures }
-              if (pocall_inline in procdefinition.proccalloptions) then
+              if (procdefinition.proccalloption=pocall_inline) then
                 begin
                    if assigned(methodpointer) then
                      CGMessage(cg_e_unable_inline_object_methods);
@@ -1494,7 +1494,7 @@ implementation
                           begin
                              { consider it has not inlined if called
                                again inside the args }
-                             exclude(procdefinition.proccalloptions,pocall_inline);
+                             procdefinition.proccalloption:=pocall_fpccall;
                              firstpass(inlinecode);
                              inlined:=true;
                           end;
@@ -1646,7 +1646,7 @@ implementation
            end;
       errorexit:
          if inlined then
-           include(procdefinition.proccalloptions,pocall_inline);
+           procdefinition.proccalloption:=pocall_inline;
       end;
 
 
@@ -1743,7 +1743,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2001-10-13 09:01:14  jonas
+  Revision 1.52  2001-10-25 21:22:33  peter
+    * calling convention rewrite
+
+  Revision 1.51  2001/10/13 09:01:14  jonas
     * fixed bug with using procedures as procvar parameters in TP/Delphi mode
 
   Revision 1.50  2001/10/12 16:04:32  peter

+ 5 - 2
compiler/ncgbas.pas

@@ -204,7 +204,7 @@ interface
            begin
              { if the routine is an inline routine, then we must hold a copy
                because it can be necessary for inlining later }
-             if (pocall_inline in aktprocsym.definition.proccalloptions) then
+             if (aktprocsym.definition.proccalloption=pocall_inline) then
                exprasmList.concatlistcopy(p_asm)
              else
                exprasmList.concatlist(p_asm);
@@ -279,7 +279,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2001-08-26 13:36:39  florian
+  Revision 1.8  2001-10-25 21:22:35  peter
+    * calling convention rewrite
+
+  Revision 1.7  2001/08/26 13:36:39  florian
     * some cg reorganisation
     * some PPC updates
 

+ 5 - 2
compiler/nmem.pas

@@ -418,7 +418,7 @@ implementation
                  { create procvardef }
                  resulttype.setdef(tprocvardef.create);
                  tprocvardef(resulttype.def).proctypeoption:=hp3.proctypeoption;
-                 tprocvardef(resulttype.def).proccalloptions:=hp3.proccalloptions;
+                 tprocvardef(resulttype.def).proccalloption:=hp3.proccalloption;
                  tprocvardef(resulttype.def).procoptions:=hp3.procoptions;
                  tprocvardef(resulttype.def).rettype:=hp3.rettype;
                  tprocvardef(resulttype.def).symtablelevel:=hp3.symtablelevel;
@@ -982,7 +982,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2001-09-02 21:12:07  peter
+  Revision 1.21  2001-10-25 21:22:35  peter
+    * calling convention rewrite
+
+  Revision 1.20  2001/09/02 21:12:07  peter
     * move class of definitions into type section for delphi
 
   Revision 1.19  2001/08/26 13:36:42  florian

+ 6 - 3
compiler/nobj.pas

@@ -636,7 +636,7 @@ implementation
                                        { the flags have to match      }
                                        { except abstract and override }
                                        { only if both are virtual !!  }
-                                       if (procdefcoll^.data.proccalloptions<>hp.proccalloptions) or
+                                       if (procdefcoll^.data.proccalloption<>hp.proccalloption) or
                                           (procdefcoll^.data.proctypeoption<>hp.proctypeoption) or
                                           ((procdefcoll^.data.procoptions-
                                               [po_abstractmethod,po_overridingmethod,po_assembler,po_overload])<>
@@ -988,7 +988,7 @@ implementation
           begin
             implprocdef:=sym.definition;
             while assigned(implprocdef) and not equal_paras(proc.para,implprocdef.para,cp_none) and
-              (proc.proccalloptions<>implprocdef.proccalloptions) do
+              (proc.proccalloption<>implprocdef.proccalloption) do
               implprocdef:=implprocdef.nextoverloaded;
           end;
         gintfgetcprocdef:=implprocdef;
@@ -1275,7 +1275,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.6  2001-10-20 19:28:38  peter
+  Revision 1.7  2001-10-25 21:22:35  peter
+    * calling convention rewrite
+
+  Revision 1.6  2001/10/20 19:28:38  peter
     * interface 2 guid support
     * guid constants support
 

+ 5 - 2
compiler/parser.pas

@@ -275,7 +275,7 @@ implementation
          oldaktinterfacetype: tinterfacetypes;
          oldaktmodeswitches : tmodeswitches;
          old_compiled_module : tmodule;
-         oldaktdefproccall : tdefproccall;
+         oldaktdefproccall : tproccalloption;
 {        will only be increased once we start parsing blocks in the }
 {         implementation, so doesn't need to be saved/restored (JM) }
 {          oldexceptblockcounter  : integer;                        }
@@ -625,7 +625,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.24  2001-10-23 21:49:42  peter
+  Revision 1.25  2001-10-25 21:22:35  peter
+    * calling convention rewrite
+
+  Revision 1.24  2001/10/23 21:49:42  peter
     * $calling directive and -Cc commandline patch added
       from Pavel Ozerski
 

+ 5 - 2
compiler/pass_2.pas

@@ -291,7 +291,7 @@ implementation
               cleanup_regvars(procinfo^.aktexitcode);
 
               if assigned(aktprocsym) and
-                 (pocall_inline in aktprocsym.definition.proccalloptions) then
+                 (aktprocsym.definition.proccalloption=pocall_inline) then
                 make_const_global:=true;
               do_secondpass(p);
 
@@ -306,7 +306,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.18  2001-08-26 13:36:44  florian
+  Revision 1.19  2001-10-25 21:22:35  peter
+    * calling convention rewrite
+
+  Revision 1.18  2001/08/26 13:36:44  florian
     * some cg reorganisation
     * some PPC updates
 

+ 6 - 1
compiler/pdecl.pas

@@ -213,6 +213,8 @@ implementation
                          if is_proc_directive(token) then
                           parse_var_proc_directives(sym);
                        end;
+                      { add default calling convention }
+                      handle_calling_convention(nil,tabstractprocdef(tt.def));
                     end;
                    if not skipequal then
                     begin
@@ -603,7 +605,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.38  2001-10-24 10:26:53  marco
+  Revision 1.39  2001-10-25 21:22:35  peter
+    * calling convention rewrite
+
+  Revision 1.38  2001/10/24 10:26:53  marco
    * Don't parse proc directives after type renaming of procvars
 
   Revision 1.37  2001/10/20 20:30:21  peter

+ 5 - 2
compiler/pdecobj.pas

@@ -877,7 +877,7 @@ implementation
         begin
            if is_cppclass(aktclass) then
              begin
-                include(aktprocsym.definition.proccalloptions,pocall_cppdecl);
+                aktprocsym.definition.proccalloption:=pocall_cppdecl;
                 aktprocsym.definition.setmangledname(
                   target_info.Cprefix+aktprocsym.definition.cplusplusmangledname);
              end;
@@ -1094,7 +1094,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  2001-10-21 13:10:50  peter
+  Revision 1.32  2001-10-25 21:22:35  peter
+    * calling convention rewrite
+
+  Revision 1.31  2001/10/21 13:10:50  peter
     * better support for indexed properties
 
   Revision 1.30  2001/10/21 12:33:06  peter

+ 260 - 253
compiler/pdecsub.pas

@@ -46,6 +46,8 @@ interface
 
     procedure parse_proc_directives(var pdflags:word);
 
+    procedure handle_calling_convention(sym:tprocsym;def:tabstractprocdef);
+
     procedure parse_proc_head(options:tproctypeoption);
     procedure parse_proc_dec;
     procedure parse_var_proc_directives(var sym : tsym);
@@ -82,6 +84,16 @@ implementation
        ;
 
 
+    procedure resetvaluepara(p:tnamedindexitem);
+      begin
+        if tsym(p).typ=varsym then
+         with tvarsym(p) do
+          if copy(name,1,3)='val' then
+           aktprocsym.definition.parast.symsearch.rename(name,copy(name,4,length(name)));
+      end;
+
+
+
     procedure parameter_dec(aktprocdef:tabstractprocdef);
       {
         handle_procvar needs the same changes
@@ -811,28 +823,11 @@ begin
    end;
 end;
 
-procedure pd_inline;
-begin
-  if not(cs_support_inline in aktmoduleswitches) then
-   begin
-     Message(parser_e_proc_inline_not_supported);
-     exclude(aktprocsym.definition.proccalloptions,pocall_inline);
-   end;
-end;
-
 procedure pd_forward;
 begin
   aktprocsym.definition.forwarddef:=true;
 end;
 
-procedure pd_stdcall;
-begin
-end;
-
-procedure pd_safecall;
-begin
-end;
-
 procedure pd_alias;
 begin
   consume(_COLON);
@@ -842,6 +837,7 @@ end;
 procedure pd_asmname;
 begin
   aktprocsym.definition.setmangledname(target_info.Cprefix+pattern);
+  aktprocsym.definition.has_mangledname:=true;
   if token=_CCHAR then
     consume(_CCHAR)
   else
@@ -866,11 +862,6 @@ begin
 {$endif i386}
 end;
 
-procedure pd_system;
-begin
-  aktprocsym.definition.setmangledname(aktprocsym.realname);
-end;
-
 procedure pd_abstract;
 begin
   if (po_virtualmethod in aktprocsym.definition.procoptions) then
@@ -956,74 +947,6 @@ begin
 end;
 
 
-procedure resetvaluepara(p:tnamedindexitem);
-begin
-  if tsym(p).typ=varsym then
-    with tvarsym(p) do
-       if copy(name,1,3)='val' then
-          aktprocsym.definition.parast.symsearch.rename(name,copy(name,4,length(name)));
-end;
-
-
-procedure pd_cdecl;
-begin
-  if aktprocsym.definition.deftype<>procvardef then
-    aktprocsym.definition.setmangledname(target_info.Cprefix+aktprocsym.realname);
-  { do not copy on local !! }
-  if (aktprocsym.definition.deftype=procdef) and
-     assigned(aktprocsym.definition.parast) then
-    aktprocsym.definition.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
-end;
-
-procedure pd_cppdecl;
-begin
-  if aktprocsym.definition.deftype<>procvardef then
-    aktprocsym.definition.setmangledname(
-      target_info.Cprefix+aktprocsym.definition.cplusplusmangledname);
-  { do not copy on local !! }
-  if (aktprocsym.definition.deftype=procdef) and
-     assigned(aktprocsym.definition.parast) then
-    aktprocsym.definition.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
-end;
-
-
-procedure pd_pascal;
-var st,parast : tsymtable;
-    lastps,ps : tsym;
-begin
-   st:=tparasymtable.create;
-   parast:=aktprocsym.definition.parast;
-   lastps:=nil;
-   while assigned(parast.symindex.first) and (lastps<>tsym(parast.symindex.first)) do
-     begin
-       ps:=tsym(parast.symindex.first);
-       while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
-         ps:=tsym(ps.indexnext);
-       ps.owner:=st;
-       { recalculate the corrected offset }
-       { the really_insert_in_data procedure
-         for parasymtable should only calculateoffset PM }
-       tstoredsym(ps).insert_in_data;
-       { reset the owner correctly }
-       ps.owner:=parast;
-       lastps:=ps;
-     end;
-end;
-
-
-procedure pd_register;
-begin
-  Message1(parser_w_proc_directive_ignored,'REGISTER');
-end;
-
-
-procedure pd_far16;
-begin
-  { Temporary stub, must be rewritten to support OS/2 far16 }
-  Message1(parser_w_proc_directive_ignored,'FAR16');
-end;
-
-
 procedure pd_reintroduce;
 begin
   Message1(parser_w_proc_directive_ignored,'REINTRODUCE');
@@ -1109,35 +1032,18 @@ begin
          consume(_NAME);
          import_name:=get_stringconst;
          aktprocsym.definition.setmangledname(import_name);
-         if target_info.DllScanSupported then
-           current_module.externals.insert(tExternalsItem.create(import_name));
-       end
-      else
-       begin
-         { external shouldn't override the cdecl/system name }
-         if not (pocall_clearstack in aktprocsym.definition.proccalloptions) then
-          begin
-            aktprocsym.definition.setmangledname(aktprocsym.realname);
-            if target_info.DllScanSupported then
-             current_module.externals.insert(tExternalsItem.create(aktprocsym.realname));
-          end;
+         aktprocsym.definition.has_mangledname:=true;
        end;
     end;
 end;
 
-procedure pd_compilerproc;
-begin
-  aktprocsym.definition.setmangledname(lower(aktprocsym.name));
-end;
-
-
 type
    pd_handler=procedure;
    proc_dir_rec=record
      idtok     : ttoken;
      pd_flags  : longint;
      handler   : pd_handler;
-     pocall    : tproccalloptions;
+     pocall    : tproccalloption;
      pooption  : tprocoptions;
      mutexclpocall : tproccalloptions;
      mutexclpotype : tproctypeoptions;
@@ -1152,7 +1058,7 @@ const
       idtok:_ABSTRACT;
       pd_flags : pd_interface+pd_object+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_abstract;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_abstractmethod];
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [potype_constructor,potype_destructor];
@@ -1161,7 +1067,7 @@ const
       idtok:_ALIAS;
       pd_flags : pd_implemen+pd_body+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_alias;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [];
       mutexclpocall : [pocall_inline];
       mutexclpotype : [];
@@ -1170,16 +1076,16 @@ const
       idtok:_ASMNAME;
       pd_flags : pd_interface+pd_implemen+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_asmname;
-      pocall   : [pocall_cdecl,pocall_clearstack];
+      pocall   : pocall_cdecl;
       pooption : [po_external];
-      mutexclpocall : [pocall_internproc];
+      mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
       idtok:_ASSEMBLER;
       pd_flags : pd_implemen+pd_body+pd_notobjintf;
       handler  : nil;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_assembler];
       mutexclpocall : [];
       mutexclpotype : [];
@@ -1187,18 +1093,17 @@ const
     ),(
       idtok:_CDECL;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_cdecl;
-      pocall   : [pocall_cdecl,pocall_clearstack];
-      pooption : [po_savestdregs];
-      mutexclpocall : [pocall_cppdecl,pocall_internproc,
-        pocall_leftright,pocall_inline,pocall_far16,pocall_fpccall];
+      handler  : nil;
+      pocall   : pocall_cdecl;
+      pooption : [];
+      mutexclpocall : [];
       mutexclpotype : [];
       mutexclpo     : [po_assembler,po_external]
     ),(
       idtok:_DYNAMIC;
       pd_flags : pd_interface+pd_object+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_virtualmethod];
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [];
@@ -1207,7 +1112,7 @@ const
       idtok:_EXPORT;
       pd_flags : pd_body+pd_global+pd_interface+pd_implemen{??}+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_export;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_exports];
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [];
@@ -1216,7 +1121,7 @@ const
       idtok:_EXTERNAL;
       pd_flags : pd_implemen+pd_interface+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_external;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_external];
       mutexclpocall : [pocall_internproc,pocall_inline,pocall_palmossyscall];
       mutexclpotype : [];
@@ -1225,7 +1130,7 @@ const
       idtok:_FAR;
       pd_flags : pd_implemen+pd_body+pd_interface+pd_procvar+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_far;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [];
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [];
@@ -1233,19 +1138,17 @@ const
     ),(
       idtok:_FAR16;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_far16;
-      pocall   : [pocall_far16];
+      handler  : nil;
+      pocall   : pocall_far16;
       pooption : [];
-      mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
-                       pocall_clearstack,pocall_inline,
-                       pocall_safecall,pocall_leftright,pocall_fpccall];
+      mutexclpocall : [];
       mutexclpotype : [];
-      mutexclpo     : [po_external]
+      mutexclpo     : [po_external,po_leftright]
     ),(
       idtok:_FORWARD;
       pd_flags : pd_implemen+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_forward;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [];
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [];
@@ -1254,27 +1157,25 @@ const
       idtok:_FPCCALL;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
       handler  : nil;
-      pocall   : [pocall_fpccall];
+      pocall   : pocall_fpccall;
       pooption : [];
-      mutexclpocall : [pocall_cdecl,pocall_cppdecl,
-                       pocall_clearstack,pocall_inline,
-                       pocall_safecall,pocall_leftright,pocall_far16];
+      mutexclpocall : [];
       mutexclpotype : [];
-      mutexclpo     : []
+      mutexclpo     : [po_leftright]
     ),(
       idtok:_INLINE;
       pd_flags : pd_implemen+pd_body+pd_notobjintf;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_inline;
-      pocall   : [pocall_inline];
+      handler  : nil;
+      pocall   : pocall_inline;
       pooption : [];
-      mutexclpocall : [pocall_internproc];
+      mutexclpocall : [];
       mutexclpotype : [potype_constructor,potype_destructor];
       mutexclpo     : [po_exports,po_external,po_interrupt]
     ),(
       idtok:_INTERNCONST;
       pd_flags : pd_implemen+pd_body+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
-      pocall   : [pocall_internconst];
+      pocall   : pocall_internconst;
       pooption : [];
       mutexclpocall : [];
       mutexclpotype : [potype_operator];
@@ -1283,28 +1184,26 @@ const
       idtok:_INTERNPROC;
       pd_flags : pd_implemen+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
-      pocall   : [pocall_internproc];
+      pocall   : pocall_internproc;
       pooption : [];
-      mutexclpocall : [pocall_inline,pocall_clearstack,pocall_leftright,pocall_cdecl,pocall_cppdecl,
-                      pocall_far16,pocall_fpccall];
+      mutexclpocall : [];
       mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
-      mutexclpo     : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck]
+      mutexclpo     : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_leftright]
     ),(
       idtok:_INTERRUPT;
       pd_flags : pd_implemen+pd_body+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_interrupt;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_interrupt];
       mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
-                       pocall_clearstack,pocall_leftright,pocall_inline,
-                       pocall_far16,pocall_fpccall];
+                       pocall_inline,pocall_pascal,pocall_system,pocall_far16,pocall_fpccall];
       mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
-      mutexclpo     : [po_external]
+      mutexclpo     : [po_external,po_leftright,po_clearstack]
     ),(
       idtok:_IOCHECK;
       pd_flags : pd_implemen+pd_body+pd_notobjintf;
       handler  : nil;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_iocheck];
       mutexclpocall : [pocall_internproc];
       mutexclpotype : [];
@@ -1313,7 +1212,7 @@ const
       idtok:_MESSAGE;
       pd_flags : pd_interface+pd_object+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_message;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : []; { can be po_msgstr or po_msgint }
       mutexclpocall : [pocall_inline,pocall_internproc];
       mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
@@ -1322,7 +1221,7 @@ const
       idtok:_NEAR;
       pd_flags : pd_implemen+pd_body+pd_procvar+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_near;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [];
       mutexclpocall : [pocall_internproc];
       mutexclpotype : [];
@@ -1331,7 +1230,7 @@ const
       idtok:_OVERLOAD;
       pd_flags : pd_implemen+pd_interface+pd_body;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_overload;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_overload];
       mutexclpocall : [pocall_internproc];
       mutexclpotype : [];
@@ -1340,7 +1239,7 @@ const
       idtok:_OVERRIDE;
       pd_flags : pd_interface+pd_object+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_override;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_overridingmethod,po_virtualmethod];
       mutexclpocall : [pocall_inline,pocall_internproc];
       mutexclpotype : [];
@@ -1348,28 +1247,26 @@ const
     ),(
       idtok:_PASCAL;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_pascal;
-      pocall   : [pocall_leftright];
+      handler  : nil;
+      pocall   : pocall_pascal;
       pooption : [];
-      mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
-                       pocall_clearstack,pocall_leftright,pocall_inline,
-                       pocall_safecall,pocall_far16,pocall_fpccall];
+      mutexclpocall : [];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
       idtok:_POPSTACK;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
       handler  : nil;
-      pocall   : [pocall_clearstack];
-      pooption : [];
-      mutexclpocall : [pocall_inline,pocall_internproc];
+      pocall   : pocall_none;
+      pooption : [po_clearstack];
+      mutexclpocall : [pocall_inline,pocall_internproc,pocall_stdcall];
       mutexclpotype : [];
       mutexclpo     : [po_assembler,po_external]
     ),(
       idtok:_PUBLIC;
       pd_flags : pd_implemen+pd_body+pd_global+pd_notobject+pd_notobjintf;
       handler  : nil;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [];
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [];
@@ -1377,18 +1274,17 @@ const
     ),(
       idtok:_REGISTER;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_register;
-      pocall   : [pocall_register];
+      handler  : nil;
+      pocall   : pocall_register;
       pooption : [];
-      mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_internproc,pocall_cppdecl,
-                       pocall_far16,pocall_fpccall];
+      mutexclpocall : [];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
       idtok:_REINTRODUCE;
       pd_flags : pd_interface+pd_object;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_reintroduce;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [];
       mutexclpocall : [];
       mutexclpotype : [];
@@ -1396,18 +1292,17 @@ const
     ),(
       idtok:_SAFECALL;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_safecall;
-      pocall   : [pocall_safecall];
-      pooption : [po_savestdregs];
-      mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl,
-        pocall_internproc,pocall_inline,pocall_far16,pocall_fpccall];
+      handler  : nil;
+      pocall   : pocall_safecall;
+      pooption : [];
+      mutexclpocall : [];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
       idtok:_SAVEREGISTERS;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar+pd_notobjintf;
       handler  : nil;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_saveregisters];
       mutexclpocall : [pocall_internproc];
       mutexclpotype : [];
@@ -1416,7 +1311,7 @@ const
       idtok:_STATIC;
       pd_flags : pd_interface+pd_object+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_static;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_staticmethod];
       mutexclpocall : [pocall_inline,pocall_internproc];
       mutexclpotype : [potype_constructor,potype_destructor];
@@ -1424,38 +1319,35 @@ const
     ),(
       idtok:_STDCALL;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_stdcall;
-      pocall   : [pocall_stdcall];
-      pooption : [po_savestdregs];
-      mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl,
-        pocall_inline,pocall_internproc,pocall_safecall,pocall_far16,pocall_fpccall];
+      handler  : nil;
+      pocall   : pocall_stdcall;
+      pooption : [];
+      mutexclpocall : [];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
       idtok:_SYSCALL;
       pd_flags : pd_interface+pd_implemen+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_syscall;
-      pocall   : [pocall_palmossyscall,pocall_cdecl,pocall_clearstack];
+      pocall   : pocall_palmossyscall;
       pooption : [];
-      mutexclpocall : [pocall_cdecl,pocall_cppdecl,pocall_inline,
-        pocall_internproc,pocall_leftright,pocall_far16,pocall_fpccall];
+      mutexclpocall : [];
       mutexclpotype : [];
       mutexclpo     : [po_external,po_assembler,po_interrupt,po_exports]
     ),(
       idtok:_SYSTEM;
       pd_flags : pd_implemen+pd_notobjintf;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_system;
-      pocall   : [pocall_clearstack];
+      handler  : nil;
+      pocall   : pocall_system;
       pooption : [];
-      mutexclpocall : [pocall_leftright,pocall_inline,pocall_cdecl,
-        pocall_internproc,pocall_cppdecl,pocall_far16,pocall_fpccall];
+      mutexclpocall : [];
       mutexclpotype : [];
       mutexclpo     : [po_external,po_assembler,po_interrupt]
     ),(
       idtok:_VIRTUAL;
       pd_flags : pd_interface+pd_object+pd_notobjintf;
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_virtualmethod];
       mutexclpocall : [pocall_inline,pocall_internproc];
       mutexclpotype : [];
@@ -1463,28 +1355,27 @@ const
     ),(
       idtok:_CPPDECL;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_cppdecl;
-      pocall   : [pocall_cppdecl,pocall_clearstack];
+      handler  : nil;
+      pocall   : pocall_cppdecl;
       pooption : [po_savestdregs];
-      mutexclpocall : [pocall_cdecl,pocall_internproc,pocall_leftright,pocall_inline,
-                      pocall_far16,pocall_fpccall];
+      mutexclpocall : [];
       mutexclpotype : [];
       mutexclpo     : [po_assembler,po_external]
     ),(
       idtok:_VARARGS;
       pd_flags : pd_interface+pd_implemen+pd_procvar;
       handler  : nil;
-      pocall   : [];
+      pocall   : pocall_none;
       pooption : [po_varargs];
       mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register,
-                       pocall_leftright,pocall_inline,pocall_far16,pocall_fpccall];
+                       pocall_inline,pocall_far16,pocall_fpccall];
       mutexclpotype : [];
-      mutexclpo     : [po_assembler,po_interrupt]
+      mutexclpo     : [po_assembler,po_interrupt,po_leftright]
     ),(
       idtok:_COMPILERPROC;
       pd_flags : pd_interface+pd_implemen+pd_body+pd_notobjintf;
-      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_compilerproc;
-      pocall   : [pocall_compilerproc];
+      handler  : nil;
+      pocall   : pocall_compilerproc;
       pooption : [];
       mutexclpocall : [];
       mutexclpotype : [];
@@ -1507,7 +1398,7 @@ const
       end;
 
 
-    function parse_proc_direc(idtoken:ttoken; var pdflags:word; do_consume:boolean):boolean;//Ozerski 08.10.01
+    function parse_proc_direc(var pdflags:word):boolean;
       {
         Parse the procedure directive, returns true if a correct directive is found
       }
@@ -1555,13 +1446,25 @@ const
 
       { Conflicts between directives ? }
         if (aktprocsym.definition.proctypeoption in proc_direcdata[p].mutexclpotype) or
-           ((aktprocsym.definition.proccalloptions*proc_direcdata[p].mutexclpocall)<>[]) or
+           (aktprocsym.definition.proccalloption in proc_direcdata[p].mutexclpocall) or
            ((aktprocsym.definition.procoptions*proc_direcdata[p].mutexclpo)<>[]) then
          begin
            Message1(parser_e_proc_dir_conflict,name);
            exit;
          end;
 
+      { set calling convention }
+        if proc_direcdata[p].pocall<>pocall_none then
+         begin
+           if aktprocsym.definition.proccalloption<>pocall_none then
+            begin
+              Message2(parser_w_proc_overriding_calling,
+                proccalloptionStr[aktprocsym.definition.proccalloption],
+                proccalloptionStr[proc_direcdata[p].pocall]);
+            end;
+           aktprocsym.definition.proccalloption:=proc_direcdata[p].pocall;
+         end;
+
         if aktprocsym.definition.deftype=procdef then
          begin
            { Check if the directive is only for objects }
@@ -1581,8 +1484,7 @@ const
          end;
 
       { consume directive, and turn flag on }
-        if do_consume then
-         consume(token);
+        consume(token);
         parse_proc_direc:=true;
 
       { Check the pd_flags if the directive should be allowed }
@@ -1612,47 +1514,152 @@ const
           pdflags:=pdflags or pd_global;
 
       { Add the correct flag }
-        aktprocsym.definition.proccalloptions:=aktprocsym.definition.proccalloptions+proc_direcdata[p].pocall;
         aktprocsym.definition.procoptions:=aktprocsym.definition.procoptions+proc_direcdata[p].pooption;
 
-       { Adjust positions of args for cdecl or stdcall }
-         if (aktprocsym.definition.deftype=procdef) and
-            (([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*aktprocsym.definition.proccalloptions)<>[]) then
-           tparasymtable(aktprocsym.definition.parast).set_alignment(target_info.size_of_longint);
-
       { Call the handler }
         if pointer({$ifndef FPCPROCVAR}@{$endif}proc_direcdata[p].handler)<>nil then
           proc_direcdata[p].handler{$ifdef FPCPROCVAR}(){$endif};
       end;
 
 
-    const
-      CallModeTokens : set of TToken = [
-         _CDECL,
-         _CPPDECL,
-         _FAR16,
-         _FPCCALL,
-         _INLINE,
-         _PASCAL,
-         _POPSTACK,
-         _REGISTER,
-         _SAFECALL,
-         _STDCALL,
-         _SYSTEM
-      ];
-      CallModeToken : array[TDefProcCall] of TToken = (
-         _CDECL,
-         _CPPDECL,
-         _FAR16,
-         _FPCCALL,
-         _INLINE,
-         _PASCAL,
-         _POPSTACK,
-         _REGISTER,
-         _SAFECALL,
-         _STDCALL,
-         _SYSTEM
-      );
+    procedure handle_calling_convention(sym:tprocsym;def:tabstractprocdef);
+      var
+        st,parast : tsymtable;
+        lastps,ps : tsym;
+      begin
+      { set the default calling convention }
+        if def.proccalloption=pocall_none then
+         def.proccalloption:=aktdefproccall;
+        case def.proccalloption of
+          pocall_cdecl :
+            begin
+              { use popstack and save std registers }
+              include(def.procoptions,po_clearstack);
+              include(def.procoptions,po_savestdregs);
+              { set mangledname }
+              if (def.deftype=procdef) then
+               begin
+                 if not tprocdef(def).has_mangledname then
+                  tprocdef(def).setmangledname(target_info.Cprefix+sym.realname);
+                 if not assigned(tprocdef(def).parast) then
+                  internalerror(200110234);
+                 { do not copy on local !! }
+                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
+                 { Adjust positions of args for cdecl or stdcall }
+                 tparasymtable(tprocdef(def).parast).set_alignment(target_info.size_of_longint);
+               end;
+            end;
+          pocall_cppdecl :
+            begin
+              if not assigned(sym) then
+               internalerror(200110231);
+              { use popstack and save std registers }
+              include(def.procoptions,po_clearstack);
+              include(def.procoptions,po_savestdregs);
+              { set mangledname }
+              if (def.deftype=procdef) then
+               begin
+                 if not tprocdef(def).has_mangledname then
+                  tprocdef(def).setmangledname(target_info.Cprefix+tprocdef(def).cplusplusmangledname);
+                 if not assigned(tprocdef(def).parast) then
+                  internalerror(200110235);
+                 { do not copy on local !! }
+                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
+                 { Adjust positions of args for cdecl or stdcall }
+                 tparasymtable(tprocdef(def).parast).set_alignment(target_info.size_of_longint);
+               end;
+            end;
+          pocall_stdcall :
+            begin
+              include(def.procoptions,po_savestdregs);
+              if (def.deftype=procdef) and
+                 assigned(tprocdef(def).parast) then
+               begin
+                 { Adjust positions of args for cdecl or stdcall }
+                 tparasymtable(tprocdef(def).parast).set_alignment(target_info.size_of_longint);
+               end;
+            end;
+          pocall_safecall :
+            begin
+              include(def.procoptions,po_savestdregs);
+            end;
+          pocall_compilerproc :
+            begin
+              if (not assigned(sym)) or
+                 (def.deftype<>procdef) then
+               internalerror(200110232);
+              tprocdef(def).setmangledname(lower(sym.name));
+            end;
+          pocall_pascal :
+            begin
+              include(def.procoptions,po_leftright);
+              st:=tparasymtable.create;
+              parast:=tprocdef(def).parast;
+              lastps:=nil;
+              while assigned(parast.symindex.first) and (lastps<>tsym(parast.symindex.first)) do
+                begin
+                  ps:=tsym(parast.symindex.first);
+                  while assigned(ps.indexnext) and (tsym(ps.indexnext)<>lastps) do
+                    ps:=tsym(ps.indexnext);
+                  ps.owner:=st;
+                  { recalculate the corrected offset }
+                  { the really_insert_in_data procedure
+                    for parasymtable should only calculateoffset PM }
+                  tstoredsym(ps).insert_in_data;
+                  { reset the owner correctly }
+                  ps.owner:=parast;
+                  lastps:=ps;
+                end;
+            end;
+          pocall_register :
+            begin
+              Message1(parser_w_proc_directive_ignored,'REGISTER');
+            end;
+          pocall_far16 :
+            begin
+              { Temporary stub, must be rewritten to support OS/2 far16 }
+              Message1(parser_w_proc_directive_ignored,'FAR16');
+            end;
+          pocall_system :
+            begin
+              include(def.procoptions,po_clearstack);
+              if (not assigned(sym)) or
+                 (def.deftype<>procdef) then
+               internalerror(200110233);
+              if not tprocdef(def).has_mangledname then
+               tprocdef(def).setmangledname(sym.realname);
+            end;
+          pocall_palmossyscall :
+            begin
+              { use popstack and save std registers }
+              include(def.procoptions,po_clearstack);
+              include(def.procoptions,po_savestdregs);
+              if (def.deftype=procdef) then
+               begin
+                 if not assigned(tprocdef(def).parast) then
+                  internalerror(200110236);
+                 { do not copy on local !! }
+                 tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara);
+                 { Adjust positions of args for cdecl or stdcall }
+                 tparasymtable(tprocdef(def).parast).set_alignment(target_info.size_of_longint);
+               end;
+            end;
+          pocall_inline :
+            begin
+              if not(cs_support_inline in aktmoduleswitches) then
+               begin
+                 Message(parser_e_proc_inline_not_supported);
+                 def.proccalloption:=pocall_fpccall;
+               end;
+            end;
+        end;
+
+        { add mangledname to external list }
+        if (def.deftype=procdef) and
+           (po_external in def.procoptions) and
+           target_info.DllScanSupported then
+           current_module.externals.insert(tExternalsItem.create(tprocdef(def).mangledname));
+      end;
 
 
     procedure parse_proc_directives(var pdflags:word);
@@ -1662,17 +1669,13 @@ const
       }
       var
         res : boolean;
-        CallModeIsChangedLocally : boolean;
       begin
-        CallModeIsChangedLocally:=false;
         while token in [_ID,_LECKKLAMMER] do
          begin
            if try_to_consume(_LECKKLAMMER) then
             begin
               repeat
-                if not CallModeIsChangedLocally then
-                  CallModeIsChangedLocally:=idtoken in CallModeTokens;
-                parse_proc_direc(idtoken,pdflags,true);
+                parse_proc_direc(pdflags);
               until not try_to_consume(_COMMA);
               consume(_RECKKLAMMER);
               { we always expect at least '[];' }
@@ -1680,9 +1683,7 @@ const
             end
            else
             begin
-              if not CallModeIsChangedLocally then
-                CallModeIsChangedLocally:=idtoken in CallModeTokens;
-              res:=parse_proc_direc(idtoken,pdflags,true);
+              res:=parse_proc_direc(pdflags);
             end;
          { A procedure directive normally followed by a semicolon, but in
            a const section we should stop when _EQUAL is found }
@@ -1699,9 +1700,7 @@ const
            else
             break;
          end;
-        { add default calling convention if none is specified }
-        if (not CallModeIsChangedLocally) then
-          parse_proc_direc(CallModeToken[aktdefproccall],pdflags,false);
+        handle_calling_convention(aktprocsym,aktprocsym.definition);
       end;
 
 
@@ -1817,18 +1816,23 @@ const
                                          aktprocsym.definition.fullprocname);
                              exit;
                            end;
-                         { Check calling convention, no check for internconst,internproc which
-                           are only defined in interface or implementation }
-                         if (hd.proccalloptions-[pocall_internconst,pocall_internproc]<>
-                             aktprocsym.definition.proccalloptions-[pocall_internconst,pocall_internproc]) then
+                        { no check for internconst,internproc which
+                          are only defined in interface or implementation }
+                         if (aktprocsym.definition.proccalloption in [pocall_internconst,pocall_internproc]) then
+                           hd.proccalloption:=aktprocsym.definition.proccalloption
+                         else
+                           if (hd.proccalloption in [pocall_internconst,pocall_internproc]) then
+                             aktprocsym.definition.proccalloption:=hd.proccalloption;
+                         { Check calling convention }
+                         if (hd.proccalloption<>aktprocsym.definition.proccalloption) then
                           begin
                             { only trigger an error, becuase it doesn't hurt, for delphi check
-                              if the current implementation has no proccalloptions, then
+                              if the current implementation has no proccalloption, then
                               take the options from the interface }
                             if (m_delphi in aktmodeswitches) then
                              begin
-                               if (aktprocsym.definition.proccalloptions=[]) then
-                                aktprocsym.definition.proccalloptions:=hd.proccalloptions
+                               if (aktprocsym.definition.proccalloption=pocall_none) then
+                                aktprocsym.definition.proccalloption:=hd.proccalloption
                                else
                                 MessagePos(aktprocsym.definition.fileinfo,parser_e_call_convention_dont_match_forward);
                              end
@@ -1902,7 +1906,7 @@ const
                          by the procdir handlers must be copied here!.}
                          hd.forwarddef:=false;
                          hd.hasforward:=true;
-                         hd.proccalloptions:=hd.proccalloptions + aktprocsym.definition.proccalloptions;
+                         hd.proccalloption:=aktprocsym.definition.proccalloption;
                          hd.procoptions:=hd.procoptions + aktprocsym.definition.procoptions;
                          if aktprocsym.definition.extnumber=-1 then
                            aktprocsym.definition.extnumber:=hd.extnumber
@@ -1919,7 +1923,7 @@ const
                          aktprocsym.definition:=hd;
                          { for compilerproc defines we need to rename and update the
                            mangledname }
-                         if (pocall_compilerproc in aktprocsym.definition.proccalloptions) then
+                         if (aktprocsym.definition.proccalloption=pocall_compilerproc) then
                           begin
                             { rename to lowercase so users can't access it }
                             aktprocsym.owner.rename(aktprocsym.name,lower(aktprocsym.name));
@@ -2005,7 +2009,10 @@ const
 end.
 {
   $Log$
-  Revision 1.39  2001-10-23 21:49:42  peter
+  Revision 1.40  2001-10-25 21:22:37  peter
+    * calling convention rewrite
+
+  Revision 1.39  2001/10/23 21:49:42  peter
     * $calling directive and -Cc commandline patch added
       from Pavel Ozerski
 

+ 6 - 3
compiler/pstatmnt.pas

@@ -757,11 +757,11 @@ implementation
              begin
                if not target_asm.allowdirect then
                  Message(parser_f_direct_assembler_not_allowed);
-               if (pocall_inline in aktprocsym.definition.proccalloptions) then
+               if (aktprocsym.definition.proccalloption=pocall_inline) then
                  Begin
                     Message1(parser_w_not_supported_for_inline,'direct asm');
                     Message(parser_w_inlining_disabled);
-                    exclude(aktprocsym.definition.proccalloptions,pocall_inline);
+                    aktprocsym.definition.proccalloption:=pocall_fpccall;
                  End;
                asmstat:=tasmnode(ra386dir.assemble);
              end;
@@ -1115,7 +1115,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.40  2001-10-24 11:51:39  marco
+  Revision 1.41  2001-10-25 21:22:37  peter
+    * calling convention rewrite
+
+  Revision 1.40  2001/10/24 11:51:39  marco
    * Make new/dispose system functions instead of keywords
 
   Revision 1.39  2001/10/17 22:41:04  florian

+ 10 - 7
compiler/psub.pas

@@ -460,7 +460,7 @@ implementation
          { so no dispose here !!                              }
          if assigned(code) and
             not(cs_browser in aktmoduleswitches) and
-            not(pocall_inline in aktprocsym.definition.proccalloptions) then
+            (aktprocsym.definition.proccalloption<>pocall_inline) then
            begin
              if lexlevel>=normal_function_level then
                aktprocsym.definition.localst.free;
@@ -480,7 +480,7 @@ implementation
 {$endif newcg}
 
          { remove code tree, if not inline procedure }
-         if assigned(code) and not(pocall_inline in aktprocsym.definition.proccalloptions) then
+         if assigned(code) and (aktprocsym.definition.proccalloption<>pocall_inline) then
            code.free;
 
          { remove class member symbol tables }
@@ -622,14 +622,14 @@ implementation
              begin
                { if external is available, then cdecl must also be available }
                if (po_external in aktprocsym.definition.procoptions) and
-                  not(pocall_cdecl in aktprocsym.definition.proccalloptions) then
+                  not(aktprocsym.definition.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
                 Message(parser_e_varargs_need_cdecl_and_external);
              end
             else
              begin
                { both must be defined now }
                if not(po_external in aktprocsym.definition.procoptions) or
-                  not(pocall_cdecl in aktprocsym.definition.proccalloptions) then
+                  not(aktprocsym.definition.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
                 Message(parser_e_varargs_need_cdecl_and_external);
              end;
           end;
@@ -754,11 +754,11 @@ implementation
         procedure Not_supported_for_inline(t : ttoken);
         begin
            if assigned(aktprocsym) and
-              (pocall_inline in aktprocsym.definition.proccalloptions) then
+              (aktprocsym.definition.proccalloption=pocall_inline) then
              Begin
                 Message1(parser_w_not_supported_for_inline,tokenstring(t));
                 Message(parser_w_inlining_disabled);
-                exclude(aktprocsym.definition.proccalloptions,pocall_inline);
+                aktprocsym.definition.proccalloption:=pocall_fpccall;
              End;
         end;
 
@@ -843,7 +843,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.39  2001-10-22 21:20:46  peter
+  Revision 1.40  2001-10-25 21:22:37  peter
+    * calling convention rewrite
+
+  Revision 1.39  2001/10/22 21:20:46  peter
     * overloaded functions don't need to be global in kylix
 
   Revision 1.38  2001/10/01 13:38:45  jonas

+ 7 - 22
compiler/symconst.pas

@@ -155,26 +155,6 @@ type
     normset,smallset,varset
   );
 
-  { calling convention for tprocdef and tprocvardef }
-  tproccalloption=(pocall_none,
-    pocall_clearstack,    { Use IBM flat calling convention. (Used by GCC.) }
-    pocall_leftright,     { Push parameters from left to right }
-    pocall_cdecl,         { procedure uses C styled calling }
-    pocall_register,      { procedure uses register (fastcall) calling }
-    pocall_stdcall,       { procedure uses stdcall call }
-    pocall_safecall,      { safe call calling conventions }
-    pocall_palmossyscall, { procedure is a PalmOS system call }
-    pocall_system,
-    pocall_inline,        { Procedure is an assembler macro }
-    pocall_internproc,    { Procedure has compiler magic}
-    pocall_internconst,   { procedure has constant evaluator intern }
-    pocall_cppdecl,       { C++ calling conventions }
-    pocall_compilerproc,  { Procedure is used for internal compiler calls }
-    pocall_far16,         { Far16 for OS/2 }
-    pocall_fpccall        { FPC default calling }
-  );
-  tproccalloptions=set of tproccalloption;
-
   { basic type for tprocdef and tprocvardef }
   tproctypeoption=(potype_none,
     potype_proginit,     { Program initialization }
@@ -205,7 +185,9 @@ type
     po_savestdregs,       { save std regs cdecl and stdcall need that ! }
     po_saveregisters,     { save all registers }
     po_overload,          { procedure is declared with overload directive }
-    po_varargs            { printf like arguments }
+    po_varargs,           { printf like arguments }
+    po_leftright,         { push arguments from left to right }
+    po_clearstack         { caller clears the stack }
   );
   tprocoptions=set of tprocoption;
 
@@ -344,7 +326,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  2001-10-23 21:49:43  peter
+  Revision 1.27  2001-10-25 21:22:37  peter
+    * calling convention rewrite
+
+  Revision 1.26  2001/10/23 21:49:43  peter
     * $calling directive and -Cc commandline patch added
       from Pavel Ozerski
 

+ 21 - 59
compiler/symdef.pas

@@ -410,7 +410,7 @@ interface
           { saves a definition to the return type }
           rettype         : ttype;
           proctypeoption  : tproctypeoption;
-          proccalloptions : tproccalloptions;
+          proccalloption  : tproccalloption;
           procoptions     : tprocoptions;
           para            : tparalinkedlist;
           maxparacount,
@@ -425,7 +425,6 @@ interface
           procedure concatpara(const tt:ttype;vsp : tvarspez;defval:tsym);
           function  para_size(alignsize:longint) : longint;
           function  demangled_paras : string;
-          function  proccalloption2str : string;
           procedure test_if_fpu_result;
           { debug }
 {$ifdef GDB}
@@ -502,6 +501,7 @@ interface
           { check the problems of manglednames }
           count      : boolean;
           is_used    : boolean;
+          has_mangledname : boolean;
           { small set which contains the modified registers }
 {$ifdef i386}
           usedregisters : longint;
@@ -2972,7 +2972,7 @@ implementation
          minparacount:=0;
          maxparacount:=0;
          proctypeoption:=potype_none;
-         proccalloptions:=[];
+         proccalloption:=pocall_none;
          procoptions:=[];
          rettype:=voidtype;
          symtablelevel:=0;
@@ -3047,8 +3047,8 @@ implementation
          maxparacount:=0;
          ppufile.gettype(rettype);
          fpu_used:=ppufile.getbyte;
-         proctypeoption:=tproctypeoption(ppufile.getlongint);
-         ppufile.getsmallset(proccalloptions);
+         proctypeoption:=tproctypeoption(ppufile.getbyte);
+         proccalloption:=tproccalloption(ppufile.getbyte);
          ppufile.getsmallset(procoptions);
          count:=ppufile.getword;
          savesize:=target_info.size_of_pointer;
@@ -3080,8 +3080,8 @@ implementation
          if simplify_ppu then
           fpu_used:=0;
          ppufile.putbyte(fpu_used);
-         ppufile.putlongint(ord(proctypeoption));
-         ppufile.putsmallset(proccalloptions);
+         ppufile.putbyte(ord(proctypeoption));
+         ppufile.putbyte(ord(proccalloption));
          ppufile.putsmallset(procoptions);
          ppufile.do_interface_crc:=oldintfcrc;
          ppufile.putword(maxparacount);
@@ -3192,49 +3192,6 @@ implementation
       end;
 
 
-    function tabstractprocdef.proccalloption2str : string;
-      type
-        tproccallopt=record
-          mask : tproccalloption;
-          str  : string[30];
-        end;
-      const
-        proccallopts=13;
-        proccallopt : array[1..proccallopts] of tproccallopt=(
-           (mask:pocall_none;         str:''),
-           (mask:pocall_clearstack;   str:'ClearStack'),
-           (mask:pocall_leftright;    str:'LeftRight'),
-           (mask:pocall_cdecl;        str:'CDecl'),
-           (mask:pocall_register;     str:'Register'),
-           (mask:pocall_stdcall;      str:'StdCall'),
-           (mask:pocall_safecall;     str:'SafeCall'),
-           (mask:pocall_palmossyscall;str:'PalmOSSysCall'),
-           (mask:pocall_system;       str:'System'),
-           (mask:pocall_inline;       str:'Inline'),
-           (mask:pocall_internproc;   str:'InternProc'),
-           (mask:pocall_internconst;  str:'InternConst'),
-           (mask:pocall_cppdecl;      str:'CPPDecl')
-        );
-      var
-        s : string;
-        i : longint;
-        first : boolean;
-      begin
-        s:='';
-        first:=true;
-        for i:=1 to proccallopts do
-         if (proccallopt[i].mask in proccalloptions) then
-          begin
-            if first then
-              first:=false
-            else
-              s:=s+';';
-            s:=s+proccallopt[i].str;
-          end;
-        proccalloption2str:=s;
-      end;
-
-
 {$ifdef GDB}
     function tabstractprocdef.stabstring : pchar;
       begin
@@ -3262,6 +3219,7 @@ implementation
       begin
          inherited create;
          deftype:=procdef;
+         has_mangledname:=false;
          _mangledname:=nil;
          nextoverloaded:=nil;
          fileinfo:=aktfilepos;
@@ -3329,6 +3287,7 @@ implementation
 {$endif POWERPC}
 {$endif}
 {$endif newcg}
+         has_mangledname:=true;
          _mangledname:=stringdup(ppufile.getstring);
 
          extnumber:=ppufile.getlongint;
@@ -3336,7 +3295,7 @@ implementation
          _class := tobjectdef(ppufile.getderef);
          ppufile.getposinfo(fileinfo);
          { inline stuff }
-         if (pocall_inline in proccalloptions) then
+         if proccalloption=pocall_inline then
            funcretsym:=tsym(ppufile.getderef)
          else
            funcretsym:=nil;
@@ -3344,7 +3303,7 @@ implementation
          parast:=tparasymtable.create;
          tparasymtable(parast).load(ppufile);
          parast.defowner:=self;
-         if (pocall_inline in proccalloptions) or
+         if (proccalloption=pocall_inline) or
             ((current_module.flags and uf_local_browser)<>0) then
           begin
             localst:=tlocalsymtable.create;
@@ -3385,7 +3344,7 @@ implementation
            parast.free;
          if assigned(localst) and (localst.symtabletype<>staticsymtable) then
            localst.free;
-         if (pocall_inline in proccalloptions) and assigned(code) then
+         if (proccalloption=pocall_inline) and assigned(code) then
            tnode(code).free;
          if assigned(regvarinfo) then
            dispose(pregvarinfo(regvarinfo));
@@ -3459,7 +3418,7 @@ implementation
            on the crc }
          oldintfcrc:=ppufile.do_crc;
          ppufile.do_crc:=false;
-         if (pocall_inline in proccalloptions) then
+         if (proccalloption=pocall_inline) then
            ppufile.putderef(funcretsym);
          ppufile.do_crc:=oldintfcrc;
 
@@ -3476,7 +3435,7 @@ implementation
 
          { save localsymtable for inline procedures or when local
            browser info is requested, this has no influence on the crc }
-         if (pocall_inline in proccalloptions) or
+         if (proccalloption=pocall_inline) or
             ((current_module.flags and uf_local_browser)<>0) then
           begin
             oldintfcrc:=ppufile.do_crc;
@@ -3947,7 +3906,7 @@ implementation
 
              { write parameter info. The parameters must be written in reverse order
                if this method uses right to left parameter pushing! }
-             if (pocall_leftright in proccalloptions) then
+             if (po_leftright in procoptions) then
               pdc:=TParaItem(Para.last)
              else
               pdc:=TParaItem(Para.first);
@@ -3967,7 +3926,7 @@ implementation
                  { write name of type of current parameter }
                  tstoreddef(pdc.paratype.def).write_rtti_name;
 
-                 if (pocall_leftright in proccalloptions) then
+                 if (po_leftright in procoptions) then
                   pdc:=TParaItem(pdc.previous)
                  else
                   pdc:=TParaItem(pdc.next);
@@ -3997,7 +3956,7 @@ implementation
            s:='<procedure variable type of procedure'+demangled_paras;
          if po_methodpointer in procoptions then
            s := s+' of object';
-         gettypename := s+';'+proccalloption2str+'>';
+         gettypename := s+';'+ProcCallOptionStr[proccalloption]+'>';
       end;
 
 
@@ -5435,7 +5394,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2001-10-20 17:21:54  peter
+  Revision 1.54  2001-10-25 21:22:37  peter
+    * calling convention rewrite
+
+  Revision 1.53  2001/10/20 17:21:54  peter
     * fixed size of constset when change from small to normalset
 
   Revision 1.52  2001/10/15 13:16:26  jonas

+ 5 - 2
compiler/symsym.pas

@@ -895,7 +895,7 @@ implementation
 
     procedure tprocsym.concatstabto(asmlist : taasmoutput);
     begin
-      if (pocall_internproc in definition.proccalloptions) then exit;
+      if (definition.proccalloption=pocall_internproc) then exit;
       if not isstabwritten then
         asmList.concat(Tai_stabs.Create(stabstring));
       isstabwritten := true;
@@ -2490,7 +2490,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.24  2001-10-23 21:49:43  peter
+  Revision 1.25  2001-10-25 21:22:40  peter
+    * calling convention rewrite
+
+  Revision 1.24  2001/10/23 21:49:43  peter
     * $calling directive and -Cc commandline patch added
       from Pavel Ozerski
 

+ 5 - 2
compiler/types.pas

@@ -1102,7 +1102,7 @@ implementation
                 { if a method is assigned to a methodpointer    }
                 { is checked before                             }
                 b:=(tprocvardef(def1).proctypeoption=tprocvardef(def2).proctypeoption) and
-                   (tprocvardef(def1).proccalloptions=tprocvardef(def2).proccalloptions) and
+                   (tprocvardef(def1).proccalloption=tprocvardef(def2).proccalloption) and
                    ((tprocvardef(def1).procoptions * po_compatibility_options)=
                     (tprocvardef(def2).procoptions * po_compatibility_options)) and
                    is_equal(tprocvardef(def1).rettype.def,tprocvardef(def2).rettype.def) and
@@ -1808,7 +1808,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.52  2001-10-22 21:21:09  peter
+  Revision 1.53  2001-10-25 21:22:40  peter
+    * calling convention rewrite
+
+  Revision 1.52  2001/10/22 21:21:09  peter
     * allow enum(enum)
 
   Revision 1.51  2001/10/22 15:13:49  jonas