浏览代码

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

peter 24 年之前
父节点
当前提交
17d62feebe
共有 10 个文件被更改,包括 243 次插入159 次删除
  1. 42 1
      compiler/globals.pas
  2. 20 1
      compiler/globtype.pas
  3. 12 2
      compiler/options.pas
  4. 11 3
      compiler/parser.pas
  5. 103 22
      compiler/pdecsub.pas
  6. 11 5
      compiler/pdecvar.pas
  7. 18 1
      compiler/scandir.pas
  8. 8 121
      compiler/symconst.pas
  9. 9 2
      compiler/symsym.pas
  10. 9 1
      compiler/tokens.pas

+ 42 - 1
compiler/globals.pas

@@ -159,6 +159,8 @@ interface
        initasmmode        : tasmmode;
        initasmmode        : tasmmode;
        initinterfacetype  : tinterfacetypes;
        initinterfacetype  : tinterfacetypes;
        initoutputformat   : tasm;
        initoutputformat   : tasm;
+       initdefproccall    : TDefProcCall;
+
      { current state values }
      { current state values }
        aktglobalswitches  : tglobalswitches;
        aktglobalswitches  : tglobalswitches;
        aktmoduleswitches  : tmoduleswitches;
        aktmoduleswitches  : tmoduleswitches;
@@ -177,6 +179,7 @@ interface
        aktasmmode         : tasmmode;
        aktasmmode         : tasmmode;
        aktinterfacetype   : tinterfacetypes;
        aktinterfacetype   : tinterfacetypes;
        aktoutputformat    : tasm;
        aktoutputformat    : tasm;
+       aktdefproccall     : TDefProcCall;
 
 
      { Memory sizes }
      { Memory sizes }
        heapsize,
        heapsize,
@@ -263,6 +266,7 @@ interface
     procedure FreeEnvPChar(p:pchar);
     procedure FreeEnvPChar(p:pchar);
 
 
     Function SetCompileMode(const s:string; changeInit: boolean):boolean;
     Function SetCompileMode(const s:string; changeInit: boolean):boolean;
+    function SetAktProcCall(const s:string; changeInit: boolean):boolean;
 
 
     procedure InitGlobals;
     procedure InitGlobals;
     procedure DoneGlobals;
     procedure DoneGlobals;
@@ -1142,6 +1146,38 @@ implementation
       end;
       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)' }
     { '('D1:'00000000-'D2:'0000-'D3:'0000-'D4:'0000-000000000000)' }
     function string2guid(const s: string; var GUID: TGUID): boolean;
     function string2guid(const s: string; var GUID: TGUID): boolean;
         function ishexstr(const hs: string): boolean;
         function ishexstr(const hs: string): boolean;
@@ -1387,6 +1423,7 @@ implementation
   {$endif m68k}
   {$endif m68k}
 {$endif i386}
 {$endif i386}
         initinterfacetype:=it_interfacecom;
         initinterfacetype:=it_interfacecom;
+        initdefproccall:=dpc_fpccall;
         initdefines:=TStringList.Create;
         initdefines:=TStringList.Create;
 
 
       { memory sizes, will be overriden by parameter or default for target
       { memory sizes, will be overriden by parameter or default for target
@@ -1412,7 +1449,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * array access for properties added
 
 
   Revision 1.46  2001/10/20 20:30:20  peter
   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
          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
     type
        stringid = string[maxidlen];
        stringid = string[maxidlen];
 
 
@@ -208,7 +223,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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-
     * read only typed const support, switch $J-
 
 
   Revision 1.15  2001/09/17 21:29:11  peter
   Revision 1.15  2001/09/17 21:29:11  peter

+ 12 - 2
compiler/options.pas

@@ -75,7 +75,7 @@ uses
   dos,
   dos,
 {$endif Delphi}
 {$endif Delphi}
   version,
   version,
-  cutils,cmsgs
+  cutils,cmsgs,symsym
 {$ifdef BrowserLog}
 {$ifdef BrowserLog}
   ,browlog
   ,browlog
 {$endif BrowserLog}
 {$endif BrowserLog}
@@ -429,6 +429,12 @@ begin
                         Begin
                         Begin
                           case more[j] of
                           case more[j] of
                             'a' : Message2(option_obsolete_switch_use_new,'-Ca','-Or');
                             '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' :
                             'h' :
                                begin
                                begin
                                  val(copy(more,j+1,length(more)-j),heapsize,code);
                                  val(copy(more,j+1,length(more)-j),heapsize,code);
@@ -1620,7 +1626,11 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $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
     * merged netbsd, fpu-overflow from fixes branch
 
 
   Revision 1.59  2001/09/12 12:46:54  marco
   Revision 1.59  2001/09/12 12:46:54  marco

+ 11 - 3
compiler/parser.pas

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

+ 103 - 22
compiler/pdecsub.pas

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

+ 11 - 5
compiler/pdecvar.pas

@@ -297,9 +297,11 @@ implementation
                - in parasymtable
                - in parasymtable
                - in record or object
                - in record or object
                - ... (PM) }
                - ... (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
                begin
                   storetokenpos:=akttokenpos;
                   storetokenpos:=akttokenpos;
                   s:=sc.get(akttokenpos);
                   s:=sc.get(akttokenpos);
@@ -309,7 +311,7 @@ implementation
                   symtablestack.insert(tconstsym);
                   symtablestack.insert(tconstsym);
                   akttokenpos:=storetokenpos;
                   akttokenpos:=storetokenpos;
                   consume(_EQUAL);
                   consume(_EQUAL);
-                  readtypedconst(tt,tconstsym,false);
+                  readtypedconst(tt,tconstsym,true);
                   symdone:=true;
                   symdone:=true;
                end;
                end;
              { hint directive }
              { hint directive }
@@ -573,7 +575,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * merged absolute support for constants
 
 
   Revision 1.19  2001/08/30 20:13:53  peter
   Revision 1.19  2001/08/30 20:13:53  peter

+ 18 - 1
compiler/scandir.pas

@@ -206,6 +206,18 @@ implementation
           end;
           end;
       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;
     procedure dir_assertions;
       begin
       begin
         do_delphiswitch('C');
         do_delphiswitch('C');
@@ -844,6 +856,7 @@ implementation
         AddDirective('ASMMODE',{$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
         AddDirective('ASMMODE',{$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
         AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions);
         AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions);
         AddDirective('BOOLEVAL',{$ifdef FPCPROCVAR}@{$endif}dir_booleval);
         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('COPYRIGHT',{$ifdef FPCPROCVAR}@{$endif}dir_copyright);
         AddDirective('D',{$ifdef FPCPROCVAR}@{$endif}dir_description);
         AddDirective('D',{$ifdef FPCPROCVAR}@{$endif}dir_description);
         AddDirective('DEBUGINFO',{$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
         AddDirective('DEBUGINFO',{$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
@@ -917,7 +930,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * split constsym.value in valueord,valueordptr,valueptr. The valueordptr
       is used for holding target platform pointer values. As those can be
       is used for holding target platform pointer values. As those can be
       bigger than the source platform.
       bigger than the source platform.

+ 8 - 121
compiler/symconst.pas

@@ -112,21 +112,6 @@ type
     sp_hint_platform,
     sp_hint_platform,
     sp_hint_library,
     sp_hint_library,
     sp_has_overloaded
     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;
   tsymoptions=set of tsymoption;
 
 
@@ -134,28 +119,6 @@ type
   tdefoption=(df_none,
   tdefoption=(df_none,
     df_has_inittable,           { init data has been generated }
     df_has_inittable,           { init data has been generated }
     df_has_rttitable            { rtti 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;
   tdefoptions=set of tdefoption;
 
 
@@ -206,18 +169,9 @@ type
     pocall_internproc,    { Procedure has compiler magic}
     pocall_internproc,    { Procedure has compiler magic}
     pocall_internconst,   { procedure has constant evaluator intern }
     pocall_internconst,   { procedure has constant evaluator intern }
     pocall_cppdecl,       { C++ calling conventions }
     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;
   tproccalloptions=set of tproccalloption;
 
 
@@ -229,24 +183,6 @@ type
     potype_constructor,  { Procedure is a constructor }
     potype_constructor,  { Procedure is a constructor }
     potype_destructor,   { Procedure is a destructor }
     potype_destructor,   { Procedure is a destructor }
     potype_operator      { Procedure defines an operator }
     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;
   tproctypeoptions=set of tproctypeoption;
 
 
@@ -270,12 +206,6 @@ type
     po_saveregisters,     { save all registers }
     po_saveregisters,     { save all registers }
     po_overload,          { procedure is declared with overload directive }
     po_overload,          { procedure is declared with overload directive }
     po_varargs            { printf like arguments }
     po_varargs            { printf like arguments }
-    ,po_19
-    ,po_20
-    ,po_21
-    ,po_22
-    ,po_23
-    ,po_24
   );
   );
   tprocoptions=set of tprocoption;
   tprocoptions=set of tprocoption;
 
 
@@ -301,19 +231,6 @@ type
     oo_has_msgint,
     oo_has_msgint,
     oo_has_abstract,       { the object/class has an abstract method => no instances can be created }
     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_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;
   tobjectoptions=set of tobjectoption;
 
 
@@ -324,25 +241,6 @@ type
     ppo_stored,
     ppo_stored,
     ppo_hasparameters,
     ppo_hasparameters,
     ppo_is_override
     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;
   tpropertyoptions=set of tpropertyoption;
 
 
@@ -357,21 +255,6 @@ type
     vo_is_local_copy,
     vo_is_local_copy,
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
     vo_is_exported
     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;
   tvaroptions=set of tvaroption;
 
 
@@ -461,7 +344,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * array access for properties added
 
 
   Revision 1.24  2001/10/20 20:30:21  peter
   Revision 1.24  2001/10/20 20:30:21  peter

+ 9 - 2
compiler/symsym.pas

@@ -337,7 +337,6 @@ interface
     const
     const
        current_object_option : tsymoptions = [sp_public];
        current_object_option : tsymoptions = [sp_public];
 
 
-
     { rtti and init/final }
     { rtti and init/final }
     procedure generate_rtti(p:tsym);
     procedure generate_rtti(p:tsym);
     procedure generate_inittable(p:tsym);
     procedure generate_inittable(p:tsym);
@@ -369,6 +368,10 @@ implementation
        cgbase,cresstr
        cgbase,cresstr
        ;
        ;
 
 
+{****************************************************************************
+                               Helpers
+****************************************************************************}
+
 {****************************************************************************
 {****************************************************************************
                           TSYM (base for all symtypes)
                           TSYM (base for all symtypes)
 ****************************************************************************}
 ****************************************************************************}
@@ -2487,7 +2490,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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-
     * read only typed const support, switch $J-
 
 
   Revision 1.22  2001/09/19 11:04:42  michael
   Revision 1.22  2001/09/19 11:04:42  michael

+ 9 - 1
compiler/tokens.pas

@@ -141,6 +141,7 @@ type
     _CLASS,
     _CLASS,
     _CONST,
     _CONST,
     _FALSE,
     _FALSE,
+    _FAR16,
     _INDEX,
     _INDEX,
     _LABEL,
     _LABEL,
     _RAISE,
     _RAISE,
@@ -171,6 +172,7 @@ type
     _EXPORTS,
     _EXPORTS,
     _FINALLY,
     _FINALLY,
     _FORWARD,
     _FORWARD,
+    _FPCCALL,
     _IOCHECK,
     _IOCHECK,
     _LIBRARY,
     _LIBRARY,
     _MESSAGE,
     _MESSAGE,
@@ -364,6 +366,7 @@ const
       (str:'CLASS'         ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'CLASS'         ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'CONST'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'CONST'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FALSE'         ;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:'INDEX'         ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'LABEL'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'LABEL'         ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'RAISE'         ;special:false;keyword:m_class;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:'EXPORTS'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FINALLY'       ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'FINALLY'       ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'FORWARD'       ;special:false;keyword:m_none;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:'IOCHECK'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'LIBRARY'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'LIBRARY'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'MESSAGE'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'MESSAGE'       ;special:false;keyword:m_none;op:NOTOKEN),
@@ -497,7 +501,11 @@ end;
 end.
 end.
 {
 {
   $Log$
   $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
     + "compilerproc" directive support, which turns both the public and mangled
       name to lowercase(declaration_name). This prevents a normal user from
       name to lowercase(declaration_name). This prevents a normal user from
       accessing the routine, but they can still be easily looked up within
       accessing the routine, but they can still be easily looked up within