Selaa lähdekoodia

* $calling directive and -Cc commandline patch added
from Pavel Ozerski

peter 24 vuotta sitten
vanhempi
commit
17d62feebe

+ 42 - 1
compiler/globals.pas

@@ -159,6 +159,8 @@ interface
        initasmmode        : tasmmode;
        initinterfacetype  : tinterfacetypes;
        initoutputformat   : tasm;
+       initdefproccall    : TDefProcCall;
+
      { current state values }
        aktglobalswitches  : tglobalswitches;
        aktmoduleswitches  : tmoduleswitches;
@@ -177,6 +179,7 @@ interface
        aktasmmode         : tasmmode;
        aktinterfacetype   : tinterfacetypes;
        aktoutputformat    : tasm;
+       aktdefproccall     : TDefProcCall;
 
      { Memory sizes }
        heapsize,
@@ -263,6 +266,7 @@ interface
     procedure FreeEnvPChar(p:pchar);
 
     Function SetCompileMode(const s:string; changeInit: boolean):boolean;
+    function SetAktProcCall(const s:string; changeInit: boolean):boolean;
 
     procedure InitGlobals;
     procedure DoneGlobals;
@@ -1142,6 +1146,38 @@ implementation
       end;
 
 
+    function SetAktProcCall(const s:string; changeInit:boolean):boolean;
+      const
+        DefProcCallName : array[TDefProcCall] of string[12] = (
+         'CDECL',
+         'CPPDECL',
+         'FAR16',
+         'FPCCALL',
+         'INLINE',
+         'PASCAL',
+         'POPSTACK',
+         'REGISTER',
+         'SAFECALL',
+         'STDCALL',
+         'SYSTEM'
+        );
+      var
+        t : TDefProcCall;
+      begin
+        SetAktProcCall:=false;
+        for t:=low(TDefProcCall) to high(TDefProcCall) do
+         if DefProcCallName[t]=s then
+          begin
+            AktDefProcCall:=t;
+            SetAktProcCall:=true;
+            break;
+          end;
+        if changeinit then
+         InitDefProcCall:=AktDefProcCall;
+      end;
+
+
+
     { '('D1:'00000000-'D2:'0000-'D3:'0000-'D4:'0000-000000000000)' }
     function string2guid(const s: string; var GUID: TGUID): boolean;
         function ishexstr(const hs: string): boolean;
@@ -1387,6 +1423,7 @@ implementation
   {$endif m68k}
 {$endif i386}
         initinterfacetype:=it_interfacecom;
+        initdefproccall:=dpc_fpccall;
         initdefines:=TStringList.Create;
 
       { memory sizes, will be overriden by parameter or default for target
@@ -1412,7 +1449,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.47  2001-10-21 12:33:05  peter
+  Revision 1.48  2001-10-23 21:49:42  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.47  2001/10/21 12:33:05  peter
     * array access for properties added
 
   Revision 1.46  2001/10/20 20:30:20  peter

+ 20 - 1
compiler/globtype.pas

@@ -163,6 +163,21 @@ 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
+       );
+
     type
        stringid = string[maxidlen];
 
@@ -208,7 +223,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2001-10-20 20:30:21  peter
+  Revision 1.17  2001-10-23 21:49:42  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.16  2001/10/20 20:30:21  peter
     * read only typed const support, switch $J-
 
   Revision 1.15  2001/09/17 21:29:11  peter

+ 12 - 2
compiler/options.pas

@@ -75,7 +75,7 @@ uses
   dos,
 {$endif Delphi}
   version,
-  cutils,cmsgs
+  cutils,cmsgs,symsym
 {$ifdef BrowserLog}
   ,browlog
 {$endif BrowserLog}
@@ -429,6 +429,12 @@ begin
                         Begin
                           case more[j] of
                             'a' : Message2(option_obsolete_switch_use_new,'-Ca','-Or');
+                            'c' :
+                               begin
+                                 if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),true) then
+                                  IllegalPara(opt);
+                                 break;
+                               end;
                             'h' :
                                begin
                                  val(copy(more,j+1,length(more)-j),heapsize,code);
@@ -1620,7 +1626,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.60  2001-09-17 21:29:12  peter
+  Revision 1.61  2001-10-23 21:49:42  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.60  2001/09/17 21:29:12  peter
     * merged netbsd, fpu-overflow from fixes branch
 
   Revision 1.59  2001/09/12 12:46:54  marco

+ 11 - 3
compiler/parser.pas

@@ -65,7 +65,7 @@ implementation
          { and no function header                        }
          testcurobject:=0;
 
-         { a long time, this was forgotten }
+         { Symtable }
          aktprocsym:=nil;
 
          current_module:=nil;
@@ -275,6 +275,7 @@ implementation
          oldaktinterfacetype: tinterfacetypes;
          oldaktmodeswitches : tmodeswitches;
          old_compiled_module : tmodule;
+         oldaktdefproccall : tdefproccall;
 {        will only be increased once we start parsing blocks in the }
 {         implementation, so doesn't need to be saved/restored (JM) }
 {          oldexceptblockcounter  : integer;                        }
@@ -304,6 +305,7 @@ implementation
          oldrefsymtable:=refsymtable;
          oldprocprefix:=procprefix;
          oldaktprocsym:=aktprocsym;
+         oldaktdefproccall:=aktdefproccall;
          move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators));
        { save scanner state }
          oldc:=c;
@@ -355,7 +357,7 @@ implementation
 {         oldexceptblockcounter:=exceptblockcounter; }
 {$ifdef newcg}
          oldcg:=cg;
-{$endif newcg} 
+{$endif newcg}
 {$ifdef GDB}
          store_dbx:=dbx_counter;
          dbx_counter:=nil;
@@ -369,6 +371,7 @@ implementation
          systemunit:=nil;
          refsymtable:=nil;
          aktprocsym:=nil;
+         aktdefproccall:=initdefproccall;
          procprefix:='';
          registerdef:=true;
          statement_level:=0;
@@ -534,6 +537,7 @@ implementation
               refsymtable:=oldrefsymtable;
               symtablestack:=oldsymtablestack;
               defaultsymtablestack:=olddefaultsymtablestack;
+              aktdefproccall:=oldaktdefproccall;
               aktprocsym:=oldaktprocsym;
               procprefix:=oldprocprefix;
               move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
@@ -621,7 +625,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2001-10-16 15:10:35  jonas
+  Revision 1.24  2001-10-23 21:49:42  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.23  2001/10/16 15:10:35  jonas
     * fixed goto/label/try bugs
 
   Revision 1.22  2001/08/26 13:36:43  florian

+ 103 - 22
compiler/pdecsub.pas

@@ -1017,6 +1017,13 @@ begin
 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');
@@ -1138,7 +1145,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=34;
+  num_proc_directives=36;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -1184,7 +1191,7 @@ const
       pocall   : [pocall_cdecl,pocall_clearstack];
       pooption : [po_savestdregs];
       mutexclpocall : [pocall_cppdecl,pocall_internproc,
-        pocall_leftright,pocall_inline];
+        pocall_leftright,pocall_inline,pocall_far16,pocall_fpccall];
       mutexclpotype : [];
       mutexclpo     : [po_assembler,po_external]
     ),(
@@ -1223,6 +1230,17 @@ const
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [];
       mutexclpo     : []
+    ),(
+      idtok:_FAR16;
+      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_far16;
+      pocall   : [pocall_far16];
+      pooption : [];
+      mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
+                       pocall_clearstack,pocall_inline,
+                       pocall_safecall,pocall_leftright,pocall_fpccall];
+      mutexclpotype : [];
+      mutexclpo     : [po_external]
     ),(
       idtok:_FORWARD;
       pd_flags : pd_implemen+pd_notobjintf;
@@ -1232,6 +1250,17 @@ const
       mutexclpocall : [pocall_internproc,pocall_inline];
       mutexclpotype : [];
       mutexclpo     : [po_external]
+    ),(
+      idtok:_FPCCALL;
+      pd_flags : pd_interface+pd_implemen+pd_body+pd_procvar;
+      handler  : nil;
+      pocall   : [pocall_fpccall];
+      pooption : [];
+      mutexclpocall : [pocall_cdecl,pocall_cppdecl,
+                       pocall_clearstack,pocall_inline,
+                       pocall_safecall,pocall_leftright,pocall_far16];
+      mutexclpotype : [];
+      mutexclpo     : []
     ),(
       idtok:_INLINE;
       pd_flags : pd_implemen+pd_body+pd_notobjintf;
@@ -1256,7 +1285,8 @@ const
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
       pocall   : [pocall_internproc];
       pooption : [];
-      mutexclpocall : [pocall_inline,pocall_clearstack,pocall_leftright,pocall_cdecl,pocall_cppdecl];
+      mutexclpocall : [pocall_inline,pocall_clearstack,pocall_leftright,pocall_cdecl,pocall_cppdecl,
+                      pocall_far16,pocall_fpccall];
       mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
       mutexclpo     : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck]
     ),(
@@ -1266,7 +1296,8 @@ const
       pocall   : [];
       pooption : [po_interrupt];
       mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
-                       pocall_clearstack,pocall_leftright,pocall_inline];
+                       pocall_clearstack,pocall_leftright,pocall_inline,
+                       pocall_far16,pocall_fpccall];
       mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
       mutexclpo     : [po_external]
     ),(
@@ -1322,7 +1353,7 @@ const
       pooption : [];
       mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,
                        pocall_clearstack,pocall_leftright,pocall_inline,
-                       pocall_safecall];
+                       pocall_safecall,pocall_far16,pocall_fpccall];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
@@ -1349,7 +1380,8 @@ const
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_register;
       pocall   : [pocall_register];
       pooption : [];
-      mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_internproc,pocall_cppdecl];
+      mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_internproc,pocall_cppdecl,
+                       pocall_far16,pocall_fpccall];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
@@ -1368,7 +1400,7 @@ const
       pocall   : [pocall_safecall];
       pooption : [po_savestdregs];
       mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl,
-        pocall_internproc,pocall_inline];
+        pocall_internproc,pocall_inline,pocall_far16,pocall_fpccall];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
@@ -1396,7 +1428,7 @@ const
       pocall   : [pocall_stdcall];
       pooption : [po_savestdregs];
       mutexclpocall : [pocall_leftright,pocall_cdecl,pocall_cppdecl,
-        pocall_inline,pocall_internproc,pocall_safecall];
+        pocall_inline,pocall_internproc,pocall_safecall,pocall_far16,pocall_fpccall];
       mutexclpotype : [];
       mutexclpo     : [po_external]
     ),(
@@ -1406,7 +1438,7 @@ const
       pocall   : [pocall_palmossyscall,pocall_cdecl,pocall_clearstack];
       pooption : [];
       mutexclpocall : [pocall_cdecl,pocall_cppdecl,pocall_inline,
-        pocall_internproc,pocall_leftright];
+        pocall_internproc,pocall_leftright,pocall_far16,pocall_fpccall];
       mutexclpotype : [];
       mutexclpo     : [po_external,po_assembler,po_interrupt,po_exports]
     ),(
@@ -1416,7 +1448,7 @@ const
       pocall   : [pocall_clearstack];
       pooption : [];
       mutexclpocall : [pocall_leftright,pocall_inline,pocall_cdecl,
-        pocall_internproc,pocall_cppdecl];
+        pocall_internproc,pocall_cppdecl,pocall_far16,pocall_fpccall];
       mutexclpotype : [];
       mutexclpo     : [po_external,po_assembler,po_interrupt]
     ),(
@@ -1434,7 +1466,8 @@ const
       handler  : {$ifdef FPCPROCVAR}@{$endif}pd_cppdecl;
       pocall   : [pocall_cppdecl,pocall_clearstack];
       pooption : [po_savestdregs];
-      mutexclpocall : [pocall_cdecl,pocall_internproc,pocall_leftright,pocall_inline];
+      mutexclpocall : [pocall_cdecl,pocall_internproc,pocall_leftright,pocall_inline,
+                      pocall_far16,pocall_fpccall];
       mutexclpotype : [];
       mutexclpo     : [po_assembler,po_external]
     ),(
@@ -1444,7 +1477,7 @@ const
       pocall   : [];
       pooption : [po_varargs];
       mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register,
-                       pocall_leftright,pocall_inline];
+                       pocall_leftright,pocall_inline,pocall_far16,pocall_fpccall];
       mutexclpotype : [];
       mutexclpo     : [po_assembler,po_interrupt]
     ),(
@@ -1474,17 +1507,17 @@ const
       end;
 
 
-    function parse_proc_direc(var pdflags:word):boolean;
+    function parse_proc_direc(idtoken:ttoken; var pdflags:word; do_consume:boolean):boolean;//Ozerski 08.10.01
       {
         Parse the procedure directive, returns true if a correct directive is found
       }
       var
         p     : longint;
         found : boolean;
-        name  : string;
+        name  : stringid;
       begin
         parse_proc_direc:=false;
-        name:=pattern;
+        name:=tokeninfo^[idtoken].str;
         found:=false;
 
       { Hint directive? Then exit immediatly }
@@ -1548,7 +1581,8 @@ const
          end;
 
       { consume directive, and turn flag on }
-        consume(token);
+        if do_consume then
+         consume(token);
         parse_proc_direc:=true;
 
       { Check the pd_flags if the directive should be allowed }
@@ -1592,6 +1626,35 @@ const
       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 parse_proc_directives(var pdflags:word);
       {
         Parse the procedure directives. It does not matter if procedure directives
@@ -1599,20 +1662,28 @@ const
       }
       var
         res : boolean;
+        CallModeIsChangedLocally : boolean;
       begin
+        CallModeIsChangedLocally:=false;
         while token in [_ID,_LECKKLAMMER] do
          begin
            if try_to_consume(_LECKKLAMMER) then
             begin
               repeat
-                parse_proc_direc(pdflags);
+                if not CallModeIsChangedLocally then
+                  CallModeIsChangedLocally:=idtoken in CallModeTokens;
+                parse_proc_direc(idtoken,pdflags,true);
               until not try_to_consume(_COMMA);
               consume(_RECKKLAMMER);
               { we always expect at least '[];' }
               res:=true;
             end
            else
-            res:=parse_proc_direc(pdflags);
+            begin
+              if not CallModeIsChangedLocally then
+                CallModeIsChangedLocally:=idtoken in CallModeTokens;
+              res:=parse_proc_direc(idtoken,pdflags,true);
+            end;
          { A procedure directive normally followed by a semicolon, but in
            a const section we should stop when _EQUAL is found }
            if res then
@@ -1628,6 +1699,9 @@ const
            else
             break;
          end;
+        { add default calling convention if none is specified }
+        if (not CallModeIsChangedLocally) then
+          parse_proc_direc(CallModeToken[aktdefproccall],pdflags,false);
       end;
 
 
@@ -1803,8 +1877,12 @@ const
                                 begin
                                   if ad.name<>fd.name then
                                    begin
-                                     MessagePos3(aktprocsym.definition.fileinfo,parser_e_header_different_var_names,
-                                                 aktprocsym.name,ad.name,fd.name);
+                                     { don't give an error if the default parameter is not
+                                       specified in the implementation }
+                                     if ((copy(fd.name,1,3)='def') and
+                                         (copy(ad.name,1,3)<>'def')) then
+                                       MessagePos3(aktprocsym.definition.fileinfo,parser_e_header_different_var_names,
+                                                   aktprocsym.name,ad.name,fd.name);
                                      break;
                                    end;
                                   ad:=tsym(ad.indexnext);
@@ -1924,11 +2002,14 @@ const
           end;
       end;
 
-
 end.
 {
   $Log$
-  Revision 1.38  2001-10-01 13:38:44  jonas
+  Revision 1.39  2001-10-23 21:49:42  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.38  2001/10/01 13:38:44  jonas
     * allow self parameter for normal procedures again (because Kylix allows
       it too) ("merged")
 

+ 11 - 5
compiler/pdecvar.pas

@@ -297,9 +297,11 @@ implementation
                - in parasymtable
                - in record or object
                - ... (PM) }
-             if (m_delphi in aktmodeswitches) and (token=_EQUAL) and
-                not (symtablestack.symtabletype in [parasymtable]) and
-                not is_record and not is_object then
+             if (token=_EQUAL) and
+                not(m_tp7 in aktmodeswitches) and
+                not(symtablestack.symtabletype in [parasymtable]) and
+                not is_record and
+                not is_object then
                begin
                   storetokenpos:=akttokenpos;
                   s:=sc.get(akttokenpos);
@@ -309,7 +311,7 @@ implementation
                   symtablestack.insert(tconstsym);
                   akttokenpos:=storetokenpos;
                   consume(_EQUAL);
-                  readtypedconst(tt,tconstsym,false);
+                  readtypedconst(tt,tconstsym,true);
                   symdone:=true;
                end;
              { hint directive }
@@ -573,7 +575,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  2001-09-30 21:15:48  peter
+  Revision 1.21  2001-10-23 21:49:42  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.20  2001/09/30 21:15:48  peter
     * merged absolute support for constants
 
   Revision 1.19  2001/08/30 20:13:53  peter

+ 18 - 1
compiler/scandir.pas

@@ -206,6 +206,18 @@ implementation
           end;
       end;
 
+
+    procedure dir_calling;
+      var
+         hs : string;
+      begin
+        current_scanner.skipspace;
+        hs:=current_scanner.readid;
+        if not SetAktProcCall(hs,false) then
+          Message1(parser_w_unknown_proc_directive_ignored,hs);
+      end;
+
+
     procedure dir_assertions;
       begin
         do_delphiswitch('C');
@@ -844,6 +856,7 @@ implementation
         AddDirective('ASMMODE',{$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
         AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions);
         AddDirective('BOOLEVAL',{$ifdef FPCPROCVAR}@{$endif}dir_booleval);
+        AddDirective('CALLING',{$ifdef FPCPROCVAR}@{$endif}dir_calling);//Ozerski 08.10.2001
         AddDirective('COPYRIGHT',{$ifdef FPCPROCVAR}@{$endif}dir_copyright);
         AddDirective('D',{$ifdef FPCPROCVAR}@{$endif}dir_description);
         AddDirective('DEBUGINFO',{$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
@@ -917,7 +930,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2001-09-02 21:18:28  peter
+  Revision 1.9  2001-10-23 21:49:42  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.8  2001/09/02 21:18:28  peter
     * split constsym.value in valueord,valueordptr,valueptr. The valueordptr
       is used for holding target platform pointer values. As those can be
       bigger than the source platform.

+ 8 - 121
compiler/symconst.pas

@@ -112,21 +112,6 @@ type
     sp_hint_platform,
     sp_hint_library,
     sp_has_overloaded
-    ,sp_10
-    ,sp_11
-    ,sp_12
-    ,sp_13
-    ,sp_14
-    ,sp_15
-    ,sp_16
-    ,sp_17
-    ,sp_18
-    ,sp_19
-    ,sp_20
-    ,sp_21
-    ,sp_22
-    ,sp_23
-    ,sp_24
   );
   tsymoptions=set of tsymoption;
 
@@ -134,28 +119,6 @@ type
   tdefoption=(df_none,
     df_has_inittable,           { init data has been generated }
     df_has_rttitable            { rtti data has been generated }
-    ,df_3
-    ,df_4
-    ,df_5
-    ,df_6
-    ,df_7
-    ,df_8
-    ,df_9
-    ,df_10
-    ,df_11
-    ,df_12
-    ,df_13
-    ,df_14
-    ,df_15
-    ,df_16
-    ,df_17
-    ,df_18
-    ,df_19
-    ,df_20
-    ,df_21
-    ,df_22
-    ,df_23
-    ,df_24
   );
   tdefoptions=set of tdefoption;
 
@@ -206,18 +169,9 @@ type
     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_14
-    ,pocall_15
-    ,pocall_16
-    ,pocall_17
-    ,pocall_18
-    ,pocall_19
-    ,pocall_20
-    ,pocall_21
-    ,pocall_22
-    ,pocall_23
-    ,pocall_24
+    pocall_compilerproc,  { Procedure is used for internal compiler calls }
+    pocall_far16,         { Far16 for OS/2 }
+    pocall_fpccall        { FPC default calling }
   );
   tproccalloptions=set of tproccalloption;
 
@@ -229,24 +183,6 @@ type
     potype_constructor,  { Procedure is a constructor }
     potype_destructor,   { Procedure is a destructor }
     potype_operator      { Procedure defines an operator }
-    ,potype_7
-    ,potype_8
-    ,potype_9
-    ,potype_10
-    ,potype_11
-    ,potype_12
-    ,potype_13
-    ,potype_14
-    ,potype_15
-    ,potype_16
-    ,potype_17
-    ,potype_18
-    ,potype_19
-    ,potype_20
-    ,potype_21
-    ,potype_22
-    ,potype_23
-    ,potype_24
   );
   tproctypeoptions=set of tproctypeoption;
 
@@ -270,12 +206,6 @@ type
     po_saveregisters,     { save all registers }
     po_overload,          { procedure is declared with overload directive }
     po_varargs            { printf like arguments }
-    ,po_19
-    ,po_20
-    ,po_21
-    ,po_22
-    ,po_23
-    ,po_24
   );
   tprocoptions=set of tprocoption;
 
@@ -301,19 +231,6 @@ type
     oo_has_msgint,
     oo_has_abstract,       { the object/class has an abstract method => no instances can be created }
     oo_can_have_published { the class has rtti, i.e. you can publish properties }
-    ,oo_12
-    ,oo_13
-    ,oo_14
-    ,oo_15
-    ,oo_16
-    ,oo_17
-    ,oo_18
-    ,oo_19
-    ,oo_20
-    ,oo_21
-    ,oo_22
-    ,oo_23
-    ,oo_24
   );
   tobjectoptions=set of tobjectoption;
 
@@ -324,25 +241,6 @@ type
     ppo_stored,
     ppo_hasparameters,
     ppo_is_override
-    ,ppo_6
-    ,ppo_7
-    ,ppo_8
-    ,ppo_9
-    ,ppo_10
-    ,ppo_11
-    ,ppo_12
-    ,ppo_13
-    ,ppo_14
-    ,ppo_15
-    ,ppo_16
-    ,ppo_17
-    ,ppo_18
-    ,ppo_19
-    ,ppo_20
-    ,ppo_21
-    ,ppo_22
-    ,ppo_23
-    ,ppo_24
   );
   tpropertyoptions=set of tpropertyoption;
 
@@ -357,21 +255,6 @@ type
     vo_is_local_copy,
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
     vo_is_exported
-    ,vo_10
-    ,vo_11
-    ,vo_12
-    ,vo_13
-    ,vo_14
-    ,vo_15
-    ,vo_16
-    ,vo_17
-    ,vo_18
-    ,vo_19
-    ,vo_20
-    ,vo_21
-    ,vo_22
-    ,vo_23
-    ,vo_24
   );
   tvaroptions=set of tvaroption;
 
@@ -461,7 +344,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  2001-10-21 12:33:07  peter
+  Revision 1.26  2001-10-23 21:49:43  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.25  2001/10/21 12:33:07  peter
     * array access for properties added
 
   Revision 1.24  2001/10/20 20:30:21  peter

+ 9 - 2
compiler/symsym.pas

@@ -337,7 +337,6 @@ interface
     const
        current_object_option : tsymoptions = [sp_public];
 
-
     { rtti and init/final }
     procedure generate_rtti(p:tsym);
     procedure generate_inittable(p:tsym);
@@ -369,6 +368,10 @@ implementation
        cgbase,cresstr
        ;
 
+{****************************************************************************
+                               Helpers
+****************************************************************************}
+
 {****************************************************************************
                           TSYM (base for all symtypes)
 ****************************************************************************}
@@ -2487,7 +2490,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2001-10-20 20:30:21  peter
+  Revision 1.24  2001-10-23 21:49:43  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.23  2001/10/20 20:30:21  peter
     * read only typed const support, switch $J-
 
   Revision 1.22  2001/09/19 11:04:42  michael

+ 9 - 1
compiler/tokens.pas

@@ -141,6 +141,7 @@ type
     _CLASS,
     _CONST,
     _FALSE,
+    _FAR16,
     _INDEX,
     _LABEL,
     _RAISE,
@@ -171,6 +172,7 @@ type
     _EXPORTS,
     _FINALLY,
     _FORWARD,
+    _FPCCALL,
     _IOCHECK,
     _LIBRARY,
     _MESSAGE,
@@ -364,6 +366,7 @@ const
       (str:'CLASS'         ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'CONST'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FALSE'         ;special:false;keyword:m_all;op:NOTOKEN),
+      (str:'FAR16'         ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'INDEX'         ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'LABEL'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'RAISE'         ;special:false;keyword:m_class;op:NOTOKEN),
@@ -394,6 +397,7 @@ const
       (str:'EXPORTS'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FINALLY'       ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'FORWARD'       ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'FPCCALL'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'IOCHECK'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'LIBRARY'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'MESSAGE'       ;special:false;keyword:m_none;op:NOTOKEN),
@@ -497,7 +501,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.13  2001-08-01 15:07:29  jonas
+  Revision 1.14  2001-10-23 21:49:43  peter
+    * $calling directive and -Cc commandline patch added
+      from Pavel Ozerski
+
+  Revision 1.13  2001/08/01 15:07:29  jonas
     + "compilerproc" directive support, which turns both the public and mangled
       name to lowercase(declaration_name). This prevents a normal user from
       accessing the routine, but they can still be easily looked up within