From f86ce17588654b58523fb9d74630e3bfd976811b Mon Sep 17 00:00:00 2001 From: peter Date: Sun, 3 Jun 2001 21:57:35 +0000 Subject: [PATCH] + hint directive parsing support --- compiler/README | 2 ++ compiler/globals.pas | 7 +++-- compiler/globtype.pas | 8 ++++-- compiler/pbase.pas | 65 +++++++++++++++++++++++++++++++++---------- compiler/pdecl.pas | 13 ++++++++- compiler/pdecobj.pas | 13 +++++---- compiler/pdecsub.pas | 22 +++++++++++++-- compiler/pdecvar.pas | 30 +++++++++++--------- compiler/pmodules.pas | 7 +++-- compiler/pstatmnt.pas | 15 ++++++---- compiler/psub.pas | 10 ++++++- compiler/scanner.pas | 9 ++++-- compiler/symconst.pas | 13 +++++---- compiler/symtable.pas | 11 +++----- compiler/tokens.pas | 30 ++++++++++++++------ 15 files changed, 181 insertions(+), 74 deletions(-) diff --git a/compiler/README b/compiler/README index 2c5c4be126..1293880aa8 100644 --- a/compiler/README +++ b/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 diff --git a/compiler/globals.pas b/compiler/globals.pas index da851afab1..641e66c3c6 100644 --- a/compiler/globals.pas +++ b/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 diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 16dcca28a4..19aeb1e130 100644 --- a/compiler/globtype.pas +++ b/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 diff --git a/compiler/pbase.pas b/compiler/pbase.pas index 63f1b74f2b..4023104595 100644 --- a/compiler/pbase.pas +++ b/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 diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index 4c9f09702e..7544367b51 100644 --- a/compiler/pdecl.pas +++ b/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 diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index e7cb8baf0f..afd594c3f7 100644 --- a/compiler/pdecobj.pas +++ b/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 diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 923ad66132..1771a5efc2 100644 --- a/compiler/pdecsub.pas +++ b/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 diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 813c405cc6..68d3c311b1 100644 --- a/compiler/pdecvar.pas +++ b/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 diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 306c09b6a3..3a7e4f9896 100644 --- a/compiler/pmodules.pas +++ b/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 diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index eb20392476..c97f73188e 100644 --- a/compiler/pstatmnt.pas +++ b/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 diff --git a/compiler/psub.pas b/compiler/psub.pas index 2f502723ca..5629629189 100644 --- a/compiler/psub.pas +++ b/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 diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 29b028e2a9..cb4129d450 100644 --- a/compiler/scanner.pas +++ b/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 diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 35ed3cd319..2af0caf1e5 100644 --- a/compiler/symconst.pas +++ b/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 diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 07e9cde6c4..9bccb4e2e2 100644 --- a/compiler/symtable.pas +++ b/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 diff --git a/compiler/tokens.pas b/compiler/tokens.pas index b76a716329..5d2dc4ba27 100644 --- a/compiler/tokens.pas +++ b/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