{
$Id: pbase.pas,v 1.25 2003/09/23 17:56:05 peter Exp $
Copyright (c) 1998-2002 by Florian Klaempfl
Contains some helper routines for the parser
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit pbase;
{$i fpcdefs.inc}
interface
uses
cutils,cclasses,
tokens,globals,
symconst,symbase,symtype,symdef,symsym,symtable
;
const
{ tokens that end a block or statement. And don't require
a ; on the statement before }
endtokens = [_SEMICOLON,_END,_ELSE,_UNTIL];
{ true, if we are after an assignement }
afterassignment : boolean = false;
{ true, if we are parsing arguments }
in_args : boolean = false;
{ true, if we got an @ to get the address }
got_addrn : boolean = false;
{ special for handling procedure vars }
getprocvardef : tprocvardef = nil;
var
{ for operators }
optoken : ttoken;
{ symtable were unit references are stored }
refsymtable : tsymtable;
{ true, if only routine headers should be parsed }
parse_only : boolean;
{ true, if we should ignore an equal in const x : 1..2=2 }
ignore_equal : boolean;
procedure identifier_not_found(const s:string);
function tokenstring(i : ttoken):string;
{ consumes token i, if the current token is unequal i }
{ a syntax error is written }
procedure consume(i : ttoken);
{Tries to consume the token i, and returns true if it was consumed:
if token=i.}
function try_to_consume(i:Ttoken):boolean;
{ consumes all tokens til atoken (for error recovering }
procedure consume_all_until(atoken : ttoken);
{ consumes tokens while they are semicolons }
procedure consume_emptystats;
{ reads a list of identifiers into a string list }
{ consume a symbol, if not found give an error and
and return an errorsym }
function consume_sym(var srsym:tsym;var srsymtable:tsymtable):boolean;
function try_consume_hintdirective(var symopt:tsymoptions):boolean;
procedure check_hints(const srsym: tsym);
{ just for an accurate position of the end of a procedure (PM) }
var
last_endtoken_filepos: tfileposinfo;
implementation
uses
globtype,scanner,systems,verbose;
{****************************************************************************
Token Parsing
****************************************************************************}
procedure identifier_not_found(const s:string);
begin
Message1(sym_e_id_not_found,s);
{ show a fatal that you need -S2 or -Sd, but only
if we just parsed the a token that has m_class }
if not(m_class in aktmodeswitches) and
(Upper(s)=pattern) and
(tokeninfo^[idtoken].keyword=m_class) then
Message(parser_f_need_objfpc_or_delphi_mode);
end;
function tokenstring(i : ttoken):string;
begin
tokenstring:=tokeninfo^[i].str;
end;
{ consumes token i, write error if token is different }
procedure consume(i : ttoken);
begin
if (token<>i) and (idtoken<>i) then
if token=_id then
Message2(scan_f_syn_expected,tokeninfo^[i].str,'identifier '+pattern)
else
Message2(scan_f_syn_expected,tokeninfo^[i].str,tokeninfo^[token].str)
else
begin
if token=_END then
last_endtoken_filepos:=akttokenpos;
current_scanner.readtoken;
end;
end;
function try_to_consume(i:Ttoken):boolean;
begin
try_to_consume:=false;
if (token=i) or (idtoken=i) then
begin
try_to_consume:=true;
if token=_END then
last_endtoken_filepos:=akttokenpos;
current_scanner.readtoken;
end;
end;
procedure consume_all_until(atoken : ttoken);
begin
while (token<>atoken) and (idtoken<>atoken) do
begin
Consume(token);
if token=_EOF then
begin
Consume(atoken);
Message(scan_f_end_of_file);
exit;
end;
end;
end;
procedure consume_emptystats;
begin
repeat
until not try_to_consume(_SEMICOLON);
end;
{ check if a symbol contains the hint directive, and if so gives out a hint
if required.
}
procedure check_hints(const srsym: tsym);
begin
if not assigned(srsym) then
exit;
if sp_hint_deprecated in srsym.symoptions then
Message1(sym_w_deprecated_symbol,srsym.realname);
if sp_hint_platform in srsym.symoptions then
Message1(sym_w_non_portable_symbol,srsym.realname);
if sp_hint_unimplemented in srsym.symoptions then
Message1(sym_w_non_implemented_symbol,srsym.realname);
end;
function consume_sym(var srsym:tsym;var srsymtable:tsymtable):boolean;
begin
{ first check for identifier }
if token<>_ID then
begin
consume(_ID);
srsym:=generrorsym;
srsymtable:=nil;
consume_sym:=false;
exit;
end;
searchsym(pattern,srsym,srsymtable);
check_hints(srsym);
if assigned(srsym) then
begin
if (srsym.typ=unitsym) then
begin
{ only allow unit.symbol access if the name was
found in the current module }
if srsym.owner.unitid=0 then
begin
consume(_ID);
consume(_POINT);
srsymtable:=tunitsym(srsym).unitsymtable;
srsym:=searchsymonlyin(srsymtable,pattern);
end
else
srsym:=nil;
end;
end;
{ if nothing found give error and return errorsym }
if srsym=nil then
begin
identifier_not_found(orgpattern);
srsym:=generrorsym;
srsymtable:=nil;
end;
consume(_ID);
consume_sym:=assigned(srsym);
end;
function try_consume_hintdirective(var symopt:tsymoptions):boolean;
begin
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;
_UNIMPLEMENTED :
begin
include(symopt,sp_hint_unimplemented);
try_consume_hintdirective:=true;
end;
else
break;
end;
consume(Token);
until false;
end;
end.
{
$Log: pbase.pas,v $
Revision 1.25 2003/09/23 17:56:05 peter
* locals and paras are allocated in the code generation
* tvarsym.localloc contains the location of para/local when
generating code for the current procedure
Revision 1.24 2003/05/15 18:58:53 peter
* removed selfpointer_offset, vmtpointer_offset
* tvarsym.adjusted_address
* address in localsymtable is now in the real direction
* removed some obsolete globals
Revision 1.23 2003/03/17 18:55:30 peter
* allow more tokens instead of only semicolon after inherited
Revision 1.22 2002/12/05 19:28:05 carl
- remove lower in hint
Revision 1.21 2002/11/30 11:12:48 carl
+ checking for symbols used with hint directives is done mostly in pexpr
only now
Revision 1.20 2002/11/29 22:31:19 carl
+ unimplemented hint directive added
* hint directive parsing implemented
* warning on these directives
Revision 1.19 2002/09/09 17:34:15 peter
* tdicationary.replace added to replace and item in a dictionary. This
is only allowed for the same name
* varsyms are inserted in symtable before the types are parsed. This
fixes the long standing "var longint : longint" bug
- consume_idlist and idstringlist removed. The loops are inserted
at the callers place and uses the symtable for duplicate id checking
Revision 1.18 2002/08/17 09:23:38 florian
* first part of procinfo rewrite
Revision 1.17 2002/05/18 13:34:11 peter
* readded missing revisions
Revision 1.16 2002/05/16 19:46:42 carl
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+ try to fix temp allocation (still in ifdef)
+ generic constructor calls
+ start of tassembler / tmodulebase class cleanup
Revision 1.14 2002/01/06 21:47:32 peter
* removed getprocvar, use only getprocvardef
}
syntax highlighted by Code2HTML, v. 0.9.1