parser.pas 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. This unit does the parsing process
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {$ifdef tp}
  19. {$E+,N+,D+,F+}
  20. {$endif}
  21. unit parser;
  22. interface
  23. procedure compile(const filename:string;compile_system:boolean);
  24. procedure initparser;
  25. implementation
  26. uses
  27. systems,cobjects,globals,verbose,
  28. symtable,files,aasm,hcodegen,
  29. assemble,link,script,gendef,
  30. {$ifdef UseBrowser}
  31. browser,
  32. {$endif UseBrowser}
  33. scanner,pbase,pdecl,psystem,pmodules;
  34. procedure initparser;
  35. begin
  36. forwardsallowed:=false;
  37. { ^M means a string or a char, because we don't parse a }
  38. { type declaration }
  39. ignore_equal:=false;
  40. { we didn't parse a object or class declaration }
  41. { and no function header }
  42. testcurobject:=0;
  43. { create error defintion }
  44. generrordef:=new(perrordef,init);
  45. symtablestack:=nil;
  46. { a long time, this was forgotten }
  47. aktprocsym:=nil;
  48. current_module:=nil;
  49. loaded_units.init;
  50. usedunits.init;
  51. { memory sizes }
  52. if heapsize=0 then
  53. heapsize:=target_info.heapsize;
  54. if stacksize=0 then
  55. stacksize:=target_info.stacksize;
  56. end;
  57. procedure default_macros;
  58. var
  59. hp : pstring_item;
  60. begin
  61. { commandline }
  62. hp:=pstring_item(initdefines.first);
  63. while assigned(hp) do
  64. begin
  65. def_macro(hp^.str^);
  66. hp:=pstring_item(hp^.next);
  67. end;
  68. { set macros for version checking }
  69. set_macro('FPC_VERSION',version_nr);
  70. set_macro('FPC_RELEASE',release_nr);
  71. set_macro('FPC_PATCH',patch_nr);
  72. end;
  73. procedure compile(const filename:string;compile_system:boolean);
  74. var
  75. { some variables to save the compiler state }
  76. oldtoken : ttoken;
  77. oldtokenpos : tfileposinfo;
  78. oldpattern : stringid;
  79. oldpreprocstack : ppreprocstack;
  80. oldorgpattern,oldprocprefix : string;
  81. old_block_type : tblock_type;
  82. oldcurrlinepos,
  83. oldlastlinepos,
  84. oldinputbuffer,
  85. oldinputpointer : pchar;
  86. olds_point,oldparse_only : boolean;
  87. oldc : char;
  88. oldcomment_level : word;
  89. oldnextlabelnr : longint;
  90. oldmacros,oldrefsymtable,oldsymtablestack : psymtable;
  91. oldimports,oldexports,oldresource,oldrttilist,
  92. oldbsssegment,olddatasegment,oldcodesegment,
  93. oldexprasmlist,olddebuglist,
  94. oldinternals,oldexternals,oldconsts : paasmoutput;
  95. oldswitches : tcswitches;
  96. oldpackrecords : word;
  97. oldoutputformat : tasm;
  98. oldoptprocessor : tprocessors;
  99. oldasmmode : tasmmode;
  100. label
  101. done;
  102. begin {compile}
  103. inc(compile_level);
  104. { save old state }
  105. { save symtable state }
  106. oldsymtablestack:=symtablestack;
  107. symtablestack:=nil;
  108. oldrefsymtable:=refsymtable;
  109. refsymtable:=nil;
  110. oldprocprefix:=procprefix;
  111. { a long time, this was only in init_parser
  112. but it should be reset to zero for each module }
  113. aktprocsym:=nil;
  114. { reset the unit or create a new program }
  115. if assigned(current_module) then
  116. begin
  117. current_module^.sourcefiles.done;
  118. current_module^.sourcefiles.init;
  119. current_module^.used_units.done;
  120. current_module^.used_units.init;
  121. end
  122. else
  123. begin
  124. current_module:=new(pmodule,init(filename,false));
  125. main_module:=current_module;
  126. end;
  127. { save scanner state }
  128. oldmacros:=macros;
  129. oldpattern:=pattern;
  130. oldtoken:=token;
  131. oldtokenpos:=tokenpos;
  132. oldorgpattern:=orgpattern;
  133. old_block_type:=block_type;
  134. oldpreprocstack:=preprocstack;
  135. oldinputbuffer:=inputbuffer;
  136. oldinputpointer:=inputpointer;
  137. oldcurrlinepos:=currlinepos;
  138. oldlastlinepos:=lastlinepos;
  139. olds_point:=s_point;
  140. oldc:=c;
  141. oldcomment_level:=comment_level;
  142. oldnextlabelnr:=nextlabelnr;
  143. oldparse_only:=parse_only;
  144. { save assembler lists }
  145. olddatasegment:=datasegment;
  146. oldbsssegment:=bsssegment;
  147. oldcodesegment:=codesegment;
  148. olddebuglist:=debuglist;
  149. oldexternals:=externals;
  150. oldinternals:=internals;
  151. oldconsts:=consts;
  152. oldrttilist:=rttilist;
  153. oldexprasmlist:=exprasmlist;
  154. oldimports:=importssection;
  155. oldexports:=exportssection;
  156. oldresource:=resourcesection;
  157. { save the current state }
  158. oldswitches:=aktswitches;
  159. oldpackrecords:=aktpackrecords;
  160. oldoutputformat:=aktoutputformat;
  161. oldoptprocessor:=aktoptprocessor;
  162. oldasmmode:=aktasmmode;
  163. Message1(parser_i_compiling,filename);
  164. InitScanner(filename);
  165. { Load current state from the init values }
  166. aktswitches:=initswitches;
  167. aktpackrecords:=initpackrecords;
  168. aktoutputformat:=initoutputformat;
  169. aktoptprocessor:=initoptprocessor;
  170. aktasmmode:=initasmmode;
  171. { we need this to make the system unit }
  172. if compile_system then
  173. aktswitches:=aktswitches+[cs_compilesystem];
  174. { macros }
  175. macros:=new(psymtable,init(macrosymtable));
  176. macros^.name:=stringdup('Conditionals for '+filename);
  177. default_macros;
  178. { startup scanner }
  179. token:=yylex;
  180. { init code generator for a new module }
  181. codegen_newmodule;
  182. {$ifdef GDB}
  183. reset_gdb_info;
  184. {$endif GDB}
  185. { global switches are read, so further changes aren't allowed }
  186. current_module^.in_main:=true;
  187. { Handle things which need to be once }
  188. if (compile_level=1) then
  189. begin
  190. { open assembler response }
  191. AsmRes.Init('ppas');
  192. end;
  193. { load system unit always }
  194. loadsystemunit;
  195. registerdef:=true;
  196. make_ref:=true;
  197. { current return type is void }
  198. procinfo.retdef:=voiddef;
  199. { reset lexical level }
  200. lexlevel:=0;
  201. { parse source }
  202. if (token=_UNIT) or (compile_level>1) then
  203. begin
  204. current_module^.is_unit:=true;
  205. { If the compile level > 1 we get a nice "unit expected" error
  206. message if we are trying to use a program as unit.}
  207. proc_unit;
  208. if current_module^.compiled then
  209. goto done;
  210. end
  211. else
  212. begin
  213. proc_program(token=_LIBRARY);
  214. end;
  215. if status.errorcount=0 then
  216. begin
  217. GenerateAsm(filename);
  218. if (cs_smartlink in aktswitches) then
  219. begin
  220. Linker.SetLibName(current_module^.libfilename^);
  221. Linker.MakeStaticLibrary(SmartLinkPath(FileName),SmartLinkFilesCnt);
  222. end;
  223. { add the files for the linker from current_module, this must be
  224. after the makestaticlibrary, because it will add the library
  225. name (PFV) }
  226. addlinkerfiles(current_module);
  227. { Check linking => we are at first level in compile }
  228. if (compile_level=1) then
  229. begin
  230. if gendeffile then
  231. deffile.writefile;
  232. if (not current_module^.is_unit) then
  233. begin
  234. if (cs_no_linking in initswitches) then
  235. externlink:=true;
  236. if Linker.ExeName='' then
  237. Linker.SetExeName(FileName);
  238. Linker.MakeExecutable;
  239. end;
  240. end;
  241. end
  242. else
  243. Message1(unit_f_errors_in_unit,tostr(status.errorcount));
  244. done:
  245. { clear memory }
  246. {$ifdef Splitheap}
  247. if testsplit then
  248. begin
  249. { temp heap should be empty after that !!!}
  250. codegen_donemodule;
  251. Releasetempheap;
  252. end;
  253. {$endif Splitheap}
  254. { restore old state, close trees }
  255. if dispose_asm_lists then
  256. codegen_donemodule;
  257. {$ifdef GDB}
  258. reset_gdb_info;
  259. {$endif GDB}
  260. { restore symtable state }
  261. {$ifdef UseBrowser}
  262. if (compile_level>1) then
  263. { we want to keep the current symtablestack }
  264. {$endif UseBrowser}
  265. begin
  266. refsymtable:=oldrefsymtable;
  267. symtablestack:=oldsymtablestack;
  268. end;
  269. procprefix:=oldprocprefix;
  270. {$ifdef UseBrowser}
  271. { close input files, but dont remove if we use the browser ! }
  272. if cs_browser in initswitches then
  273. current_module^.sourcefiles.close_all
  274. else
  275. current_module^.sourcefiles.done;
  276. {$else UseBrowser}
  277. { close the inputfiles }
  278. current_module^.sourcefiles.done;
  279. {$endif not UseBrowser}
  280. { restore scanner state }
  281. pattern:=oldpattern;
  282. token:=oldtoken;
  283. tokenpos:=oldtokenpos;
  284. orgpattern:=oldorgpattern;
  285. block_type:=old_block_type;
  286. { call donescanner before restoring preprocstack, because }
  287. { donescanner tests for a empty preprocstack }
  288. { and can also check for unused macros }
  289. donescanner(current_module^.compiled);
  290. dispose(macros,done);
  291. macros:=oldmacros;
  292. { restore scanner }
  293. preprocstack:=oldpreprocstack;
  294. inputbuffer:=oldinputbuffer;
  295. inputpointer:=oldinputpointer;
  296. lastlinepos:=oldlastlinepos;
  297. currlinepos:=oldcurrlinepos;
  298. s_point:=olds_point;
  299. c:=oldc;
  300. comment_level:=oldcomment_level;
  301. nextlabelnr:=oldnextlabelnr;
  302. parse_only:=oldparse_only;
  303. { restore asmlists }
  304. exprasmlist:=oldexprasmlist;
  305. datasegment:=olddatasegment;
  306. bsssegment:=oldbsssegment;
  307. codesegment:=oldcodesegment;
  308. consts:=oldconsts;
  309. debuglist:=olddebuglist;
  310. externals:=oldexternals;
  311. internals:=oldinternals;
  312. importssection:=oldimports;
  313. exportssection:=oldexports;
  314. resourcesection:=oldresource;
  315. rttilist:=oldrttilist;
  316. { restore current state }
  317. aktswitches:=oldswitches;
  318. aktpackrecords:=oldpackrecords;
  319. aktoutputformat:=oldoutputformat;
  320. aktoptprocessor:=oldoptprocessor;
  321. aktasmmode:=oldasmmode;
  322. { Shut down things when the last file is compiled }
  323. if (compile_level=1) then
  324. begin
  325. { Close script }
  326. if (not AsmRes.Empty) then
  327. begin
  328. Message1(exec_i_closing_script,AsmRes.Fn);
  329. AsmRes.WriteToDisk;
  330. end;
  331. {$ifdef UseBrowser}
  332. { Write Browser }
  333. if cs_browser in initswitches then
  334. begin
  335. Comment(V_Info,'Writing Browser '+Browse.Fname);
  336. Browse.CreateLog;
  337. write_browser_log;
  338. Browse.CloseLog;
  339. end;
  340. {$endif UseBrowser}
  341. end;
  342. dec(compile_level);
  343. end;
  344. end.
  345. {
  346. $Log$
  347. Revision 1.27 1998-06-17 14:10:15 peter
  348. * small os2 fixes
  349. * fixed interdependent units with newppu (remake3 under linux works now)
  350. Revision 1.26 1998/06/16 08:56:23 peter
  351. + targetcpu
  352. * cleaner pmodules for newppu
  353. Revision 1.25 1998/06/15 15:38:07 pierre
  354. * small bug in systems.pas corrected
  355. + operators in different units better hanlded
  356. Revision 1.24 1998/06/13 00:10:08 peter
  357. * working browser and newppu
  358. * some small fixes against crashes which occured in bp7 (but not in
  359. fpc?!)
  360. Revision 1.23 1998/06/08 22:59:48 peter
  361. * smartlinking works for win32
  362. * some defines to exclude some compiler parts
  363. Revision 1.22 1998/06/05 17:47:28 peter
  364. * some better uses clauses
  365. Revision 1.21 1998/06/04 23:51:49 peter
  366. * m68k compiles
  367. + .def file creation moved to gendef.pas so it could also be used
  368. for win32
  369. Revision 1.20 1998/06/03 22:48:55 peter
  370. + wordbool,longbool
  371. * rename bis,von -> high,low
  372. * moved some systemunit loading/creating to psystem.pas
  373. Revision 1.19 1998/05/27 19:45:04 peter
  374. * symtable.pas splitted into includefiles
  375. * symtable adapted for $ifdef NEWPPU
  376. Revision 1.18 1998/05/23 01:21:15 peter
  377. + aktasmmode, aktoptprocessor, aktoutputformat
  378. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  379. + $LIBNAME to set the library name where the unit will be put in
  380. * splitted cgi386 a bit (codeseg to large for bp7)
  381. * nasm, tasm works again. nasm moved to ag386nsm.pas
  382. Revision 1.17 1998/05/20 09:42:34 pierre
  383. + UseTokenInfo now default
  384. * unit in interface uses and implementation uses gives error now
  385. * only one error for unknown symbol (uses lastsymknown boolean)
  386. the problem came from the label code !
  387. + first inlined procedures and function work
  388. (warning there might be allowed cases were the result is still wrong !!)
  389. * UseBrower updated gives a global list of all position of all used symbols
  390. with switch -gb
  391. Revision 1.16 1998/05/12 10:47:00 peter
  392. * moved printstatus to verb_def
  393. + V_Normal which is between V_Error and V_Warning and doesn't have a
  394. prefix like error: warning: and is included in V_Default
  395. * fixed some messages
  396. * first time parameter scan is only for -v and -T
  397. - removed old style messages
  398. Revision 1.15 1998/05/11 13:07:54 peter
  399. + $ifdef NEWPPU for the new ppuformat
  400. + $define GDB not longer required
  401. * removed all warnings and stripped some log comments
  402. * no findfirst/findnext anymore to remove smartlink *.o files
  403. Revision 1.14 1998/05/06 18:36:53 peter
  404. * tai_section extended with code,data,bss sections and enumerated type
  405. * ident 'compiled by FPC' moved to pmodules
  406. * small fix for smartlink
  407. Revision 1.13 1998/05/06 08:38:42 pierre
  408. * better position info with UseTokenInfo
  409. UseTokenInfo greatly simplified
  410. + added check for changed tree after first time firstpass
  411. (if we could remove all the cases were it happen
  412. we could skip all firstpass if firstpasscount > 1)
  413. Only with ExtDebug
  414. Revision 1.12 1998/05/04 17:54:28 peter
  415. + smartlinking works (only case jumptable left todo)
  416. * redesign of systems.pas to support assemblers and linkers
  417. + Unitname is now also in the PPU-file, increased version to 14
  418. Revision 1.11 1998/05/01 16:38:45 florian
  419. * handling of private and protected fixed
  420. + change_keywords_to_tp implemented to remove
  421. keywords which aren't supported by tp
  422. * break and continue are now symbols of the system unit
  423. + widestring, longstring and ansistring type released
  424. Revision 1.10 1998/05/01 07:43:56 florian
  425. + basics for rtti implemented
  426. + switch $m (generate rtti for published sections)
  427. Revision 1.9 1998/04/30 15:59:40 pierre
  428. * GDB works again better :
  429. correct type info in one pass
  430. + UseTokenInfo for better source position
  431. * fixed one remaining bug in scanner for line counts
  432. * several little fixes
  433. Revision 1.8 1998/04/29 10:33:55 pierre
  434. + added some code for ansistring (not complete nor working yet)
  435. * corrected operator overloading
  436. * corrected nasm output
  437. + started inline procedures
  438. + added starstarn : use ** for exponentiation (^ gave problems)
  439. + started UseTokenInfo cond to get accurate positions
  440. Revision 1.7 1998/04/27 23:10:28 peter
  441. + new scanner
  442. * $makelib -> if smartlink
  443. * small filename fixes pmodule.setfilename
  444. * moved import from files.pas -> import.pas
  445. Revision 1.6 1998/04/21 10:16:48 peter
  446. * patches from strasbourg
  447. * objects is not used anymore in the fpc compiled version
  448. Revision 1.5 1998/04/10 14:41:43 peter
  449. * removed some Hints
  450. * small speed optimization for AsmLn
  451. Revision 1.4 1998/04/08 16:58:03 pierre
  452. * several bugfixes
  453. ADD ADC and AND are also sign extended
  454. nasm output OK (program still crashes at end
  455. and creates wrong assembler files !!)
  456. procsym types sym in tdef removed !!
  457. Revision 1.3 1998/04/07 22:45:04 florian
  458. * bug0092, bug0115 and bug0121 fixed
  459. + packed object/class/array
  460. }