{ Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman Reads command line options and config files 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 options; {$i fpcdefs.inc} interface uses CClasses,CFileUtils, globtype,globals,verbose,systems,cpuinfo; Type TOption=class FirstPass, ParaLogo, NoPressEnter, LogoWritten : boolean; FileLevel : longint; QuickInfo : string; ParaIncludePath, ParaUnitPath, ParaObjectPath, ParaLibraryPath : TSearchPathList; ParaAlignment : TAlignmentInfo; Constructor Create; Destructor Destroy;override; procedure WriteLogo; procedure WriteInfo; procedure WriteHelpPages; procedure WriteQuickInfo; procedure IllegalPara(const opt:string); function Unsetbool(var Opts:string; Pos: Longint):boolean; procedure interpret_option(const opt :string;ispara:boolean); procedure Interpret_envvar(const envname : string); procedure Interpret_file(const filename : string); procedure Read_Parameters; procedure parsecmd(cmd:string); procedure TargetDefines(def:boolean); end; TOptionClass=class of toption; var coption : TOptionClass; procedure read_arguments(cmd:string); implementation uses widestr, SysUtils, version, cutils,cmsgs, comphook, symtable,scanner,rabase ; const page_size = 24; var option : toption; read_configfile, { read config file, set when a cfgfile is found } disable_configfile : boolean; fpcdir, ppccfg, ppcaltcfg, param_file : string; { file to compile specified on the commandline } {**************************************************************************** Defines ****************************************************************************} procedure set_default_link_type; begin undef_system_macro('FPC_LINK_SMART'); def_system_macro('FPC_LINK_STATIC'); undef_system_macro('FPC_LINK_DYNAMIC'); init_settings.globalswitches:=init_settings.globalswitches+[cs_link_static]; init_settings.globalswitches:=init_settings.globalswitches-[cs_link_shared,cs_link_smart]; end; {**************************************************************************** Toption ****************************************************************************} procedure StopOptions(err:longint); begin if assigned(Option) then begin Option.free; Option:=nil; end; raise ECompilerAbortSilent.Create; end; procedure Toption.WriteLogo; var p : pchar; begin if not LogoWritten then begin p:=MessagePchar(option_logo); while assigned(p) do Comment(V_Normal,GetMsgLine(p)); LogoWritten:= true; end; end; procedure Toption.WriteInfo; var p : pchar; hs,hs1,s : TCmdStr; target : tsystem; cpu : tcputype; fpu : tfputype; opt : toptimizerswitch; begin p:=MessagePchar(option_info); while assigned(p) do begin s:=GetMsgLine(p); { list OS Targets } if pos('$OSTARGETS',s)>0 then begin for target:=low(tsystem) to high(tsystem) do if assigned(targetinfos[target]) then begin hs:=s; hs1:=targetinfos[target]^.name; if tf_under_development in targetinfos[target]^.flags then hs1:=hs1+' (under development)'; Replace(hs,'$OSTARGETS',hs1); Comment(V_Normal,hs); end; end else if pos('$INSTRUCTIONSETS',s)>0 then begin for cpu:=low(tcputype) to high(tcputype) do begin hs:=s; hs1:=cputypestr[cpu]; if hs1<>'' then begin Replace(hs,'$INSTRUCTIONSETS',hs1); Comment(V_Normal,hs); end; end; end else if pos('$FPUINSTRUCTIONSETS',s)>0 then begin for fpu:=low(tfputype) to high(tfputype) do begin hs:=s; hs1:=fputypestr[fpu]; if hs1<>'' then begin Replace(hs,'$FPUINSTRUCTIONSETS',hs1); Comment(V_Normal,hs); end; end; end else if pos('$OPTIMIZATIONS',s)>0 then begin for opt:=low(toptimizerswitch) to high(toptimizerswitch) do begin if opt in supported_optimizerswitches then begin hs:=s; hs1:=OptimizerSwitchStr[opt]; if hs1<>'' then begin Replace(hs,'$OPTIMIZATIONS',hs1); Comment(V_Normal,hs); end; end; end; end else Comment(V_Normal,s); end; StopOptions(0); end; procedure Toption.WriteHelpPages; function PadEnd(s:string;i:longint):string; begin while (length(s)0) then begin Comment(V_Normal,''); inc(Lines); end; { page full ? } if (lines >= page_size - 1) then begin if not NoPressEnter then begin Message(option_help_press_enter); readln(input); if upper(input)='Q' then StopOptions(0); end; lines:=0; end; Comment(V_Normal,PadEnd('',ident)+opt+Copy(s,j+1,255)); LastIdent:=Ident; inc(Lines); end; end; StopOptions(0); end; procedure Toption.IllegalPara(const opt:string); begin Message1(option_illegal_para,opt); Message(option_help_pages_para); StopOptions(1); end; function Toption.Unsetbool(var Opts:string; Pos: Longint):boolean; { checks if the character after pos in Opts is a + or a - and returns resp. false or true. If it is another character (or none), it also returns false } begin UnsetBool := false; if Length(Opts)>Pos then begin inc(Pos); UnsetBool := Opts[Pos] = '-'; if Opts[Pos] in ['-','+']then delete(Opts,Pos,1); end; end; procedure TOption.interpret_option(const opt:string;ispara:boolean); var code : integer; c : char; more : string; major,minor : longint; error : integer; j,l : longint; d,s : string; begin if opt='' then exit; { only parse define,undef,target,verbosity,link etc options the firsttime } if firstpass and not( (opt[1]='-') and ( ((length(opt)>1) and (opt[2] in ['i','d','v','T','u','n','X','l'])) or ((length(opt)>3) and (opt[2]='F') and (opt[3]='e')) ) ) then exit; Message1(option_handling_option,opt); case opt[1] of '-' : begin more:=Copy(opt,3,255); if firstpass then Message1(option_interpreting_firstpass_option,opt) else Message1(option_interpreting_option,opt); case opt[2] of '?' : WriteHelpPages; 'a' : begin include(init_settings.globalswitches,cs_asm_leave); j:=1; while j<=length(more) do begin case more[j] of 'l' : include(init_settings.globalswitches,cs_asm_source); 'r' : include(init_settings.globalswitches,cs_asm_regalloc); 't' : include(init_settings.globalswitches,cs_asm_tempalloc); 'n' : include(init_settings.globalswitches,cs_asm_nodes); 'p' : begin exclude(init_settings.globalswitches,cs_asm_leave); if UnsetBool(More, 0) then exclude(init_settings.globalswitches,cs_asm_pipe) else include(init_settings.globalswitches,cs_asm_pipe); end; '-' : init_settings.globalswitches:=init_settings.globalswitches - [cs_asm_leave, cs_asm_source,cs_asm_regalloc, cs_asm_tempalloc, cs_asm_nodes, cs_asm_pipe]; else IllegalPara(opt); end; inc(j); end; end; 'A' : begin paratargetasm:=find_asm_by_string(More); if paratargetasm=as_none then IllegalPara(opt); end; 'b' : begin Message1(option_obsolete_switch,'-b'); end; 'B' : do_build:=not UnSetBool(more,0); 'C' : begin j:=1; while j<=length(more) do begin case more[j] of 'c' : begin if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),init_settings.defproccall) then IllegalPara(opt); break; end; {$ifdef cpufpemu} 'e' : begin If UnsetBool(More, j) then exclude(init_settings.moduleswitches,cs_fp_emulation) Else include(init_settings.moduleswitches,cs_fp_emulation); end; {$endif cpufpemu} 'f' : begin s:=upper(copy(more,j+1,length(more)-j)); if not(SetFpuType(s,init_settings.fputype)) then IllegalPara(opt); break; end; 'g' : include(init_settings.moduleswitches,cs_create_pic); 'h' : begin val(copy(more,j+1,length(more)-j),heapsize,code); if (code<>0) or (heapsize<1024) then IllegalPara(opt); break; end; 'i' : If UnsetBool(More, j) then exclude(init_settings.localswitches,cs_check_io) else include(init_settings.localswitches,cs_check_io); 'n' : If UnsetBool(More, j) then exclude(init_settings.globalswitches,cs_link_nolink) Else include(init_settings.globalswitches,cs_link_nolink); 'o' : If UnsetBool(More, j) then exclude(init_settings.localswitches,cs_check_overflow) Else include(init_settings.localswitches,cs_check_overflow); 'p' : begin s:=upper(copy(more,j+1,length(more)-j)); if not(Setcputype(s,init_settings.cputype)) then IllegalPara(opt); break; end; 'r' : If UnsetBool(More, j) then exclude(init_settings.localswitches,cs_check_range) Else include(init_settings.localswitches,cs_check_range); 'R' : If UnsetBool(More, j) then begin exclude(init_settings.localswitches,cs_check_range); exclude(init_settings.localswitches,cs_check_object); end Else begin include(init_settings.localswitches,cs_check_range); include(init_settings.localswitches,cs_check_object); end; 's' : begin val(copy(more,j+1,length(more)-j),stacksize,code); if (code<>0) or (stacksize>=67107840) or (stacksize<1024) then IllegalPara(opt); break; end; 't' : If UnsetBool(More, j) then exclude(init_settings.localswitches,cs_check_stack) Else include(init_settings.localswitches,cs_check_stack); 'D' : If UnsetBool(More, j) then exclude(init_settings.moduleswitches,cs_create_dynamic) Else include(init_settings.moduleswitches,cs_create_dynamic); 'X' : If UnsetBool(More, j) then exclude(init_settings.moduleswitches,cs_create_smart) Else include(init_settings.moduleswitches,cs_create_smart); else IllegalPara(opt); end; inc(j); end; end; 'd' : if more <> '' then begin l:=Pos(':=',more); if l>0 then set_system_compvar(Copy(more,1,l-1),Copy(more,l+2,255)) else def_system_macro(more); end; 'D' : begin include(init_settings.globalswitches,cs_link_deffile); j:=1; while j<=length(more) do begin case more[j] of 'd' : begin description:=Copy(more,j+1,255); break; end; 'v' : begin dllversion:=Copy(more,j+1,255); l:=pos('.',dllversion); dllminor:=0; error:=0; if l>0 then begin val(copy(dllversion,l+1,255),minor,error); if (error=0) and (minor>=0) and (minor<=$ffff) then dllminor:=minor else if error=0 then error:=1; end; if l=0 then l:=256; dllmajor:=1; if error=0 then val(copy(dllversion,1,l-1),major,error); if (error=0) and (major>=0) and (major<=$ffff) then dllmajor:=major else if error=0 then error:=1; if error<>0 then Message1(scan_w_wrong_version_ignored,dllversion); break; end; 'w' : usewindowapi:=true; '-' : begin exclude(init_settings.globalswitches,cs_link_deffile); usewindowapi:=false; end; else IllegalPara(opt); end; inc(j); end; end; 'e' : exepath:=FixPath(More,true); 'E' : begin if UnsetBool(More, 0) then exclude(init_settings.globalswitches,cs_link_nolink) else include(init_settings.globalswitches,cs_link_nolink); end; 'F' : begin c:=more[1]; Delete(more,1,1); DefaultReplacements(More); case c of 'a' : autoloadunits:=more; 'c' : begin if (upper(more)='UTF8') or (upper(more)='UTF-8') then init_settings.sourcecodepage:='utf8' else if not(cpavailable(more)) then Message1(option_code_page_not_available,more) else init_settings.sourcecodepage:=more; end; 'D' : utilsdirectory:=FixPath(More,true); 'e' : SetRedirectFile(More); 'E' : OutputExeDir:=FixPath(More,true); 'i' : begin if ispara then ParaIncludePath.AddPath(More,false) else includesearchpath.AddPath(More,true); end; 'g' : Message2(option_obsolete_switch_use_new,'-Fg','-Fl'); 'l' : begin if ispara then ParaLibraryPath.AddPath(More,false) else LibrarySearchPath.AddPath(More,true); end; 'L' : begin if More<>'' then ParaDynamicLinker:=More else IllegalPara(opt); end; 'o' : begin if ispara then ParaObjectPath.AddPath(More,false) else ObjectSearchPath.AddPath(More,true); end; 'r' : Msgfilename:=More; 'u' : begin if ispara then ParaUnitPath.AddPath(More,false) else unitsearchpath.AddPath(More,true); end; 'U' : OutputUnitDir:=FixPath(More,true); else IllegalPara(opt); end; end; 'g' : begin if UnsetBool(More, 0) then begin exclude(init_settings.moduleswitches,cs_debuginfo); exclude(init_settings.globalswitches,cs_use_heaptrc); exclude(init_settings.globalswitches,cs_use_lineinfo); exclude(init_settings.localswitches,cs_checkpointer); localvartrashing := -1; end else begin include(init_settings.moduleswitches,cs_debuginfo); end; if not RelocSectionSetExplicitly then RelocSection:=false; j:=1; while j<=length(more) do begin case more[j] of 'c' : begin if UnsetBool(More, j) then exclude(init_settings.localswitches,cs_checkpointer) else include(init_settings.localswitches,cs_checkpointer); end; 'd' : begin paratargetdbg:=dbg_dwarf2; end; 'h' : begin if UnsetBool(More, j) then exclude(init_settings.globalswitches,cs_use_heaptrc) else include(init_settings.globalswitches,cs_use_heaptrc); end; 'l' : begin if UnsetBool(More, j) then exclude(init_settings.globalswitches,cs_use_lineinfo) else include(init_settings.globalswitches,cs_use_lineinfo); end; 's' : begin paratargetdbg:=dbg_stabs; end; 't' : begin if UnsetBool(More, j) then localvartrashing := -1 else localvartrashing := (localvartrashing + 1) mod nroftrashvalues; end; 'v' : begin if UnsetBool(More, j) then exclude(init_settings.globalswitches,cs_gdb_valgrind) else include(init_settings.globalswitches,cs_gdb_valgrind); end; 'w' : begin if (j'' then ParaLinkOptions:=ParaLinkOptions+' '+More else IllegalPara(opt); end; 'l' : if not UnSetBool(more,0) then ParaLogo:=true; 'm' : parapreprocess:=not UnSetBool(more,0); 'M' : begin more:=Upper(more); if not SetCompileMode(more, true) then IllegalPara(opt); end; 'n' : begin if More='' then disable_configfile:=true else IllegalPara(opt); end; 'o' : begin if More<>'' then begin DefaultReplacements(More); D:=ExtractFilePath(More); if (D<>'') then OutputExeDir:=FixPath(D,True); OutputFileName:=ExtractFileName(More); end else IllegalPara(opt); end; 'O' : begin j:=1; while j<=length(more) do begin case more[j] of '1' : init_settings.optimizerswitches:=init_settings.optimizerswitches+level1optimizerswitches; '2' : init_settings.optimizerswitches:=init_settings.optimizerswitches+level2optimizerswitches; '3' : init_settings.optimizerswitches:=init_settings.optimizerswitches+level3optimizerswitches; 'a' : begin if not(UpdateAlignmentStr(Copy(Opt,j+3,255),ParaAlignment)) then IllegalPara(opt); break; end; 's' : include(init_settings.optimizerswitches,cs_opt_size); 'p' : begin if not Setcputype(copy(more,j+1,length(more)),init_settings.optimizecputype) then begin { Give warning for old i386 switches } if (Length(More)-j=1) and (More[j+1]>='1') and (More[j+1]<='5')then Message2(option_obsolete_switch_use_new,'-Op','-Op') else IllegalPara(opt); end; break; end; 'o' : begin if not UpdateOptimizerStr(copy(more,j+1,length(more)),init_settings.optimizerswitches) then IllegalPara(opt); break; end; '-' : begin init_settings.optimizerswitches:=[]; FillChar(ParaAlignment,sizeof(ParaAlignment),0); end; { Obsolete switches } 'g' : Message2(option_obsolete_switch_use_new,'-Og','-Os'); 'G' : Message1(option_obsolete_switch,'-OG'); 'r' : Message2(option_obsolete_switch_use_new,'-Or','-O2 or -Ooregvar'); 'u' : Message2(option_obsolete_switch_use_new,'-Ou','-Oouncertain'); else IllegalPara(opt); end; inc(j); end; end; 'p' : begin if UnsetBool(More, 0) then begin init_settings.moduleswitches:=init_settings.moduleswitches-[cs_profile]; undef_system_macro('FPC_PROFILE'); end else if Length(More)=0 then IllegalPara(opt) else case more[1] of 'g' : if UnsetBool(more, 1) then begin exclude(init_settings.moduleswitches,cs_profile); undef_system_macro('FPC_PROFILE'); end else begin include(init_settings.moduleswitches,cs_profile); def_system_macro('FPC_PROFILE'); end; else IllegalPara(opt); end; end; 'P' : ; { Ignore used by fpc.pp } 'R' : begin if not SetAsmReadMode(More,init_settings.asmmode) then IllegalPara(opt); end; 's' : begin if UnsetBool(More, 0) then begin init_settings.globalswitches:=init_settings.globalswitches-[cs_asm_extern,cs_link_extern,cs_link_nolink]; if more<>'' then IllegalPara(opt); end else begin init_settings.globalswitches:=init_settings.globalswitches+[cs_asm_extern,cs_link_extern,cs_link_nolink]; if more='h' then init_settings.globalswitches:=init_settings.globalswitches-[cs_link_on_target] else if more='t' then init_settings.globalswitches:=init_settings.globalswitches+[cs_link_on_target] else if more='r' then init_settings.globalswitches:=init_settings.globalswitches+[cs_asm_leave,cs_no_regalloc] else if more<>'' then IllegalPara(opt); end; end; 'S' : begin if more[1]='I' then begin if upper(more)='ICOM' then init_settings.interfacetype:=it_interfacecom else if upper(more)='ICORBA' then init_settings.interfacetype:=it_interfacecorba else IllegalPara(opt); end else begin j:=1; while j<=length(more) do begin case more[j] of '2' : //an alternative to -Mobjfpc SetCompileMode('OBJFPC',true); 'a' : include(init_settings.localswitches,cs_do_assertion); 'c' : include(init_settings.moduleswitches,cs_support_c_operators); 'd' : //an alternative to -Mdelphi SetCompileMode('DELPHI',true); 'e' : begin SetErrorFlags(copy(more,j+1,length(more))); break; end; 'g' : include(init_settings.moduleswitches,cs_support_goto); 'h' : include(init_settings.localswitches,cs_ansistrings); 'i' : include(init_settings.localswitches,cs_do_inline); 'k' : include(init_settings.globalswitches,cs_load_fpcylix_unit); 'm' : include(init_settings.moduleswitches,cs_support_macro); 'o' : //an alternative to -Mtp SetCompileMode('TP',true); 'p' : //an alternative to -Mgpc SetCompileMode('GPC',true); 's' : include(init_settings.globalswitches,cs_constructor_name); 't' : include(init_settings.moduleswitches,cs_static_keyword); 'v' : include(init_settings.globalswitches,cs_support_vectors); 'x' : include(init_settings.globalswitches,cs_support_exceptions); '-' : begin init_settings.globalswitches:=init_settings.globalswitches - [cs_constructor_name,cs_support_exceptions]; init_settings.localswitches:=init_settings.localswitches - [cs_do_assertion, cs_do_inline, cs_ansistrings]; init_settings.moduleswitches:=init_settings.moduleswitches - [cs_support_c_operators, cs_support_goto, cs_support_macro, cs_static_keyword]; end; else IllegalPara(opt); end; inc(j); end; end; end; 'T' : begin more:=Upper(More); if paratarget=system_none then begin { remove old target define } TargetDefines(false); { load new target } paratarget:=find_system_by_string(More); if paratarget<>system_none then set_target(paratarget) else IllegalPara(opt); { set new define } TargetDefines(true); end else if More<>upper(target_info.shortname) then Message1(option_target_is_already_set,target_info.shortname); end; 'u' : if more <> '' then undef_system_macro(more); 'U' : begin j:=1; while j<=length(more) do begin case more[j] of {$ifdef UNITALIASES} 'a' : begin AddUnitAlias(Copy(More,j+1,255)); break; end; {$endif UNITALIASES} 'n' : exclude(init_settings.globalswitches,cs_check_unit_name); 'p' : begin Message2(option_obsolete_switch_use_new,'-Up','-Fu'); break; end; 'r' : do_release:=true; 's' : include(init_settings.moduleswitches,cs_compilesystem); '-' : begin exclude(init_settings.moduleswitches,cs_compilesystem); exclude(init_settings.globalswitches,cs_check_unit_name); end; else IllegalPara(opt); end; inc(j); end; end; 'v' : begin if not setverbosity(More) then IllegalPara(opt); end; 'V' : ; { Ignore used by fpc } 'W' : begin j:=1; while j<=length(More) do begin case More[j] of 'A': begin if UnsetBool(More, j) then apptype:=app_native else apptype:=app_cui; end; 'B': begin { -WB200000 means set trefered base address to $200000, but does not change relocsection boolean this way we can create both relocatble and non relocatable DLL at a specific base address PM } if (length(More)>j) then begin if DLLImageBase=nil then DLLImageBase:=StringDup(Copy(More,j+1,255)); end else begin RelocSection:=true; RelocSectionSetExplicitly:=true; end; break; end; 'C': begin if UnsetBool(More, j) then apptype:=app_gui else apptype:=app_cui; end; 'D': begin UseDeffileForExports:=not UnsetBool(More, j); UseDeffileForExportsSetExplicitly:=true; end; 'F': begin if UnsetBool(More, j) then apptype:=app_cui else apptype:=app_fs; end; 'G': begin if UnsetBool(More, j) then apptype:=app_cui else apptype:=app_gui; end; 'I': begin GenerateImportSection:=not UnsetBool(More,j); GenerateImportSectionSetExplicitly:=true; end; 'N': begin RelocSection:=UnsetBool(More,j); RelocSectionSetExplicitly:=true; end; 'R': begin { support -WR+ / -WR- as synonyms to -WR / -WN } RelocSection:=not UnsetBool(More,j); RelocSectionSetExplicitly:=true; end; 'T': begin if UnsetBool(More, j) then apptype:=app_cui else apptype:=app_tool; end; else IllegalPara(opt); end; inc(j); end; end; 'X' : begin j:=1; while j<=length(more) do begin case More[j] of 'c' : Cshared:=TRUE; 'd' : Dontlinkstdlibpath:=TRUE; 'e' : begin If UnsetBool(More, j) then exclude(init_settings.globalswitches,cs_link_extern) else include(init_settings.globalswitches,cs_link_extern); end; 'f' : include(init_settings.globalswitches,cs_link_pthread); 'i' : begin If UnsetBool(More, j) then include(init_settings.globalswitches,cs_link_extern) else exclude(init_settings.globalswitches,cs_link_extern); end; 'm' : begin If UnsetBool(More, j) then exclude(init_settings.globalswitches,cs_link_map) else include(init_settings.globalswitches,cs_link_map); end; 'p' : ; { Ignore used by fpc.pp } 'r' : begin rlinkpath:=Copy(more,2,length(More)-1); DefaultReplacements(rlinkpath); More:=''; end; 's' : begin If UnsetBool(More, j) then exclude(init_settings.globalswitches,cs_link_strip) else include(init_settings.globalswitches,cs_link_strip); end; 't' : include(init_settings.globalswitches,cs_link_staticflag); 'v' : begin If UnsetBool(More, j) then exclude(init_settings.globalswitches,cs_link_opt_vtable) else include(init_settings.globalswitches,cs_link_opt_vtable); end; 'D' : begin def_system_macro('FPC_LINK_DYNAMIC'); undef_system_macro('FPC_LINK_SMART'); undef_system_macro('FPC_LINK_STATIC'); exclude(init_settings.globalswitches,cs_link_static); exclude(init_settings.globalswitches,cs_link_smart); include(init_settings.globalswitches,cs_link_shared); LinkTypeSetExplicitly:=true; end; 'M' : begin mainaliasname:=Copy(more,2,length(More)-1); More:=''; end; 'P' : begin utilsprefix:=Copy(more,2,length(More)-1); DefaultReplacements(utilsprefix); More:=''; end; 'L' : begin // -XLO is link order -XLA is link alias. -XLD avoids load defaults. // these are not aggregable. if (j=length(more)) or not (more[j+1] in ['O','A','D']) then IllegalPara(opt) else begin case more[j+1] of 'A' : begin s:=Copy(more,3,length(More)-2); if not LinkLibraryAliases.AddDep(s) Then IllegalPara(opt); end; 'O' : begin s:=Copy(more,3,length(More)-2); if not LinkLibraryOrder.AddWeight(s) Then IllegalPara(opt); end; 'D' : include(init_settings.globalswitches,cs_link_no_default_lib_order) else IllegalPara(opt); end; {case} j:=length(more); end; {else begin} end; 'S' : begin def_system_macro('FPC_LINK_STATIC'); undef_system_macro('FPC_LINK_SMART'); undef_system_macro('FPC_LINK_DYNAMIC'); include(init_settings.globalswitches,cs_link_static); exclude(init_settings.globalswitches,cs_link_smart); exclude(init_settings.globalswitches,cs_link_shared); LinkTypeSetExplicitly:=true; end; 'X' : begin def_system_macro('FPC_LINK_SMART'); undef_system_macro('FPC_LINK_STATIC'); undef_system_macro('FPC_LINK_DYNAMIC'); exclude(init_settings.globalswitches,cs_link_static); include(init_settings.globalswitches,cs_link_smart); exclude(init_settings.globalswitches,cs_link_shared); LinkTypeSetExplicitly:=true; end; '-' : begin exclude(init_settings.globalswitches,cs_link_staticflag); exclude(init_settings.globalswitches,cs_link_strip); exclude(init_settings.globalswitches,cs_link_map); set_default_link_type; end; else IllegalPara(opt); end; inc(j); end; end; end; end; '@' : begin Message(option_no_nested_response_file); StopOptions(1); end; else begin if (length(param_file)<>0) then Message(option_only_one_source_support); param_file:=opt; Message1(option_found_file,opt); end; end; end; procedure Toption.Interpret_file(const filename : string); procedure RemoveSep(var fn:string); var i : longint; begin i:=0; while (i0) and (fn[i] in [',',' ',#9]) do dec(i); fn:=copy(fn,1,i); end; function GetName(var fn:string):string; var i : longint; begin i:=0; while (iMaxLevel then Message(option_too_many_cfg_files); { Maybe It's Directory ?} //Jaro Change: if PathExists(filename,false) then begin Message1(option_config_is_dir,filename); exit; end; { open file } Message1(option_using_file,filename); assign(f,ExpandFileName(filename)); {$I-} reset(f); {$I+} if ioresult<>0 then begin Message1(option_unable_open_file,filename); exit; end; Message1(option_start_reading_configfile,filename); fillchar(skip,sizeof(skip),0); level:=0; while not eof(f) do begin readln(f,opts); RemoveSep(opts); if (opts<>'') and (opts[1]<>';') then begin if opts[1]='#' then begin Message1(option_interpreting_file_option,opts); Delete(opts,1,1); s:=upper(GetName(opts)); if (s='SECTION') then begin RemoveSep(opts); s:=upper(GetName(opts)); if level=0 then skip[level]:=not (assigned(search_macro(s)) or (s='COMMON')); end else if (s='IFDEF') then begin RemoveSep(opts); if Level>=maxlevel then begin Message(option_too_many_ifdef); stopOptions(1); end; inc(Level); skip[level]:=(skip[level-1] or not assigned(search_macro(upper(GetName(opts))))); end else if (s='IFNDEF') then begin RemoveSep(opts); if Level>=maxlevel then begin Message(option_too_many_ifdef); stopOptions(1); end; inc(Level); skip[level]:=(skip[level-1] or assigned(search_macro(upper(GetName(opts))))); end else if (s='ELSE') then skip[level]:=skip[level-1] or (not skip[level]) else if (s='ENDIF') then begin skip[level]:=false; if Level=0 then begin Message(option_too_many_endif); stopOptions(1); end; dec(level); end else if (not skip[level]) then begin if (s='DEFINE') then begin RemoveSep(opts); tmp:= GetName(opts); if tmp <> '' then def_system_macro(tmp); end else if (s='UNDEF') then begin RemoveSep(opts); tmp:= GetName(opts); if tmp <> '' then undef_system_macro(tmp); end else if (s='WRITE') then begin Delete(opts,1,1); WriteLn(opts); end else if (s='INCLUDE') then begin Delete(opts,1,1); Interpret_file(opts); end; end; end else begin if (opts[1]='-') or (opts[1]='@') then begin if (not skip[level]) then interpret_option(opts,false); Option_read:=true; end else Message1(option_illegal_para,opts); end; end; end; if Level>0 then Message(option_too_less_endif); if Not Option_read then Message1(option_no_option_found,filename) else Message1(option_end_reading_configfile,filename); Close(f); Dec(FileLevel); end; procedure Toption.Interpret_envvar(const envname : string); var argstart, env, pc : pchar; arglen : longint; quote : set of char; hs : string; begin Message1(option_using_env,envname); env:=GetEnvPChar(envname); pc:=env; if assigned(pc) then begin repeat { skip leading spaces } while pc^ in [' ',#9,#13] do inc(pc); case pc^ of #0 : break; '"' : begin quote:=['"']; inc(pc); end; '''' : begin quote:=['''']; inc(pc); end; else quote:=[' ',#9,#13]; end; { scan until the end of the argument } argstart:=pc; while (pc^<>#0) and not(pc^ in quote) do inc(pc); { create argument } arglen:=pc-argstart; hs[0]:=chr(arglen); move(argstart^,hs[1],arglen); interpret_option(hs,true); { skip quote } if pc^ in quote then inc(pc); until false; end else Message1(option_no_option_found,'(env) '+envname); FreeEnvPChar(env); end; procedure toption.read_parameters; var opts : string; paramindex : longint; begin paramindex:=0; while paramindex'') do begin while cmd[1]=' ' do delete(cmd,1,1); i:=pos(' ',cmd); if i=0 then i:=256; opts:=Copy(cmd,1,i-1); Delete(cmd,1,i); case opts[1] of '@' : if not firstpass then begin Delete(opts,1,1); Message1(option_reading_further_from,opts); interpret_file(opts); end; '!' : if not firstpass then begin Delete(opts,1,1); Message1(option_reading_further_from,'(env) '+opts); interpret_envvar(opts); end; '"' : begin Delete(opts,1,1); ps:=pos('"',cmd); if (i<>256) and (ps>0) then begin opts:=opts + ' '+ copy(cmd,1,ps-1); cmd:=copy(cmd,ps+1,255); end; interpret_option(opts,true); end; else interpret_option(opts,true); end; end; end; procedure toption.writequickinfo; var s : string; i : longint; procedure addinfo(const hs:string); begin if s<>'' then s:=s+' '+hs else s:=hs; end; begin s:=''; i:=0; while (i'' then begin writeln(s); stopoptions(0); end; end; procedure TOption.TargetDefines(def:boolean); var s : string; i : integer; begin if def then def_system_macro(target_info.shortname) else undef_system_macro(target_info.shortname); s:=target_info.extradefines; while (s<>'') do begin i:=pos(';',s); if i=0 then i:=length(s)+1; if def then def_system_macro(Copy(s,1,i-1)) else undef_system_macro(Copy(s,1,i-1)); delete(s,1,i); end; end; constructor TOption.create; begin LogoWritten:=false; NoPressEnter:=false; FirstPass:=false; FileLevel:=0; Quickinfo:=''; ParaIncludePath:=TSearchPathList.Create; ParaObjectPath:=TSearchPathList.Create; ParaUnitPath:=TSearchPathList.Create; ParaLibraryPath:=TSearchPathList.Create; FillChar(ParaAlignment,sizeof(ParaAlignment),0); end; destructor TOption.destroy; begin ParaIncludePath.Free; ParaObjectPath.Free; ParaUnitPath.Free; ParaLibraryPath.Free; end; {**************************************************************************** Callable Routines ****************************************************************************} function check_configfile(const fn:string;var foundfn:string):boolean; function CfgFileExists(const fn:string):boolean; begin Comment(V_Tried,'Configfile search: '+fn); CfgFileExists:=FileExists(fn); end; var hs, configpath : string; begin foundfn:=fn; check_configfile:=true; { retrieve configpath } configpath:=FixPath(GetEnvironmentVariable('PPC_CONFIG_PATH'),false); {$ifdef Unix} if configpath='' then configpath:=ExpandFileName(FixPath(exepath+'../etc/',false)); {$endif} { Order to read configuration file : try reading fpc.cfg in : 1 - current dir 2 - configpath 3 - compiler path } if not FileExists(fn) then begin {$ifdef Unix} hs:=GetEnvironmentVariable('HOME'); if (hs<>'') and CfgFileExists(FixPath(hs,false)+'.'+fn) then foundfn:=FixPath(hs,false)+'.'+fn else {$endif} if CfgFileExists(configpath+fn) then foundfn:=configpath+fn else {$ifndef Unix} if CfgFileExists(exepath+fn) then foundfn:=exepath+fn else {$else} if CfgFileExists('/etc/'+fn) then foundfn:='/etc/'+fn else {$endif} check_configfile:=false; end; end; procedure read_arguments(cmd:string); begin option:=coption.create; disable_configfile:=false; { get default messagefile } msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE'); { default configfile can be specified on the commandline, remove it first } if (cmd<>'') and (cmd[1]='[') then begin ppccfg:=Copy(cmd,2,pos(']',cmd)-2); Delete(cmd,1,pos(']',cmd)); end else begin ppccfg:='fpc.cfg'; ppcaltcfg:='ppc386.cfg'; end; { first pass reading of parameters, only -i -v -T etc.} option.firstpass:=true; if cmd<>'' then option.parsecmd(cmd) else begin option.read_parameters; { Write only quickinfo } if option.quickinfo<>'' then option.writequickinfo; end; option.firstpass:=false; { target is set here, for wince the default app type is gui } if target_info.system in system_wince then apptype:=app_gui; { default defines } def_system_macro(target_info.shortname); def_system_macro('FPC'); def_system_macro('VER'+version_nr); def_system_macro('VER'+version_nr+'_'+release_nr); def_system_macro('VER'+version_nr+'_'+release_nr+'_'+patch_nr); { Temporary defines, until things settle down } { "main" symbol is generated in the main program, and left out of the system unit } def_system_macro('FPC_DARWIN_PASCALMAIN'); def_system_macro('FPC_DARWIN_JMP_MAIN'); def_system_macro('COMPPROCINLINEFIXED'); def_system_macro('PARAOUTFILE'); def_system_macro('RESSTRSECTIONS'); def_system_macro('FPC_HASFIXED64BITVARIANT'); def_system_macro('FPC_HASINTERNALOLEVARIANT2VARIANTCAST'); {$ifdef x86} def_system_macro('INTERNAL_BACKTRACE'); {$endif} def_system_macro('STR_CONCAT_PROCS'); if pocall_default = pocall_register then def_system_macro('REGCALL'); { using a case is pretty useless here (FK) } { some stuff for TP compatibility } {$ifdef i386} def_system_macro('CPU86'); def_system_macro('CPU87'); def_system_macro('CPU386'); {$endif} {$ifdef m68k} def_system_macro('CPU68'); {$endif} { new processor stuff } {$ifdef i386} def_system_macro('CPUI386'); def_system_macro('CPU32'); def_system_macro('FPC_HAS_TYPE_EXTENDED'); def_system_macro('FPC_HAS_TYPE_DOUBLE'); def_system_macro('FPC_HAS_TYPE_SINGLE'); def_system_macro('FPC_HAS_RESOURCES'); {$endif} {$ifdef m68k} def_system_macro('CPU68K'); def_system_macro('CPUM68K'); def_system_macro('CPU32'); def_system_macro('FPC_HAS_TYPE_DOUBLE'); def_system_macro('FPC_HAS_TYPE_SINGLE'); def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE'); def_system_macro('FPC_CURRENCY_IS_INT64'); def_system_macro('FPC_COMP_IS_INT64'); {$endif} {$ifdef ALPHA} def_system_macro('CPUALPHA'); def_system_macro('CPU64'); {$endif} {$ifdef powerpc} def_system_macro('CPUPOWERPC'); def_system_macro('CPUPOWERPC32'); def_system_macro('CPU32'); def_system_macro('FPC_HAS_TYPE_DOUBLE'); def_system_macro('FPC_HAS_TYPE_SINGLE'); def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE'); def_system_macro('FPC_CURRENCY_IS_INT64'); def_system_macro('FPC_COMP_IS_INT64'); {$endif} {$ifdef POWERPC64} def_system_macro('CPUPOWERPC'); def_system_macro('CPUPOWERPC64'); def_system_macro('CPU64'); def_system_macro('FPC_HAS_TYPE_DOUBLE'); def_system_macro('FPC_HAS_TYPE_SINGLE'); def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE'); def_system_macro('FPC_CURRENCY_IS_INT64'); def_system_macro('FPC_COMP_IS_INT64'); def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT'); {$endif} {$ifdef iA64} def_system_macro('CPUIA64'); def_system_macro('CPU64'); {$endif} {$ifdef x86_64} def_system_macro('CPUX86_64'); def_system_macro('CPUAMD64'); def_system_macro('CPU64'); { not supported for now, afaik (FK) def_system_macro('FPC_HAS_TYPE_FLOAT128'); } { win64 doesn't support the legacy fpu } if target_info.system<>system_x86_64_win64 then def_system_macro('FPC_HAS_TYPE_EXTENDED') else begin def_system_macro('FPC_CURRENCY_IS_INT64'); def_system_macro('FPC_COMP_IS_INT64'); undef_system_macro('FPC_HAS_TYPE_EXTENDED'); end; def_system_macro('FPC_HAS_TYPE_DOUBLE'); def_system_macro('FPC_HAS_TYPE_SINGLE'); {$endif} {$ifdef sparc} def_system_macro('CPUSPARC'); def_system_macro('CPUSPARC32'); def_system_macro('CPU32'); def_system_macro('FPC_HAS_TYPE_DOUBLE'); def_system_macro('FPC_HAS_TYPE_SINGLE'); def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE'); def_system_macro('FPC_CURRENCY_IS_INT64'); def_system_macro('FPC_COMP_IS_INT64'); def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT'); {$endif} {$ifdef vis} def_system_macro('CPUVIS'); def_system_macro('CPU32'); {$endif} {$ifdef arm} def_system_macro('CPUARM'); def_system_macro('FPUFPA'); def_system_macro('CPU32'); def_system_macro('FPC_HAS_TYPE_DOUBLE'); def_system_macro('FPC_HAS_TYPE_SINGLE'); def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE'); def_system_macro('FPC_CURRENCY_IS_INT64'); def_system_macro('FPC_COMP_IS_INT64'); def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT'); {$endif arm} if source_info.system<>target_info.system then def_system_macro('FPC_CROSSCOMPILING'); if source_info.cpu<>target_info.cpu then def_system_macro('FPC_CPUCROSSCOMPILING'); if tf_winlikewidestring in target_info.flags then def_system_macro('FPC_WINLIKEWIDESTRING'); { read configuration file } if (not disable_configfile) and (ppccfg<>'') then begin read_configfile:=check_configfile(ppccfg,ppccfg); { Maybe alternative configfile ? } if (not read_configfile) and (ppcaltcfg<>'') then read_configfile:=check_configfile(ppcaltcfg,ppccfg); end else read_configfile := false; { Read commandline and configfile } param_file:=''; { read configfile } if read_configfile then option.interpret_file(ppccfg); { read parameters again to override config file } if cmd<>'' then option.parsecmd(cmd) else begin { Write help pages if no parameters are passed } if (paramcount=0) then Option.WriteHelpPages; option.read_parameters; { Write only quickinfo } if option.quickinfo<>'' then option.writequickinfo; end; { Stop if errors in options } if ErrorCount>0 then StopOptions(1); { Write logo } if option.ParaLogo then option.writelogo; { Non-core target defines } Option.TargetDefines(true); { endian define } case target_info.endian of endian_little : begin def_system_macro('ENDIAN_LITTLE'); def_system_macro('FPC_LITTLE_ENDIAN'); end; endian_big : begin def_system_macro('ENDIAN_BIG'); def_system_macro('FPC_BIG_ENDIAN'); end; end; { abi define } case target_info.abi of abi_powerpc_sysv : def_system_macro('FPC_ABI_SYSV'); abi_powerpc_aix : def_system_macro('FPC_ABI_AIX'); end; { CPU Define } def_system_macro('CPU'+Cputypestr[init_settings.cputype]); { Check file to compile } if param_file='' then begin Message(option_no_source_found); StopOptions(1); end; {$ifndef Unix} param_file:=FixFileName(param_file); {$endif not unix} inputfilepath:=ExtractFilePath(param_file); inputfilename:=ExtractFileName(param_file); if ExtractFileExt(inputfilename)='' then begin if FileExists(inputfilepath+ChangeFileExt(inputfilename,sourceext)) then inputfilename:=ChangeFileExt(inputfilename,sourceext) else if FileExists(inputfilepath+ChangeFileExt(inputfilename,pasext)) then inputfilename:=ChangeFileExt(inputfilename,pasext) else if ((m_mac in current_settings.modeswitches) or (tf_p_ext_support in target_info.flags)) and FileExists(inputfilepath+ChangeFileExt(inputfilename,pext)) then inputfilename:=ChangeFileExt(inputfilename,pext); end; { Check output dir } if (OutputExeDir<>'') and not PathExists(OutputExeDir,false) then begin Message1(general_e_path_does_not_exist,OutputExeDir); StopOptions(1); end; { Add paths specified with parameters to the searchpaths } UnitSearchPath.AddList(option.ParaUnitPath,true); ObjectSearchPath.AddList(option.ParaObjectPath,true); IncludeSearchPath.AddList(option.ParaIncludePath,true); LibrarySearchPath.AddList(option.ParaLibraryPath,true); { add unit environment and exepath to the unit search path } if inputfilepath<>'' then Unitsearchpath.AddPath(inputfilepath,true); if not disable_configfile then UnitSearchPath.AddPath(GetEnvironmentVariable(target_info.unit_env),false); {$ifdef Unix} fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false); if fpcdir='' then begin if PathExists('/usr/local/lib/fpc/'+version_string,true) then fpcdir:='/usr/local/lib/fpc/'+version_string+'/' else fpcdir:='/usr/lib/fpc/'+version_string+'/'; end; {$else unix} fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false); if fpcdir='' then begin fpcdir:=ExePath+'../'; if not(PathExists(fpcdir+'/units',true)) and not(PathExists(fpcdir+'/rtl',true)) then fpcdir:=fpcdir+'../'; end; {$endif unix} { first try development RTL, else use the default installation path } if not disable_configfile then begin if PathExists(FpcDir+'rtl',true) then if tf_use_8_3 in Source_Info.Flags then UnitSearchPath.AddPath(FpcDir+'rtl/'+target_os_string,false) else UnitSearchPath.AddPath(FpcDir+'rtl/'+target_full_string,false) else if tf_use_8_3 in Source_Info.Flags then UnitSearchPath.AddPath(FpcDir+'units/'+target_os_string+'/rtl',false) else UnitSearchPath.AddPath(FpcDir+'units/'+target_full_string+'/rtl',false); end; { Add exepath if the exe is not in the current dir, because that is always searched already. Do not add it when linking on the target because then we can maybe already find .o files that are not for the target } if (ExePath<>GetCurrentDir) and not(cs_link_on_target in init_settings.globalswitches) then UnitSearchPath.AddPath(ExePath,false); { Add unit dir to the object and library path } objectsearchpath.AddList(unitsearchpath,false); librarysearchpath.AddList(unitsearchpath,false); { maybe override debug info format } if (paratargetdbg<>dbg_none) then set_target_dbg(paratargetdbg); { maybe override assembler } if (paratargetasm<>as_none) then begin if not set_target_asm(paratargetasm) then begin Message2(option_incompatible_asm,asminfos[paratargetasm]^.idtxt,target_info.name); set_target_asm(target_info.assemextern); Message1(option_asm_forced,target_asm.idtxt); end; end; { switch assembler if it's binary and we got -a on the cmdline } if (cs_asm_leave in init_settings.globalswitches) and (af_outputbinary in target_asm.flags) then begin Message(option_switch_bin_to_src_assembler); set_target_asm(target_info.assemextern); end; { Force use of external linker if there is no internal linker or the linking is skipped } if not(cs_link_extern in init_settings.globalswitches) and (not assigned(target_info.link) or (cs_link_nolink in init_settings.globalswitches)) then include(init_settings.globalswitches,cs_link_extern); { turn off stripping if compiling with debuginfo or profile } if (cs_debuginfo in init_settings.moduleswitches) or (cs_profile in init_settings.moduleswitches) then exclude(init_settings.globalswitches,cs_link_strip); { force fpu emulation on arm/wince and arm/gba } if target_info.system in [system_arm_wince,system_arm_gba,system_m68k_amiga, system_m68k_linux] then include(init_settings.moduleswitches,cs_fp_emulation); { Section smartlinking conflicts with import sections on Windows } if GenerateImportSection and (target_info.system in [system_i386_win32,system_x86_64_win64]) then exclude(target_info.flags,tf_smartlink_sections); {$ifdef x86_64} {$warning HACK: turn off smartlinking} exclude(init_settings.moduleswitches,cs_create_smart); {$endif} if not LinkTypeSetExplicitly then set_default_link_type; { Default alignment settings, 1. load the defaults for the target 2. override with generic optimizer setting (little size) 3. override with the user specified -Oa } UpdateAlignment(init_settings.alignment,target_info.alignment); if (cs_opt_size in current_settings.optimizerswitches) then begin init_settings.alignment.procalign:=1; init_settings.alignment.jumpalign:=1; init_settings.alignment.loopalign:=1; end; UpdateAlignment(init_settings.alignment,option.paraalignment); set_system_macro('FPC_VERSION',version_nr); set_system_macro('FPC_RELEASE',release_nr); set_system_macro('FPC_PATCH',patch_nr); option.free; Option:=nil; end; initialization coption:=toption; finalization if assigned(option) then option.free; end.