From 01fd6782113d5402fc3e54ffa920800e6fc67a04 Mon Sep 17 00:00:00 2001 From: florian Date: Thu, 1 Nov 2007 23:20:28 +0000 Subject: [PATCH] + basic parsing of package files + basic implementation of creation of packages git-svn-id: trunk@9054 - --- compiler/comphook.pas | 1 + compiler/fmodule.pas | 2 + compiler/parser.pas | 5 + compiler/pmodules.pas | 302 +++++++++++++++++++++++++++++++++++++ compiler/systems/t_win.pas | 31 ++-- 5 files changed, 328 insertions(+), 13 deletions(-) diff --git a/compiler/comphook.pas b/compiler/comphook.pas index d64a4e7833..05c9282e58 100644 --- a/compiler/comphook.pas +++ b/compiler/comphook.pas @@ -87,6 +87,7 @@ type datasize : aint; { program info } isexe, + ispackage, islibrary : boolean; { Settings for the output } verbosity : longint; diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas index 65b336c623..4813a13c01 100644 --- a/compiler/fmodule.pas +++ b/compiler/fmodule.pas @@ -115,6 +115,7 @@ interface interface_crc : cardinal; flags : cardinal; { the PPU flags } islibrary : boolean; { if it is a library (win32 dll) } + IsPackage : boolean; moduleid : longint; unitmap : punitmap; { mapping of all used units } unitmapsize : longint; { number of units in the map } @@ -498,6 +499,7 @@ implementation in_global:=true; is_unit:=_is_unit; islibrary:=false; + ispackage:=false; is_dbginfo_written:=false; is_reset:=false; mode_switch_allowed:= true; diff --git a/compiler/parser.pas b/compiler/parser.pas index 47509f996e..71ca68bafc 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -378,6 +378,11 @@ implementation current_module.is_unit:=true; proc_unit; end + else if (token=_ID) and (idtoken=_PACKAGE) then + begin + current_module.IsPackage:=true; + proc_package; + end else proc_program(token=_LIBRARY); except diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index c189132473..1086d035b8 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -26,6 +26,7 @@ unit pmodules; interface procedure proc_unit; + procedure proc_package; procedure proc_program(islibrary : boolean); @@ -1187,6 +1188,306 @@ implementation end; + procedure insert_export(sym : TObject;arg:pointer); + var + hp : texported_item; + i : longint; + begin + case TSym(sym).typ of + { ignore: } + unitsym, + syssym, + constsym, + enumsym, + typesym: + ; + procsym: + begin + for i:=0 to tprocsym(sym).ProcdefList.Count-1 do + begin + if not(tprocdef(tprocsym(sym).ProcdefList[i]).proccalloption in [pocall_internproc]) then + begin + hp:=texported_item.create; + // hp.sym:=tsym(sym); + hp.name:=stringdup(tprocdef(tprocsym(sym).ProcdefList[i]).mangledname); + hp.options:=hp.options or eo_name; + exportlib.exportprocedure(hp) + end; + end; + end; + staticvarsym: + begin + hp:=texported_item.create; + // hp.sym:=tsym(sym); + hp.name:=stringdup(tsym(sym).mangledname); + hp.options:=hp.options or eo_name; + exportlib.exportvar(hp); + end; + else + begin + writeln('unknown: ',ord(TSym(sym).typ)); + end; + end; + end; + + + procedure proc_package; + var + main_file : tinputfile; + hp,hp2 : tmodule; + finalize_procinfo, + init_procinfo, + main_procinfo : tcgprocinfo; + force_init_final : boolean; + uu : tused_unit; + begin + Status.IsPackage:=true; + Status.IsExe:=true; + parse_only:=false; + main_procinfo:=nil; + init_procinfo:=nil; + finalize_procinfo:=nil; + + if not RelocSectionSetExplicitly then + RelocSection:=true; + + { Relocation works only without stabs under Windows when } + { external linker (LD) is used. LD generates relocs for } + { stab sections which is not loaded in memory. It causes } + { AV error when DLL is loaded and relocation is needed. } + { Internal linker does not have this problem. } + if RelocSection and + (target_info.system in system_all_windows+[system_i386_wdosx]) and + (cs_link_extern in current_settings.globalswitches) then + begin + include(current_settings.globalswitches,cs_link_strip); + { Warning stabs info does not work with reloc section !! } + if cs_debuginfo in current_settings.moduleswitches then + begin + Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^); + Message(parser_w_parser_win32_debug_needs_WN); + exclude(current_settings.moduleswitches,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); + + consume(_ID); + current_module.setmodulename(orgpattern); + current_module.ispackage:=true; + exportlib.preparelib(orgpattern); + + if tf_library_needs_pic in target_info.flags then + include(current_settings.moduleswitches,cs_create_pic); + + consume(_ID); + consume(_SEMICOLON); + + { global switches are read, so further changes aren't allowed } + current_module.in_global:=false; + + { setup things using the switches } + 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 } + current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid); + + {Load the units used by the program we compile.} + if token=_REQUIRES then + begin + end; + + {Load the units used by the program we compile.} + if (token=_ID) and (idtoken=_CONTAINS) then + begin + consume(_ID); + while true do + begin + if token=_ID then + AddUnit(pattern); + consume(_ID); + if token=_COMMA then + consume(_COMMA) + else break; + end; + consume(_SEMICOLON); + end; + + { 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 + current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module)); + + Message1(parser_u_parsing_implementation,current_module.mainsource^); + + symtablestack.push(current_module.localsymtable); + + { should we force unit initialization? } + force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final; + if force_init_final then + init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable); + + { 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 and uf_has_exports)<>0) then + current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0)); + + { all labels must be defined before generating code } + if Errorcount=0 then + tstoredsymtable(current_module.localsymtable).checklabels; + + symtablestack.pop(current_module.localsymtable); + + { consume the last point } + consume(_END); + consume(_POINT); + + if (Errorcount=0) then + begin + { test static symtable } + tstoredsymtable(current_module.localsymtable).allsymbolsused; + tstoredsymtable(current_module.localsymtable).allprivatesused; + tstoredsymtable(current_module.localsymtable).check_forwards; + tstoredsymtable(current_module.localsymtable).unchain_overloaded; + + current_module.allunitsused; + end; + + new_section(current_asmdata.asmlists[al_globals],sec_data,'_FPCDummy',4); + current_asmdata.asmlists[al_globals].concat(tai_symbol.createname_global('_FPCDummy',AT_DATA,0)); + current_asmdata.asmlists[al_globals].concat(tai_const.create_32bit(0)); + + new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0); + current_asmdata.asmlists[al_procedures].concat(tai_symbol.createname_global('_DLLMainCRTStartup',AT_FUNCTION,0)); + current_asmdata.asmlists[al_procedures].concat(tai_const.createname('_FPCDummy',0)); + + { 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; + + { force exports } + uu:=tused_unit(usedunits.first); + while assigned(uu) do + begin + uu.u.globalsymtable.symlist.ForEachCall(@insert_export,nil); + uu:=tused_unit(uu.next); + end; + +{$ifdef arm} + { Insert .pdata section for arm-wince. + It is needed for exception handling. } + if target_info.system in [system_arm_wince] then + InsertPData; +{$endif arm} + + { generate imports } + if current_module.ImportLibraryList.Count>0 then + importlib.generatelib; + + { generate debuginfo } + if (cs_debuginfo in current_settings.moduleswitches) then + current_debuginfo.inserttypeinfo; + + exportlib.generatelib; + + { Reference all DEBUGINFO sections from the main .fpc section } + if (cs_debuginfo in current_settings.moduleswitches) then + current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]); + + { insert own objectfile } + insertobjectfile; + + { assemble and link } + create_objectfile; + + { We might need the symbols info if not using + the default do_extractsymbolinfo + which is a dummy function PM } + needsymbolinfo:=do_extractsymbolinfo<>@def_extractsymbolinfo; + { release all local symtables that are not needed anymore } + if (not needsymbolinfo) then + 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; + + if (not current_module.is_unit) then + begin + { create the executable when we are at level 1 } + if (compile_level=1) then + begin + { create global resource file by collecting all resource files } + CollectResourceFiles; + { write .def file } + if (cs_link_deffile in current_settings.globalswitches) then + deffile.writefile; + { insert all .o files from all loaded units and + unload the units, we don't need them anymore. + Keep the current_module because that is still needed } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + { the package itself contains no code so far } + linker.AddModuleFiles(hp); + hp2:=tmodule(hp.next); + if (hp<>current_module) and + (not needsymbolinfo) then + begin + loaded_units.remove(hp); + hp.free; + end; + hp:=hp2; + end; + linker.MakeSharedLibrary + end; + + { Give Fatal with error count for linker errors } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + end; + end; + end; + + procedure proc_program(islibrary : boolean); var main_file : tinputfile; @@ -1198,6 +1499,7 @@ implementation begin DLLsource:=islibrary; Status.IsLibrary:=IsLibrary; + Status.IsPackage:=false; Status.IsExe:=true; parse_only:=false; main_procinfo:=nil; diff --git a/compiler/systems/t_win.pas b/compiler/systems/t_win.pas index e1a1dce9a5..dfefc3884a 100644 --- a/compiler/systems/t_win.pas +++ b/compiler/systems/t_win.pas @@ -638,7 +638,7 @@ implementation procedure TExportLibWin.exportprocedure(hp : texported_item); begin - if ((hp.options and eo_index)<>0)and((hp.index<=0) or (hp.index>$ffff)) then + if ((hp.options and eo_index)<>0) and ((hp.index<=0) or (hp.index>$ffff)) then begin message1(parser_e_export_invalid_index,tostr(hp.index)); exit; @@ -705,9 +705,9 @@ implementation autoindex:=1; while EList_nonindexed.Count>0 do begin - hole:=(EList_indexed.Count>0)and(texported_item(EList_indexed.Items[0]).index>1); + hole:=(EList_indexed.Count>0) and (texported_item(EList_indexed.Items[0]).index>1); if not hole then - for i:=autoindex to pred(EList_indexed.Count)do + for i:=autoindex to pred(EList_indexed.Count) do if texported_item(EList_indexed.Items[i]).index-texported_item(EList_indexed.Items[pred(i)]).index>1 then begin autoindex:=succ(texported_item(EList_indexed.Items[pred(i)]).index); @@ -726,8 +726,8 @@ implementation texported_item(EList_indexed.Items[pred(AutoIndex)]).index:=autoindex; end; FreeAndNil(EList_nonindexed); - for i:=0 to pred(EList_indexed.Count)do - exportfromlist(texported_item(EList_indexed.Items[i])); + for i:=0 to pred(EList_indexed.Count) do + exportfromlist(texported_item(EList_indexed.Items[i])); FreeAndNil(EList_indexed); if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then @@ -856,14 +856,19 @@ implementation address_table.concat(Tai_const.Create_32bit(0)); inc(current_index); end; - case hp.sym.typ of - staticvarsym : - asmsym:=current_asmdata.RefAsmSymbol(tstaticvarsym(hp.sym).mangledname); - procsym : - asmsym:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname); - else - internalerror(200709272); - end; + + { symbol known? then get a new name } + if assigned(hp.sym) then + case hp.sym.typ of + staticvarsym : + asmsym:=current_asmdata.RefAsmSymbol(tstaticvarsym(hp.sym).mangledname); + procsym : + asmsym:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname) + else + internalerror(200709272); + end + else + asmsym:=current_asmdata.RefAsmSymbol(hp.name^); address_table.concat(Tai_const.Create_rva_sym(asmsym)); inc(current_index); hp:=texported_item(hp.next);