1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561 |
- {
- Copyright (c) 1998-2002 by Florian Klaempfl
- Handles the parsing and loading of the modules (ppufiles)
- 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 pmodules;
- {$i fpcdefs.inc}
- interface
- procedure proc_unit;
- procedure proc_program(islibrary : boolean);
- implementation
- uses
- globtype,version,systems,tokens,
- cutils,cclasses,comphook,
- globals,verbose,fmodule,finput,fppu,
- symconst,symbase,symtype,symdef,symsym,symtable,
- aasmtai,aasmcpu,aasmbase,
- cgbase,cgobj,
- nbas,ncgutil,
- link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
- cresstr,procinfo,
- dwarf,pexports,
- scanner,pbase,pexpr,psystem,psub,pdecsub;
- procedure create_objectfile;
- var
- DLLScanner : TDLLScanner;
- s : string;
- KeepShared : TStringList;
- begin
- { try to create import entries from system dlls }
- if target_info.DllScanSupported and
- (not current_module.linkOtherSharedLibs.Empty) then
- begin
- { Init DLLScanner }
- if assigned(CDLLScanner[target_info.system]) then
- DLLScanner:=CDLLScanner[target_info.system].Create
- else
- internalerror(200104121);
- KeepShared:=TStringList.Create;
- { Walk all shared libs }
- While not current_module.linkOtherSharedLibs.Empty do
- begin
- S:=current_module.linkOtherSharedLibs.Getusemask(link_allways);
- if not DLLScanner.scan(s) then
- KeepShared.Concat(s);
- end;
- DLLscanner.Free;
- { Recreate import section }
- if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
- begin
- if assigned(asmlist[al_imports]) then
- asmlist[al_imports].clear
- else
- asmlist[al_imports]:=taasmoutput.Create;
- importlib.generatelib;
- end;
- { Readd the not processed files }
- while not KeepShared.Empty do
- begin
- s:=KeepShared.GetFirst;
- current_module.linkOtherSharedLibs.add(s,link_allways);
- end;
- KeepShared.Free;
- end;
- { Start and end module debuginfo, at least required for stabs
- to insert n_sourcefile lines }
- if (cs_debuginfo in aktmoduleswitches) or
- (cs_use_lineinfo in aktglobalswitches) then
- debuginfo.insertmoduleinfo;
- { create the .s file and assemble it }
- GenerateAsm(false);
- { Also create a smartlinked version ? }
- if (cs_create_smart in aktmoduleswitches) and
- not(af_smartlink_sections in target_asm.flags) then
- begin
- { regenerate the importssection for win32 }
- if assigned(asmlist[al_imports]) and
- (target_info.system in [system_i386_win32,system_i386_wdosx, system_arm_wince,system_i386_wince]) then
- begin
- asmlist[al_imports].clear;
- importlib.generatesmartlib;
- end;
- GenerateAsm(true);
- if (af_needar in target_asm.flags) then
- Linker.MakeStaticLibrary;
- end;
- { resource files }
- CompileResourceFiles;
- end;
- procedure insertobjectfile;
- { Insert the used object file for this unit in the used list for this unit }
- begin
- current_module.linkunitofiles.add(current_module.objfilename^,link_static);
- current_module.flags:=current_module.flags or uf_static_linked;
- if (cs_create_smart in aktmoduleswitches) and
- not(af_smartlink_sections in target_asm.flags) then
- begin
- current_module.linkunitstaticlibs.add(current_module.staticlibfilename^,link_smart);
- current_module.flags:=current_module.flags or uf_smart_linked;
- end;
- end;
- procedure create_dwarf;
- begin
- asmlist[al_dwarf]:=taasmoutput.create;
- { Call frame information }
- if (tf_needs_dwarf_cfi in target_info.flags) and
- (af_supports_dwarf in target_asm.flags) then
- dwarfcfi.generate_code(asmlist[al_dwarf]);
- end;
- {$ifndef segment_threadvars}
- procedure InsertThreadvarTablesTable;
- var
- hp : tused_unit;
- ltvTables : taasmoutput;
- count : longint;
- begin
- ltvTables:=TAAsmOutput.Create;
- count:=0;
- hp:=tused_unit(usedunits.first);
- while assigned(hp) do
- begin
- If (hp.u.flags and uf_threadvars)=uf_threadvars then
- begin
- ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),AT_DATA,0));
- inc(count);
- end;
- hp:=tused_unit(hp.next);
- end;
- { Add program threadvars, if any }
- If (current_module.flags and uf_threadvars)=uf_threadvars then
- begin
- ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',current_module.localsymtable,''),AT_DATA,0));
- inc(count);
- end;
- { Insert TableCount at start }
- ltvTables.insert(Tai_const.Create_32bit(count));
- { insert in data segment }
- maybe_new_object_file(asmlist[al_globals]);
- new_section(asmlist[al_globals],sec_data,'FPC_THREADVARTABLES',sizeof(aint));
- asmlist[al_globals].concat(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0));
- asmlist[al_globals].concatlist(ltvTables);
- asmlist[al_globals].concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
- ltvTables.free;
- end;
- procedure AddToThreadvarList(p:tnamedindexitem;arg:pointer);
- var
- ltvTable : taasmoutput;
- begin
- ltvTable:=taasmoutput(arg);
- if (tsym(p).typ=globalvarsym) and
- (vo_is_thread_var in tglobalvarsym(p).varoptions) then
- begin
- { address of threadvar }
- ltvTable.concat(tai_const.Createname(tglobalvarsym(p).mangledname,AT_DATA,0));
- { size of threadvar }
- ltvTable.concat(tai_const.create_32bit(tglobalvarsym(p).getsize));
- end;
- end;
- procedure InsertThreadvars;
- var
- s : string;
- ltvTable : TAAsmoutput;
- begin
- ltvTable:=TAAsmoutput.create;
- if assigned(current_module.globalsymtable) then
- current_module.globalsymtable.foreach_static(@AddToThreadvarList,ltvTable);
- current_module.localsymtable.foreach_static(@AddToThreadvarList,ltvTable);
- if ltvTable.first<>nil then
- begin
- s:=make_mangledname('THREADVARLIST',current_module.localsymtable,'');
- { end of the list marker }
- ltvTable.concat(tai_const.create_sym(nil));
- { add to datasegment }
- maybe_new_object_file(asmlist[al_globals]);
- new_section(asmlist[al_globals],sec_data,s,sizeof(aint));
- asmlist[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
- asmlist[al_globals].concatlist(ltvTable);
- asmlist[al_globals].concat(Tai_symbol_end.Createname(s));
- current_module.flags:=current_module.flags or uf_threadvars;
- end;
- ltvTable.Free;
- end;
- {$endif}
- Procedure InsertResourceInfo;
- var
- hp : tused_unit;
- found : Boolean;
- I : Integer;
- ResourceInfo : taasmoutput;
- begin
- if target_res.id=res_elf then
- begin
- hp:=tused_unit(usedunits.first);
- found:=false;
- Found:=((current_module.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
- If not found then
- While Assigned(hp) and not Found do
- begin
- Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
- hp:=tused_unit(hp.next);
- end;
- ResourceInfo:=TAAsmOutput.Create;
- if found then
- begin
- { Valid pointer to resource information }
- ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
- ResourceInfo.concat(Tai_const.Createname('FPC_RESSYMBOL',AT_DATA,0));
- {$ifdef EXTERNALRESPTRS}
- current_module.linkotherofiles.add('resptrs.o',link_allways);
- {$else EXTERNALRESPTRS}
- new_section(ResourceInfo,sec_fpc,'resptrs',4);
- ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESSYMBOL',AT_DATA,0));
- For I:=1 to 32 do
- ResourceInfo.Concat(Tai_const.Create_32bit(0));
- {$endif EXTERNALRESPTRS}
- end
- else
- begin
- { Nil pointer to resource information }
- ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
- ResourceInfo.Concat(Tai_const.Create_32bit(0));
- end;
- maybe_new_object_file(asmlist[al_globals]);
- asmlist[al_globals].concatlist(ResourceInfo);
- ResourceInfo.free;
- end;
- end;
- Procedure InsertResourceTablesTable;
- var
- hp : tused_unit;
- ResourceStringTables : taasmoutput;
- count : longint;
- begin
- ResourceStringTables:=TAAsmOutput.Create;
- count:=0;
- hp:=tused_unit(usedunits.first);
- while assigned(hp) do
- begin
- If (hp.u.flags and uf_has_resources)=uf_has_resources then
- begin
- ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESOURCESTRINGLIST',hp.u.globalsymtable,''),AT_DATA,0));
- inc(count);
- end;
- hp:=tused_unit(hp.next);
- end;
- { Add program resources, if any }
- If resourcestrings.ResStrCount>0 then
- begin
- ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),AT_DATA,0));
- Inc(Count);
- end;
- { Insert TableCount at start }
- ResourceStringTables.insert(Tai_const.Create_32bit(count));
- { Add to data segment }
- maybe_new_object_file(asmlist[al_globals]);
- new_section(asmlist[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',sizeof(aint));
- asmlist[al_globals].concat(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0));
- asmlist[al_globals].concatlist(ResourceStringTables);
- asmlist[al_globals].concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
- ResourceStringTables.free;
- end;
- procedure InsertInitFinalTable;
- var
- hp : tused_unit;
- unitinits : taasmoutput;
- count : longint;
- begin
- unitinits:=TAAsmOutput.Create;
- count:=0;
- hp:=tused_unit(usedunits.first);
- while assigned(hp) do
- begin
- { call the unit init code and make it external }
- if (hp.u.flags and (uf_init or uf_finalize))<>0 then
- begin
- if (hp.u.flags and uf_init)<>0 then
- unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),AT_FUNCTION,0))
- else
- unitinits.concat(Tai_const.Create_sym(nil));
- if (hp.u.flags and uf_finalize)<>0 then
- unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),AT_FUNCTION,0))
- else
- unitinits.concat(Tai_const.Create_sym(nil));
- inc(count);
- end;
- hp:=tused_unit(hp.next);
- end;
- { Insert initialization/finalization of the program }
- if (current_module.flags and (uf_init or uf_finalize))<>0 then
- begin
- if (current_module.flags and uf_init)<>0 then
- unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),AT_FUNCTION,0))
- else
- unitinits.concat(Tai_const.Create_sym(nil));
- if (current_module.flags and uf_finalize)<>0 then
- unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),AT_FUNCTION,0))
- else
- unitinits.concat(Tai_const.Create_sym(nil));
- inc(count);
- end;
- { Insert TableCount,InitCount at start }
- unitinits.insert(Tai_const.Create_32bit(0));
- unitinits.insert(Tai_const.Create_32bit(count));
- { Add to data segment }
- maybe_new_object_file(asmlist[al_globals]);
- new_section(asmlist[al_globals],sec_data,'INITFINAL',sizeof(aint));
- asmlist[al_globals].concat(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0));
- asmlist[al_globals].concatlist(unitinits);
- asmlist[al_globals].concat(Tai_symbol_end.Createname('INITFINAL'));
- unitinits.free;
- end;
- procedure insertmemorysizes;
- begin
- { stacksize can be specified and is now simulated }
- maybe_new_object_file(asmlist[al_globals]);
- new_section(asmlist[al_globals],sec_data,'__stklen', sizeof(aint));
- asmlist[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(aint)));
- asmlist[al_globals].concat(Tai_const.Create_aint(stacksize));
- { Initial heapsize }
- maybe_new_object_file(asmlist[al_globals]);
- new_section(asmlist[al_globals],sec_data,'__heapsize',sizeof(aint));
- asmlist[al_globals].concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,sizeof(aint)));
- asmlist[al_globals].concat(Tai_const.Create_aint(heapsize));
- end;
- procedure AddUnit(const s:string);
- var
- hp : tppumodule;
- unitsym : tunitsym;
- begin
- { load unit }
- hp:=registerunit(current_module,s,'');
- hp.loadppu;
- hp.adddependency(current_module);
- { add to symtable stack }
- tsymtable(hp.globalsymtable).next:=symtablestack;
- symtablestack:=hp.globalsymtable;
- if (m_mac in aktmodeswitches) and assigned(hp.globalmacrosymtable) then
- begin
- tsymtable(hp.globalmacrosymtable).next:=macrosymtablestack;
- macrosymtablestack:=hp.globalmacrosymtable;
- end;
- { insert unitsym }
- unitsym:=tunitsym.create(s,hp.globalsymtable);
- inc(unitsym.refs);
- refsymtable.insert(unitsym);
- { add to used units }
- current_module.addusedunit(hp,false,unitsym);
- end;
- procedure maybeloadvariantsunit;
- var
- hp : tmodule;
- begin
- { Do we need the variants unit? Skip this
- for VarUtils unit for bootstrapping }
- if (current_module.flags and uf_uses_variants=0) or
- (current_module.modulename^='VARUTILS') then
- exit;
- { Variants unit already loaded? }
- hp:=tmodule(loaded_units.first);
- while assigned(hp) do
- begin
- if hp.modulename^='VARIANTS' then
- exit;
- hp:=tmodule(hp.next);
- end;
- { Variants unit is not loaded yet, load it now }
- Message(parser_w_implicit_uses_of_variants_unit);
- AddUnit('Variants');
- end;
- procedure loaddefaultunits;
- begin
- { are we compiling the system unit? }
- if (cs_compilesystem in aktmoduleswitches) then
- begin
- { create system defines }
- createconstdefs;
- { we don't need to reset anything, it's already done in parser.pas }
- exit;
- end;
- { insert the system unit, it is allways the first }
- symtablestack:=nil;
- macrosymtablestack:=initialmacrosymtable;
- AddUnit('System');
- SystemUnit:=TGlobalSymtable(Symtablestack);
- { read default constant definitions }
- make_ref:=false;
- readconstdefs;
- make_ref:=true;
- { Set the owner of errorsym and errortype to symtable to
- prevent crashes when accessing .owner }
- generrorsym.owner:=systemunit;
- generrortype.def.owner:=systemunit;
- { Units only required for main module }
- { load heaptrace before any other units especially objpas }
- if not(current_module.is_unit) then
- begin
- { Heaptrc unit }
- if (cs_use_heaptrc in aktglobalswitches) then
- AddUnit('HeapTrc');
- { Lineinfo unit }
- if (cs_use_lineinfo in aktglobalswitches) then
- AddUnit('LineInfo');
- { Lineinfo unit }
- if (cs_gdb_valgrind in aktglobalswitches) then
- AddUnit('CMem');
- {$ifdef cpufpemu}
- { Floating point emulation unit? }
- if (cs_fp_emulation in aktmoduleswitches) and not(target_info.system in system_wince) then
- AddUnit('SoftFpu');
- {$endif cpufpemu}
- end;
- { Objpas unit? }
- if m_objpas in aktmodeswitches then
- AddUnit('ObjPas');
- { Macpas unit? }
- if m_mac in aktmodeswitches then
- AddUnit('MacPas');
- { Profile unit? Needed for go32v2 only }
- if (cs_profile in aktmoduleswitches) and
- (target_info.system in [system_i386_go32v2,system_i386_watcom]) then
- AddUnit('Profile');
- if (cs_load_fpcylix_unit in aktglobalswitches) then
- begin
- AddUnit('FPCylix');
- AddUnit('DynLibs');
- end;
- { save default symtablestack }
- defaultsymtablestack:=symtablestack;
- defaultmacrosymtablestack:=macrosymtablestack;
- end;
- procedure loadautounits;
- var
- hs,s : string;
- begin
- hs:=autoloadunits;
- repeat
- s:=GetToken(hs,',');
- if s='' then
- break;
- AddUnit(s);
- until false;
- end;
- procedure loadunits;
- var
- s,sorg : stringid;
- fn : string;
- pu : tused_unit;
- hp2 : tmodule;
- hp3 : tsymtable;
- unitsym : tunitsym;
- top_of_macrosymtable : tsymtable;
- begin
- consume(_USES);
- {$ifdef DEBUG}
- test_symtablestack;
- {$endif DEBUG}
- repeat
- s:=pattern;
- sorg:=orgpattern;
- consume(_ID);
- { support "<unit> in '<file>'" construct, but not for tp7 }
- if not(m_tp7 in aktmodeswitches) then
- begin
- if try_to_consume(_OP_IN) then
- fn:=FixFileName(get_stringconst)
- else
- fn:='';
- end;
- { Give a warning if objpas is loaded }
- if s='OBJPAS' then
- Message(parser_w_no_objpas_use_mode);
- { Using the unit itself is not possible }
- if (s<>current_module.modulename^) then
- begin
- { check if the unit is already used }
- hp2:=nil;
- pu:=tused_unit(current_module.used_units.first);
- while assigned(pu) do
- begin
- if (pu.u.modulename^=s) then
- begin
- hp2:=pu.u;
- break;
- end;
- pu:=tused_unit(pu.next);
- end;
- if not assigned(hp2) then
- hp2:=registerunit(current_module,sorg,fn)
- else
- Message1(sym_e_duplicate_id,s);
- { Create unitsym, we need to use the name as specified, we
- can not use the modulename because that can be different
- when -Un is used }
- unitsym:=tunitsym.create(sorg,nil);
- refsymtable.insert(unitsym);
- { the current module uses the unit hp2 }
- current_module.addusedunit(hp2,true,unitsym);
- end
- else
- Message1(sym_e_duplicate_id,s);
- if token=_COMMA then
- begin
- pattern:='';
- consume(_COMMA);
- end
- else
- break;
- until false;
- { Load the units }
- top_of_macrosymtable:= macrosymtablestack;
- pu:=tused_unit(current_module.used_units.first);
- while assigned(pu) do
- begin
- { Only load the units that are in the current
- (interface/implementation) uses clause }
- if pu.in_uses and
- (pu.in_interface=current_module.in_interface) then
- begin
- tppumodule(pu.u).loadppu;
- { is our module compiled? then we can stop }
- if current_module.state=ms_compiled then
- exit;
- { add this unit to the dependencies }
- pu.u.adddependency(current_module);
- { save crc values }
- pu.checksum:=pu.u.crc;
- pu.interface_checksum:=pu.u.interface_crc;
- { connect unitsym to the globalsymtable of the unit }
- pu.unitsym.unitsymtable:=pu.u.globalsymtable;
- end;
- pu:=tused_unit(pu.next);
- end;
- { set the symtable to systemunit so it gets reorderd correctly,
- then insert the units in the symtablestack }
- pu:=tused_unit(current_module.used_units.first);
- symtablestack:=defaultsymtablestack;
- macrosymtablestack:=defaultmacrosymtablestack;
- while assigned(pu) do
- begin
- if pu.in_uses then
- begin
- { Reinsert in symtablestack }
- hp3:=symtablestack;
- while assigned(hp3) do
- begin
- { insert units only once ! }
- if pu.u.globalsymtable=hp3 then
- break;
- hp3:=hp3.next;
- { unit isn't inserted }
- if hp3=nil then
- begin
- tsymtable(pu.u.globalsymtable).next:=symtablestack;
- symtablestack:=tsymtable(pu.u.globalsymtable);
- if (m_mac in aktmodeswitches) and assigned(pu.u.globalmacrosymtable) then
- begin
- tsymtable(pu.u.globalmacrosymtable).next:=macrosymtablestack;
- macrosymtablestack:=tsymtable(pu.u.globalmacrosymtable);
- end;
- {$ifdef DEBUG}
- test_symtablestack;
- {$endif DEBUG}
- end;
- end;
- end;
- pu:=tused_unit(pu.next);
- end;
- if assigned (current_module.globalmacrosymtable) then
- top_of_macrosymtable.next.next:= macrosymtablestack
- else
- top_of_macrosymtable.next:= macrosymtablestack;
- macrosymtablestack:= top_of_macrosymtable;
- consume(_SEMICOLON);
- end;
- procedure reset_all_defs;
- procedure reset_used_unit_defs(hp:tmodule);
- var
- pu : tused_unit;
- begin
- pu:=tused_unit(hp.used_units.first);
- while assigned(pu) do
- begin
- if not pu.u.is_reset then
- begin
- { prevent infinte loop for circular dependencies }
- pu.u.is_reset:=true;
- if assigned(pu.u.globalsymtable) then
- begin
- tglobalsymtable(pu.u.globalsymtable).reset_all_defs;
- reset_used_unit_defs(pu.u);
- end;
- end;
- pu:=tused_unit(pu.next);
- end;
- end;
- var
- hp2 : tmodule;
- begin
- hp2:=tmodule(loaded_units.first);
- while assigned(hp2) do
- begin
- hp2.is_reset:=false;
- hp2:=tmodule(hp2.next);
- end;
- reset_used_unit_defs(current_module);
- end;
- procedure free_localsymtables(st:tsymtable);
- var
- def : tstoreddef;
- pd : tprocdef;
- begin
- def:=tstoreddef(st.defindex.first);
- while assigned(def) do
- begin
- if def.deftype=procdef then
- begin
- pd:=tprocdef(def);
- if assigned(pd.localst) and
- (pd.localst.symtabletype<>staticsymtable) and
- not((po_inline in pd.procoptions) or
- ((current_module.flags and uf_local_browser)<>0)) then
- begin
- free_localsymtables(pd.localst);
- pd.localst.free;
- pd.localst:=nil;
- end;
- end;
- def:=tstoreddef(def.indexnext);
- end;
- end;
- procedure parse_implementation_uses;
- begin
- if token=_USES then
- begin
- loadunits;
- {$ifdef DEBUG}
- test_symtablestack;
- {$endif DEBUG}
- end;
- end;
- procedure setupglobalswitches;
- begin
- { can't have local browser when no global browser }
- if (cs_local_browser in aktmoduleswitches) and
- not(cs_browser in aktmoduleswitches) then
- exclude(aktmoduleswitches,cs_local_browser);
- if (cs_create_pic in aktmoduleswitches) then
- def_system_macro('FPC_PIC');
- end;
- function create_main_proc(const name:string;potype:tproctypeoption;st:tsymtable):tprocdef;
- var
- stt : tsymtable;
- ps : tprocsym;
- pd : tprocdef;
- begin
- { there should be no current_procinfo available }
- if assigned(current_procinfo) then
- internalerror(200304275);
- {Generate a procsym for main}
- make_ref:=false;
- { try to insert in in static symtable ! }
- stt:=symtablestack;
- symtablestack:=st;
- { generate procsym }
- ps:=tprocsym.create('$'+name);
- { main are allways used }
- inc(ps.refs);
- symtablestack.insert(ps);
- pd:=tprocdef.create(main_program_level);
- include(pd.procoptions,po_global);
- pd.procsym:=ps;
- ps.addprocdef(pd);
- { restore symtable }
- make_ref:=true;
- symtablestack:=stt;
- { set procdef options }
- pd.proctypeoption:=potype;
- pd.proccalloption:=pocall_default;
- pd.forwarddef:=false;
- pd.setmangledname(target_info.cprefix+name);
- pd.aliasnames.insert(pd.mangledname);
- handle_calling_convention(pd);
- { We don't need is a local symtable. Change it into the static
- symtable }
- pd.localst.free;
- pd.localst:=st;
- { set procinfo and current_procinfo.procdef }
- current_procinfo:=cprocinfo.create(nil);
- current_module.procinfo:=current_procinfo;
- current_procinfo.procdef:=pd;
- { return procdef }
- create_main_proc:=pd;
- { main proc does always a call e.g. to init system unit }
- include(current_procinfo.flags,pi_do_call);
- end;
- procedure release_main_proc(pd:tprocdef);
- begin
- { this is a main proc, so there should be no parent }
- if not(assigned(current_procinfo)) or
- assigned(current_procinfo.parent) or
- not(current_procinfo.procdef=pd) then
- internalerror(200304276);
- { remove procinfo }
- current_module.procinfo:=nil;
- current_procinfo.free;
- current_procinfo:=nil;
- { remove localst as it was replaced by staticsymtable }
- pd.localst:=nil;
- end;
- procedure gen_implicit_initfinal(flag:word;st:tsymtable);
- var
- pd : tprocdef;
- begin
- { update module flags }
- current_module.flags:=current_module.flags or flag;
- { create procdef }
- case flag of
- uf_init :
- begin
- pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit'),potype_unitinit,st);
- pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
- end;
- uf_finalize :
- begin
- pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit'),potype_unitfinalize,st);
- pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
- end;
- else
- internalerror(200304253);
- end;
- tcgprocinfo(current_procinfo).code:=cnothingnode.create;
- tcgprocinfo(current_procinfo).generate_code;
- release_main_proc(pd);
- end;
- procedure delete_duplicate_macros(p:TNamedIndexItem; arg:pointer);
- var
- hp: tsymentry;
- begin
- hp:= current_module.localmacrosymtable.search(p.name);
- if assigned(hp) then
- current_module.localmacrosymtable.delete(hp);
- end;
- procedure proc_unit;
- function is_assembler_generated:boolean;
- var
- hal : tasmlist;
- begin
- result:=false;
- if Errorcount=0 then
- begin
- for hal:=low(Tasmlist) to high(Tasmlist) do
- if not asmlist[hal].empty then
- begin
- result:=true;
- exit;
- end;
- end;
- end;
- var
- main_file: tinputfile;
- st : tsymtable;
- unitst : tglobalsymtable;
- {$ifdef EXTDEBUG}
- store_crc,
- {$endif EXTDEBUG}
- store_interface_crc : cardinal;
- s1,s2 : ^string; {Saves stack space}
- force_init_final : boolean;
- pd : tprocdef;
- unitname8 : string[8];
- has_impl,ag: boolean;
- begin
- if m_mac in aktmodeswitches then
- begin
- ConsolidateMode;
- current_module.mode_switch_allowed:= false;
- end;
- consume(_UNIT);
- if compile_level=1 then
- Status.IsExe:=false;
- if token=_ID then
- begin
- { create filenames and unit name }
- main_file := current_scanner.inputfile;
- while assigned(main_file.next) do
- main_file := main_file.next;
- new(s1);
- s1^:=current_module.modulename^;
- current_module.SetFileName(main_file.path^+main_file.name^,true);
- current_module.SetModuleName(orgpattern);
- { check for system unit }
- new(s2);
- s2^:=upper(SplitName(main_file.name^));
- unitname8:=copy(current_module.modulename^,1,8);
- if (cs_check_unit_name in aktglobalswitches) and
- (
- not(
- (current_module.modulename^=s2^) or
- (
- (length(current_module.modulename^)>8) and
- (unitname8=s2^)
- )
- )
- or
- (
- (length(s1^)>8) and
- (s1^<>current_module.modulename^)
- )
- ) then
- Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
- if (current_module.modulename^='SYSTEM') then
- include(aktmoduleswitches,cs_compilesystem);
- dispose(s2);
- dispose(s1);
- end;
- if (target_info.system in system_unit_program_exports) then
- exportlib.preparelib(current_module.realmodulename^);
- consume(_ID);
- consume(_SEMICOLON);
- consume(_INTERFACE);
- { global switches are read, so further changes aren't allowed }
- current_module.in_global:=false;
- { handle the global switches }
- ConsolidateMode;
- setupglobalswitches;
- message1(unit_u_loading_interface_units,current_module.modulename^);
- { update status }
- status.currentmodule:=current_module.realmodulename^;
- { maybe turn off m_objpas if we are compiling objpas }
- if (current_module.modulename^='OBJPAS') then
- exclude(aktmodeswitches,m_objpas);
- { maybe turn off m_mac if we are compiling macpas }
- if (current_module.modulename^='MACPAS') then
- exclude(aktmodeswitches,m_mac);
- parse_only:=true;
- { generate now the global symboltable }
- st:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
- refsymtable:=st;
- unitst:=tglobalsymtable(st);
- { define first as local to overcome dependency conflicts }
- current_module.localsymtable:=st;
- { the unit name must be usable as a unit specifier }
- { inside the unit itself (PM) }
- { this also forbids to have another symbol }
- { with the same name as the unit }
- refsymtable.insert(tunitsym.create(current_module.realmodulename^,unitst));
- macrosymtablestack:= initialmacrosymtable;
- { load default units, like the system unit }
- loaddefaultunits;
- current_module.localmacrosymtable.next:=macrosymtablestack;
- if assigned(current_module.globalmacrosymtable) then
- begin
- current_module.globalmacrosymtable.next:= current_module.localmacrosymtable;
- macrosymtablestack:=current_module.globalmacrosymtable;
- end
- else
- macrosymtablestack:=current_module.localmacrosymtable;
- { reset }
- make_ref:=true;
- { insert qualifier for the system unit (allows system.writeln) }
- if not(cs_compilesystem in aktmoduleswitches) then
- begin
- if token=_USES then
- begin
- loadunits;
- { has it been compiled at a higher level ?}
- if current_module.state=ms_compiled then
- exit;
- end;
- { ... but insert the symbol table later }
- st.next:=symtablestack;
- symtablestack:=st;
- end
- else
- { while compiling a system unit, some types are directly inserted }
- begin
- st.next:=symtablestack;
- symtablestack:=st;
- insert_intern_types(st);
- end;
- { now we know the place to insert the constants }
- constsymtable:=symtablestack;
- { move the global symtab from the temporary local to global }
- current_module.globalsymtable:=current_module.localsymtable;
- current_module.localsymtable:=nil;
- reset_all_defs;
- { number all units, so we know if a unit is used by this unit or
- needs to be added implicitly }
- current_module.updatemaps;
- { ... parse the declarations }
- Message1(parser_u_parsing_interface,current_module.realmodulename^);
- read_interface_declarations;
- { leave when we got an error }
- if (Errorcount>0) and not status.skip_error then
- begin
- Message1(unit_f_errors_in_unit,tostr(Errorcount));
- status.skip_error:=true;
- exit;
- end;
- { Our interface is compiled, generate CRC and switch to implementation }
- if not(cs_compilesystem in aktmoduleswitches) and
- (Errorcount=0) then
- tppumodule(current_module).getppucrc;
- current_module.in_interface:=false;
- current_module.interface_compiled:=true;
- { First reload all units depending on our interface, we need to do this
- in the implementation part to prevent errorneous circular references }
- reload_flagged_units;
- { Parse the implementation section }
- if (m_mac in aktmodeswitches) and try_to_consume(_END) then
- has_impl:= false
- else
- has_impl:= true;
- parse_only:=false;
- { generates static symbol table }
- st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
- current_module.localsymtable:=st;
- { Swap the positions of the local and global macro sym table}
- if assigned(current_module.globalmacrosymtable) then
- begin
- macrosymtablestack:=current_module.localmacrosymtable;
- current_module.globalmacrosymtable.next:= current_module.localmacrosymtable.next;
- current_module.localmacrosymtable.next:=current_module.globalmacrosymtable;
- current_module.globalmacrosymtable.foreach_static(@delete_duplicate_macros, nil);
- end;
- { remove the globalsymtable from the symtable stack }
- { to reinsert it after loading the implementation units }
- symtablestack:=unitst.next;
- { we don't want implementation units symbols in unitsymtable !! PM }
- refsymtable:=st;
- if has_impl then
- begin
- consume(_IMPLEMENTATION);
- Message1(unit_u_loading_implementation_units,current_module.modulename^);
- { Read the implementation units }
- parse_implementation_uses;
- end;
- if current_module.state=ms_compiled then
- exit;
- { reset ranges/stabs in exported definitions }
- reset_all_defs;
- { All units are read, now give them a number }
- current_module.updatemaps;
- { now we can change refsymtable }
- refsymtable:=st;
- { but reinsert the global symtable as lasts }
- unitst.next:=symtablestack;
- symtablestack:=unitst;
- {$ifdef DEBUG}
- test_symtablestack;
- {$endif DEBUG}
- constsymtable:=symtablestack;
- if has_impl then
- begin
- Message1(parser_u_parsing_implementation,current_module.modulename^);
- if current_module.in_interface then
- internalerror(200212285);
- { Compile the unit }
- pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,st);
- pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
- tcgprocinfo(current_procinfo).parse_body;
- tcgprocinfo(current_procinfo).generate_code;
- tcgprocinfo(current_procinfo).resetprocdef;
- { save file pos for debuginfo }
- current_module.mainfilepos:=current_procinfo.entrypos;
- release_main_proc(pd);
- end;
- { if the unit contains ansi/widestrings, initialization and
- finalization code must be forced }
- force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
- tstaticsymtable(current_module.localsymtable).needs_init_final;
- { should we force unit initialization? }
- { this is a hack, but how can it be done better ? }
- if force_init_final and ((current_module.flags and uf_init)=0) then
- gen_implicit_initfinal(uf_init,st);
- { finalize? }
- if has_impl and (token=_FINALIZATION) then
- begin
- { set module options }
- current_module.flags:=current_module.flags or uf_finalize;
- { Compile the finalize }
- pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,st);
- pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
- tcgprocinfo(current_procinfo).parse_body;
- tcgprocinfo(current_procinfo).generate_code;
- tcgprocinfo(current_procinfo).resetprocdef;
- release_main_proc(pd);
- end
- else if force_init_final then
- gen_implicit_initfinal(uf_finalize,st);
- { the last char should always be a point }
- consume(_POINT);
- { Generate resoucestrings }
- If resourcestrings.ResStrCount>0 then
- begin
- resourcestrings.CreateResourceStringList;
- current_module.flags:=current_module.flags or uf_has_resources;
- { only write if no errors found }
- if (Errorcount=0) then
- resourcestrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
- end;
- if (Errorcount=0) then
- begin
- { tests, if all (interface) forwards are resolved }
- tstoredsymtable(symtablestack).check_forwards;
- { check if all private fields are used }
- tstoredsymtable(symtablestack).allprivatesused;
- { remove cross unit overloads }
- tstoredsymtable(symtablestack).unchain_overloaded;
- { test static symtable }
- tstoredsymtable(st).allsymbolsused;
- tstoredsymtable(st).allprivatesused;
- tstoredsymtable(st).check_forwards;
- tstoredsymtable(st).checklabels;
- tstoredsymtable(st).unchain_overloaded;
- { used units }
- current_module.allunitsused;
- end;
- { leave when we got an error }
- if (Errorcount>0) and not status.skip_error then
- begin
- Message1(unit_f_errors_in_unit,tostr(Errorcount));
- status.skip_error:=true;
- exit;
- end;
- { do we need to add the variants unit? }
- maybeloadvariantsunit;
- { generate debuginfo }
- if (cs_debuginfo in aktmoduleswitches) then
- debuginfo.inserttypeinfo;
- { generate wrappers for interfaces }
- gen_intf_wrappers(asmlist[al_procedures],current_module.globalsymtable);
- gen_intf_wrappers(asmlist[al_procedures],current_module.localsymtable);
- { generate a list of threadvars }
- {$ifndef segment_threadvars}
- InsertThreadvars;
- {$endif}
- { generate imports }
- if current_module.uses_imports then
- importlib.generatelib;
- { insert own objectfile, or say that it's in a library
- (no check for an .o when loading) }
- ag:=is_assembler_generated;
- if ag then
- insertobjectfile
- else
- begin
- current_module.flags:=current_module.flags or uf_no_link;
- current_module.flags:=current_module.flags and not uf_has_debuginfo;
- end;
- if cs_local_browser in aktmoduleswitches then
- current_module.localsymtable:=refsymtable;
- if ag then
- begin
- { create dwarf debuginfo }
- create_dwarf;
- { finish asmlist by adding segment starts }
- // insertsegment;
- { assemble }
- create_objectfile;
- end;
- { Write out the ppufile after the object file has been created }
- store_interface_crc:=current_module.interface_crc;
- {$ifdef EXTDEBUG}
- store_crc:=current_module.crc;
- {$endif EXTDEBUG}
- if (Errorcount=0) then
- tppumodule(current_module).writeppu;
- if not(cs_compilesystem in aktmoduleswitches) then
- if store_interface_crc<>current_module.interface_crc then
- Message1(unit_u_interface_crc_changed,current_module.ppufilename^);
- {$ifdef EXTDEBUG}
- if not(cs_compilesystem in aktmoduleswitches) then
- if (store_crc<>current_module.crc) and simplify_ppu then
- Message1(unit_u_implementation_crc_changed,current_module.ppufilename^);
- {$endif EXTDEBUG}
- { release all overload references and local symtables that
- are not needed anymore }
- tstoredsymtable(current_module.localsymtable).unchain_overloaded;
- tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
- free_localsymtables(current_module.globalsymtable);
- free_localsymtables(current_module.localsymtable);
- { remove static symtable (=refsymtable) here to save some mem, possible references
- (like procsym overloads) should already have been freed above }
- if not (cs_local_browser in aktmoduleswitches) then
- begin
- st.free;
- current_module.localsymtable:=nil;
- end;
- { leave when we got an error }
- if (Errorcount>0) and not status.skip_error then
- begin
- Message1(unit_f_errors_in_unit,tostr(Errorcount));
- status.skip_error:=true;
- exit;
- end;
- Message1(unit_u_finished_compiling,current_module.modulename^);
- end;
- procedure proc_program(islibrary : boolean);
- var
- main_file : tinputfile;
- st : tsymtable;
- hp,hp2 : tmodule;
- pd : tprocdef;
- begin
- DLLsource:=islibrary;
- Status.IsLibrary:=IsLibrary;
- Status.IsExe:=true;
- parse_only:=false;
- { DLL defaults to create reloc info }
- if islibrary then
- begin
- if not RelocSectionSetExplicitly then
- RelocSection:=true;
- end;
- { relocation works only without stabs under win32 !! PM }
- { internal assembler uses rva for stabs info
- so it should work with relocated DLLs }
- if RelocSection and
- (target_info.system in [system_i386_win32,system_i386_wdosx]) and
- (target_info.assem<>as_i386_pecoff) then
- begin
- include(aktglobalswitches,cs_link_strip);
- { Warning stabs info does not work with reloc section !! }
- if cs_debuginfo in aktmoduleswitches then
- begin
- Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
- Message(parser_w_parser_win32_debug_needs_WN);
- exclude(aktmoduleswitches,cs_debuginfo);
- end;
- end;
- { get correct output names }
- main_file := current_scanner.inputfile;
- while assigned(main_file.next) do
- main_file := main_file.next;
- current_module.SetFileName(main_file.path^+main_file.name^,true);
- if islibrary then
- begin
- consume(_LIBRARY);
- stringdispose(current_module.modulename);
- stringdispose(current_module.realmodulename);
- current_module.modulename:=stringdup(pattern);
- current_module.realmodulename:=stringdup(orgpattern);
- current_module.islibrary:=true;
- exportlib.preparelib(orgpattern);
- if tf_library_needs_pic in target_info.flags then
- include(aktmoduleswitches,cs_create_pic);
- consume(_ID);
- consume(_SEMICOLON);
- end
- else
- { is there an program head ? }
- if token=_PROGRAM then
- begin
- consume(_PROGRAM);
- stringdispose(current_module.modulename);
- stringdispose(current_module.realmodulename);
- current_module.modulename:=stringdup(pattern);
- current_module.realmodulename:=stringdup(orgpattern);
- if (target_info.system in system_unit_program_exports) then
- exportlib.preparelib(orgpattern);
- consume(_ID);
- if token=_LKLAMMER then
- begin
- consume(_LKLAMMER);
- repeat
- consume(_ID);
- until not try_to_consume(_COMMA);
- consume(_RKLAMMER);
- end;
- consume(_SEMICOLON);
- end
- else if (target_info.system in system_unit_program_exports) then
- exportlib.preparelib(current_module.realmodulename^);
- { global switches are read, so further changes aren't allowed }
- current_module.in_global:=false;
- { setup things using the switches }
- ConsolidateMode;
- setupglobalswitches;
- { set implementation flag }
- current_module.in_interface:=false;
- current_module.interface_compiled:=true;
- { insert after the unit symbol tables the static symbol table }
- { of the program }
- st:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
- current_module.localsymtable:=st;
- refsymtable:=st;
- macrosymtablestack:= nil;
- { load standard units (system,objpas,profile unit) }
- loaddefaultunits;
- current_module.localmacrosymtable.next:=macrosymtablestack;
- macrosymtablestack:=current_module.localmacrosymtable;
- { Load units provided on the command line }
- loadautounits;
- {Load the units used by the program we compile.}
- if token=_USES then
- loadunits;
- { reset ranges/stabs in exported definitions }
- reset_all_defs;
- { All units are read, now give them a number }
- current_module.updatemaps;
- {Insert the name of the main program into the symbol table.}
- if current_module.realmodulename^<>'' then
- st.insert(tunitsym.create(current_module.realmodulename^,st));
- { ...is also constsymtable, this is the symtable where }
- { the elements of enumeration types are inserted }
- constsymtable:=st;
- Message1(parser_u_parsing_implementation,current_module.mainsource^);
- { The program intialization needs an alias, so it can be called
- from the bootstrap code.}
- if islibrary then
- begin
- pd:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,st);
- { Win32 startup code needs a single name }
- // if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
- pd.aliasnames.insert('PASCALMAIN');
- end
- else if (target_info.system = system_i386_netware) or
- (target_info.system = system_i386_netwlibc) then
- begin
- pd:=create_main_proc('PASCALMAIN',potype_proginit,st); { main is need by the netware rtl }
- end
- else
- begin
- pd:=create_main_proc(mainaliasname,potype_proginit,st);
- pd.aliasnames.insert('PASCALMAIN');
- end;
- tcgprocinfo(current_procinfo).parse_body;
- tcgprocinfo(current_procinfo).generate_code;
- tcgprocinfo(current_procinfo).resetprocdef;
- { save file pos for debuginfo }
- current_module.mainfilepos:=current_procinfo.entrypos;
- release_main_proc(pd);
- { should we force unit initialization? }
- if tstaticsymtable(current_module.localsymtable).needs_init_final then
- begin
- { initialize section }
- gen_implicit_initfinal(uf_init,st);
- { finalize section }
- gen_implicit_initfinal(uf_finalize,st);
- end;
- { Add symbol to the exports section for win32 so smartlinking a
- DLL will include the edata section }
- if assigned(exportlib) and
- (target_info.system in [system_i386_win32,system_i386_wdosx]) and
- ((current_module.flags or uf_has_exports)<>0) then
- asmlist[al_procedures].concat(tai_const.create_sym(exportlib.edatalabel));
- If resourcestrings.ResStrCount>0 then
- begin
- resourcestrings.CreateResourceStringList;
- { only write if no errors found }
- if (Errorcount=0) then
- resourcestrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
- end;
- { finalize? }
- if token=_FINALIZATION then
- begin
- { set module options }
- current_module.flags:=current_module.flags or uf_finalize;
- { Compile the finalize }
- pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,st);
- pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
- tcgprocinfo(current_procinfo).parse_body;
- tcgprocinfo(current_procinfo).generate_code;
- tcgprocinfo(current_procinfo).resetprocdef;
- release_main_proc(pd);
- end;
- { consume the last point }
- consume(_POINT);
- if (Errorcount=0) then
- begin
- { test static symtable }
- tstoredsymtable(st).allsymbolsused;
- tstoredsymtable(st).allprivatesused;
- tstoredsymtable(st).check_forwards;
- tstoredsymtable(st).checklabels;
- tstoredsymtable(st).unchain_overloaded;
- current_module.allunitsused;
- end;
- { leave when we got an error }
- if (Errorcount>0) and not status.skip_error then
- begin
- Message1(unit_f_errors_in_unit,tostr(Errorcount));
- status.skip_error:=true;
- exit;
- end;
- { remove all unused units, this happends when units are removed
- from the uses clause in the source and the ppu was already being loaded }
- hp:=tmodule(loaded_units.first);
- while assigned(hp) do
- begin
- hp2:=hp;
- hp:=tmodule(hp.next);
- if hp2.is_unit and
- not assigned(hp2.globalsymtable) then
- loaded_units.remove(hp2);
- end;
- { do we need to add the variants unit? }
- maybeloadvariantsunit;
- { generate debuginfo }
- if (cs_debuginfo in aktmoduleswitches) then
- debuginfo.inserttypeinfo;
- { generate wrappers for interfaces }
- gen_intf_wrappers(asmlist[al_procedures],current_module.localsymtable);
- {$ifndef segment_threadvars}
- { generate a list of threadvars }
- InsertThreadvars;
- {$endif}
- { generate imports }
- if current_module.uses_imports then
- importlib.generatelib;
- if islibrary or (target_info.system in system_unit_program_exports) then
- exportlib.generatelib;
- { insert Tables and StackLength }
- {$ifndef segment_threadvars}
- insertThreadVarTablesTable;
- {$endif}
- insertResourceTablesTable;
- insertinitfinaltable;
- insertmemorysizes;
- { Insert symbol to resource info }
- InsertResourceInfo;
- { create dwarf debuginfo }
- create_dwarf;
- { finish asmlist by adding segment starts }
- // insertsegment;
- { insert own objectfile }
- insertobjectfile;
- { assemble and link }
- create_objectfile;
- { release all local symtables that are not needed anymore }
- free_localsymtables(current_module.localsymtable);
- { leave when we got an error }
- if (Errorcount>0) and not status.skip_error then
- begin
- Message1(unit_f_errors_in_unit,tostr(Errorcount));
- status.skip_error:=true;
- exit;
- end;
- { create the executable when we are at level 1 }
- if (compile_level=1) then
- begin
- { insert all .o files from all loaded units }
- hp:=tmodule(loaded_units.first);
- while assigned(hp) do
- begin
- linker.AddModuleFiles(hp);
- hp:=tmodule(hp.next);
- end;
- { write .def file }
- if (cs_link_deffile in aktglobalswitches) then
- deffile.writefile;
- { finally we can create a executable }
- if (not current_module.is_unit) then
- begin
- if DLLSource then
- linker.MakeSharedLibrary
- else
- linker.MakeExecutable;
- end;
- end;
- end;
- end.
|