+ hint directive parsing support

compiler/README

@@ -117,4 +117,6 @@ Changes in the syntax or semantic of FPC:
   13/04/01   in FPC mode you're now always forced to use @ to get the address
              of a procedure and load it in a procedure variable. Before it was
              sometimes a bit more relaxed
+  03/06/01   hint directives (library,platform,deprecated) are parsed, but
+             futher ignored
 

compiler/globals.pas

@@ -68,7 +68,7 @@ interface
        delphimodeswitches : tmodeswitches=
          [m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar,
           m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,
-          m_out,m_default_para];
+          m_out,m_default_para,m_hintdirective];
        fpcmodeswitches    : tmodeswitches=
          [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
           m_cvar_support,m_initfinal,m_add_pointer];
@@ -1282,7 +1282,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2001-06-03 20:21:08  peter
+  Revision 1.37  2001-06-03 21:57:35  peter
+    + hint directive parsing support
+
+  Revision 1.36  2001/06/03 20:21:08  peter
     * Kylix fixes, mostly case names of units
 
   Revision 1.35  2001/05/30 21:35:48  peter

compiler/globtype.pas

@@ -143,7 +143,8 @@ interface
          m_add_pointer,         { allow pointer add/sub operations }
          m_default_ansistring,  { ansistring turned on by default }
          m_out,                 { support the calling convention OUT }
-         m_default_para         { support default parameters }
+         m_default_para,        { support default parameters }
+         m_hintdirective        { support hint directives }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -219,7 +220,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.11  2001-01-20 18:32:52  hajny
+  Revision 1.12  2001-06-03 21:57:35  peter
+    + hint directive parsing support
+
+  Revision 1.11  2001/01/20 18:32:52  hajny
     + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
 
   Revision 1.10  2000/11/29 00:30:30  florian

compiler/pbase.pas

@@ -98,14 +98,16 @@ interface
     procedure consume_all_until(atoken : ttoken);
 
     { consumes tokens while they are semicolons }
-    procedure emptystats;
+    procedure consume_emptystats;
+
+    { reads a list of identifiers into a string list }
+    function consume_idlist : tidstringlist;
 
     { consume a symbol, if not found give an error and
       and return an errorsym }
     function consume_sym(var srsym:tsym;var srsymtable:tsymtable):boolean;
 
-    { reads a list of identifiers into a string list }
-    function idlist : tidstringlist;
+    function try_consume_hintdirective(var symopt:tsymoptions):boolean;
 
     { just for an accurate position of the end of a procedure (PM) }
     var
@@ -251,13 +253,26 @@ implementation
       end;
 
 
-    procedure emptystats;
+    procedure consume_emptystats;
       begin
          repeat
          until not try_to_consume(_SEMICOLON);
       end;
 
 
+    { reads a list of identifiers into a string list }
+    function consume_idlist : tidstringlist;
+      var
+        sc : tIdstringlist;
+      begin
+         sc:=TIdStringlist.Create;
+         repeat
+           sc.add(orgpattern,akttokenpos);
+           consume(_ID);
+         until not try_to_consume(_COMMA);
+         consume_idlist:=sc;
+      end;
+
 
     function consume_sym(var srsym:tsym;var srsymtable:tsymtable):boolean;
       begin
@@ -300,19 +315,36 @@ implementation
       end;
 
 
-    { reads a list of identifiers into a string list }
-    function idlist : tidstringlist;
-      var
-        sc : tIdstringlist;
+    function try_consume_hintdirective(var symopt:tsymoptions):boolean;
       begin
-         sc:=TIdStringlist.Create;
-         repeat
-           sc.add(orgpattern,akttokenpos);
-           consume(_ID);
-         until not try_to_consume(_COMMA);
-         idlist:=sc;
+        try_consume_hintdirective:=false;
+        if not(m_hintdirective in aktmodeswitches) then
+         exit;
+        repeat
+          case idtoken of
+            _LIBRARY :
+              begin
+                include(symopt,sp_hint_library);
+                try_consume_hintdirective:=true;
+              end;
+            _DEPRECATED :
+              begin
+                include(symopt,sp_hint_deprecated);
+                try_consume_hintdirective:=true;
+              end;
+            _PLATFORM :
+              begin
+                include(symopt,sp_hint_platform);
+                try_consume_hintdirective:=true;
+              end;
+            else
+              break;
+          end;
+          consume(Token);
+        until false;
       end;
 
+
 {$ifdef fixLeaksOnError}
 procedure pbase_do_stop;
 var names: PStringlist;
@@ -337,7 +369,10 @@ end.
 
 {
   $Log$
-  Revision 1.12  2001-05-06 14:49:17  peter
+  Revision 1.13  2001-06-03 21:57:35  peter
+    + hint directive parsing support
+
+  Revision 1.12  2001/05/06 14:49:17  peter
     * ppu object to class rewrite
     * move ppu read and write stuff to fppu
 

compiler/pdecl.pas

@@ -154,6 +154,7 @@ implementation
                    sym:=readconstant(name,filepos);
                    if assigned(sym) then
                     symtablestack.insert(sym);
+                   try_consume_hintdirective(sym.symoptions);
                    consume(_SEMICOLON);
                 end;
 
@@ -218,6 +219,7 @@ implementation
                       else
 {$endif DELPHI_CONST_IN_RODATA}
                        readtypedconst(tt,ttypedconstsym(sym),false);
+                      try_consume_hintdirective(sym.symoptions);
                       consume(_SEMICOLON);
                     end;
                 end;
@@ -453,6 +455,12 @@ implementation
                      consume(_SEMICOLON);
                     parse_var_proc_directives(tsym(newtype));
                   end;
+                objectdef,
+                recorddef :
+                  begin
+                    try_consume_hintdirective(newtype.symoptions);
+                    consume(_SEMICOLON);
+                  end;
                 else
                   consume(_SEMICOLON);
               end;
@@ -543,7 +551,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.30  2001-05-08 21:06:31  florian
+  Revision 1.31  2001-06-03 21:57:35  peter
+    + hint directive parsing support
+
+  Revision 1.30  2001/05/08 21:06:31  florian
     * some more support for widechars commited especially
       regarding type casting and constants
 

compiler/pdecobj.pas

@@ -158,7 +158,7 @@ implementation
                             varspez:=vs_out;
                          end
                        else varspez:=vs_value;
-                       sc:=idlist;
+                       sc:=consume_idlist;
 {$ifdef fixLeaksOnError}
                        strContStack.push(sc);
 {$endif fixLeaksOnError}
@@ -1039,10 +1039,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  2001-05-04 15:52:03  florian
-    * some Delphi incompatibilities fixed:
-       - out, dispose and new can be used as idenfiers now
-       - const p = apointerype(nil); is supported now
+  Revision 1.26  2001-06-03 21:57:36  peter
+    + hint directive parsing support
+
+  Revision 1.25  2001/05/04 15:52:03  florian
+    * some Delphi incompatibilities fixed:
+       - out, dispose and new can be used as idenfiers now
+       - const p = apointerype(nil); is supported now
     + support for const p = apointertype(pointer(1234)); added
 
   Revision 1.24  2001/04/21 15:36:00  peter

compiler/pdecsub.pas

@@ -166,7 +166,7 @@ implementation
           else
             begin
              { read identifiers }
-               sc:=idlist;
+               sc:=consume_idlist;
 {$ifdef fixLeaksOnError}
                strContStack.push(sc);
 {$endif fixLeaksOnError}
@@ -693,7 +693,7 @@ begin
                    if lexlevel>normal_function_level then
                      Message(parser_e_no_local_operator);
                    consume(_OPERATOR);
-                   if (token in [_PLUS..last_overloaded]) then
+                   if (token in [first_overloaded..last_overloaded]) then
                     begin
                       procinfo^.flags:=procinfo^.flags or pi_operator;
                       optoken:=token;
@@ -1432,6 +1432,19 @@ const
         parse_proc_direc:=false;
         name:=pattern;
         found:=false;
+
+      { Hint directive? Then exit immediatly }
+        if (m_hintdirective in aktmodeswitches) then
+         begin
+           case idtoken of
+             _LIBRARY,
+             _PLATFORM,
+             _DEPRECATED :
+               exit;
+           end;
+         end;
+
+      { retrieve data for directive if found }
         for p:=1 to num_proc_directives do
          if proc_direcdata[p].idtok=idtoken then
           begin
@@ -1851,7 +1864,10 @@ const
 end.
 {
   $Log$
-  Revision 1.24  2001-05-08 21:06:31  florian
+  Revision 1.25  2001-06-03 21:57:36  peter
+    + hint directive parsing support
+
+  Revision 1.24  2001/05/08 21:06:31  florian
     * some more support for widechars commited especially
       regarding type casting and constants
 

compiler/pdecvar.pas

@@ -125,6 +125,7 @@ implementation
          uniondef : trecorddef;
          unionsym : tvarsym;
          uniontype : ttype;
+         dummysymoptions : tsymoptions;
       begin
          old_current_object_option:=current_object_option;
          { all variables are public if not in a object declaration }
@@ -141,7 +142,7 @@ implementation
                not(is_object and (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED])) do
            begin
              C_name:=orgpattern;
-             sc:=idlist;
+             sc:=consume_idlist;
 {$ifdef fixLeaksOnError}
              strContStack.push(sc);
 {$endif fixLeaksOnError}
@@ -151,11 +152,7 @@ implementation
                 (token=_ID) and (orgpattern='__asmname__') then
                begin
                  consume(_ID);
-                 C_name:=pattern;
-                 if token=_CCHAR then
-                  consume(_CCHAR)
-                 else
-                  consume(_CSTRING);
+                 C_name:=get_stringconst;
                  Is_gpc_name:=true;
                end;
              { this is needed for Delphi mode at least
@@ -165,13 +162,13 @@ implementation
               begin
                 { for records, don't search the recordsymtable for
                   the symbols of the types }
-                    oldsymtablestack:=symtablestack;
-                    symtablestack:=symtablestack.next;
+                oldsymtablestack:=symtablestack;
+                symtablestack:=symtablestack.next;
                 read_type(tt,'');
-                    symtablestack:=oldsymtablestack;
-                  end
-                 else
-                  read_type(tt,'');
+                symtablestack:=oldsymtablestack;
+              end
+             else
+              read_type(tt,'');
              if (variantrecordlevel>0) and tt.def.needs_inittable then
                Message(parser_e_cant_use_inittable_here);
              ignore_equal:=false;
@@ -291,6 +288,10 @@ implementation
                   readtypedconst(tt,tconstsym,false);
                   symdone:=true;
                end;
+             { hint directive }
+             {$warning hintdirective not stored in syms}
+             dummysymoptions:=[];
+             try_consume_hintdirective(dummysymoptions);
              { for a record there doesn't need to be a ; before the END or ) }
              if not((is_record or is_object) and (token in [_END,_RKLAMMER])) then
                consume(_SEMICOLON);
@@ -529,7 +530,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2001-04-18 22:01:57  peter
+  Revision 1.17  2001-06-03 21:57:36  peter
+    + hint directive parsing support
+
+  Revision 1.16  2001/04/18 22:01:57  peter
     * registration of targets and assemblers
 
   Revision 1.15  2001/04/13 01:22:12  peter

compiler/pmodules.pas

@@ -1132,7 +1132,7 @@ implementation
               if token=_LKLAMMER then
                 begin
                    consume(_LKLAMMER);
-                   idlist;
+                   consume_idlist;
                    consume(_RKLAMMER);
                 end;
               consume(_SEMICOLON);
@@ -1328,7 +1328,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  2001-06-03 15:15:31  peter
+  Revision 1.35  2001-06-03 21:57:36  peter
+    + hint directive parsing support
+
+  Revision 1.34  2001/06/03 15:15:31  peter
     * dllprt0 stub for linux shared libs
     * pass -init and -fini for linux shared libs
     * libprefix splitted into staticlibprefix and sharedlibprefix

compiler/pstatmnt.pas

@@ -122,7 +122,7 @@ implementation
                 end;
               if not try_to_consume(_SEMICOLON) then
                 break;
-              emptystats;
+              consume_emptystats;
            end;
          consume(_END);
          statements_til_end:=cblocknode.create(first);
@@ -316,7 +316,7 @@ implementation
                 end;
               if not try_to_consume(_SEMICOLON) then
                 break;
-              emptystats;
+              consume_emptystats;
            end;
          consume(_UNTIL);
          dec(statement_level);
@@ -539,7 +539,7 @@ implementation
                 end;
               if not try_to_consume(_SEMICOLON) then
                 break;
-              emptystats;
+              consume_emptystats;
            end;
          p_try_block:=cblocknode.create(first);
 
@@ -668,7 +668,7 @@ implementation
                        end;
                      if not try_to_consume(_SEMICOLON) then
                         break;
-                     emptystats;
+                     consume_emptystats;
                    until (token=_END) or (token=_ELSE);
                    if token=_ELSE then
                      { catch the other exceptions }
@@ -1141,7 +1141,7 @@ implementation
                      end;
                    consume(_SEMICOLON);
                 end;
-              emptystats;
+              consume_emptystats;
            end;
 
          { don't consume the finalization token, it is consumed when
@@ -1222,7 +1222,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.30  2001-05-17 13:25:24  jonas
+  Revision 1.31  2001-06-03 21:57:37  peter
+    + hint directive parsing support
+
+  Revision 1.30  2001/05/17 13:25:24  jonas
     * fixed web bugs 1480 and 1481
 
   Revision 1.29  2001/05/04 15:52:04  florian

compiler/psub.pas

@@ -603,6 +603,11 @@ implementation
          parse_proc_directives(pdflags);
          dec(lexlevel);
 
+      { hint directives, these can be separated by semicolons here,
+        that need to be handled here with a loop (PFV) }
+         while try_consume_hintdirective(aktprocsym.symoptions) do
+          Consume(_SEMICOLON);
+
       { set aktfilepos to the beginning of the function declaration }
          oldfilepos:=aktfilepos;
          aktfilepos:=aktprocsym.definition.fileinfo;
@@ -813,7 +818,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.32  2001-04-21 12:03:12  peter
+  Revision 1.33  2001-06-03 21:57:37  peter
+    + hint directive parsing support
+
+  Revision 1.32  2001/04/21 12:03:12  peter
     * m68k updates merged from fixes branch
 
   Revision 1.31  2001/04/18 22:01:57  peter

compiler/scanner.pas

@@ -216,7 +216,7 @@ implementation
       var
         low,high,mid : longint;
       begin
-        if not (length(s) in [2..tokenidlen]) then
+        if not (length(s) in [tokenlenmin..tokenlenmax]) then
          begin
            is_keyword:=false;
            exit;
@@ -1900,7 +1900,7 @@ implementation
            idtoken:=_ID;
          { keyword or any other known token,
            pattern is always uppercased }
-           if (pattern[1]<>'_') and (length(pattern) in [2..tokenidlen]) then
+           if (pattern[1]<>'_') and (length(pattern) in [tokenlenmin..tokenlenmax]) then
             begin
               low:=ord(tokenidx^[length(pattern),pattern[1]].first);
               high:=ord(tokenidx^[length(pattern),pattern[1]].last);
@@ -2593,7 +2593,10 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.17  2001-05-27 14:30:55  florian
+  Revision 1.18  2001-06-03 21:57:38  peter
+    + hint directive parsing support
+
+  Revision 1.17  2001/05/27 14:30:55  florian
     + some widestring stuff added
 
   Revision 1.16  2001/04/13 22:12:34  peter

compiler/symconst.pas

@@ -108,8 +108,9 @@ type
     sp_published,
     sp_protected,
     sp_static,
-    sp_primary_typesym    { this is for typesym, to know who is the primary symbol of a def }
-{$ifdef tp}
+    sp_hint_deprecated,
+    sp_hint_platform,
+    sp_hint_library
     ,sp_7
     ,sp_8
     ,sp_9
@@ -128,7 +129,6 @@ type
     ,sp_22
     ,sp_23
     ,sp_24
-{$endif}
   );
   tsymoptions=set of tsymoption;
 
@@ -136,7 +136,6 @@ type
   tdefoption=(df_none,
     df_need_rtti,          { the definitions needs rtti }
     df_has_rtti            { the rtti is generated      }
-{$ifdef tp}
     ,df_3
     ,df_4
     ,df_5
@@ -159,7 +158,6 @@ type
     ,df_22
     ,df_23
     ,df_24
-{$endif}
   );
   tdefoptions=set of tdefoption;
 
@@ -451,7 +449,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  2001-05-08 21:06:31  florian
+  Revision 1.18  2001-06-03 21:57:38  peter
+    + hint directive parsing support
+
+  Revision 1.17  2001/05/08 21:06:31  florian
     * some more support for widechars commited especially
       regarding type casting and constants
 

compiler/symtable.pas

@@ -244,12 +244,6 @@ interface
     procedure InitSymtable;
     procedure DoneSymtable;
 
-
-    const
-       { last operator which can be overloaded, the first_overloaded should
-         be in tokens.pas after NOTOKEN }
-       first_overloaded = _PLUS;
-       last_overloaded  = _ASSIGNMENT;
     type
        toverloaded_operators = array[NOTOKEN..last_overloaded] of tprocsym;
     var
@@ -2006,7 +2000,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  2001-05-06 14:49:18  peter
+  Revision 1.36  2001-06-03 21:57:38  peter
+    + hint directive parsing support
+
+  Revision 1.35  2001/05/06 14:49:18  peter
     * ppu object to class rewrite
     * move ppu read and write stuff to fppu
 

compiler/tokens.pas

@@ -28,9 +28,6 @@ interface
 uses
   globtype;
 
-const
-  tokenidlen=14;
-
 type
   ttoken=(NOTOKEN,
     { operators, which can also be overloaded }
@@ -181,6 +178,7 @@ type
     _PROGRAM,
     _STDCALL,
     _SYSCALL,
+    _VARARGS,
     _VIRTUAL,
     _ABSOLUTE,
     _ABSTRACT,
@@ -191,6 +189,7 @@ type
     _OPERATOR,
     _OVERLOAD,
     _OVERRIDE,
+    _PLATFORM,
     _POPSTACK,
     _PROPERTY,
     _REGISTER,
@@ -206,6 +205,7 @@ type
     _PROTECTED,
     _PUBLISHED,
     _THREADVAR,
+    _DEPRECATED,
     _DESTRUCTOR,
     _IMPLEMENTS,
     _INTERNPROC,
@@ -222,13 +222,21 @@ type
     _RESOURCESTRING
   );
 
+const
+  tokenlenmin = 2;
+  tokenlenmax = 14;
+
+  { last operator which can be overloaded, the first_overloaded should
+    be declared directly after NOTOKEN }
+  first_overloaded = succ(NOTOKEN);
+  last_overloaded  = _ASSIGNMENT;
+
+type
   tokenrec=record
-    str     : string[tokenidlen];
+    str     : string[tokenlenmax];
     special : boolean;
     keyword : tmodeswitch;
     op      : ttoken;
-{ unused currently? (JM)
-    encoded : longint; }
   end;
 
   ttokenarray=array[ttoken] of tokenrec;
@@ -239,7 +247,7 @@ type
   end;
 
   ptokenidx=^ttokenidx;
-  ttokenidx=array[2..tokenidlen,'A'..'Z'] of tokenidxrec;
+  ttokenidx=array[tokenlenmin..tokenlenmax,'A'..'Z'] of tokenidxrec;
 
 const
   arraytokeninfo : ttokenarray =(
@@ -392,6 +400,7 @@ const
       (str:'PROGRAM'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'STDCALL'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'SYSCALL'       ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'VARARGS'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'VIRTUAL'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'ABSOLUTE'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'ABSTRACT'      ;special:false;keyword:m_none;op:NOTOKEN),
@@ -402,6 +411,7 @@ const
       (str:'OPERATOR'      ;special:false;keyword:m_fpc;op:NOTOKEN),
       (str:'OVERLOAD'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OVERRIDE'      ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'PLATFORM'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'POPSTACK'      ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'PROPERTY'      ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'REGISTER'      ;special:false;keyword:m_none;op:NOTOKEN),
@@ -417,6 +427,7 @@ const
       (str:'PROTECTED'     ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'PUBLISHED'     ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'THREADVAR'     ;special:false;keyword:m_class;op:NOTOKEN),
+      (str:'DEPRECATED'    ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'DESTRUCTOR'    ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'IMPLEMENTS'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'INTERNPROC'    ;special:false;keyword:m_none;op:NOTOKEN),
@@ -479,7 +490,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.10  2001-05-06 17:12:43  jonas
+  Revision 1.11  2001-06-03 21:57:38  peter
+    + hint directive parsing support
+
+  Revision 1.10  2001/05/06 17:12:43  jonas
     - commented out an unused field in tokenrec
 
   Revision 1.9  2001/05/04 15:52:04  florian