parser.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 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. unit parser;
  19. {$i fpcdefs.inc}
  20. interface
  21. {$ifdef PREPROCWRITE}
  22. procedure preprocess(const filename:string);
  23. {$endif PREPROCWRITE}
  24. procedure compile(const filename:string);
  25. procedure initparser;
  26. procedure doneparser;
  27. implementation
  28. uses
  29. cutils,cclasses,
  30. globtype,version,tokens,systems,globals,verbose,
  31. symbase,symtable,symdef,symsym,
  32. fmodule,fppu,
  33. aasmbase,aasmtai,
  34. cgbase,
  35. script,gendef,
  36. {$ifdef BrowserLog}
  37. browlog,
  38. {$endif BrowserLog}
  39. {$ifdef UseExcept}
  40. tpexcept,
  41. {$endif UseExcept}
  42. {$ifdef GDB}
  43. gdb,
  44. {$endif GDB}
  45. comphook,
  46. scanner,scandir,
  47. pbase,ptype,pmodules,cresstr;
  48. procedure initparser;
  49. begin
  50. { ^M means a string or a char, because we don't parse a }
  51. { type declaration }
  52. ignore_equal:=false;
  53. { we didn't parse a object or class declaration }
  54. { and no function header }
  55. testcurobject:=0;
  56. { Symtable }
  57. aktprocsym:=nil;
  58. aktprocdef:=nil;
  59. objectlibrary:=nil;
  60. current_module:=nil;
  61. compiled_module:=nil;
  62. procinfo:=nil;
  63. loaded_units:=TLinkedList.Create;
  64. usedunits:=TLinkedList.Create;
  65. { global switches }
  66. aktglobalswitches:=initglobalswitches;
  67. aktsourcecodepage:=initsourcecodepage;
  68. { initialize scanner }
  69. InitScanner;
  70. InitScannerDirectives;
  71. { scanner }
  72. c:=#0;
  73. pattern:='';
  74. orgpattern:='';
  75. current_scanner:=nil;
  76. { memory sizes }
  77. if heapsize=0 then
  78. heapsize:=target_info.heapsize;
  79. if stacksize=0 then
  80. stacksize:=target_info.stacksize;
  81. { open assembler response }
  82. GenerateAsmRes(outputexedir+'ppas');
  83. { open deffile }
  84. DefFile:=TDefFile.Create(outputexedir+inputfile+target_info.defext);
  85. { list of generated .o files, so the linker can remove them }
  86. SmartLinkOFiles:=TStringList.Create;
  87. end;
  88. procedure doneparser;
  89. begin
  90. { unload units }
  91. loaded_units.free;
  92. usedunits.free;
  93. { if there was an error in the scanner, the scanner is
  94. still assinged }
  95. if assigned(current_scanner) then
  96. begin
  97. current_scanner.free;
  98. current_scanner:=nil;
  99. end;
  100. { close scanner }
  101. DoneScanner;
  102. { close ppas,deffile }
  103. asmres.free;
  104. deffile.free;
  105. { free list of .o files }
  106. SmartLinkOFiles.Free;
  107. end;
  108. procedure default_macros;
  109. var
  110. hp : tstringlistitem;
  111. begin
  112. { commandline }
  113. hp:=tstringlistitem(initdefines.first);
  114. while assigned(hp) do
  115. begin
  116. current_scanner.def_macro(hp.str);
  117. hp:=tstringlistitem(hp.next);
  118. end;
  119. { set macros for version checking }
  120. current_scanner.set_macro('FPC_VERSION',version_nr);
  121. current_scanner.set_macro('FPC_RELEASE',release_nr);
  122. current_scanner.set_macro('FPC_PATCH',patch_nr);
  123. end;
  124. {$ifdef PREPROCWRITE}
  125. procedure preprocess(const filename:string);
  126. var
  127. i : longint;
  128. begin
  129. new(preprocfile,init('pre'));
  130. { default macros }
  131. current_scanner^.macros:=new(pdictionary,init);
  132. default_macros;
  133. { initialize a module }
  134. current_module:=new(pmodule,init(filename,false));
  135. main_module:=current_module;
  136. { startup scanner, and save in current_module }
  137. current_scanner:=new(pscannerfile,Init(filename));
  138. current_module.scanner:=current_scanner;
  139. { loop until EOF is found }
  140. repeat
  141. current_scanner^.readtoken;
  142. preprocfile^.AddSpace;
  143. case token of
  144. _ID :
  145. begin
  146. preprocfile^.Add(orgpattern);
  147. end;
  148. _REALNUMBER,
  149. _INTCONST :
  150. preprocfile^.Add(pattern);
  151. _CSTRING :
  152. begin
  153. i:=0;
  154. while (i<length(pattern)) do
  155. begin
  156. inc(i);
  157. if pattern[i]='''' then
  158. begin
  159. insert('''',pattern,i);
  160. inc(i);
  161. end;
  162. end;
  163. preprocfile^.Add(''''+pattern+'''');
  164. end;
  165. _CCHAR :
  166. begin
  167. case pattern[1] of
  168. #39 :
  169. pattern:='''''''';
  170. #0..#31,
  171. #128..#255 :
  172. begin
  173. str(ord(pattern[1]),pattern);
  174. pattern:='#'+pattern;
  175. end;
  176. else
  177. pattern:=''''+pattern[1]+'''';
  178. end;
  179. preprocfile^.Add(pattern);
  180. end;
  181. _EOF :
  182. break;
  183. else
  184. preprocfile^.Add(tokeninfo^[token].str)
  185. end;
  186. until false;
  187. { free scanner }
  188. dispose(current_scanner,done);
  189. current_scanner:=nil;
  190. { close }
  191. dispose(preprocfile,done);
  192. end;
  193. {$endif PREPROCWRITE}
  194. procedure compile(const filename:string);
  195. var
  196. { scanner }
  197. oldidtoken,
  198. oldtoken : ttoken;
  199. oldtokenpos : tfileposinfo;
  200. oldc : char;
  201. oldpattern,
  202. oldorgpattern : string;
  203. old_block_type : tblock_type;
  204. oldcurrent_scanner,prev_scanner,
  205. scanner : tscannerfile;
  206. { symtable }
  207. oldrefsymtable,
  208. olddefaultsymtablestack,
  209. oldsymtablestack : tsymtable;
  210. oldaktprocsym : tprocsym;
  211. oldaktprocdef : tprocdef;
  212. oldoverloaded_operators : toverloaded_operators;
  213. { cg }
  214. oldparse_only : boolean;
  215. { asmlists }
  216. oldimports,
  217. oldexports,
  218. oldresource,
  219. oldrttilist,
  220. oldresourcestringlist,
  221. oldbsssegment,
  222. olddatasegment,
  223. oldcodesegment,
  224. oldexprasmlist,
  225. olddebuglist,
  226. oldwithdebuglist,
  227. oldconsts : taasmoutput;
  228. oldobjectlibrary : tasmlibrarydata;
  229. { resourcestrings }
  230. OldResourceStrings : tResourceStrings;
  231. { akt.. things }
  232. oldaktlocalswitches : tlocalswitches;
  233. oldaktmoduleswitches : tmoduleswitches;
  234. oldaktfilepos : tfileposinfo;
  235. oldaktpackenum,oldaktmaxfpuregisters : longint;
  236. oldaktalignment : talignmentinfo;
  237. oldaktoutputformat : tasm;
  238. oldaktspecificoptprocessor,
  239. oldaktoptprocessor : tprocessors;
  240. oldaktasmmode : tasmmode;
  241. oldaktinterfacetype: tinterfacetypes;
  242. oldaktmodeswitches : tmodeswitches;
  243. old_compiled_module : tmodule;
  244. oldaktdefproccall : tproccalloption;
  245. oldsourcecodepage : tcodepagestring;
  246. { will only be increased once we start parsing blocks in the }
  247. { implementation, so doesn't need to be saved/restored (JM) }
  248. { oldexceptblockcounter : integer; }
  249. oldstatement_level : integer;
  250. {$ifdef USEEXCEPT}
  251. {$ifndef Delphi}
  252. recoverpos : jmp_buf;
  253. oldrecoverpos : pjmp_buf;
  254. {$endif Delphi}
  255. {$endif useexcept}
  256. {$ifdef GDB}
  257. store_dbx : plongint;
  258. {$endif GDB}
  259. begin
  260. inc(compile_level);
  261. parser_current_file:=filename;
  262. old_compiled_module:=compiled_module;
  263. { save symtable state }
  264. oldsymtablestack:=symtablestack;
  265. olddefaultsymtablestack:=defaultsymtablestack;
  266. oldrefsymtable:=refsymtable;
  267. oldaktprocsym:=aktprocsym;
  268. oldaktprocdef:=aktprocdef;
  269. oldaktdefproccall:=aktdefproccall;
  270. move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators));
  271. { save scanner state }
  272. oldc:=c;
  273. oldpattern:=pattern;
  274. oldorgpattern:=orgpattern;
  275. oldtoken:=token;
  276. oldidtoken:=idtoken;
  277. old_block_type:=block_type;
  278. oldtokenpos:=akttokenpos;
  279. oldcurrent_scanner:=current_scanner;
  280. oldsourcecodepage:=aktsourcecodepage;
  281. { save cg }
  282. oldparse_only:=parse_only;
  283. { save assembler lists }
  284. olddatasegment:=datasegment;
  285. oldbsssegment:=bsssegment;
  286. oldcodesegment:=codesegment;
  287. olddebuglist:=debuglist;
  288. oldwithdebuglist:=withdebuglist;
  289. oldconsts:=consts;
  290. oldrttilist:=rttilist;
  291. oldexprasmlist:=exprasmlist;
  292. oldimports:=importssection;
  293. oldexports:=exportssection;
  294. oldresource:=resourcesection;
  295. oldresourcestringlist:=resourcestringlist;
  296. oldobjectlibrary:=objectlibrary;
  297. OldResourceStrings:=ResourceStrings;
  298. { save akt... state }
  299. { handle the postponed case first }
  300. if localswitcheschanged then
  301. begin
  302. aktlocalswitches:=nextaktlocalswitches;
  303. localswitcheschanged:=false;
  304. end;
  305. oldaktlocalswitches:=aktlocalswitches;
  306. oldaktmoduleswitches:=aktmoduleswitches;
  307. oldaktalignment:=aktalignment;
  308. oldaktpackenum:=aktpackenum;
  309. oldaktmaxfpuregisters:=aktmaxfpuregisters;
  310. oldaktoutputformat:=aktoutputformat;
  311. oldaktoptprocessor:=aktoptprocessor;
  312. oldaktspecificoptprocessor:=aktspecificoptprocessor;
  313. oldaktasmmode:=aktasmmode;
  314. oldaktinterfacetype:=aktinterfacetype;
  315. oldaktfilepos:=aktfilepos;
  316. oldaktmodeswitches:=aktmodeswitches;
  317. oldstatement_level:=statement_level;
  318. { oldexceptblockcounter:=exceptblockcounter; }
  319. {$ifdef GDB}
  320. store_dbx:=dbx_counter;
  321. dbx_counter:=nil;
  322. {$endif GDB}
  323. { show info }
  324. Message1(parser_i_compiling,filename);
  325. { reset symtable }
  326. symtablestack:=nil;
  327. defaultsymtablestack:=nil;
  328. systemunit:=nil;
  329. refsymtable:=nil;
  330. aktprocsym:=nil;
  331. aktdefproccall:=initdefproccall;
  332. registerdef:=true;
  333. statement_level:=0;
  334. aktexceptblock:=0;
  335. exceptblockcounter:=0;
  336. aktmaxfpuregisters:=-1;
  337. fillchar(overloaded_operators,sizeof(toverloaded_operators),0);
  338. { reset the unit or create a new program }
  339. if assigned(current_module) then
  340. begin
  341. {current_module.reset this is wrong !! }
  342. scanner:=tscannerfile(current_module.scanner);
  343. current_module.reset;
  344. tscannerfile(current_module.scanner):=scanner;
  345. end
  346. else
  347. begin
  348. current_module:=tppumodule.create(filename,'',false);
  349. main_module:=current_module;
  350. end;
  351. { a unit compiled at command line must be inside the loaded_unit list }
  352. if (compile_level=1) then
  353. loaded_units.insert(current_module);
  354. { Set the module to use for verbose }
  355. SetCompileModule(current_module);
  356. compiled_module:=current_module;
  357. current_module.in_compile:=true;
  358. { Load current state from the init values }
  359. aktlocalswitches:=initlocalswitches;
  360. aktmoduleswitches:=initmoduleswitches;
  361. aktmodeswitches:=initmodeswitches;
  362. {$IFDEF Testvarsets}
  363. aktsetalloc:=initsetalloc;
  364. {$ENDIF}
  365. aktalignment:=initalignment;
  366. aktpackenum:=initpackenum;
  367. aktoutputformat:=initoutputformat;
  368. set_target_asm(aktoutputformat);
  369. aktoptprocessor:=initoptprocessor;
  370. aktspecificoptprocessor:=initspecificoptprocessor;
  371. aktasmmode:=initasmmode;
  372. aktinterfacetype:=initinterfacetype;
  373. { startup scanner and load the first file }
  374. current_scanner:=tscannerfile.Create(filename);
  375. current_scanner.firstfile;
  376. { macros }
  377. default_macros;
  378. { read the first token }
  379. current_scanner.readtoken;
  380. prev_scanner:=tscannerfile(current_module.scanner);
  381. current_module.scanner:=current_scanner;
  382. { init code generator for a new module }
  383. codegen_newmodule;
  384. { If the compile level > 1 we get a nice "unit expected" error
  385. message if we are trying to use a program as unit.}
  386. {$ifdef USEEXCEPT}
  387. if setjmp(recoverpos)=0 then
  388. begin
  389. oldrecoverpos:=recoverpospointer;
  390. recoverpospointer:=@recoverpos;
  391. {$endif USEEXCEPT}
  392. if (token=_UNIT) or (compile_level>1) then
  393. begin
  394. current_module.is_unit:=true;
  395. proc_unit;
  396. end
  397. else
  398. proc_program(token=_LIBRARY);
  399. {$ifdef USEEXCEPT}
  400. recoverpospointer:=oldrecoverpos;
  401. end
  402. else
  403. begin
  404. recoverpospointer:=oldrecoverpos;
  405. longjump_used:=true;
  406. end;
  407. {$endif USEEXCEPT}
  408. { clear memory }
  409. {$ifdef Splitheap}
  410. if testsplit then
  411. begin
  412. { temp heap should be empty after that !!!}
  413. codegen_donemodule;
  414. Releasetempheap;
  415. end;
  416. {$endif Splitheap}
  417. { restore old state, close trees, > 0.99.5 has heapblocks, so
  418. it's the default to release the trees }
  419. codegen_donemodule;
  420. { free ppu }
  421. if assigned(tppumodule(current_module).ppufile) then
  422. begin
  423. tppumodule(current_module).ppufile.free;
  424. tppumodule(current_module).ppufile:=nil;
  425. end;
  426. { free scanner }
  427. current_scanner.free;
  428. current_scanner:=nil;
  429. { restore previous scanner !! }
  430. current_module.scanner:=prev_scanner;
  431. if assigned(prev_scanner) then
  432. prev_scanner.SetInvalid;
  433. if (compile_level>1) then
  434. begin
  435. {$ifdef GDB}
  436. dbx_counter:=store_dbx;
  437. {$endif GDB}
  438. { restore scanner }
  439. c:=oldc;
  440. pattern:=oldpattern;
  441. orgpattern:=oldorgpattern;
  442. token:=oldtoken;
  443. idtoken:=oldidtoken;
  444. akttokenpos:=oldtokenpos;
  445. block_type:=old_block_type;
  446. current_scanner:=oldcurrent_scanner;
  447. if not current_scanner.invalid then
  448. parser_current_file:=current_scanner.inputfile.name^;
  449. { restore cg }
  450. parse_only:=oldparse_only;
  451. { restore asmlists }
  452. exprasmlist:=oldexprasmlist;
  453. datasegment:=olddatasegment;
  454. bsssegment:=oldbsssegment;
  455. codesegment:=oldcodesegment;
  456. consts:=oldconsts;
  457. debuglist:=olddebuglist;
  458. withdebuglist:=oldwithdebuglist;
  459. importssection:=oldimports;
  460. exportssection:=oldexports;
  461. resourcesection:=oldresource;
  462. rttilist:=oldrttilist;
  463. resourcestringlist:=oldresourcestringlist;
  464. { object data }
  465. ResourceStrings:=OldResourceStrings;
  466. objectlibrary:=oldobjectlibrary;
  467. { restore symtable state }
  468. refsymtable:=oldrefsymtable;
  469. symtablestack:=oldsymtablestack;
  470. defaultsymtablestack:=olddefaultsymtablestack;
  471. aktdefproccall:=oldaktdefproccall;
  472. aktprocsym:=oldaktprocsym;
  473. aktprocdef:=oldaktprocdef;
  474. move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
  475. aktsourcecodepage:=oldsourcecodepage;
  476. aktlocalswitches:=oldaktlocalswitches;
  477. aktmoduleswitches:=oldaktmoduleswitches;
  478. aktalignment:=oldaktalignment;
  479. aktpackenum:=oldaktpackenum;
  480. aktmaxfpuregisters:=oldaktmaxfpuregisters;
  481. aktoutputformat:=oldaktoutputformat;
  482. set_target_asm(aktoutputformat);
  483. aktoptprocessor:=oldaktoptprocessor;
  484. aktspecificoptprocessor:=oldaktspecificoptprocessor;
  485. aktasmmode:=oldaktasmmode;
  486. aktinterfacetype:=oldaktinterfacetype;
  487. aktfilepos:=oldaktfilepos;
  488. aktmodeswitches:=oldaktmodeswitches;
  489. statement_level:=oldstatement_level;
  490. aktexceptblock:=0;
  491. exceptblockcounter:=0;
  492. end
  493. else
  494. begin
  495. parser_current_file:='';
  496. end;
  497. { Shut down things when the last file is compiled }
  498. if (compile_level=1) then
  499. begin
  500. { Close script }
  501. if (not AsmRes.Empty) then
  502. begin
  503. Message1(exec_i_closing_script,AsmRes.Fn);
  504. AsmRes.WriteToDisk;
  505. end;
  506. {$ifdef USEEXCEPT}
  507. if not longjump_used then
  508. {$endif USEEXCEPT}
  509. { do not create browsers on errors !! }
  510. if status.errorcount=0 then
  511. begin
  512. {$ifdef BrowserLog}
  513. { Write Browser Log }
  514. if (cs_browser_log in aktglobalswitches) and
  515. (cs_browser in aktmoduleswitches) then
  516. begin
  517. if browserlog.elements_to_list.empty then
  518. begin
  519. Message1(parser_i_writing_browser_log,browserlog.Fname);
  520. WriteBrowserLog;
  521. end
  522. else
  523. browserlog.list_elements;
  524. end;
  525. {$endif BrowserLog}
  526. { Write Browser Collections }
  527. do_extractsymbolinfo{$ifdef FPC}(){$endif};
  528. end;
  529. if current_module.in_second_compile then
  530. begin
  531. current_module.in_second_compile:=false;
  532. current_module.in_compile:=true;
  533. end
  534. else
  535. current_module.in_compile:=false;
  536. (* Obsolete code aktprocsym
  537. is disposed by the localsymtable disposal (PM)
  538. { Free last aktprocsym }
  539. if assigned(aktprocsym) and (aktprocsym.owner=nil) then
  540. begin
  541. { init parts are not needed in units !! }
  542. if current_module.is_unit then
  543. aktprocdef.forwarddef:=false;
  544. dispose(aktprocsym,done);
  545. end; *)
  546. end;
  547. dec(compile_level);
  548. compiled_module:=old_compiled_module;
  549. {$ifdef USEEXCEPT}
  550. if longjump_used then
  551. longjmp(recoverpospointer^,1);
  552. {$endif USEEXCEPT}
  553. end;
  554. end.
  555. {
  556. $Log$
  557. Revision 1.38 2002-08-11 14:28:19 peter
  558. * TScannerFile.SetInvalid added that will also reset inputfile
  559. Revision 1.37 2002/08/11 13:24:12 peter
  560. * saving of asmsymbols in ppu supported
  561. * asmsymbollist global is removed and moved into a new class
  562. tasmlibrarydata that will hold the info of a .a file which
  563. corresponds with a single module. Added librarydata to tmodule
  564. to keep the library info stored for the module. In the future the
  565. objectfiles will also be stored to the tasmlibrarydata class
  566. * all getlabel/newasmsymbol and friends are moved to the new class
  567. Revision 1.36 2002/08/09 19:15:41 carl
  568. - removed newcg define
  569. Revision 1.35 2002/07/20 17:16:03 florian
  570. + source code page support
  571. Revision 1.34 2002/07/01 18:46:24 peter
  572. * internal linker
  573. * reorganized aasm layer
  574. Revision 1.33 2002/05/18 13:34:11 peter
  575. * readded missing revisions
  576. Revision 1.32 2002/05/16 19:46:42 carl
  577. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  578. + try to fix temp allocation (still in ifdef)
  579. + generic constructor calls
  580. + start of tassembler / tmodulebase class cleanup
  581. Revision 1.30 2002/04/21 18:57:23 peter
  582. * fixed memleaks when file can't be opened
  583. Revision 1.29 2002/04/20 21:32:24 carl
  584. + generic FPC_CHECKPOINTER
  585. + first parameter offset in stack now portable
  586. * rename some constants
  587. + move some cpu stuff to other units
  588. - remove unused constents
  589. * fix stacksize for some targets
  590. * fix generic size problems which depend now on EXTEND_SIZE constant
  591. Revision 1.28 2002/04/19 15:46:02 peter
  592. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  593. in most cases and not written to the ppu
  594. * add mangeledname_prefix() routine to generate the prefix of
  595. manglednames depending on the current procedure, object and module
  596. * removed static procprefix since the mangledname is now build only
  597. on demand from tprocdef.mangledname
  598. Revision 1.27 2002/01/29 19:43:11 peter
  599. * update target_asm according to outputformat
  600. }