pbase.pas 8.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Contains some helper routines for the parser
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit pbase;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cutils,cclasses,
  22. tokens,globtype,
  23. symconst,symbase,symtype,symdef,symsym,symtable
  24. ;
  25. const
  26. { tokens that end a block or statement. And don't require
  27. a ; on the statement before }
  28. endtokens = [_SEMICOLON,_END,_ELSE,_UNTIL,_EXCEPT,_FINALLY];
  29. { true, if we are after an assignement }
  30. afterassignment : boolean = false;
  31. { true, if we are parsing arguments }
  32. in_args : boolean = false;
  33. { true, if we are parsing arguments allowing named parameters }
  34. named_args_allowed : boolean = false;
  35. { true, if we got an @ to get the address }
  36. got_addrn : boolean = false;
  37. { special for handling procedure vars }
  38. getprocvardef : tprocvardef = nil;
  39. var
  40. { for operators }
  41. optoken : ttoken;
  42. { true, if only routine headers should be parsed }
  43. parse_only : boolean;
  44. { true, if we found a name for a named arg }
  45. found_arg_name : boolean;
  46. procedure identifier_not_found(const s:string);
  47. { function tokenstring(i : ttoken):string;}
  48. { consumes token i, if the current token is unequal i }
  49. { a syntax error is written }
  50. procedure consume(i : ttoken);
  51. {Tries to consume the token i, and returns true if it was consumed:
  52. if token=i.}
  53. function try_to_consume(i:Ttoken):boolean;
  54. { consumes all tokens til atoken (for error recovering }
  55. procedure consume_all_until(atoken : ttoken);
  56. { consumes tokens while they are semicolons }
  57. procedure consume_emptystats;
  58. { reads a list of identifiers into a string list }
  59. { consume a symbol, if not found give an error and
  60. and return an errorsym }
  61. function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean;
  62. function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean;
  63. function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable):boolean;
  64. function try_consume_hintdirective(var symopt:tsymoptions):boolean;
  65. { just for an accurate position of the end of a procedure (PM) }
  66. var
  67. last_endtoken_filepos: tfileposinfo;
  68. implementation
  69. uses
  70. globals,htypechk,scanner,systems,verbose;
  71. {****************************************************************************
  72. Token Parsing
  73. ****************************************************************************}
  74. procedure identifier_not_found(const s:string);
  75. begin
  76. Message1(sym_e_id_not_found,s);
  77. { show a fatal that you need -S2 or -Sd, but only
  78. if we just parsed the a token that has m_class }
  79. if not(m_class in current_settings.modeswitches) and
  80. (Upper(s)=pattern) and
  81. (tokeninfo^[idtoken].keyword=m_class) then
  82. Message(parser_f_need_objfpc_or_delphi_mode);
  83. end;
  84. { consumes token i, write error if token is different }
  85. procedure consume(i : ttoken);
  86. begin
  87. if (token<>i) and (idtoken<>i) then
  88. if token=_id then
  89. Message2(scan_f_syn_expected,tokeninfo^[i].str,'identifier '+pattern)
  90. else
  91. Message2(scan_f_syn_expected,tokeninfo^[i].str,tokeninfo^[token].str)
  92. else
  93. begin
  94. if token=_END then
  95. last_endtoken_filepos:=current_tokenpos;
  96. current_scanner.readtoken(true);
  97. end;
  98. end;
  99. function try_to_consume(i:Ttoken):boolean;
  100. begin
  101. try_to_consume:=false;
  102. if (token=i) or (idtoken=i) then
  103. begin
  104. try_to_consume:=true;
  105. if token=_END then
  106. last_endtoken_filepos:=current_tokenpos;
  107. current_scanner.readtoken(true);
  108. end;
  109. end;
  110. procedure consume_all_until(atoken : ttoken);
  111. begin
  112. while (token<>atoken) and (idtoken<>atoken) do
  113. begin
  114. Consume(token);
  115. if token=_EOF then
  116. begin
  117. Consume(atoken);
  118. Message(scan_f_end_of_file);
  119. exit;
  120. end;
  121. end;
  122. end;
  123. procedure consume_emptystats;
  124. begin
  125. repeat
  126. until not try_to_consume(_SEMICOLON);
  127. end;
  128. { check if a symbol contains the hint directive, and if so gives out a hint
  129. if required.
  130. If this code is changed, it's likly that consume_sym_orgid and factor_read_id
  131. must be changed as well (FK)
  132. }
  133. function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean;
  134. begin
  135. { first check for identifier }
  136. if token<>_ID then
  137. begin
  138. consume(_ID);
  139. srsym:=generrorsym;
  140. srsymtable:=nil;
  141. result:=false;
  142. exit;
  143. end;
  144. searchsym(pattern,srsym,srsymtable);
  145. { handle unit specification like System.Writeln }
  146. try_consume_unitsym(srsym,srsymtable);
  147. { if nothing found give error and return errorsym }
  148. if assigned(srsym) then
  149. check_hints(srsym,srsym.symoptions)
  150. else
  151. begin
  152. identifier_not_found(orgpattern);
  153. srsym:=generrorsym;
  154. srsymtable:=nil;
  155. end;
  156. consume(_ID);
  157. result:=assigned(srsym);
  158. end;
  159. { check if a symbol contains the hint directive, and if so gives out a hint
  160. if required and returns the id with it's original casing
  161. }
  162. function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean;
  163. begin
  164. { first check for identifier }
  165. if token<>_ID then
  166. begin
  167. consume(_ID);
  168. srsym:=generrorsym;
  169. srsymtable:=nil;
  170. result:=false;
  171. exit;
  172. end;
  173. searchsym(pattern,srsym,srsymtable);
  174. { handle unit specification like System.Writeln }
  175. try_consume_unitsym(srsym,srsymtable);
  176. { if nothing found give error and return errorsym }
  177. if assigned(srsym) then
  178. check_hints(srsym,srsym.symoptions)
  179. else
  180. begin
  181. identifier_not_found(orgpattern);
  182. srsym:=generrorsym;
  183. srsymtable:=nil;
  184. end;
  185. s:=orgpattern;
  186. consume(_ID);
  187. result:=assigned(srsym);
  188. end;
  189. function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable):boolean;
  190. begin
  191. result:=false;
  192. if assigned(srsym) and
  193. (srsym.typ=unitsym) then
  194. begin
  195. if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then
  196. internalerror(200501154);
  197. { only allow unit.symbol access if the name was
  198. found in the current module }
  199. if srsym.owner.iscurrentunit then
  200. begin
  201. consume(_ID);
  202. consume(_POINT);
  203. searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable);
  204. end
  205. else
  206. begin
  207. srsym:=nil;
  208. srsymtable:=nil;
  209. end;
  210. result:=true;
  211. end;
  212. end;
  213. function try_consume_hintdirective(var symopt:tsymoptions):boolean;
  214. begin
  215. try_consume_hintdirective:=false;
  216. if not(m_hintdirective in current_settings.modeswitches) then
  217. exit;
  218. repeat
  219. case idtoken of
  220. _LIBRARY :
  221. begin
  222. include(symopt,sp_hint_library);
  223. try_consume_hintdirective:=true;
  224. end;
  225. _DEPRECATED :
  226. begin
  227. include(symopt,sp_hint_deprecated);
  228. try_consume_hintdirective:=true;
  229. end;
  230. _PLATFORM :
  231. begin
  232. include(symopt,sp_hint_platform);
  233. try_consume_hintdirective:=true;
  234. end;
  235. _UNIMPLEMENTED :
  236. begin
  237. include(symopt,sp_hint_unimplemented);
  238. try_consume_hintdirective:=true;
  239. end;
  240. else
  241. break;
  242. end;
  243. consume(Token);
  244. until false;
  245. end;
  246. end.