pmodules.pas 36 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081
  1. {
  2. $Id$
  3. Copyright (c) 1998 by Florian Klaempfl
  4. Handles the parsing and loading of the modules (ppufiles)
  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 pmodules;
  19. {define TEST_IMPL does not work well }
  20. interface
  21. uses
  22. files;
  23. procedure loadsystemunit;
  24. procedure proc_unit;
  25. procedure proc_program(islibrary : boolean);
  26. implementation
  27. uses
  28. cobjects,verbose,comphook,systems,globals,
  29. symtable,aasm,hcodegen,
  30. link,assemble,import,gendef,ppu
  31. {$ifdef i386}
  32. ,i386
  33. {$endif}
  34. {$ifdef m68k}
  35. ,m68k
  36. {$endif}
  37. ,scanner,pbase,psystem,pdecl,psub,parser;
  38. procedure create_objectfile;
  39. begin
  40. { create the .s file and assemble it }
  41. GenerateAsm;
  42. { When creating a library call the linker. And insert the output
  43. of the linker files }
  44. if (cs_create_staticlib in aktmoduleswitches) then
  45. Linker.MakeStaticLibrary(SmartLinkFilesCnt)
  46. else
  47. if (cs_create_sharedlib in aktmoduleswitches) then
  48. Linker.MakeSharedLibrary;
  49. { add the files for the linker from current_module }
  50. Linker.AddModuleFiles(current_module);
  51. end;
  52. procedure insertobjectfile;
  53. { Insert the used object file for this unit in the used list for this unit }
  54. begin
  55. if (cs_create_staticlib in aktmoduleswitches) then
  56. current_module^.linkstaticlibs.insert(current_module^.staticlibfilename^)
  57. else
  58. if (cs_create_sharedlib in aktmoduleswitches) then
  59. current_module^.linksharedlibs.insert(current_module^.sharedlibfilename^)
  60. else
  61. current_module^.linkofiles.insert(current_module^.objfilename^);
  62. end;
  63. procedure insertsegment;
  64. procedure fixseg(p:paasmoutput;sec:tsection);
  65. begin
  66. p^.insert(new(pai_section,init(sec)));
  67. if (cs_smartlink in aktmoduleswitches) then
  68. p^.insert(new(pai_cut,init));
  69. p^.concat(new(pai_section,init(sec_none)));
  70. end;
  71. begin
  72. {Insert Ident of the compiler}
  73. if (not (cs_smartlink in aktmoduleswitches))
  74. {$ifndef EXTDEBUG}
  75. and (not current_module^.is_unit)
  76. {$endif}
  77. then
  78. begin
  79. datasegment^.insert(new(pai_align,init(4)));
  80. datasegment^.insert(new(pai_string,init('FPC '+version_string+' for '+target_string+' - '+target_info.short_name)));
  81. end;
  82. { Insert start and end of sections }
  83. fixseg(codesegment,sec_code);
  84. fixseg(datasegment,sec_data);
  85. fixseg(bsssegment,sec_bss);
  86. fixseg(consts,sec_data);
  87. end;
  88. procedure insertheap;
  89. begin
  90. if (cs_smartlink in aktmoduleswitches) then
  91. begin
  92. bsssegment^.concat(new(pai_cut,init));
  93. datasegment^.concat(new(pai_cut,init));
  94. end;
  95. { On the Macintosh Classic M68k Architecture
  96. The Heap variable is simply a POINTER to the
  97. real HEAP. The HEAP must be set up by the RTL
  98. and must store the pointer in this value.
  99. On OS/2 the heap is also intialized by the RTL. We do
  100. not output a pointer }
  101. case target_info.target of
  102. {$ifdef i386}
  103. target_OS2 : ;
  104. {$endif i386}
  105. {$ifdef m68k}
  106. target_Mac68K : bsssegment^.concat(new(pai_datablock,init_global('HEAP',4)));
  107. {$endif m68k}
  108. else
  109. bsssegment^.concat(new(pai_datablock,init_global('HEAP',heapsize)));
  110. end;
  111. {$ifdef i386}
  112. datasegment^.concat(new(pai_symbol,init_global('HEAPSIZE')));
  113. {$endif i386}
  114. {$ifdef m68k}
  115. datasegment^.concat(new(pai_symbol,init_global('HEAP_SIZE')));
  116. {$endif m68k}
  117. datasegment^.concat(new(pai_const,init_32bit(heapsize)));
  118. end;
  119. procedure inserttargetspecific;
  120. begin
  121. {$ifdef i386}
  122. case target_info.target of
  123. target_GO32V2 : begin
  124. { stacksize can be specified }
  125. datasegment^.concat(new(pai_symbol,init_global('__stklen')));
  126. datasegment^.concat(new(pai_const,init_32bit(stacksize)));
  127. end;
  128. target_WIN32 : begin
  129. { Generate an external entry to be sure that _mainCRTStarup will be
  130. linked, can't use concat_external because those aren't written for
  131. asw (PFV) }
  132. datasegment^.concat(new(pai_const,init_symbol('_mainCRTStartup')));
  133. end;
  134. end;
  135. {$endif i386}
  136. end;
  137. function loadunit(const s : string;compile_system:boolean) : pmodule;forward;
  138. procedure load_usedunits(compile_system:boolean);
  139. var
  140. pu : pused_unit;
  141. loaded_unit : pmodule;
  142. nextmapentry : longint;
  143. begin
  144. { init the map }
  145. new(current_module^.map);
  146. nextmapentry:=1;
  147. { load the used units from interface }
  148. pu:=pused_unit(current_module^.used_units.first);
  149. while assigned(pu) do
  150. begin
  151. if (not pu^.loaded) and (pu^.in_interface) then
  152. begin
  153. loaded_unit:=loadunit(pu^.name^,false);
  154. if current_module^.compiled then
  155. exit;
  156. { register unit in used units }
  157. pu^.u:=loaded_unit;
  158. pu^.loaded:=true;
  159. { need to recompile the current unit ? }
  160. if loaded_unit^.crc<>pu^.checksum then
  161. begin
  162. current_module^.do_compile:=true;
  163. exit;
  164. end;
  165. { setup the map entry for deref }
  166. current_module^.map^[nextmapentry]:=loaded_unit^.symtable;
  167. inc(nextmapentry);
  168. if nextmapentry>maxunits then
  169. Message(unit_f_too_much_units);
  170. end;
  171. pu:=pused_unit(pu^.next);
  172. end;
  173. { ok, now load the unit }
  174. current_module^.symtable:=new(punitsymtable,loadasunit);
  175. { if this is the system unit insert the intern symbols }
  176. if compile_system then
  177. begin
  178. make_ref:=false;
  179. insertinternsyms(psymtable(current_module^.symtable));
  180. make_ref:=true;
  181. end;
  182. { now only read the implementation part }
  183. current_module^.in_implementation:=true;
  184. { load the used units from implementation }
  185. pu:=pused_unit(current_module^.used_units.first);
  186. while assigned(pu) do
  187. begin
  188. if (not pu^.loaded) and (not pu^.in_interface) then
  189. begin
  190. loaded_unit:=loadunit(pu^.name^,false);
  191. if current_module^.compiled then
  192. exit;
  193. { register unit in used units }
  194. pu^.u:=loaded_unit;
  195. pu^.loaded:=true;
  196. {$ifdef TEST_IMPL}
  197. { need to recompile the current unit ? }
  198. if loaded_unit^.crc<>pu^.checksum then
  199. begin
  200. current_module^.do_compile:=true;
  201. exit;
  202. end;
  203. { setup the map entry for deref }
  204. current_module^.map^[nextmapentry]:=loaded_unit^.symtable;
  205. inc(nextmapentry);
  206. if nextmapentry>maxunits then
  207. Message(unit_f_too_much_units);
  208. {$endif TEST_IMPL}
  209. end;
  210. pu:=pused_unit(pu^.next);
  211. end;
  212. { remove the map, it's not needed anymore }
  213. dispose(current_module^.map);
  214. current_module^.map:=nil;
  215. end;
  216. function loadunit(const s : string;compile_system:boolean) : pmodule;
  217. var
  218. st : punitsymtable;
  219. old_current_ppu : pppufile;
  220. old_current_module,hp : pmodule;
  221. procedure loadppufile;
  222. begin
  223. { load interface section }
  224. if not current_module^.do_compile then
  225. load_interface;
  226. { only load units when we don't recompile }
  227. if not current_module^.do_compile then
  228. load_usedunits(compile_system);
  229. { recompile if set }
  230. if current_module^.do_compile then
  231. begin
  232. { we needn't the ppufile }
  233. if assigned(current_module^.ppufile) then
  234. begin
  235. dispose(current_module^.ppufile,done);
  236. current_module^.ppufile:=nil;
  237. end;
  238. { recompile the unit or give a fatal error if sources not available }
  239. if not(current_module^.sources_avail) then
  240. Message1(unit_f_cant_compile_unit,current_module^.modulename^)
  241. else
  242. begin
  243. current_scanner^.close;
  244. compile(current_module^.mainsource^,compile_system);
  245. if (not old_current_module^.compiled) then
  246. current_scanner^.reopen;
  247. end;
  248. end
  249. else
  250. begin
  251. { only reassemble ? }
  252. if (current_module^.do_assemble) then
  253. OnlyAsm;
  254. { add the files for the linker }
  255. Linker.AddModuleFiles(current_module);
  256. end;
  257. if assigned(current_module^.ppufile) then
  258. begin
  259. dispose(current_module^.ppufile,done);
  260. current_module^.ppufile:=nil;
  261. end;
  262. end;
  263. begin
  264. old_current_module:=current_module;
  265. old_current_ppu:=current_ppu;
  266. { be sure not to mix lines from different files }
  267. { update_line; }
  268. { unit not found }
  269. st:=nil;
  270. { search all loaded units }
  271. hp:=pmodule(loaded_units.first);
  272. while assigned(hp) do
  273. begin
  274. if hp^.modulename^=s then
  275. begin
  276. { the unit is already registered }
  277. { and this means that the unit }
  278. { is already compiled }
  279. { else there is a cyclic unit use }
  280. if assigned(hp^.symtable) then
  281. st:=punitsymtable(hp^.symtable)
  282. else
  283. begin
  284. { recompile the unit ? }
  285. if (not current_module^.in_implementation) and (hp^.in_implementation) then
  286. Message(unit_f_circular_unit_reference);
  287. end;
  288. break;
  289. end;
  290. { the next unit }
  291. hp:=pmodule(hp^.next);
  292. end;
  293. { the unit is not in the symtable stack }
  294. if (not assigned(st)) then
  295. begin
  296. { if the unit is loaded remove it first }
  297. if assigned(hp) then
  298. begin
  299. { remove the old unit }
  300. loaded_units.remove(hp);
  301. dispose(hp,done);
  302. end;
  303. { generates a new unit info record }
  304. current_module:=new(pmodule,init(s,true));
  305. current_ppu:=current_module^.ppufile;
  306. { now we can register the unit }
  307. loaded_units.insert(current_module);
  308. { now realy load the ppu }
  309. loadppufile;
  310. { set compiled flag }
  311. current_module^.compiled:=true;
  312. { register the unit _once_ }
  313. usedunits.concat(new(pused_unit,init(current_module,true)));
  314. { load return pointer }
  315. hp:=current_module;
  316. end;
  317. { set the old module }
  318. current_ppu:=old_current_ppu;
  319. current_module:=old_current_module;
  320. loadunit:=hp;
  321. end;
  322. procedure loadsystemunit;
  323. var
  324. hp : pmodule;
  325. begin
  326. { if the current file isn't a system unit the the system unit
  327. will be loaded }
  328. if not(cs_compilesystem in aktmoduleswitches) then
  329. begin
  330. hp:=loadunit(upper(target_info.system_unit),true);
  331. systemunit:=hp^.symtable;
  332. { add to the used units }
  333. current_module^.used_units.concat(new(pused_unit,init(hp,true)));
  334. { read default constant definitions }
  335. make_ref:=false;
  336. readconstdefs;
  337. { we could try to overload caret by default }
  338. symtablestack:=systemunit;
  339. { if POWER is defined in the RTL then use it for starstar overloading }
  340. getsym('POWER',false);
  341. if assigned(srsym) and (srsym^.typ=procsym) and
  342. (overloaded_operators[STARSTAR]=nil) then
  343. overloaded_operators[STARSTAR]:=pprocsym(srsym);
  344. make_ref:=true;
  345. end
  346. else
  347. begin
  348. createconstdefs;
  349. systemunit:=nil;
  350. end;
  351. end;
  352. procedure loadunits;
  353. var
  354. s : stringid;
  355. hp : pused_unit;
  356. hp2 : pmodule;
  357. hp3 : psymtable;
  358. oldprocsym:Pprocsym;
  359. begin
  360. oldprocsym:=aktprocsym;
  361. consume(_USES);
  362. {$ifdef DEBUG}
  363. test_symtablestack;
  364. {$endif DEBUG}
  365. repeat
  366. s:=pattern;
  367. consume(ID);
  368. hp2:=loadunit(s,false);
  369. { the current module uses the unit hp2 }
  370. current_module^.used_units.concat(new(pused_unit,init(hp2,not current_module^.in_implementation)));
  371. pused_unit(current_module^.used_units.last)^.in_uses:=true;
  372. if current_module^.compiled then
  373. exit;
  374. refsymtable^.insert(new(punitsym,init(s,hp2^.symtable)));
  375. if token=COMMA then
  376. begin
  377. pattern:='';
  378. consume(COMMA);
  379. end
  380. else
  381. break;
  382. until false;
  383. consume(SEMICOLON);
  384. { set the symtable to systemunit so it gets reorderd correctly }
  385. symtablestack:=systemunit;
  386. { now insert the units in the symtablestack }
  387. hp:=pused_unit(current_module^.used_units.first);
  388. while assigned(hp) do
  389. begin
  390. {$IfDef GDB}
  391. if (cs_debuginfo in aktmoduleswitches) and
  392. not hp^.is_stab_written then
  393. begin
  394. punitsymtable(hp^.u^.symtable)^.concattypestabto(debuglist);
  395. hp^.is_stab_written:=true;
  396. hp^.unitid:=psymtable(hp^.u^.symtable)^.unitid;
  397. end;
  398. {$EndIf GDB}
  399. if hp^.in_uses then
  400. begin
  401. hp3:=symtablestack;
  402. while assigned(hp3) do
  403. begin
  404. { insert units only once ! }
  405. if hp^.u^.symtable=hp3 then
  406. break;
  407. hp3:=hp3^.next;
  408. { unit isn't inserted }
  409. if hp3=nil then
  410. begin
  411. psymtable(hp^.u^.symtable)^.next:=symtablestack;
  412. symtablestack:=psymtable(hp^.u^.symtable);
  413. {$ifdef CHAINPROCSYMS}
  414. symtablestack^.chainprocsyms;
  415. {$endif CHAINPROCSYMS}
  416. {$ifdef DEBUG}
  417. test_symtablestack;
  418. {$endif DEBUG}
  419. end;
  420. end;
  421. end;
  422. hp:=pused_unit(hp^.next);
  423. end;
  424. aktprocsym:=oldprocsym;
  425. end;
  426. procedure parse_implementation_uses(symt:Psymtable);
  427. begin
  428. if token=_USES then
  429. begin
  430. symt^.symtabletype:=unitsymtable;
  431. loadunits;
  432. symt^.symtabletype:=globalsymtable;
  433. {$ifdef DEBUG}
  434. test_symtablestack;
  435. {$endif DEBUG}
  436. end;
  437. end;
  438. procedure proc_unit;
  439. var
  440. { unitname : stringid; }
  441. names : Tstringcontainer;
  442. p : psymtable;
  443. unitst : punitsymtable;
  444. pu : pused_unit;
  445. i : longint;
  446. s1,s2 : ^string; {Saves stack space}
  447. begin
  448. consume(_UNIT);
  449. if token=ID then
  450. begin
  451. { create filenames and unit name }
  452. current_module^.SetFileName(current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^);
  453. stringdispose(current_module^.modulename);
  454. current_module^.modulename:=stringdup(upper(pattern));
  455. { check for system unit }
  456. new(s1);
  457. new(s2);
  458. s1^:=upper(target_info.system_unit);
  459. s2^:=upper(current_scanner^.inputfile^.name^);
  460. { strip extension, there could only be one dot }
  461. i:=pos('.',s2^);
  462. if i>0 then
  463. s2^:=Copy(s2^,1,i-1);
  464. if (cs_compilesystem in aktmoduleswitches) then
  465. begin
  466. if (cs_check_unit_name in aktglobalswitches) and
  467. ((length(current_module^.modulename^)>8) or
  468. (current_module^.modulename^<>s1^) or
  469. (current_module^.modulename^<>s2^)) then
  470. Message1(unit_e_illegal_unit_name,s1^);
  471. end
  472. else
  473. if (current_module^.modulename^=s1^) then
  474. Message(unit_w_switch_us_missed);
  475. dispose(s2);
  476. dispose(s1);
  477. end;
  478. consume(ID);
  479. consume(SEMICOLON);
  480. consume(_INTERFACE);
  481. { update status }
  482. status.currentmodule:=current_module^.modulename^;
  483. { this should be placed after uses !!}
  484. {$ifndef UseNiceNames}
  485. procprefix:='_'+current_module^.modulename^+'$$';
  486. {$else UseNiceNames}
  487. procprefix:='_'+tostr(length(current_module^.unitname^))+lowercase(current_module^.unitname^)+'_';
  488. {$endif UseNiceNames}
  489. parse_only:=true;
  490. { generate now the global symboltable }
  491. p:=new(punitsymtable,init(globalsymtable,current_module^.modulename^));
  492. refsymtable:=p;
  493. unitst:=punitsymtable(p);
  494. { the unit name must be usable as a unit specifier }
  495. { inside the unit itself (PM) }
  496. { this also forbids to have another symbol }
  497. { with the same name as the unit }
  498. refsymtable^.insert(new(punitsym,init(current_module^.modulename^,unitst)));
  499. { set the symbol table for the current unit }
  500. { this must be set later for interdependency }
  501. { current_module^.symtable:=psymtable(p); }
  502. { a unit compiled at command line must be inside the loaded_unit list }
  503. if (compile_level=1) then
  504. loaded_units.insert(current_module);
  505. { insert qualifier for the system unit (allows system.writeln) }
  506. if not(cs_compilesystem in aktmoduleswitches) then
  507. begin
  508. { insert the system unit }
  509. { it is allways the first }
  510. systemunit^.next:=nil;
  511. symtablestack:=systemunit;
  512. refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
  513. if token=_USES then
  514. begin
  515. unitst^.symtabletype:=unitsymtable;
  516. loadunits;
  517. { has it been compiled at a higher level ?}
  518. if current_module^.compiled then
  519. exit;
  520. unitst^.symtabletype:=globalsymtable;
  521. end;
  522. { ... but insert the symbol table later }
  523. p^.next:=symtablestack;
  524. symtablestack:=p;
  525. end
  526. else
  527. { while compiling a system unit, some types are directly inserted }
  528. begin
  529. p^.next:=symtablestack;
  530. symtablestack:=p;
  531. insert_intern_types(p);
  532. end;
  533. { displaced for inter-dependency considerations }
  534. current_module^.symtable:=psymtable(p);
  535. constsymtable:=symtablestack;
  536. { ... parse the declarations }
  537. read_interface_declarations;
  538. { Parse the implementation section }
  539. consume(_IMPLEMENTATION);
  540. current_module^.in_implementation:=true;
  541. parse_only:=false;
  542. {$ifdef GDB}
  543. { add all used definitions even for implementation}
  544. if (cs_debuginfo in aktmoduleswitches) then
  545. begin
  546. { all types }
  547. punitsymtable(refsymtable)^.concattypestabto(debuglist);
  548. { and all local symbols}
  549. refsymtable^.concatstabto(debuglist);
  550. end;
  551. {$endif GDB}
  552. { generates static symbol table }
  553. p:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
  554. {Generate a procsym.}
  555. make_ref:=false;
  556. aktprocsym:=new(Pprocsym,init(current_module^.modulename^+'_init'));
  557. aktprocsym^.definition:=new(Pprocdef,init);
  558. aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pounitinit;
  559. aktprocsym^.definition^.setmangledname(current_module^.modulename^+'_init');
  560. make_ref:=true;
  561. {The generated procsym has a local symtable. Discard it and turn
  562. it into the static one.}
  563. dispose(aktprocsym^.definition^.localst,done);
  564. aktprocsym^.definition^.localst:=p;
  565. { remove the globalsymtable from the symtable stack }
  566. { to reinsert it after loading the implementation units }
  567. symtablestack:=unitst^.next;
  568. { number the definitions, so a deref from other units works }
  569. refsymtable^.number_defs;
  570. { Read the implementation units }
  571. parse_implementation_uses(unitst);
  572. numberunits;
  573. { now we can change refsymtable }
  574. refsymtable:=p;
  575. { but reinsert the global symtable as lasts }
  576. unitst^.next:=symtablestack;
  577. symtablestack:=unitst;
  578. {$ifdef DEBUG}
  579. test_symtablestack;
  580. {$endif DEBUG}
  581. constsymtable:=symtablestack;
  582. {$ifdef Splitheap}
  583. if testsplit then
  584. begin
  585. Split_Heap;
  586. allow_special:=true;
  587. Switch_to_temp_heap;
  588. end;
  589. { it will report all crossings }
  590. allow_special:=false;
  591. {$endif Splitheap}
  592. { set some informations }
  593. procinfo.retdef:=voiddef;
  594. procinfo._class:=nil;
  595. procinfo.call_offset:=8;
  596. { for temporary values }
  597. procinfo.framepointer:=frame_pointer;
  598. { clear flags }
  599. procinfo.flags:=0;
  600. { Create a new procedure }
  601. codegen_newprocedure;
  602. { Compile the unit }
  603. names.init;
  604. names.insert(current_module^.modulename^+'_init');
  605. names.insert('INIT$$'+current_module^.modulename^);
  606. compile_proc_body(names,true,false);
  607. names.done;
  608. { Shutdown the codegen for this procedure }
  609. codegen_doneprocedure;
  610. {$ifdef dummy}
  611. if token=_FINALIZATION then
  612. begin
  613. current_module^.flags:=current_module^.flags or uf_finalize;
  614. { clear flags }
  615. procinfo.flags:=0;
  616. {Reset the codegenerator.}
  617. codegen_newprocedure;
  618. names.init;
  619. names.insert(current_module^.modulename^+'_finalize');
  620. names.insert('FINALIZE$$'+current_module^.modulename^);
  621. compile_proc_body(names,true,false);
  622. names.done;
  623. codegen_doneprocedure;
  624. end;
  625. {$endif dummy}
  626. consume(POINT);
  627. { size of the static data }
  628. datasize:=symtablestack^.datasize;
  629. { unsed static symbols ? }
  630. symtablestack^.allsymbolsused;
  631. {$ifdef GDB}
  632. { add all used definitions even for implementation}
  633. if (cs_debuginfo in aktmoduleswitches) then
  634. begin
  635. { all types }
  636. punitsymtable(symtablestack)^.concattypestabto(debuglist);
  637. { and all local symbols}
  638. symtablestack^.concatstabto(debuglist);
  639. end;
  640. {$endif GDB}
  641. current_module^.in_implementation:=false;
  642. { deletes all symtables generated in the implementation part }
  643. while symtablestack^.symtabletype<>globalsymtable do
  644. dellexlevel;
  645. { tests, if all forwards are resolved }
  646. symtablestack^.check_forwards;
  647. symtablestack^.symtabletype:=unitsymtable;
  648. punitsymtable(symtablestack)^.is_stab_written:=false;
  649. { insert own objectfile }
  650. insertobjectfile;
  651. {Write out the unit if the compile was succesfull.}
  652. if status.errorcount=0 then
  653. writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack));
  654. pu:=pused_unit(usedunits.first);
  655. while assigned(pu) do
  656. begin
  657. punitsymtable(pu^.u^.symtable)^.is_stab_written:=false;
  658. pu:=pused_unit(pu^.next);
  659. end;
  660. inc(datasize,symtablestack^.datasize);
  661. { leave when we got an error }
  662. if status.errorcount>0 then
  663. exit;
  664. { generate imports }
  665. if current_module^.uses_imports then
  666. importlib^.generatelib;
  667. { finish asmlist by adding segment starts }
  668. insertsegment;
  669. { assemble }
  670. create_objectfile;
  671. end;
  672. procedure proc_program(islibrary : boolean);
  673. var
  674. st : psymtable;
  675. names : Tstringcontainer;
  676. begin
  677. parse_only:=false;
  678. if islibrary then
  679. begin
  680. consume(_LIBRARY);
  681. stringdispose(current_module^.modulename);
  682. current_module^.modulename:=stringdup(pattern);
  683. consume(ID);
  684. consume(SEMICOLON);
  685. end
  686. else
  687. { is there an program head ? }
  688. if token=_PROGRAM then
  689. begin
  690. consume(_PROGRAM);
  691. stringdispose(current_module^.modulename);
  692. current_module^.modulename:=stringdup(pattern);
  693. consume(ID);
  694. if token=LKLAMMER then
  695. begin
  696. consume(LKLAMMER);
  697. idlist;
  698. consume(RKLAMMER);
  699. end;
  700. consume(SEMICOLON);
  701. end;
  702. { set implementation flag }
  703. current_module^.in_implementation:=true;
  704. { insert after the unit symbol tables the static symbol table }
  705. { of the program }
  706. st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
  707. {Generate a procsym.}
  708. make_ref:=false;
  709. aktprocsym:=new(Pprocsym,init('main'));
  710. aktprocsym^.definition:=new(Pprocdef,init);
  711. aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poproginit;
  712. aktprocsym^.definition^.setmangledname(target_os.Cprefix+'main');
  713. make_ref:=true;
  714. {The localst is a local symtable. Change it into the static
  715. symtable.}
  716. dispose(aktprocsym^.definition^.localst,done);
  717. aktprocsym^.definition^.localst:=st;
  718. refsymtable:=st;
  719. { necessary for browser }
  720. loaded_units.insert(current_module);
  721. {Insert the symbols of the system unit into the stack of symbol
  722. tables.}
  723. symtablestack:=systemunit;
  724. systemunit^.next:=nil;
  725. refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
  726. {Load the units used by the program we compile.}
  727. if token=_USES then
  728. loadunits;
  729. {Insert the name of the main program into the symbol table.}
  730. if current_module^.modulename^<>'' then
  731. st^.insert(new(pprogramsym,init(current_module^.modulename^)));
  732. { ...is also constsymtable, this is the symtable where }
  733. { the elements of enumeration types are inserted }
  734. constsymtable:=st;
  735. { set some informations about the main program }
  736. with procinfo do
  737. begin
  738. retdef:=voiddef;
  739. _class:=nil;
  740. call_offset:=8;
  741. framepointer:=frame_pointer;
  742. flags:=0;
  743. end;
  744. procprefix:='';
  745. in_except_block:=false;
  746. codegen_newprocedure;
  747. {The program intialization needs an alias, so it can be called
  748. from the bootstrap code.}
  749. names.init;
  750. names.insert('program_init');
  751. names.insert('PASCALMAIN');
  752. names.insert(target_os.cprefix+'main');
  753. compile_proc_body(names,true,false);
  754. names.done;
  755. codegen_doneprocedure;
  756. consume(POINT);
  757. { leave when we got an error }
  758. if status.errorcount>0 then
  759. exit;
  760. { insert heap }
  761. insertheap;
  762. { generate imports }
  763. if current_module^.uses_imports then
  764. importlib^.generatelib;
  765. inserttargetspecific;
  766. datasize:=symtablestack^.datasize;
  767. { finish asmlist by adding segment starts }
  768. insertsegment;
  769. { insert own objectfile }
  770. insertobjectfile;
  771. { assemble and link }
  772. create_objectfile;
  773. { create the executable when we are at level 1 }
  774. if (compile_level=1) then
  775. begin
  776. if (cs_link_deffile in aktglobalswitches) then
  777. deffile.writefile;
  778. if (not current_module^.is_unit) then
  779. Linker.MakeExecutable;
  780. end;
  781. end;
  782. end.
  783. {
  784. $Log$
  785. Revision 1.42 1998-08-19 18:04:54 peter
  786. * fixed current_module^.in_implementation flag
  787. Revision 1.41 1998/08/17 10:10:08 peter
  788. - removed OLDPPU
  789. Revision 1.40 1998/08/17 09:17:50 peter
  790. * static/shared linking updates
  791. Revision 1.39 1998/08/14 21:56:37 peter
  792. * setting the outputfile using -o works now to create static libs
  793. Revision 1.38 1998/08/10 14:50:13 peter
  794. + localswitches, moduleswitches, globalswitches splitting
  795. Revision 1.37 1998/08/10 10:18:31 peter
  796. + Compiler,Comphook unit which are the new interface units to the
  797. compiler
  798. Revision 1.36 1998/07/14 14:46:54 peter
  799. * released NEWINPUT
  800. Revision 1.35 1998/07/08 12:39:38 peter
  801. * heap_size for m68k
  802. Revision 1.34 1998/07/07 11:20:03 peter
  803. + NEWINPUT for a better inputfile and scanner object
  804. Revision 1.33 1998/06/25 11:15:34 pierre
  805. * ppu files where not closed in newppu !!
  806. second compilation was impossible due to too many opened files
  807. (not visible in 'make cycle' as we remove all the ppu files)
  808. Revision 1.32 1998/06/25 08:48:16 florian
  809. * first version of rtti support
  810. Revision 1.31 1998/06/24 14:48:35 peter
  811. * ifdef newppu -> ifndef oldppu
  812. Revision 1.30 1998/06/17 14:10:16 peter
  813. * small os2 fixes
  814. * fixed interdependent units with newppu (remake3 under linux works now)
  815. Revision 1.29 1998/06/16 08:56:25 peter
  816. + targetcpu
  817. * cleaner pmodules for newppu
  818. Revision 1.28 1998/06/13 00:10:10 peter
  819. * working browser and newppu
  820. * some small fixes against crashes which occured in bp7 (but not in
  821. fpc?!)
  822. Revision 1.27 1998/06/11 13:58:08 peter
  823. * small fix to let newppu compile
  824. Revision 1.26 1998/06/09 16:01:47 pierre
  825. + added procedure directive parsing for procvars
  826. (accepted are popstack cdecl and pascal)
  827. + added C vars with the following syntax
  828. var C calias 'true_c_name';(can be followed by external)
  829. reason is that you must add the Cprefix
  830. which is target dependent
  831. Revision 1.25 1998/06/08 22:59:49 peter
  832. * smartlinking works for win32
  833. * some defines to exclude some compiler parts
  834. Revision 1.24 1998/06/08 13:13:44 pierre
  835. + temporary variables now in temp_gen.pas unit
  836. because it is processor independent
  837. * mppc68k.bat modified to undefine i386 and support_mmx
  838. (which are defaults for i386)
  839. Revision 1.23 1998/06/05 17:47:29 peter
  840. * some better uses clauses
  841. Revision 1.22 1998/06/05 14:37:34 pierre
  842. * fixes for inline for operators
  843. * inline procedure more correctly restricted
  844. Revision 1.21 1998/06/04 23:51:53 peter
  845. * m68k compiles
  846. + .def file creation moved to gendef.pas so it could also be used
  847. for win32
  848. Revision 1.20 1998/06/04 09:55:42 pierre
  849. * demangled name of procsym reworked to become independant of the mangling scheme
  850. Revision 1.19 1998/06/03 23:40:38 peter
  851. + unlimited file support, release tempclose
  852. Revision 1.18 1998/06/03 22:49:00 peter
  853. + wordbool,longbool
  854. * rename bis,von -> high,low
  855. * moved some systemunit loading/creating to psystem.pas
  856. Revision 1.17 1998/05/28 14:40:25 peter
  857. * fixes for newppu, remake3 works now with it
  858. Revision 1.16 1998/05/27 19:45:06 peter
  859. * symtable.pas splitted into includefiles
  860. * symtable adapted for $ifdef NEWPPU
  861. Revision 1.15 1998/05/23 01:21:22 peter
  862. + aktasmmode, aktoptprocessor, aktoutputformat
  863. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  864. + $LIBNAME to set the library name where the unit will be put in
  865. * splitted cgi386 a bit (codeseg to large for bp7)
  866. * nasm, tasm works again. nasm moved to ag386nsm.pas
  867. Revision 1.14 1998/05/20 09:42:35 pierre
  868. + UseTokenInfo now default
  869. * unit in interface uses and implementation uses gives error now
  870. * only one error for unknown symbol (uses lastsymknown boolean)
  871. the problem came from the label code !
  872. + first inlined procedures and function work
  873. (warning there might be allowed cases were the result is still wrong !!)
  874. * UseBrower updated gives a global list of all position of all used symbols
  875. with switch -gb
  876. Revision 1.13 1998/05/12 10:47:00 peter
  877. * moved printstatus to verb_def
  878. + V_Normal which is between V_Error and V_Warning and doesn't have a
  879. prefix like error: warning: and is included in V_Default
  880. * fixed some messages
  881. * first time parameter scan is only for -v and -T
  882. - removed old style messages
  883. Revision 1.12 1998/05/11 13:07:56 peter
  884. + $ifdef NEWPPU for the new ppuformat
  885. + $define GDB not longer required
  886. * removed all warnings and stripped some log comments
  887. * no findfirst/findnext anymore to remove smartlink *.o files
  888. Revision 1.11 1998/05/06 18:36:53 peter
  889. * tai_section extended with code,data,bss sections and enumerated type
  890. * ident 'compiled by FPC' moved to pmodules
  891. * small fix for smartlink
  892. Revision 1.10 1998/05/04 17:54:28 peter
  893. + smartlinking works (only case jumptable left todo)
  894. * redesign of systems.pas to support assemblers and linkers
  895. + Unitname is now also in the PPU-file, increased version to 14
  896. Revision 1.9 1998/05/01 16:38:45 florian
  897. * handling of private and protected fixed
  898. + change_keywords_to_tp implemented to remove
  899. keywords which aren't supported by tp
  900. * break and continue are now symbols of the system unit
  901. + widestring, longstring and ansistring type released
  902. Revision 1.8 1998/04/30 15:59:41 pierre
  903. * GDB works again better :
  904. correct type info in one pass
  905. + UseTokenInfo for better source position
  906. * fixed one remaining bug in scanner for line counts
  907. * several little fixes
  908. Revision 1.7 1998/04/29 10:33:59 pierre
  909. + added some code for ansistring (not complete nor working yet)
  910. * corrected operator overloading
  911. * corrected nasm output
  912. + started inline procedures
  913. + added starstarn : use ** for exponentiation (^ gave problems)
  914. + started UseTokenInfo cond to get accurate positions
  915. Revision 1.6 1998/04/27 23:10:28 peter
  916. + new scanner
  917. * $makelib -> if smartlink
  918. * small filename fixes pmodule.setfilename
  919. * moved import from files.pas -> import.pas
  920. Revision 1.5 1998/04/14 23:27:03 florian
  921. + exclude/include with constant second parameter added
  922. Revision 1.4 1998/04/10 14:41:43 peter
  923. * removed some Hints
  924. * small speed optimization for AsmLn
  925. Revision 1.3 1998/04/03 09:51:00 daniel
  926. * Fixed heap allocation for OS/2.
  927. }