paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 04:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ hint directive parsing support

Browse Source
This commit is contained in:
peter 2001-06-03 21:57:35 +00:00
parent 34db6813c3
commit f86ce17588
15 changed files with 181 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/README
View File

@ -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

7
compiler/globals.pas
View File

@ -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

8
compiler/globtype.pas
View File

@ -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

65
compiler/pbase.pas
View File

@ -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

13
compiler/pdecl.pas
View File

@ -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

13
compiler/pdecobj.pas
View File

@ -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

22
compiler/pdecsub.pas
View File

@ -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

30
compiler/pdecvar.pas
View File

@ -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

7
compiler/pmodules.pas
View File

@ -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

15
compiler/pstatmnt.pas
View File

@ -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

10
compiler/psub.pas
View File

@ -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

9
compiler/scanner.pas
View File

@ -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

13
compiler/symconst.pas
View File

@ -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

11
compiler/symtable.pas
View File

@ -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

30
compiler/tokens.pas
View File

@ -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