{ $Id$ 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 globtype,globals,verbose,systems,cpuinfo; type TOption=class FirstPass, NoPressEnter, DoWriteLogo : 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_proc_specific_options(const opt:string);virtual; 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, {$ifdef Delphi} dmisc, {$else Delphi} dos, {$endif Delphi} version, cutils,cmsgs {$ifdef BrowserLog} ,browlog {$endif BrowserLog} ; const page_size = 24; var option : toption; read_configfile, { read config file, set when a cfgfile is found } disable_configfile, target_is_set : boolean; { do not allow contradictory target settings } asm_is_set : boolean; { -T also change initoutputformat if not set idrectly } fpcdir, ppccfg, ppcaltcfg, param_file : string; { file to compile specified on the commandline } {**************************************************************************** Defines ****************************************************************************} procedure def_symbol(const s : string); begin if s='' then exit; initdefines.insert(upper(s)); Message1(option_defining_symbol,s); end; procedure undef_symbol(const s : string); begin if s='' then exit; InitDefines.Remove(s); Message1(option_undefining_symbol,s); end; function check_symbol(const s:string):boolean; begin check_symbol:=(initdefines.find(s)<>nil); end; procedure set_default_link_type; begin if (target_info.system in [system_i386_win32,system_i386_wdosx]) then begin def_symbol('FPC_LINK_SMART'); undef_symbol('FPC_LINK_STATIC'); undef_symbol('FPC_LINK_DYNAMIC'); initglobalswitches:=initglobalswitches+[cs_link_smart]; initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_static]; end else begin undef_symbol('FPC_LINK_SMART'); def_symbol('FPC_LINK_STATIC'); undef_symbol('FPC_LINK_DYNAMIC'); initglobalswitches:=initglobalswitches+[cs_link_static]; initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_smart]; end; end; {**************************************************************************** Toption ****************************************************************************} procedure StopOptions; begin if assigned(Option) then begin Option.free; Option:=nil; end; DoneVerbose; Stop; end; procedure Toption.WriteLogo; var p : pchar; begin p:=MessagePchar(option_logo); while assigned(p) do Comment(V_Normal,GetMsgLine(p)); end; procedure Toption.WriteInfo; var p : pchar; hs,hs1,s : string; target : tsystem; 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 Comment(V_Normal,s); end; StopOptions; 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; end; lines:=0; end; Comment(V_Normal,PadEnd('',ident)+opt+Copy(s,j+1,255)); LastIdent:=Ident; inc(Lines); end; end; StopOptions; end; procedure Toption.IllegalPara(const opt:string); begin Message1(option_illegal_para,opt); Message(option_help_pages_para); StopOptions; 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_proc_specific_options(const opt:string); begin 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 : DirStr; e : ExtStr; {$ifdef arm} s : string; {$endif arm} forceasm : tasm; begin if opt='' then exit; { only parse define,undef,target,verbosity and link options the firsttime } if firstpass and not((opt[1]='-') and (opt[2] in ['i','d','v','T','u','n','X'])) 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(initglobalswitches,cs_asm_leave); j:=1; while j<=length(more) do begin case more[j] of 'l' : include(initglobalswitches,cs_asm_source); 'r' : include(initglobalswitches,cs_asm_regalloc); 't' : include(initglobalswitches,cs_asm_tempalloc); 'n' : include(initglobalswitches,cs_asm_nodes); 'p' : begin exclude(initglobalswitches,cs_asm_leave); if UnsetBool(More, 0) then exclude(initglobalswitches,cs_asm_pipe) else include(initglobalswitches,cs_asm_pipe); end; '-' : initglobalswitches:=initglobalswitches - [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 if set_target_asm_by_string(More) then asm_is_set:=true else IllegalPara(opt); end; 'b' : begin if UnsetBool(More,0) then begin exclude(initmoduleswitches,cs_browser); exclude(initmoduleswitches,cs_local_browser); {$ifdef BrowserLog} exclude(initglobalswitches,cs_browser_log); {$endif} end else begin include(initmoduleswitches,cs_browser); {$ifdef BrowserLog} include(initglobalswitches,cs_browser_log); {$endif} end; if More<>'' then if (More='l') or (More='l+') then include(initmoduleswitches,cs_local_browser) else if More='l-' then exclude(initmoduleswitches,cs_local_browser) else {$ifdef BrowserLog} browserlog.elements_to_list.insert(more); {$else} IllegalPara(opt); {$endif} end; 'B' : do_build:=not UnSetBool(more,0); 'C' : begin j:=1; while j<=length(more) do begin case more[j] of 'a' : Message2(option_obsolete_switch_use_new,'-Ca','-Or'); 'c' : begin if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),true) then IllegalPara(opt); break; end; {$ifdef cpufpemu} 'e' : begin If UnsetBool(More, j) then exclude(initmoduleswitches,cs_fp_emulation) Else include(initmoduleswitches,cs_fp_emulation); end; {$endif cpufpemu} {$ifdef arm} 'f' : begin s:=upper(copy(more,j+1,length(more)-j)); if s='SOFT' then initfputype:=fpu_soft else if s='FPA' then initfputype:=fpu_fpa else if s='FPA10' then initfputype:=fpu_fpa10 else if s='FPA11' then initfputype:=fpu_fpa11 else if s='VFP' then initfputype:=fpu_vfp else IllegalPara(opt); break; end; {$endif arm} 'h' : begin val(copy(more,j+1,length(more)-j),heapsize,code); if (code<>0) or (heapsize>=67107840) or (heapsize<1024) then IllegalPara(opt); break; end; 'i' : If UnsetBool(More, j) then exclude(initlocalswitches,cs_check_io) else include(initlocalswitches,cs_check_io); 'n' : If UnsetBool(More, j) then exclude(initglobalswitches,cs_link_extern) Else include(initglobalswitches,cs_link_extern); 'o' : If UnsetBool(More, j) then exclude(initlocalswitches,cs_check_overflow) Else include(initlocalswitches,cs_check_overflow); 'r' : If UnsetBool(More, j) then exclude(initlocalswitches,cs_check_range) Else include(initlocalswitches,cs_check_range); 'R' : If UnsetBool(More, j) then begin exclude(initlocalswitches,cs_check_range); exclude(initlocalswitches,cs_check_object); end Else begin include(initlocalswitches,cs_check_range); include(initlocalswitches,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(initlocalswitches,cs_check_stack) Else include(initlocalswitches,cs_check_stack); 'D' : If UnsetBool(More, j) then exclude(initmoduleswitches,cs_create_dynamic) Else include(initmoduleswitches,cs_create_dynamic); 'X' : If UnsetBool(More, j) then exclude(initmoduleswitches,cs_create_smart) Else include(initmoduleswitches,cs_create_smart); else IllegalPara(opt); end; inc(j); end; end; 'd' : def_symbol(more); 'D' : begin include(initglobalswitches,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 valint(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 valint(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(initglobalswitches,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(initglobalswitches,cs_link_extern) else include(initglobalswitches,cs_link_extern); end; 'F' : begin c:=more[1]; Delete(more,1,1); DefaultReplacements(More); case c of 'c' : begin if not(cpavailable(more)) then Message1(option_code_page_not_available,more) else initsourcecodepage:=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(initmoduleswitches,cs_debuginfo); exclude(initglobalswitches,cs_gdb_dbx); exclude(initglobalswitches,cs_gdb_gsym); exclude(initglobalswitches,cs_gdb_heaptrc); exclude(initglobalswitches,cs_gdb_lineinfo); exclude(initglobalswitches,cs_checkpointer); end else begin {$ifdef GDB} include(initmoduleswitches,cs_debuginfo); if not RelocSectionSetExplicitly then RelocSection:=false; j:=1; while j<=length(more) do begin case more[j] of 'd' : begin if UnsetBool(More, j) then exclude(initglobalswitches,cs_gdb_dbx) else include(initglobalswitches,cs_gdb_dbx); end; 'g' : begin if UnsetBool(More, j) then exclude(initglobalswitches,cs_gdb_gsym) else include(initglobalswitches,cs_gdb_gsym); end; 'h' : begin if UnsetBool(More, j) then exclude(initglobalswitches,cs_gdb_heaptrc) else include(initglobalswitches,cs_gdb_heaptrc); end; 'l' : begin if UnsetBool(More, j) then exclude(initglobalswitches,cs_gdb_lineinfo) else include(initglobalswitches,cs_gdb_lineinfo); end; 'c' : begin if UnsetBool(More, j) then exclude(initglobalswitches,cs_checkpointer) else include(initglobalswitches,cs_checkpointer); end; else IllegalPara(opt); end; inc(j); end; {$else GDB} Message(option_no_debug_support); Message(option_no_debug_support_recompile_fpc); {$endif GDB} end; end; 'h' : begin NoPressEnter:=true; WriteHelpPages; end; 'i' : begin if More='' then WriteInfo else QuickInfo:=QuickInfo+More; end; 'I' : begin if ispara then ParaIncludePath.AddPath(More,false) else includesearchpath.AddPath(More,false); end; 'k' : begin if more<>'' then ParaLinkOptions:=ParaLinkOptions+' '+More else IllegalPara(opt); end; 'l' : DoWriteLogo:=not UnSetBool(more,0); 'm' : parapreprocess:=not UnSetBool(more,0); 'n' : begin if More='' then disable_configfile:=true else IllegalPara(opt); end; 'o' : begin if More<>'' then Fsplit(More,d,OutputFile,e) else IllegalPara(opt); end; 'p' : begin if UnsetBool(More, 0) then begin initmoduleswitches:=initmoduleswitches-[cs_profile]; undef_symbol('FPC_PROFILE'); end else if Length(More)=0 then IllegalPara(opt) else case more[1] of 'g' : if UnsetBool(more, 1) then begin exclude(initmoduleswitches,cs_profile); undef_symbol('FPC_PROFILE'); end else begin include(initmoduleswitches,cs_profile); def_symbol('FPC_PROFILE'); end; else IllegalPara(opt); end; end; {$ifdef Unix} 'P' : ; { Ignore used by fpc.pp } {$endif Unix} 's' : begin if UnsetBool(More, 0) then begin initglobalswitches:=initglobalswitches-[cs_asm_extern,cs_link_extern]; if more<>'' then IllegalPara(opt); end else begin initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern]; if more='h' then initglobalswitches:=initglobalswitches-[cs_link_on_target] else if more='t' then initglobalswitches:=initglobalswitches+[cs_link_on_target] else if more='r' then initglobalswitches:=initglobalswitches+[cs_asm_leave,cs_no_regalloc] else if more<>'' then IllegalPara(opt); end; end; 'M' : begin more:=Upper(more); if not SetCompileMode(more, true) then IllegalPara(opt); end; 'S' : begin if more[1]='I' then begin if upper(more)='ICOM' then initinterfacetype:=it_interfacecom else if upper(more)='ICORBA' then initinterfacetype:=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(initlocalswitches,cs_do_assertion); 'c' : include(initmoduleswitches,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(initmoduleswitches,cs_support_goto); 'h' : include(initlocalswitches,cs_ansistrings); 'i' : include(initmoduleswitches,cs_support_inline); 'm' : include(initmoduleswitches,cs_support_macro); 'o' : //an alternative to -Mtp SetCompileMode('TP',true); 'p' : //an alternative to -Mgpc SetCompileMode('GPC',true); 's' : include(initglobalswitches,cs_constructor_name); 't' : include(initmoduleswitches,cs_static_keyword); '-' : begin exclude(initglobalswitches,cs_constructor_name); initlocalswitches:=InitLocalswitches - [cs_do_assertion, cs_ansistrings]; initmoduleswitches:=initmoduleswitches - [cs_support_c_operators, cs_support_goto, cs_support_inline, cs_support_macro, cs_static_keyword]; end; else IllegalPara(opt); end; inc(j); end; end; end; 'T' : begin more:=Upper(More); if not target_is_set then begin { remove old target define } TargetDefines(false); { Save assembler if set } if asm_is_set then forceasm:=target_asm.id; { load new target } if not(set_target_by_string(More)) then IllegalPara(opt); { also initialize assembler if not explicitly set } if asm_is_set then set_target_asm(forceasm); { set new define } TargetDefines(true); target_is_set:=true; end else if More<>upper(target_info.shortname) then Message1(option_target_is_already_set,target_info.shortname); end; 'u' : undef_symbol(upper(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(initglobalswitches,cs_check_unit_name); 'p' : begin Message2(option_obsolete_switch_use_new,'-Up','-Fu'); break; end; 'r' : do_release:=true; 's' : include(initmoduleswitches,cs_compilesystem); '-' : begin exclude(initmoduleswitches,cs_compilesystem); exclude(initglobalswitches,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 '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': ForceDeffileForExport:=not UnsetBool(More, j); '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; '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; else IllegalPara(opt); end; inc(j); end; end; 'X' : begin j:=1; while j<=length(more) do begin case More[j] of 'i' : include(initglobalswitches,cs_link_internal); 'm' : include(initglobalswitches,cs_link_map); 's' : include(initglobalswitches,cs_link_strip); 't' : include(initglobalswitches,cs_link_staticflag); 'D' : begin def_symbol('FPC_LINK_DYNAMIC'); undef_symbol('FPC_LINK_SMART'); undef_symbol('FPC_LINK_STATIC'); exclude(initglobalswitches,cs_link_static); exclude(initglobalswitches,cs_link_smart); include(initglobalswitches,cs_link_shared); LinkTypeSetExplicitly:=true; end; 'd' : Dontlinkstdlibpath:=TRUE; 'P' : Begin utilsprefix:=Copy(more,2,length(More)-1); More:=''; End; 'p' : include(initmoduleswitches,cs_create_pic); 'S' : begin def_symbol('FPC_LINK_STATIC'); undef_symbol('FPC_LINK_SMART'); undef_symbol('FPC_LINK_DYNAMIC'); include(initglobalswitches,cs_link_static); exclude(initglobalswitches,cs_link_smart); exclude(initglobalswitches,cs_link_shared); LinkTypeSetExplicitly:=true; end; 'X' : begin def_symbol('FPC_LINK_SMART'); undef_symbol('FPC_LINK_STATIC'); undef_symbol('FPC_LINK_DYNAMIC'); exclude(initglobalswitches,cs_link_static); include(initglobalswitches,cs_link_smart); exclude(initglobalswitches,cs_link_shared); LinkTypeSetExplicitly:=true; end; '-' : begin exclude(initglobalswitches,cs_link_staticflag); exclude(initglobalswitches,cs_link_strip); exclude(initglobalswitches,cs_link_map); set_default_link_type; end; else IllegalPara(opt); end; inc(j); end; end; { give processor specific options a chance } else interpret_proc_specific_options(opt); end; end; '@' : begin Message(option_no_nested_response_file); StopOptions; 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); { open file } Message1(option_using_file,filename); assign(f,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 (check_symbol(s) or (s='COMMON')); end else if (s='IFDEF') then begin RemoveSep(opts); if Level>=maxlevel then begin Message(option_too_many_ifdef); stopOptions; end; inc(Level); skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts))))); end else if (s='IFNDEF') then begin RemoveSep(opts); if Level>=maxlevel then begin Message(option_too_many_ifdef); stopOptions; end; inc(Level); skip[level]:=(skip[level-1] or (check_symbol(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; end; dec(level); end else if (not skip[level]) then begin if (s='DEFINE') then begin RemoveSep(opts); def_symbol(upper(GetName(opts))); end else if (s='UNDEF') then begin RemoveSep(opts); undef_symbol(upper(GetName(opts))); 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; end; end; procedure TOption.TargetDefines(def:boolean); var s : string; i : integer; begin if def then def_symbol(upper(target_info.shortname)) else undef_symbol(upper(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_symbol(Copy(s,1,i-1)) else undef_symbol(Copy(s,1,i-1)); delete(s,1,i); end; end; constructor TOption.create; begin DoWriteLogo:=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 configpath : pathstr; begin foundfn:=fn; check_configfile:=true; { retrieve configpath } {$ifdef Delphi} configpath:=FixPath(dmisc.getenv('PPC_CONFIG_PATH'),false); {$else Delphi} configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false); {$endif Delphi} {$ifdef Unix} if configpath='' then configpath:='/etc/'; {$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} if (dos.getenv('HOME')<>'') and CfgFileExists(FixPath(dos.getenv('HOME'),false)+'.'+fn) then foundfn:=FixPath(dos.getenv('HOME'),false)+'.'+fn else {$endif} if CfgFileExists(configpath+fn) then foundfn:=configpath+fn else {$ifndef Unix} if CfgFileExists(exepath+fn) then foundfn:=exepath+fn else {$endif} check_configfile:=false; end; end; procedure read_arguments(cmd:string); begin option:=coption.create; disable_configfile:=false; { default defines } def_symbol(upper(target_info.shortname)); def_symbol('FPC'); def_symbol('VER'+version_nr); def_symbol('VER'+version_nr+'_'+release_nr); def_symbol('VER'+version_nr+'_'+release_nr+'_'+patch_nr); { Temporary defines, until things settle down } def_symbol('HASWIDECHAR'); def_symbol('HASWIDESTRING'); def_symbol('HASOUT'); { for now, the PowerPC doesn't support variants and interfaces } {$ifdef i386} def_symbol('HASINTF'); def_symbol('HASVARIANT'); {$endif i386} def_symbol('INTERNSETLENGTH'); def_symbol('INTERNLENGTH'); def_symbol('INTERNCOPY'); def_symbol('INT64FUNCRESOK'); def_symbol('HAS_ADDR_STACK_ON_STACK'); def_symbol('NOBOUNDCHECK'); def_symbol('HASCOMPILERPROC'); def_symbol('VALUEGETMEM'); def_symbol('VALUEFREEMEM'); def_symbol('HASCURRENCY'); def_symbol('HASTHREADVAR'); def_symbol('HAS_GENERICCONSTRUCTOR'); def_symbol('NOCLASSHELPERS'); { using a case is pretty useless here (FK) } { some stuff for TP compatibility } {$ifdef i386} def_symbol('CPU86'); def_symbol('CPU87'); {$endif} {$ifdef m68k} def_symbol('CPU68'); {$endif} { new processor stuff } {$ifdef i386} def_symbol('CPUI386'); def_symbol('CPU32'); def_symbol('FPC_HAS_TYPE_EXTENDED'); def_symbol('FPC_HAS_TYPE_DOUBLE'); def_symbol('FPC_HAS_TYPE_SINGLE'); {$endif} {$ifdef m68k} def_symbol('CPUM68K'); def_symbol('CPU32'); {$endif} {$ifdef ALPHA} def_symbol('CPUALPHA'); def_symbol('CPU64'); {$endif} {$ifdef powerpc} def_symbol('CPUPOWERPC'); def_symbol('CPUPOWERPC32'); def_symbol('CPU32'); def_symbol('FPC_HAS_TYPE_DOUBLE'); def_symbol('FPC_HAS_TYPE_SINGLE'); def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE'); {$endif} {$ifdef iA64} def_symbol('CPUIA64'); def_symbol('CPU64'); {$endif} {$ifdef x86_64} def_symbol('CPUX86_64'); def_symbol('CPU64'); def_symbol('FPC_HAS_TYPE_FLOAT128'); def_symbol('FPC_HAS_TYPE_EXTENDED'); def_symbol('FPC_HAS_TYPE_DOUBLE'); def_symbol('FPC_HAS_TYPE_SINGLE'); {$endif} {$ifdef sparc} def_symbol('CPUSPARC'); def_symbol('CPUSPARC32'); def_symbol('CPU32'); def_symbol('FPC_HAS_TYPE_DOUBLE'); def_symbol('FPC_HAS_TYPE_SINGLE'); def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE'); {$endif} {$ifdef vis} def_symbol('CPUVIS'); def_symbol('CPU32'); {$endif} {$ifdef arm} def_symbol('CPUARM'); def_symbol('CPU32'); def_symbol('FPC_HAS_TYPE_DOUBLE'); def_symbol('FPC_HAS_TYPE_SINGLE'); {$endif arm} { get default messagefile } {$ifdef Delphi} msgfilename:=dmisc.getenv('PPC_ERROR_FILE'); {$else Delphi} msgfilename:=dos.getenv('PPC_ERROR_FILE'); {$endif Delphi} { 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; { read the parameters quick, only -i -v -T } 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; { 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 } target_is_set:=false; asm_is_set:=false; 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 option.read_parameters; { Write only quickinfo } if option.quickinfo<>'' then option.writequickinfo; end; { Write help pages } if (cmd='') and (paramcount=0) then Option.WriteHelpPages; { Stop if errors in options } if ErrorCount>0 then StopOptions; { Non-core target defines } Option.TargetDefines(true); { endian define } case target_info.endian of endian_little : begin def_symbol('ENDIAN_LITTLE'); def_symbol('FPC_LITTLE_ENDIAN'); end; endian_big : begin def_symbol('ENDIAN_BIG'); def_symbol('FPC_BIG_ENDIAN'); end; end; { abi define } case target_info.abi of abi_powerpc_sysv : def_symbol('FPC_ABI_SYSV'); abi_powerpc_aix : def_symbol('FPC_ABI_AIX'); end; {$ifdef m68k} if initoptprocessor=MC68020 then def_symbol('CPUM68020'); {$endif m68k} { write logo if set } if option.DoWriteLogo then option.WriteLogo; { Check file to compile } if param_file='' then begin Message(option_no_source_found); StopOptions; end; {$ifndef Unix} param_file:=FixFileName(param_file); {$endif} fsplit(param_file,inputdir,inputfile,inputextension); if inputextension='' then begin if FileExists(inputdir+inputfile+target_info.sourceext) then inputextension:=target_info.sourceext else if FileExists(inputdir+inputfile+target_info.pasext) then inputextension:=target_info.pasext; 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 inputdir<>'' then Unitsearchpath.AddPath(inputdir,true); if not disable_configfile then begin {$ifdef Delphi} UnitSearchPath.AddPath(dmisc.getenv(target_info.unit_env),false); {$else} UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false); {$endif Delphi} end; {$ifdef Unix} fpcdir:=FixPath(getenv('FPCDIR'),false); if fpcdir='' then begin if PathExists('/usr/local/lib/fpc/'+version_string) then fpcdir:='/usr/local/lib/fpc/'+version_string+'/' else fpcdir:='/usr/lib/fpc/'+version_string+'/'; end; {$else} fpcdir:=FixPath(getenv('FPCDIR'),false); if fpcdir='' then begin fpcdir:=ExePath+'../'; if not(PathExists(fpcdir+'/units')) and not(PathExists(fpcdir+'/rtl')) then fpcdir:=fpcdir+'../'; end; {$endif} { first try development RTL, else use the default installation path } if not disable_configfile then begin if PathExists(FpcDir+'rtl/'+lower(target_info.shortname)) then UnitSearchPath.AddPath(FpcDir+'rtl/'+lower(target_info.shortname),false) else begin UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname),false); UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname)+'/rtl',false); end; 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 initglobalswitches) then UnitSearchPath.AddPath(ExePath,false); { Add unit dir to the object and library path } objectsearchpath.AddList(unitsearchpath,false); librarysearchpath.AddList(unitsearchpath,false); { switch assembler if it's binary and we got -a on the cmdline } if (cs_asm_leave in initglobalswitches) and (target_asm.outputbinary) then begin Message(option_switch_bin_to_src_assembler); set_target_asm(target_info.assemextern); end; if (target_asm.supported_target <> system_any) and (target_asm.supported_target <> target_info.system) then begin Message2(option_incompatible_asm,target_asm.idtxt,target_info.name); set_target_asm(target_info.assemextern); Message1(option_asm_forced,target_asm.idtxt); end; { turn off stripping if compiling with debuginfo or profile } if (cs_debuginfo in initmoduleswitches) or (cs_profile in initmoduleswitches) then exclude(initglobalswitches,cs_link_strip); 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(initalignment,target_info.alignment); if (cs_littlesize in aktglobalswitches) then begin initalignment.procalign:=1; initalignment.jumpalign:=1; initalignment.loopalign:=1; end; UpdateAlignment(initalignment,option.paraalignment); option.free; Option:=nil; end; initialization coption:=toption; finalization if assigned(option) then option.free; end. { $Log$ Revision 1.111 2003-10-17 21:05:27 olle * compiler now defines cpum68k instead of cpu68k (as is used in rtl) Revision 1.110 2003/10/14 00:30:48 florian + some code for PIC support added Revision 1.109 2003/10/11 19:32:04 marco * -Xd Revision 1.108 2003/10/08 19:17:43 peter * -P to -ap * -V to -vv Revision 1.107 2003/10/03 14:16:48 marco * -XP support Revision 1.106 2003/09/17 21:37:07 olle + added command line option for language mode -M Revision 1.105 2003/09/14 21:33:11 peter * don't check exepath when linking on target Revision 1.104 2003/09/06 10:41:54 olle + compiler now define abi macros for powerpc FPC_ABI_AIX or FPC_ABI_SYSV Revision 1.103 2003/09/05 17:41:12 florian * merged Wiktor's Watcom patches in 1.1 Revision 1.102 2003/09/03 21:06:05 peter * powerpc needs software int64 to double Revision 1.101 2003/09/03 15:55:01 peter * NEWRA branch merged Revision 1.100 2003/09/03 11:18:37 florian * fixed arm concatcopy + arm support in the common compiler sources added * moved some generic cg code around + tfputype added * ... Revision 1.99.2.4 2003/09/02 17:48:42 peter * sparc need software int64 to double Revision 1.99.2.3 2003/09/01 21:02:55 peter * sparc updates for new tregister Revision 1.99.2.2 2003/08/31 16:18:05 peter * more fixes Revision 1.99.2.1 2003/08/31 13:50:15 daniel * Remove sorting and use pregenerated indexes * Some work on making things compile Revision 1.99 2003/05/13 19:14:41 peter * failn removed * inherited result code check moven to pexpr Revision 1.98 2003/05/11 19:17:16 florian * FPC_LITTLE_ENDIAN and FPC_BIG_ENDIAN is now defined as well Revision 1.97 2003/05/01 07:59:42 florian * introduced defaultordconsttype to decribe the default size of ordinal constants on 64 bit CPUs it's equal to cs64bitdef while on 32 bit CPUs it's equal to s32bitdef + added defines CPU32 and CPU64 for 32 bit and 64 bit CPUs * int64s/qwords are allowed as for loop counter on 64 bit CPUs Revision 1.96 2003/04/30 16:35:00 florian * fixed defines for x86-64 Revision 1.95 2003/04/24 11:21:45 florian + HAS_TYPE_* defines for floats on i386 and powerpc added Revision 1.94 2003/03/28 19:16:56 peter * generic constructor working for i386 * remove fixed self register * esi added as address register for i386 Revision 1.93 2003/03/23 23:20:38 hajny + emx target added Revision 1.92 2003/03/08 08:59:07 daniel + $define newra will enable new register allocator + getregisterint will return imaginary registers with $newra + -sr switch added, will skip register allocation so you can see the direct output of the code generator before register allocation Revision 1.91 2002/12/06 16:56:58 peter * only compile cs_fp_emulation support when cpufpuemu is defined * define cpufpuemu for m68k only Revision 1.90 2002/11/30 23:14:55 carl - removed cs_fp_emulation checking for m68k, its now controled by a global switch + added powerpc/sparc/vis message options support Revision 1.89 2002/11/30 21:29:56 carl + -Ce for softfpu Revision 1.88 2002/11/15 01:58:52 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.87 2002/10/23 17:07:40 peter * fix -n that was broken in the previous commit Revision 1.86 2002/10/23 16:57:16 peter * first search for fpc.cfg instead of deprecated ppc386.cfg * parse commandline options first before searching configfile so -vt can be used to display the searched files Revision 1.85 2002/10/13 21:33:01 peter * define HASTHREADVAR Revision 1.84 2002/10/02 18:20:52 peter * Copy() is now internal syssym that calls compilerprocs Revision 1.83 2002/09/22 14:02:35 carl * stack checking cannot be called before system unit is initialized * MC68020 define Revision 1.82 2002/08/12 15:08:40 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class * many many updates for m68k (will soon start to compile) - removed some ifdef or correct them for correct cpu Revision 1.81 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.80 2002/08/09 19:15:41 carl - removed newcg define Revision 1.79 2002/07/26 22:22:10 florian * several PowerPC related fixes to get forward with system unit compilation Revision 1.78 2002/07/26 21:15:39 florian * rewrote the system handling Revision 1.77 2002/07/20 17:16:03 florian + source code page support Revision 1.76 2002/07/04 20:43:01 florian * first x86-64 patches Revision 1.75 2002/07/01 18:46:24 peter * internal linker * reorganized aasm layer Revision 1.74 2002/07/01 16:23:53 peter * cg64 patch * basics for currency * asnode updates for class and interface (not finished) Revision 1.73 2002/05/18 13:34:11 peter * readded missing revisions Revision 1.72 2002/05/16 19:46:41 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.70 2002/05/12 16:53:08 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.69 2002/04/21 19:02:04 peter * removed newn and disposen nodes, the code is now directly inlined from pexpr * -an option that will write the secondpass nodes to the .s file, this requires EXTDEBUG define to actually write the info * fixed various internal errors and crashes due recent code changes Revision 1.68 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.67 2002/04/07 10:22:35 carl + CPU defines now depends on current target Revision 1.66 2002/04/04 19:05:58 peter * removed unused units * use tlocation.size in cg.a_*loc*() routines Revision 1.65 2002/04/04 18:39:45 carl + added wdosx support (patch from Pavel) }