123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608 |
- {
- $Id$
- 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}
- {$define New_GDB}
- 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,
- aasmbase,aasmtai,aasmcpu,
- cgbase,cpuinfo,
- ncgutil,
- link,assemble,import,export,gendef,ppu,comprsrc,
- cresstr,cpubase,
- {$ifdef GDB}
- gdb,
- {$endif GDB}
- scanner,pbase,pexpr,psystem,psub;
- 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(importssection)then
- importssection.clear
- else
- importssection:=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;
- { create the .s file and assemble it }
- GenerateAsm(false);
- { Also create a smartlinked version ? }
- if (cs_create_smart in aktmoduleswitches) then
- begin
- { regenerate the importssection for win32 }
- if assigned(importssection) and
- (target_info.system in [system_i386_win32,system_i386_wdosx]) then
- begin
- importsSection.clear;
- importlib.generatesmartlib;
- end;
- GenerateAsm(true);
- if target_asm.needar 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) then
- begin
- current_module.linkunitstaticlibs.add(current_module.staticlibfilename^,link_smart);
- current_module.flags:=current_module.flags or uf_smart_linked;
- end;
- end;
- procedure insertsegment;
- procedure fixseg(p:TAAsmoutput;sec:TSection);
- begin
- p.insert(Tai_section.Create(sec));
- if (cs_create_smart in aktmoduleswitches) then
- p.insert(Tai_cut.Create);
- p.concat(Tai_section.Create(sec_none));
- end;
- begin
- { Insert Ident of the compiler }
- if (not (cs_create_smart in aktmoduleswitches))
- {$ifndef EXTDEBUG}
- and (not current_module.is_unit)
- {$endif}
- then
- begin
- { align the first data }
- dataSegment.insert(Tai_align.Create(const_align(32)));
- dataSegment.insert(Tai_string.Create('FPC '+full_version_string+
- ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
- end;
- { align code segment }
- codeSegment.concat(Tai_align.Create(aktalignment.procalign));
- { Insert start and end of sections }
- fixseg(codesegment,sec_code);
- fixseg(datasegment,sec_data);
- fixseg(bsssegment,sec_bss);
- { we should use .rdata section for these two no ? }
- { .rdata is a read only data section (PM) }
- fixseg(rttilist,sec_data);
- fixseg(consts,sec_data);
- if assigned(resourcestringlist) then
- fixseg(resourcestringlist,sec_data);
- {$ifdef GDB}
- if assigned(debuglist) then
- begin
- debugList.insert(Tai_symbol.Createname('gcc2_compiled',0));
- debugList.insert(Tai_symbol.Createname('fpc_compiled',0));
- fixseg(debuglist,sec_code);
- end;
- {$endif GDB}
- end;
- 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_symbol.Createname(hp.u.modulename^+'_$THREADVARLIST'));
- 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_symbol.Createname(current_module.modulename^+'_$THREADVARLIST'));
- inc(count);
- end;
- { TableCount }
- ltvTables.insert(Tai_const.Create_32bit(count));
- ltvTables.insert(Tai_symbol.Createdataname_global('FPC_THREADVARTABLES',0));
- ltvTables.insert(Tai_align.Create(const_align(pointer_size)));
- ltvTables.concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
- { insert in data segment }
- if (cs_create_smart in aktmoduleswitches) then
- dataSegment.concat(Tai_cut.Create);
- dataSegment.concatlist(ltvTables);
- ltvTables.free;
- if count > 0 then
- have_local_threadvars := true;
- end;
- procedure AddToThreadvarList(p:tnamedindexitem;arg:pointer);
- var
- ltvTable : taasmoutput;
- begin
- ltvTable:=taasmoutput(arg);
- if (tsym(p).typ=varsym) and
- (vo_is_thread_var in tvarsym(p).varoptions) then
- begin
- { address of threadvar }
- ltvTable.concat(tai_const_symbol.createname(tvarsym(p).mangledname));
- { size of threadvar }
- ltvTable.concat(tai_const.create_32bit(tvarsym(p).getsize));
- end;
- end;
- procedure InsertThreadvars;
- var
- ltvTable : TAAsmoutput;
- begin
- ltvTable:=TAAsmoutput.create;
- if assigned(current_module.globalsymtable) then
- current_module.globalsymtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}AddToThreadvarList,ltvTable);
- current_module.localsymtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}AddToThreadvarList,ltvTable);
- if ltvTable.first<>nil then
- begin
- { add begin and end of the list }
- ltvTable.insert(tai_symbol.createdataname_global(current_module.modulename^+'_$THREADVARLIST',0));
- ltvTable.concat(tai_const.create_32bit(0)); { end of list marker }
- ltvTable.concat(tai_symbol_end.createname(current_module.modulename^+'_$THREADVARLIST'));
- if (cs_create_smart in aktmoduleswitches) then
- dataSegment.concat(Tai_cut.Create);
- dataSegment.concatlist(ltvTable);
- current_module.flags:=current_module.flags or uf_threadvars;
- end;
- ltvTable.Free;
- 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_symbol.Createname(hp.u.modulename^+'_RESOURCESTRINGLIST'));
- inc(count);
- end;
- hp:=tused_unit(hp.next);
- end;
- { Add program resources, if any }
- If ResourceStringList<>Nil then
- begin
- ResourceStringTables.concat(Tai_const_symbol.Createname(current_module.modulename^+'_RESOURCESTRINGLIST'));
- Inc(Count);
- end;
- { TableCount }
- ResourceStringTables.insert(Tai_const.Create_32bit(count));
- ResourceStringTables.insert(Tai_symbol.Createdataname_global('FPC_RESOURCESTRINGTABLES',0));
- ResourceStringTables.insert(Tai_align.Create(const_align(4)));
- ResourceStringTables.concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
- { insert in data segment }
- if (cs_create_smart in aktmoduleswitches) then
- dataSegment.concat(Tai_cut.Create);
- dataSegment.concatlist(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_symbol.Createname('INIT$$'+hp.u.modulename^))
- else
- unitinits.concat(Tai_const.Create_32bit(0));
- if (hp.u.flags and uf_finalize)<>0 then
- unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+hp.u.modulename^))
- else
- unitinits.concat(Tai_const.Create_32bit(0));
- 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_symbol.Createname('INIT$$'+current_module.modulename^))
- else
- unitinits.concat(Tai_const.Create_32bit(0));
- if (current_module.flags and uf_finalize)<>0 then
- unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+current_module.modulename^))
- else
- unitinits.concat(Tai_const.Create_32bit(0));
- inc(count);
- end;
- { TableCount,InitCount }
- unitinits.insert(Tai_const.Create_32bit(0));
- unitinits.insert(Tai_const.Create_32bit(count));
- unitinits.insert(Tai_symbol.Createdataname_global('INITFINAL',0));
- unitinits.insert(Tai_align.Create(const_align(4)));
- unitinits.concat(Tai_symbol_end.Createname('INITFINAL'));
- { insert in data segment }
- if (cs_create_smart in aktmoduleswitches) then
- dataSegment.concat(Tai_cut.Create);
- dataSegment.concatlist(unitinits);
- unitinits.free;
- end;
- procedure insertheap;
- begin
- if (cs_create_smart in aktmoduleswitches) then
- begin
- bssSegment.concat(Tai_cut.Create);
- dataSegment.concat(Tai_cut.Create);
- end;
- { On the Macintosh Classic M68k Architecture
- The Heap variable is simply a POINTER to the
- real HEAP. The HEAP must be set up by the RTL
- and must store the pointer in this value.
- On OS/2 the heap is also intialized by the RTL. We do
- not output a pointer }
- case target_info.system of
- {$ifdef x86_64}
- system_x86_64_linux:
- ;
- {$endif x86_64}
- {$ifdef i386}
- system_i386_OS2:
- ;
- {$endif i386}
- {$ifdef powerpc}
- system_powerpc_macos:
- ;
- {$endif powerpc}
- {$ifdef alpha}
- system_alpha_linux:
- ;
- {$endif alpha}
- {$ifdef m68k}
- system_m68k_Mac:
- bssSegment.concat(Tai_datablock.Create_global('HEAP',4));
- system_m68k_PalmOS:
- ;
- {$endif m68k}
- {$IFDEF SPARC}
- system_SPARC_Linux:
- ;
- {$ENDIF SPARC}
- else
- begin
- bssSegment.concat(Tai_align.Create(var_align(heapsize)));
- bssSegment.concat(Tai_datablock.Create_global('HEAP',heapsize));
- end;
- end;
- {$ifdef m68k}
- if target_info.system<>system_m68k_PalmOS then
- begin
- dataSegment.concat(Tai_align.Create(const_align(4)));
- dataSegment.concat(Tai_symbol.Createdataname_global('HEAPSIZE',4));
- dataSegment.concat(Tai_const.Create_32bit(heapsize));
- end;
- {$else m68k}
- dataSegment.concat(Tai_align.Create(const_align(4)));
- dataSegment.concat(Tai_symbol.Createdataname_global('HEAPSIZE',4));
- dataSegment.concat(Tai_const.Create_32bit(heapsize));
- {$endif m68k}
- end;
- procedure insertstacklength;
- begin
- { stacksize can be specified and is now simulated }
- dataSegment.concat(Tai_align.Create(const_align(4)));
- dataSegment.concat(Tai_symbol.Createdataname_global('__stklen',4));
- dataSegment.concat(Tai_const.Create_32bit(stacksize));
- end;
- procedure loaddefaultunits;
- procedure AddUnit(const s:string);
- var
- hp : tppumodule;
- unitsym : tunitsym;
- begin
- { load unit }
- hp:=registerunit(current_module,s,'');
- hp.loadppu;
- hp.adddependency(current_module);
- current_module.addusedunit(hp,false);
- { add to symtable stack }
- tsymtable(hp.globalsymtable).next:=symtablestack;
- symtablestack:=hp.globalsymtable;
- { insert unitsym }
- unitsym:=tunitsym.create(s,hp.globalsymtable);
- inc(unitsym.refs);
- refsymtable.insert(unitsym);
- end;
- 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;
- AddUnit('System');
- SystemUnit:=TGlobalSymtable(Symtablestack);
- { read default constant definitions }
- make_ref:=false;
- readconstdefs;
- make_ref:=true;
- {$ifdef cpufpemu}
- { Floating point emulation unit? }
- if (cs_fp_emulation in aktmoduleswitches) then
- AddUnit('SoftFpu');
- {$endif cpufpemu}
- { Thread support unit? }
- if (cs_threading in aktmoduleswitches) then
- AddUnit('SysThrds');
- { Objpas unit? }
- if m_objpas in aktmodeswitches then
- AddUnit('ObjPas');
- { Profile unit? Needed for go32v2 only }
- if (cs_profile in aktmoduleswitches) and
- (target_info.system=system_i386_go32v2) then
- AddUnit('Profile');
- { Units only required for main module }
- if not(current_module.is_unit) then
- begin
- { Heaptrc unit }
- if (cs_gdb_heaptrc in aktglobalswitches) then
- AddUnit('HeapTrc');
- { Lineinfo unit }
- if (cs_gdb_lineinfo in aktglobalswitches) then
- AddUnit('LineInfo');
- end;
- { save default symtablestack }
- defaultsymtablestack:=symtablestack;
- end;
- procedure loadunits;
- var
- s,sorg : stringid;
- fn : string;
- pu : tused_unit;
- hp2 : tmodule;
- hp3 : tsymtable;
- oldprocsym:tprocsym;
- oldprocdef:tprocdef;
- unitsym : tunitsym;
- begin
- oldprocsym:=aktprocsym;
- oldprocdef:=aktprocdef;
- 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);
- { check if the unit is already used }
- pu:=tused_unit(current_module.used_units.first);
- while assigned(pu) do
- begin
- if (pu.u.modulename^=s) then
- break;
- pu:=tused_unit(pu.next);
- end;
- { avoid uses of itself }
- if not assigned(pu) and (s<>current_module.modulename^) then
- begin
- { register the unit }
- hp2:=registerunit(current_module,sorg,fn);
- { the current module uses the unit hp2 }
- current_module.addusedunit(hp2,true);
- end
- else
- Message1(sym_e_duplicate_id,s);
- if token=_COMMA then
- begin
- pattern:='';
- consume(_COMMA);
- end
- else
- break;
- until false;
- consume(_SEMICOLON);
- { Load the units }
- pu:=tused_unit(current_module.used_units.first);
- while assigned(pu) do
- begin
- if pu.in_uses then
- begin
- { store the original name to create the unitsym }
- sorg:=pu.u.realmodulename^;
- 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);
- pu.checksum:=pu.u.crc;
- pu.interface_checksum:=pu.u.interface_crc;
- { 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,pu.u.globalsymtable);
- if (pu.u.flags and (uf_init or uf_finalize))<>0 then
- inc(unitsym.refs);
- refsymtable.insert(unitsym);
- 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;
- while assigned(pu) do
- begin
- {$IfDef GDB}
- if (cs_debuginfo in aktmoduleswitches) and
- (cs_gdb_dbx in aktglobalswitches) and
- not pu.is_stab_written then
- begin
- tglobalsymtable(pu.u.globalsymtable).concattypestabto(debuglist);
- pu.is_stab_written:=true;
- pu.unitid:=tsymtable(pu.u.globalsymtable).unitid;
- end;
- {$EndIf GDB}
- 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);
- {$ifdef DEBUG}
- test_symtablestack;
- {$endif DEBUG}
- end;
- end;
- end;
- pu:=tused_unit(pu.next);
- end;
- aktprocsym:=oldprocsym;
- aktprocdef:=oldprocdef;
- end;
- procedure write_gdb_info;
- {$IfDef GDB}
- var
- hp : tused_unit;
- begin
- if not (cs_debuginfo in aktmoduleswitches) then
- exit;
- { now insert the units in the symtablestack }
- hp:=tused_unit(current_module.used_units.first);
- while assigned(hp) do
- begin
- if (cs_debuginfo in aktmoduleswitches) and
- not hp.is_stab_written then
- begin
- tglobalsymtable(hp.u.globalsymtable).concattypestabto(debuglist);
- hp.is_stab_written:=true;
- hp.unitid:=tsymtable(hp.u.globalsymtable).unitid;
- end;
- hp:=tused_unit(hp.next);
- end;
- if (not current_module.in_interface) and
- assigned(current_module.localsymtable) then
- begin
- { all types }
- tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist);
- { and all local symbols}
- tstaticsymtable(current_module.localsymtable).concatstabto(debuglist);
- end
- else if assigned(current_module.globalsymtable) then
- begin
- { all types }
- tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
- { and all local symbols}
- tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
- end;
- if (cs_gdb_dbx in aktglobalswitches) then
- begin
- debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
- tglobalsymtable(current_module.globalsymtable).name^+' has index '+
- tostr(tglobalsymtable(current_module.globalsymtable).unitid))));
- debugList.concat(Tai_stabs.Create(strpnew('"'+
- tglobalsymtable(current_module.globalsymtable).name^+'",'+
- tostr(N_EINCL)+',0,0,0')));
- tglobalsymtable(current_module.globalsymtable).dbx_count_ok:={true}false;
- dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter;
- do_count_dbx:=false;
- end;
- end;
- {$Else GDB}
- begin
- end;
- {$EndIf GDB}
- procedure parse_implementation_uses(symt:tsymtable);
- 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);
- { define a symbol in delphi,objfpc,tp,gpc mode }
- if (m_delphi in aktmodeswitches) then
- current_scanner.def_macro('FPC_DELPHI')
- else
- if (m_tp7 in aktmodeswitches) then
- current_scanner.def_macro('FPC_TP')
- else
- if (m_objfpc in aktmodeswitches) then
- current_scanner.def_macro('FPC_OBJFPC')
- else
- if (m_gpc in aktmodeswitches) then
- current_scanner.def_macro('FPC_GPC');
- end;
- procedure gen_main_procsym(const name:string;options:tproctypeoption;st:tsymtable);
- var
- stt : tsymtable;
- begin
- {Generate a procsym for main}
- make_ref:=false;
- aktprocsym:=tprocsym.create('$'+name);
- { main are allways used }
- inc(aktprocsym.refs);
- {Try to insert in in static symtable ! }
- stt:=symtablestack;
- symtablestack:=st;
- aktprocdef:=tprocdef.create;
- aktprocsym.addprocdef(aktprocdef);
- aktprocdef.procsym:=aktprocsym;
- symtablestack:=stt;
- aktprocdef.proctypeoption:=options;
- aktprocdef.setmangledname(target_info.cprefix+name);
- aktprocdef.forwarddef:=false;
- make_ref:=true;
- { The localst is a local symtable. Change it into the static
- symtable }
- aktprocdef.localst.free;
- aktprocdef.localst:=st;
- { and insert the procsym in symtable }
- st.insert(aktprocsym);
- { set some informations about the main program }
- with procinfo do
- begin
- _class:=nil;
- para_offset:=target_info.first_parm_offset;
- framepointer:=FRAME_POINTER_REG;
- flags:=0;
- procdef:=aktprocdef;
- end;
- end;
- procedure proc_unit;
- function is_assembler_generated:boolean;
- begin
- is_assembler_generated:=(Errorcount=0) and
- not(
- codeSegment.empty and
- dataSegment.empty and
- bssSegment.empty and
- ((importssection=nil) or importsSection.empty) and
- ((resourcesection=nil) or resourceSection.empty) and
- ((resourcestringlist=nil) or resourcestringList.empty)
- );
- end;
- var
- main_file: tinputfile;
- st : tsymtable;
- unitst : tglobalsymtable;
- {$ifdef GDB}
- pu : tused_unit;
- {$endif GDB}
- store_crc,store_interface_crc : cardinal;
- s2 : ^string; {Saves stack space}
- force_init_final : boolean;
- begin
- 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;
- current_module.SetFileName(main_file.path^+main_file.name^,true);
- stringdispose(current_module.modulename);
- stringdispose(current_module.realmodulename);
- current_module.modulename:=stringdup(pattern);
- current_module.realmodulename:=stringdup(orgpattern);
- { check for system unit }
- new(s2);
- s2^:=upper(SplitName(main_file.name^));
- if (cs_check_unit_name in aktglobalswitches) and
- not((current_module.modulename^=s2^) or
- ((length(current_module.modulename^)>8) and
- (copy(current_module.modulename^,1,8)=s2^))) then
- Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
- if (current_module.modulename^='SYSTEM') then
- include(aktmoduleswitches,cs_compilesystem);
- dispose(s2);
- end;
- 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 }
- setupglobalswitches;
- Comment(V_Used,'Loading interface units from '+current_module.modulename^);
- // Message1(unit_u_start_parse_interface,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);
- parse_only:=true;
- { generate now the global symboltable }
- st:=tglobalsymtable.create(current_module.modulename^);
- 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));
- { load default units, like the system unit }
- loaddefaultunits;
- { reset }
- make_ref:=true;
- lexlevel:=0;
- { 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
- begin
- { this unit symtable is obsolete }
- { dispose(unitst,done);
- disposed as localsymtable !! }
- RestoreUnitSyms;
- exit;
- end;
- 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_global_defs;
- { number all units, so we know if a unit is used by this unit or
- needs to be added implicitly }
- current_module.numberunits;
- { ... parse the declarations }
- Comment(V_Used,'Parsing interface of '+current_module.modulename^);
- // 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;
- {else in inteface its somatimes necessary even if unused
- st^.allunitsused; }
- {$ifdef New_GDB}
- write_gdb_info;
- {$endIf Def New_GDB}
- if not(cs_compilesystem in aktmoduleswitches) then
- if (Errorcount=0) then
- tppumodule(current_module).getppucrc;
- { Parse the implementation section }
- consume(_IMPLEMENTATION);
- current_module.in_interface:=false;
- Comment(V_Used,'Loading implementation units from '+current_module.modulename^);
- // Message1(unit_u_start_parse_implementation,current_module.modulename^);
- parse_only:=false;
- { generates static symbol table }
- st:=tstaticsymtable.create(current_module.modulename^);
- current_module.localsymtable:=st;
- { 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;
- { Read the implementation units }
- parse_implementation_uses(unitst);
- if current_module.state=ms_compiled then
- begin
- RestoreUnitSyms;
- exit;
- end;
- { reset ranges/stabs in exported definitions }
- reset_global_defs;
- { All units are read, now give them a number }
- current_module.numberunits;
- { now we can change refsymtable }
- refsymtable:=st;
- { but reinsert the global symtable as lasts }
- unitst.next:=symtablestack;
- symtablestack:=unitst;
- tstoredsymtable(symtablestack).chainoperators;
- {$ifdef DEBUG}
- test_symtablestack;
- {$endif DEBUG}
- constsymtable:=symtablestack;
- {$ifdef Splitheap}
- if testsplit then
- begin
- Split_Heap;
- allow_special:=true;
- Switch_to_temp_heap;
- end;
- { it will report all crossings }
- allow_special:=false;
- {$endif Splitheap}
- Comment(V_Used,'Parsing implementation of '+current_module.modulename^);
- if current_module.in_interface then
- internalerror(200212285);
- // Message1(parser_u_parsing_implementation,current_module.modulename^);
- { Compile the unit }
- codegen_newprocedure;
- gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
- aktprocdef.aliasnames.insert('INIT$$'+current_module.modulename^);
- aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
- compile_proc_body(true,false);
- codegen_doneprocedure;
- { avoid self recursive destructor call !! PM }
- aktprocdef.localst:=nil;
- { 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
- begin
- current_module.flags:=current_module.flags or uf_init;
- { now we can insert a cut }
- if (cs_create_smart in aktmoduleswitches) then
- codeSegment.concat(Tai_cut.Create);
- genimplicitunitinit(codesegment);
- end;
- { finalize? }
- if token=_FINALIZATION then
- begin
- { set module options }
- current_module.flags:=current_module.flags or uf_finalize;
- { Compile the finalize }
- codegen_newprocedure;
- gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
- aktprocdef.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
- aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
- compile_proc_body(true,false);
- codegen_doneprocedure;
- end
- else if force_init_final then
- begin
- current_module.flags:=current_module.flags or uf_finalize;
- { now we can insert a cut }
- if (cs_create_smart in aktmoduleswitches) then
- codeSegment.concat(Tai_cut.Create);
- genimplicitunitfinal(codesegment);
- end;
- { the last char should always be a point }
- consume(_POINT);
- { generate a list of threadvars }
- InsertThreadvars;
- { 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;
- { avoid self recursive destructor call !! PM }
- aktprocdef.localst:=nil;
- { absence does not matter here !! }
- aktprocdef.forwarddef:=false;
- { test static symtable }
- if (Errorcount=0) then
- begin
- tstoredsymtable(st).allsymbolsused;
- tstoredsymtable(st).allunitsused;
- tstoredsymtable(st).allprivatesused;
- end;
- { size of the static data }
- datasize:=st.datasize;
- {$ifdef GDB}
- { add all used definitions even for implementation}
- if (cs_debuginfo in aktmoduleswitches) then
- begin
- {$IfnDef New_GDB}
- if assigned(current_module.globalsymtable) then
- begin
- { all types }
- tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
- { and all local symbols}
- tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
- end;
- { all local types }
- tglobalsymtable(st)^.concattypestabto(debuglist);
- { and all local symbols}
- st^.concatstabto(debuglist);
- {$else New_GDB}
- write_gdb_info;
- {$endIf Def New_GDB}
- end;
- {$endif GDB}
- reset_global_defs;
- 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;
- end;
- {$ifdef GDB}
- tglobalsymtable(symtablestack).is_stab_written:=false;
- {$endif GDB}
- { 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;
- { 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) }
- if is_assembler_generated then
- insertobjectfile
- else
- current_module.flags:=current_module.flags or uf_no_link;
- if cs_local_browser in aktmoduleswitches then
- current_module.localsymtable:=refsymtable;
- {$ifdef GDB}
- pu:=tused_unit(usedunits.first);
- while assigned(pu) do
- begin
- if assigned(pu.u.globalsymtable) then
- tglobalsymtable(pu.u.globalsymtable).is_stab_written:=false;
- pu:=tused_unit(pu.next);
- end;
- {$endif GDB}
- if is_assembler_generated then
- begin
- { 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;
- store_crc:=current_module.crc;
- if (Errorcount=0) then
- tppumodule(current_module).writeppu;
- if not(cs_compilesystem in aktmoduleswitches) then
- if store_interface_crc<>current_module.interface_crc then
- Comment(V_Warning,current_module.ppufilename^+' Interface CRC changed '+
- hexstr(store_crc,8)+'<>'+hexstr(current_module.interface_crc,8));
- {$ifdef EXTDEBUG}
- if not(cs_compilesystem in aktmoduleswitches) then
- if (store_crc<>current_module.crc) and simplify_ppu then
- Comment(V_Note,current_module.ppufilename^+' implementation CRC changed '+
- hexstr(store_crc,8)+'<>'+hexstr(current_module.crc,8));
- {$endif EXTDEBUG}
- { remove static symtable (=refsymtable) here to save some mem }
- if not (cs_local_browser in aktmoduleswitches) then
- begin
- st.free;
- current_module.localsymtable:=nil;
- end;
- RestoreUnitSyms;
- { 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;
- Comment(V_Used,'Finished compiling module '+current_module.modulename^);
- end;
- procedure proc_program(islibrary : boolean);
- var
- main_file: tinputfile;
- st : tsymtable;
- hp : tmodule;
- begin
- DLLsource:=islibrary;
- Status.IsLibrary:=IsLibrary;
- Status.IsExe:=true;
- parse_only:=false;
- { 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);
- current_module.modulename:=stringdup(pattern);
- current_module.islibrary:=true;
- exportlib.preparelib(pattern);
- 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_i386_WIN32,system_i386_wdosx]) then
- exportlib.preparelib(pattern);
- 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_i386_WIN32,system_i386_wdosx]) then
- exportlib.preparelib(current_module.modulename^);
- { global switches are read, so further changes aren't allowed }
- current_module.in_global:=false;
- { setup things using the global switches }
- setupglobalswitches;
- { set implementation flag }
- current_module.in_interface:=false;
- { insert after the unit symbol tables the static symbol table }
- { of the program }
- st:=tstaticsymtable.create(current_module.modulename^);;
- current_module.localsymtable:=st;
- refsymtable:=st;
- { load standard units (system,objpas,profile unit) }
- loaddefaultunits;
- { reset }
- lexlevel:=0;
- {Load the units used by the program we compile.}
- if token=_USES then
- loadunits;
- tstoredsymtable(symtablestack).chainoperators;
- { reset ranges/stabs in exported definitions }
- reset_global_defs;
- { All units are read, now give them a number }
- current_module.numberunits;
- {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.}
- codegen_newprocedure;
- if islibrary then
- begin
- gen_main_procsym(current_module.modulename^+'_main',potype_proginit,st);
- aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_main');
- { Win32 startup code needs a single name }
- if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
- aktprocdef.aliasnames.insert('PASCALMAIN');
- { this code is called from C so we need to save some
- registers }
- include(aktprocdef.procoptions,po_savestdregs);
- end
- else
- begin
- gen_main_procsym('main',potype_proginit,st);
- aktprocdef.aliasnames.insert('program_init');
- aktprocdef.aliasnames.insert('PASCALMAIN');
- aktprocdef.aliasnames.insert(target_info.cprefix+'main');
- end;
- compile_proc_body(true,false);
- { should we force unit initialization? }
- if tstaticsymtable(current_module.localsymtable).needs_init_final then
- begin
- current_module.flags:=current_module.flags or (uf_init or uf_finalize);
- { Add initialize section }
- if (cs_create_smart in aktmoduleswitches) then
- codeSegment.concat(Tai_cut.Create);
- genimplicitunitinit(codesegment);
- { Add finalize section }
- if (cs_create_smart in aktmoduleswitches) then
- codeSegment.concat(Tai_cut.Create);
- genimplicitunitfinal(codesegment);
- 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
- assigned(current_module._exports.first) then
- codesegment.concat(tai_const_symbol.create(exportlib.edatalabel));
- { avoid self recursive destructor call !! PM }
- aktprocdef.localst:=nil;
- { consider these symbols as global ones for browser
- but the typecasting of the globalsymtable with tglobalsymtable
- can then lead to problems (PFV)
- current_module.globalsymtable:=current_module.localsymtable;
- current_module.localsymtable:=nil;}
- 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;
- codegen_doneprocedure;
- { finalize? }
- if token=_FINALIZATION then
- begin
- { set module options }
- current_module.flags:=current_module.flags or uf_finalize;
- { Compile the finalize }
- codegen_newprocedure;
- gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
- aktprocdef.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
- aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
- compile_proc_body(true,false);
- codegen_doneprocedure;
- end;
- { consume the last point }
- consume(_POINT);
- {$ifdef New_GDB}
- write_gdb_info;
- {$endIf Def New_GDB}
- { 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;
- { test static symtable }
- if (Errorcount=0) then
- begin
- tstoredsymtable(st).allsymbolsused;
- tstoredsymtable(st).allunitsused;
- tstoredsymtable(st).allprivatesused;
- end;
- { generate a list of threadvars }
- InsertThreadvars;
- { generate imports }
- if current_module.uses_imports then
- importlib.generatelib;
- if islibrary or
- (target_info.system in [system_i386_WIN32,system_i386_wdosx]) or
- (target_info.system=system_i386_NETWARE) then
- exportlib.generatelib;
- { insert Tables and Heap }
- insertThreadVarTablesTable;
- insertResourceTablesTable;
- insertinitfinaltable;
- insertheap;
- insertstacklength;
- datasize:=symtablestack.datasize;
- { finish asmlist by adding segment starts }
- insertsegment;
- { insert own objectfile }
- insertobjectfile;
- { assemble and link }
- create_objectfile;
- { 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.
- {
- $Log$
- Revision 1.91 2003-01-05 13:36:53 florian
- * x86-64 compiles
- + very basic support for float128 type (x86-64 only)
- Revision 1.90 2002/12/29 18:17:23 peter
- * insert unitsym with the name as specified in the uses list
- Revision 1.89 2002/12/29 14:57:50 peter
- * unit loading changed to first register units and load them
- afterwards. This is needed to support uses xxx in yyy correctly
- * unit dependency check fixed
- Revision 1.87 2002/12/24 23:32:56 peter
- * Use FixFilename for specified unit sourcefile in uses
- Revision 1.86 2002/12/06 16:56:58 peter
- * only compile cs_fp_emulation support when cpufpuemu is defined
- * define cpufpuemu for m68k only
- Revision 1.85 2002/11/30 21:32:24 carl
- + Add loading of softfpu in emulation mode
- + Correct routine call for softfpu
- * Extended type must also be defined even with softfpu
- Revision 1.84 2002/11/15 01:58:53 peter
- * merged changes from 1.0.7 up to 04-11
- - -V option for generating bug report tracing
- - more tracing for option parsing
- - errors for cdecl and high()
- - win32 import stabs
- - win32 records<=8 are returned in eax:edx (turned off by default)
- - heaptrc update
- - more info for temp management in .s file with EXTDEBUG
- Revision 1.83 2002/11/09 15:33:26 carl
- * major alignment updates
- Revision 1.82 2002/10/16 06:32:52 michael
- + Renamed thread unit to systhrds
- Revision 1.81 2002/10/14 19:42:34 peter
- * only use init tables for threadvars
- Revision 1.80 2002/10/06 19:41:30 peter
- * Add finalization of typed consts
- * Finalization of globals in the main program
- Revision 1.79 2002/09/09 17:34:15 peter
- * tdicationary.replace added to replace and item in a dictionary. This
- is only allowed for the same name
- * varsyms are inserted in symtable before the types are parsed. This
- fixes the long standing "var longint : longint" bug
- - consume_idlist and idstringlist removed. The loops are inserted
- at the callers place and uses the symtable for duplicate id checking
- Revision 1.78 2002/09/07 15:25:07 peter
- * old logs removed and tabs fixed
- Revision 1.77 2002/09/03 16:26:27 daniel
- * Make Tprocdef.defs protected
- Revision 1.76 2002/09/02 18:46:26 peter
- * insert PASCALMAIN in library for Win32 only
- Revision 1.75 2002/08/31 15:59:30 florian
- + HEAP* stuff must be generated for Linux/PPC as well
- + direct assembler reader searches now global and static symtables as well
- Revision 1.74 2002/08/25 19:25:20 peter
- * sym.insert_in_data removed
- * symtable.insertvardata/insertconstdata added
- * removed insert_in_data call from symtable.insert, it needs to be
- called separatly. This allows to deref the address calculation
- * procedures now calculate the parast addresses after the procedure
- directives are parsed. This fixes the cdecl parast problem
- * push_addr_param has an extra argument that specifies if cdecl is used
- or not
- Revision 1.73 2002/08/18 20:06:25 peter
- * inlining is now also allowed in interface
- * renamed write/load to ppuwrite/ppuload
- * tnode storing in ppu
- * nld,ncon,nbas are already updated for storing in ppu
- Revision 1.72 2002/08/17 09:23:39 florian
- * first part of procinfo rewrite
- Revision 1.71 2002/08/11 13:24:12 peter
- * saving of asmsymbols in ppu supported
- * asmsymbollist global is removed and moved into a new class
- tasmlibrarydata that will hold the info of a .a file which
- corresponds with a single module. Added librarydata to tmodule
- to keep the library info stored for the module. In the future the
- objectfiles will also be stored to the tasmlibrarydata class
- * all getlabel/newasmsymbol and friends are moved to the new class
- Revision 1.70 2002/08/10 14:46:29 carl
- + moved target_cpu_string to cpuinfo
- * renamed asmmode enum.
- * assembler reader has now less ifdef's
- * move from nppcmem.pas -> ncgmem.pas vec. node.
- Revision 1.69 2002/07/26 21:15:41 florian
- * rewrote the system handling
- Revision 1.68 2002/07/04 20:43:01 florian
- * first x86-64 patches
- Revision 1.67 2002/07/01 18:46:25 peter
- * internal linker
- * reorganized aasm layer
- Revision 1.66 2002/05/16 19:46:43 carl
- + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
- + try to fix temp allocation (still in ifdef)
- + generic constructor calls
- + start of tassembler / tmodulebase class cleanup
- Revision 1.65 2002/05/14 19:34:49 peter
- * removed old logs and updated copyright year
- Revision 1.64 2002/05/12 16:53:09 peter
- * moved entry and exitcode to ncgutil and cgobj
- * foreach gets extra argument for passing local data to the
- iterator function
- * -CR checks also class typecasts at runtime by changing them
- into as
- * fixed compiler to cycle with the -CR option
- * fixed stabs with elf writer, finally the global variables can
- be watched
- * removed a lot of routines from cga unit and replaced them by
- calls to cgobj
- * u32bit-s32bit updates for and,or,xor nodes. When one element is
- u32bit then the other is typecasted also to u32bit without giving
- a rangecheck warning/error.
- * fixed pascal calling method with reversing also the high tree in
- the parast, detected by tcalcst3 test
- Revision 1.63 2002/05/06 19:54:50 carl
- + added more patches from Mazen for SPARC port
- Revision 1.62 2002/04/20 21:32:24 carl
- + generic FPC_CHECKPOINTER
- + first parameter offset in stack now portable
- * rename some constants
- + move some cpu stuff to other units
- - remove unused constents
- * fix stacksize for some targets
- * fix generic size problems which depend now on EXTEND_SIZE constant
- Revision 1.61 2002/04/19 15:46:02 peter
- * mangledname rewrite, tprocdef.mangledname is now created dynamicly
- in most cases and not written to the ppu
- * add mangeledname_prefix() routine to generate the prefix of
- manglednames depending on the current procedure, object and module
- * removed static procprefix since the mangledname is now build only
- on demand from tprocdef.mangledname
- Revision 1.60 2002/04/14 16:53:10 carl
- + align code section and data section according to alignment rules
- Revision 1.59 2002/04/07 17:58:38 carl
- + generic stack checking
- Revision 1.58 2002/04/04 19:06:03 peter
- * removed unused units
- * use tlocation.size in cg.a_*loc*() routines
- }
|