options.pas 54 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
  4. Reads command line options and config files
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit options;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. globtype,globals,verbose,systems;
  23. type
  24. TOption=class
  25. FirstPass,
  26. NoPressEnter,
  27. DoWriteLogo : boolean;
  28. FileLevel : longint;
  29. QuickInfo : string;
  30. ParaIncludePath,
  31. ParaUnitPath,
  32. ParaObjectPath,
  33. ParaLibraryPath : TSearchPathList;
  34. ParaAlignment : TAlignmentInfo;
  35. Constructor Create;
  36. Destructor Destroy;override;
  37. procedure WriteLogo;
  38. procedure WriteInfo;
  39. procedure WriteHelpPages;
  40. procedure WriteQuickInfo;
  41. procedure IllegalPara(const opt:string);
  42. function Unsetbool(var Opts:string; Pos: Longint):boolean;
  43. procedure interpret_proc_specific_options(const opt:string);virtual;
  44. procedure interpret_option(const opt :string;ispara:boolean);
  45. procedure Interpret_envvar(const envname : string);
  46. procedure Interpret_file(const filename : string);
  47. procedure Read_Parameters;
  48. procedure parsecmd(cmd:string);
  49. procedure TargetDefines(def:boolean);
  50. end;
  51. TOptionClass=class of toption;
  52. var
  53. coption : TOptionClass;
  54. procedure read_arguments(cmd:string);
  55. implementation
  56. uses
  57. {$ifdef Delphi}
  58. dmisc,
  59. {$else Delphi}
  60. dos,
  61. {$endif Delphi}
  62. version,
  63. cutils,cmsgs
  64. {$ifdef BrowserLog}
  65. ,browlog
  66. {$endif BrowserLog}
  67. ;
  68. const
  69. page_size = 24;
  70. var
  71. option : toption;
  72. read_configfile, { read config file, set when a cfgfile is found }
  73. disable_configfile,
  74. target_is_set : boolean; { do not allow contradictory target settings }
  75. asm_is_set : boolean; { -T also change initoutputformat if not set idrectly }
  76. fpcdir,
  77. ppccfg,
  78. ppcaltcfg,
  79. param_file : string; { file to compile specified on the commandline }
  80. {****************************************************************************
  81. Defines
  82. ****************************************************************************}
  83. procedure def_symbol(const s : string);
  84. begin
  85. if s='' then
  86. exit;
  87. initdefines.insert(upper(s));
  88. end;
  89. procedure undef_symbol(const s : string);
  90. begin
  91. if s='' then
  92. exit;
  93. InitDefines.Remove(s);
  94. end;
  95. function check_symbol(const s:string):boolean;
  96. begin
  97. check_symbol:=(initdefines.find(s)<>nil);
  98. end;
  99. procedure set_default_link_type;
  100. begin
  101. if (target_info.target in [target_i386_win32,target_i386_wdosx]) then
  102. begin
  103. def_symbol('FPC_LINK_SMART');
  104. undef_symbol('FPC_LINK_STATIC');
  105. undef_symbol('FPC_LINK_DYNAMIC');
  106. initglobalswitches:=initglobalswitches+[cs_link_smart];
  107. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_static];
  108. end
  109. else
  110. begin
  111. undef_symbol('FPC_LINK_SMART');
  112. def_symbol('FPC_LINK_STATIC');
  113. undef_symbol('FPC_LINK_DYNAMIC');
  114. initglobalswitches:=initglobalswitches+[cs_link_static];
  115. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_smart];
  116. end;
  117. end;
  118. {****************************************************************************
  119. Toption
  120. ****************************************************************************}
  121. procedure StopOptions;
  122. begin
  123. if assigned(Option) then
  124. begin
  125. Option.free;
  126. Option:=nil;
  127. end;
  128. DoneVerbose;
  129. Stop;
  130. end;
  131. procedure Toption.WriteLogo;
  132. var
  133. p : pchar;
  134. begin
  135. p:=MessagePchar(option_logo);
  136. while assigned(p) do
  137. Comment(V_Normal,GetMsgLine(p));
  138. end;
  139. procedure Toption.WriteInfo;
  140. var
  141. p : pchar;
  142. hs,hs1,s : string;
  143. target : ttarget;
  144. begin
  145. p:=MessagePchar(option_info);
  146. while assigned(p) do
  147. begin
  148. s:=GetMsgLine(p);
  149. { list OS Targets }
  150. if pos('$OSTARGETS',s)>0 then
  151. begin
  152. for target:=low(ttarget) to high(ttarget) do
  153. if assigned(targetinfos[target]) then
  154. begin
  155. hs:=s;
  156. hs1:=targetinfos[target]^.name;
  157. if tf_under_development in targetinfos[target]^.flags then
  158. hs1:=hs1+' (under development)';
  159. Replace(hs,'$OSTARGETS',hs1);
  160. Comment(V_Normal,hs);
  161. end;
  162. end
  163. else
  164. Comment(V_Normal,s);
  165. end;
  166. StopOptions;
  167. end;
  168. procedure Toption.WriteHelpPages;
  169. function PadEnd(s:string;i:longint):string;
  170. begin
  171. while (length(s)<i) do
  172. s:=s+' ';
  173. PadEnd:=s;
  174. end;
  175. var
  176. lastident,
  177. j,outline,
  178. ident,
  179. lines : longint;
  180. show : boolean;
  181. opt : string[32];
  182. input,
  183. s : string;
  184. p : pchar;
  185. begin
  186. WriteLogo;
  187. Lines:=4;
  188. Message1(option_usage,system.paramstr(0));
  189. lastident:=0;
  190. p:=MessagePChar(option_help_pages);
  191. while assigned(p) do
  192. begin
  193. { get a line and reset }
  194. s:=GetMsgLine(p);
  195. ident:=0;
  196. show:=false;
  197. { parse options }
  198. case s[1] of
  199. {$ifdef UNITALIASES}
  200. 'a',
  201. {$endif}
  202. {$ifdef EXTDEBUG}
  203. 'e',
  204. {$endif EXTDEBUG}
  205. {$ifdef i386}
  206. '3',
  207. {$endif}
  208. {$ifdef m68k}
  209. '6',
  210. {$endif}
  211. '*' : show:=true;
  212. end;
  213. if show then
  214. begin
  215. case s[2] of
  216. {$ifdef GDB}
  217. 'g',
  218. {$endif}
  219. {$ifdef Unix}
  220. 'L',
  221. {$endif}
  222. {$ifdef os2}
  223. 'O',
  224. {$endif}
  225. '*' : show:=true;
  226. else
  227. show:=false;
  228. end;
  229. end;
  230. { now we may show the message or not }
  231. if show then
  232. begin
  233. case s[3] of
  234. '0' : begin
  235. ident:=0;
  236. outline:=0;
  237. end;
  238. '1' : begin
  239. ident:=2;
  240. outline:=7;
  241. end;
  242. '2' : begin
  243. ident:=6;
  244. outline:=11;
  245. end;
  246. '3' : begin
  247. ident:=9;
  248. outline:=6;
  249. end;
  250. end;
  251. j:=pos('_',s);
  252. opt:=Copy(s,4,j-4);
  253. if opt='*' then
  254. opt:=''
  255. else
  256. if opt=' ' then
  257. opt:=PadEnd(opt,outline)
  258. else
  259. opt:=PadEnd('-'+opt,outline);
  260. if (ident=0) and (lastident<>0) then
  261. begin
  262. Comment(V_Normal,'');
  263. inc(Lines);
  264. end;
  265. { page full ? }
  266. if (lines >= page_size - 1) then
  267. begin
  268. if not NoPressEnter then
  269. begin
  270. Message(option_help_press_enter);
  271. readln(input);
  272. if upper(input)='Q' then
  273. StopOptions;
  274. end;
  275. lines:=0;
  276. end;
  277. Comment(V_Normal,PadEnd('',ident)+opt+Copy(s,j+1,255));
  278. LastIdent:=Ident;
  279. inc(Lines);
  280. end;
  281. end;
  282. StopOptions;
  283. end;
  284. procedure Toption.IllegalPara(const opt:string);
  285. begin
  286. Message1(option_illegal_para,opt);
  287. Message(option_help_pages_para);
  288. StopOptions;
  289. end;
  290. function Toption.Unsetbool(var Opts:string; Pos: Longint):boolean;
  291. { checks if the character after pos in Opts is a + or a - and returns resp.
  292. false or true. If it is another character (or none), it also returns false }
  293. begin
  294. UnsetBool := false;
  295. if Length(Opts)>Pos then
  296. begin
  297. inc(Pos);
  298. UnsetBool := Opts[Pos] = '-';
  299. if Opts[Pos] in ['-','+']then
  300. delete(Opts,Pos,1);
  301. end;
  302. end;
  303. procedure TOption.interpret_proc_specific_options(const opt:string);
  304. begin
  305. end;
  306. procedure TOption.interpret_option(const opt:string;ispara:boolean);
  307. var
  308. code : integer;
  309. c : char;
  310. more : string;
  311. major,minor : longint;
  312. error : integer;
  313. j,l : longint;
  314. d : DirStr;
  315. e : ExtStr;
  316. forceasm : tasm;
  317. begin
  318. if opt='' then
  319. exit;
  320. { only parse define,undef,target,verbosity and link options the firsttime }
  321. if firstpass and
  322. not((opt[1]='-') and (opt[2] in ['i','d','v','T','u','n','X'])) then
  323. exit;
  324. Message1(option_handling_option,opt);
  325. case opt[1] of
  326. '-' : begin
  327. more:=Copy(opt,3,255);
  328. case opt[2] of
  329. '!' : initlocalswitches:=initlocalswitches+[cs_ansistrings];
  330. '?' : WriteHelpPages;
  331. 'a' : begin
  332. initglobalswitches:=initglobalswitches+[cs_asm_leave];
  333. for j:=1 to length(more) do
  334. case more[j] of
  335. 'l' : include(initglobalswitches,cs_asm_source);
  336. 'r' : include(initglobalswitches,cs_asm_regalloc);
  337. 't' : include(initglobalswitches,cs_asm_tempalloc);
  338. 'n' : include(initglobalswitches,cs_asm_nodes);
  339. '-' : initglobalswitches:=initglobalswitches -
  340. [cs_asm_leave, cs_asm_source,cs_asm_regalloc, cs_asm_tempalloc];
  341. else
  342. IllegalPara(opt);
  343. end;
  344. end;
  345. 'A' : begin
  346. if set_target_asm_by_string(More) then
  347. asm_is_set:=true
  348. else
  349. IllegalPara(opt);
  350. end;
  351. 'b' : begin
  352. if UnsetBool(More,0) then
  353. begin
  354. exclude(initmoduleswitches,cs_browser);
  355. exclude(initmoduleswitches,cs_local_browser);
  356. {$ifdef BrowserLog}
  357. exclude(initglobalswitches,cs_browser_log);
  358. {$endif}
  359. end
  360. else
  361. begin
  362. include(initmoduleswitches,cs_browser);
  363. {$ifdef BrowserLog}
  364. include(initglobalswitches,cs_browser_log);
  365. {$endif}
  366. end;
  367. if More<>'' then
  368. if (More='l') or (More='l+') then
  369. include(initmoduleswitches,cs_local_browser)
  370. else
  371. if More='l-' then
  372. exclude(initmoduleswitches,cs_local_browser)
  373. else
  374. {$ifdef BrowserLog}
  375. browserlog.elements_to_list.insert(more);
  376. {$else}
  377. IllegalPara(opt);
  378. {$endif}
  379. end;
  380. 'B' : do_build:=not UnSetBool(more,0);
  381. 'C' : begin
  382. j := 1;
  383. while j <= length(more) Do
  384. Begin
  385. case more[j] of
  386. 'a' : Message2(option_obsolete_switch_use_new,'-Ca','-Or');
  387. 'c' :
  388. begin
  389. if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),true) then
  390. IllegalPara(opt);
  391. break;
  392. end;
  393. 'h' :
  394. begin
  395. val(copy(more,j+1,length(more)-j),heapsize,code);
  396. if (code<>0) or (heapsize>=67107840) or (heapsize<1024) then
  397. IllegalPara(opt);
  398. break;
  399. end;
  400. 'i' :
  401. If UnsetBool(More, j) then
  402. exclude(initlocalswitches,cs_check_io)
  403. else
  404. include(initlocalswitches,cs_check_io);
  405. 'n' :
  406. If UnsetBool(More, j) then
  407. exclude(initglobalswitches,cs_link_extern)
  408. Else
  409. include(initglobalswitches,cs_link_extern);
  410. 'o' :
  411. If UnsetBool(More, j) then
  412. exclude(initlocalswitches,cs_check_overflow)
  413. Else
  414. include(initlocalswitches,cs_check_overflow);
  415. 'r' :
  416. If UnsetBool(More, j) then
  417. exclude(initlocalswitches,cs_check_range)
  418. Else
  419. include(initlocalswitches,cs_check_range);
  420. 'R' :
  421. If UnsetBool(More, j) then
  422. begin
  423. exclude(initlocalswitches,cs_check_range);
  424. exclude(initlocalswitches,cs_check_object);
  425. end
  426. Else
  427. begin
  428. include(initlocalswitches,cs_check_range);
  429. include(initlocalswitches,cs_check_object);
  430. end;
  431. 's' :
  432. begin
  433. val(copy(more,j+1,length(more)-j),stacksize,code);
  434. if (code<>0) or (stacksize>=67107840) or (stacksize<1024) then
  435. IllegalPara(opt);
  436. break;
  437. end;
  438. 't' :
  439. If UnsetBool(More, j) then
  440. exclude(initlocalswitches,cs_check_stack)
  441. Else
  442. include(initlocalswitches,cs_check_stack);
  443. 'D' :
  444. If UnsetBool(More, j) then
  445. exclude(initmoduleswitches,cs_create_dynamic)
  446. Else
  447. include(initmoduleswitches,cs_create_dynamic);
  448. 'X' :
  449. If UnsetBool(More, j) then
  450. exclude(initmoduleswitches,cs_create_smart)
  451. Else
  452. include(initmoduleswitches,cs_create_smart);
  453. else
  454. IllegalPara(opt);
  455. end;
  456. inc(j);
  457. end;
  458. end;
  459. 'd' : def_symbol(more);
  460. 'D' : begin
  461. include(initglobalswitches,cs_link_deffile);
  462. for j:=1 to length(more) do
  463. case more[j] of
  464. 'd' : begin
  465. description:=Copy(more,j+1,255);
  466. break;
  467. end;
  468. 'v' : begin
  469. dllversion:=Copy(more,j+1,255);
  470. l:=pos('.',dllversion);
  471. dllminor:=0;
  472. error:=0;
  473. if l>0 then
  474. begin
  475. valint(copy(dllversion,l+1,255),minor,error);
  476. if (error=0) and
  477. (minor>=0) and (minor<=$ffff) then
  478. dllminor:=minor
  479. else if error=0 then
  480. error:=1;
  481. end;
  482. if l=0 then l:=256;
  483. dllmajor:=1;
  484. if error=0 then
  485. valint(copy(dllversion,1,l-1),major,error);
  486. if (error=0) and (major>=0) and (major<=$ffff) then
  487. dllmajor:=major
  488. else if error=0 then
  489. error:=1;
  490. if error<>0 then
  491. Message1(scan_w_wrong_version_ignored,dllversion);
  492. break;
  493. end;
  494. 'w' : usewindowapi:=true;
  495. '-' : begin
  496. exclude(initglobalswitches,cs_link_deffile);
  497. usewindowapi:=false;
  498. end;
  499. else
  500. IllegalPara(opt);
  501. end;
  502. end;
  503. 'e' : exepath:=FixPath(More,true);
  504. { Just used by RHIDE }
  505. 'E' : if UnsetBool(More, 0) then
  506. exclude(initglobalswitches,cs_link_extern)
  507. else
  508. include(initglobalswitches,cs_link_extern);
  509. 'F' : begin
  510. c:=more[1];
  511. Delete(more,1,1);
  512. DefaultReplacements(More);
  513. case c of
  514. 'D' : utilsdirectory:=FixPath(More,true);
  515. 'e' : SetRedirectFile(More);
  516. 'E' : OutputExeDir:=FixPath(More,true);
  517. 'i' : if ispara then
  518. ParaIncludePath.AddPath(More,false)
  519. else
  520. includesearchpath.AddPath(More,true);
  521. 'g' : Message2(option_obsolete_switch_use_new,'-Fg','-Fl');
  522. 'l' : if ispara then
  523. ParaLibraryPath.AddPath(More,false)
  524. else
  525. LibrarySearchPath.AddPath(More,true);
  526. 'L' : if More<>'' then
  527. ParaDynamicLinker:=More
  528. else
  529. IllegalPara(opt);
  530. 'o' : if ispara then
  531. ParaObjectPath.AddPath(More,false)
  532. else
  533. ObjectSearchPath.AddPath(More,true);
  534. 'r' : Msgfilename:=More;
  535. 'u' : if ispara then
  536. ParaUnitPath.AddPath(More,false)
  537. else
  538. unitsearchpath.AddPath(More,true);
  539. 'U' : OutputUnitDir:=FixPath(More,true);
  540. else
  541. IllegalPara(opt);
  542. end;
  543. end;
  544. 'g' : begin
  545. if UnsetBool(More, 0) then
  546. begin
  547. exclude(initmoduleswitches,cs_debuginfo);
  548. exclude(initglobalswitches,cs_gdb_dbx);
  549. exclude(initglobalswitches,cs_gdb_gsym);
  550. exclude(initglobalswitches,cs_gdb_heaptrc);
  551. exclude(initglobalswitches,cs_gdb_lineinfo);
  552. exclude(initglobalswitches,cs_checkpointer);
  553. end
  554. else
  555. begin
  556. {$ifdef GDB}
  557. include(initmoduleswitches,cs_debuginfo);
  558. if not RelocSectionSetExplicitly then
  559. RelocSection:=false;
  560. for j:=1 to length(more) do
  561. case more[j] of
  562. 'd' : if UnsetBool(More, j) then
  563. exclude(initglobalswitches,cs_gdb_dbx)
  564. else
  565. include(initglobalswitches,cs_gdb_dbx);
  566. 'g' : if UnsetBool(More, j) then
  567. exclude(initglobalswitches,cs_gdb_gsym)
  568. else
  569. include(initglobalswitches,cs_gdb_gsym);
  570. 'h' : if UnsetBool(More, j) then
  571. exclude(initglobalswitches,cs_gdb_heaptrc)
  572. else
  573. include(initglobalswitches,cs_gdb_heaptrc);
  574. 'l' : if UnsetBool(More, j) then
  575. exclude(initglobalswitches,cs_gdb_lineinfo)
  576. else
  577. include(initglobalswitches,cs_gdb_lineinfo);
  578. 'c' : if UnsetBool(More, j) then
  579. exclude(initglobalswitches,cs_checkpointer)
  580. else
  581. include(initglobalswitches,cs_checkpointer);
  582. else
  583. IllegalPara(opt);
  584. end;
  585. {$else GDB}
  586. Message(option_no_debug_support);
  587. Message(option_no_debug_support_recompile_fpc);
  588. {$endif GDB}
  589. end;
  590. end;
  591. 'h' : begin
  592. NoPressEnter:=true;
  593. WriteHelpPages;
  594. end;
  595. 'i' : if More='' then
  596. WriteInfo
  597. else
  598. QuickInfo:=QuickInfo+More;
  599. 'I' : if ispara then
  600. ParaIncludePath.AddPath(More,false)
  601. else
  602. includesearchpath.AddPath(More,false);
  603. 'k' : if more<>'' then
  604. ParaLinkOptions:=ParaLinkOptions+' '+More
  605. else
  606. IllegalPara(opt);
  607. 'l' : DoWriteLogo:=not UnSetBool(more,0);
  608. 'm' : parapreprocess:=not UnSetBool(more,0);
  609. 'n' : if More='' then
  610. begin
  611. read_configfile:=false;
  612. disable_configfile:=true;
  613. end
  614. else
  615. IllegalPara(opt);
  616. 'o' : if More<>'' then
  617. Fsplit(More,d,OutputFile,e)
  618. else
  619. IllegalPara(opt);
  620. 'p' : begin
  621. if UnsetBool(More, 0) then
  622. begin
  623. initmoduleswitches:=initmoduleswitches-[cs_profile];
  624. undef_symbol('FPC_PROFILE');
  625. end
  626. else
  627. if Length(More)=0 then
  628. IllegalPara(opt)
  629. else
  630. case more[1] of
  631. 'g' : if UnsetBool(more, 1) then
  632. begin
  633. exclude(initmoduleswitches,cs_profile);
  634. undef_symbol('FPC_PROFILE');
  635. end
  636. else
  637. begin
  638. include(initmoduleswitches,cs_profile);
  639. def_symbol('FPC_PROFILE');
  640. end;
  641. else
  642. IllegalPara(opt);
  643. end;
  644. end;
  645. {$ifdef Unix}
  646. 'P' : if UnsetBool(More, 0) then
  647. exclude(initglobalswitches,cs_asm_pipe)
  648. else
  649. include(initglobalswitches,cs_asm_pipe);
  650. {$endif Unix}
  651. 's' :
  652. begin
  653. if UnsetBool(More, 0) then
  654. begin
  655. initglobalswitches:=initglobalswitches-[cs_asm_extern,cs_link_extern];
  656. if more<>'' then
  657. IllegalPara(opt);
  658. end
  659. else
  660. begin
  661. initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern];
  662. if more='h' then
  663. initglobalswitches:=initglobalswitches-[cs_link_on_target]
  664. else if more='t' then
  665. initglobalswitches:=initglobalswitches+[cs_link_on_target]
  666. else if more<>'' then
  667. IllegalPara(opt);
  668. end;
  669. end;
  670. 'S' : begin
  671. if more[1]='I' then
  672. begin
  673. if upper(more)='ICOM' then
  674. initinterfacetype:=it_interfacecom
  675. else if upper(more)='ICORBA' then
  676. initinterfacetype:=it_interfacecorba
  677. else
  678. IllegalPara(opt);
  679. end
  680. else
  681. for j:=1 to length(more) do
  682. case more[j] of
  683. '2' : SetCompileMode('OBJFPC',true);
  684. 'a' : include(initlocalswitches,cs_do_assertion);
  685. 'c' : include(initmoduleswitches,cs_support_c_operators);
  686. 'd' : SetCompileMode('DELPHI',true);
  687. 'e' : begin
  688. SetErrorFlags(copy(more,j+1,length(more)));
  689. break;
  690. end;
  691. 'g' : include(initmoduleswitches,cs_support_goto);
  692. 'h' : include(initlocalswitches,cs_ansistrings);
  693. 'i' : include(initmoduleswitches,cs_support_inline);
  694. 'm' : include(initmoduleswitches,cs_support_macro);
  695. 'o' : SetCompileMode('TP',true);
  696. 'p' : SetCompileMode('GPC',true);
  697. 's' : include(initglobalswitches,cs_constructor_name);
  698. 't' : include(initmoduleswitches,cs_static_keyword);
  699. '-' : begin
  700. exclude(initglobalswitches,cs_constructor_name);
  701. initlocalswitches:=InitLocalswitches - [cs_do_assertion, cs_ansistrings];
  702. initmoduleswitches:=initmoduleswitches - [cs_support_c_operators, cs_support_goto,
  703. cs_support_inline, cs_support_macro,
  704. cs_static_keyword];
  705. end;
  706. else
  707. IllegalPara(opt);
  708. end;
  709. end;
  710. 'T' : begin
  711. more:=Upper(More);
  712. if not target_is_set then
  713. begin
  714. { remove old target define }
  715. TargetDefines(false);
  716. { Save assembler if set }
  717. if asm_is_set then
  718. forceasm:=target_asm.id;
  719. { load new target }
  720. if not(set_target_by_string(More)) then
  721. IllegalPara(opt);
  722. { also initialize assembler if not explicitly set }
  723. if asm_is_set then
  724. set_target_asm(forceasm);
  725. { set new define }
  726. TargetDefines(true);
  727. target_is_set:=true;
  728. end
  729. else
  730. if More<>upper(target_info.shortname) then
  731. Message1(option_target_is_already_set,target_info.shortname);
  732. end;
  733. 'u' : undef_symbol(upper(More));
  734. 'U' : begin
  735. for j:=1 to length(more) do
  736. case more[j] of
  737. {$ifdef UNITALIASES}
  738. 'a' : begin
  739. AddUnitAlias(Copy(More,j+1,255));
  740. break;
  741. end;
  742. {$endif UNITALIASES}
  743. 'n' : exclude(initglobalswitches,cs_check_unit_name);
  744. 'p' : begin
  745. Message2(option_obsolete_switch_use_new,'-Up','-Fu');
  746. break;
  747. end;
  748. 'r' : do_release:=true;
  749. 's' : include(initmoduleswitches,cs_compilesystem);
  750. '-' : begin
  751. exclude(initmoduleswitches,cs_compilesystem);
  752. exclude(initglobalswitches,cs_check_unit_name);
  753. end;
  754. else
  755. IllegalPara(opt);
  756. end;
  757. end;
  758. 'v' : if not setverbosity(More) then
  759. IllegalPara(opt);
  760. 'W' : begin
  761. j:=0;
  762. while j<length(More) do
  763. begin
  764. inc(j);
  765. case More[j] of
  766. 'B': begin
  767. { -WB200000 means set trefered base address
  768. to $200000, but does not change relocsection boolean
  769. this way we can create both relocatble and
  770. non relocatable DLL at a specific base address PM }
  771. if (length(More)>j) then
  772. begin
  773. if DLLImageBase=nil then
  774. DLLImageBase:=StringDup(Copy(More,j+1,255));
  775. end
  776. else
  777. begin
  778. RelocSection:=true;
  779. RelocSectionSetExplicitly:=true;
  780. end;
  781. break;
  782. end;
  783. 'C': if UnsetBool(More, j) then
  784. apptype:=app_gui
  785. else
  786. apptype:=app_cui;
  787. 'D': ForceDeffileForExport:=not UnsetBool(More, j);
  788. 'F': apptype:=app_fs;
  789. 'G': if UnsetBool(More, j) then
  790. apptype:=app_cui
  791. else
  792. apptype:=app_gui;
  793. 'N': begin
  794. RelocSection:=UnsetBool(More,j);
  795. RelocSectionSetExplicitly:=true;
  796. end;
  797. 'R': begin
  798. { support -WR+ / -WR- as synonims to -WR / -WN }
  799. RelocSection:=not UnsetBool(More,j);
  800. RelocSectionSetExplicitly:=true;
  801. end;
  802. else
  803. IllegalPara(opt);
  804. end;
  805. end; {of while}
  806. end;
  807. 'X' : begin
  808. for j:=1 to length(More) do
  809. case More[j] of
  810. 'i' : include(initglobalswitches,cs_link_internal);
  811. 'm' : include(initglobalswitches,cs_link_map);
  812. 's' : include(initglobalswitches,cs_link_strip);
  813. 't' : include(initglobalswitches,cs_link_staticflag);
  814. 'D' : begin
  815. def_symbol('FPC_LINK_DYNAMIC');
  816. undef_symbol('FPC_LINK_SMART');
  817. undef_symbol('FPC_LINK_STATIC');
  818. exclude(initglobalswitches,cs_link_static);
  819. exclude(initglobalswitches,cs_link_smart);
  820. include(initglobalswitches,cs_link_shared);
  821. LinkTypeSetExplicitly:=true;
  822. end;
  823. 'S' : begin
  824. def_symbol('FPC_LINK_STATIC');
  825. undef_symbol('FPC_LINK_SMART');
  826. undef_symbol('FPC_LINK_DYNAMIC');
  827. include(initglobalswitches,cs_link_static);
  828. exclude(initglobalswitches,cs_link_smart);
  829. exclude(initglobalswitches,cs_link_shared);
  830. LinkTypeSetExplicitly:=true;
  831. end;
  832. 'X' : begin
  833. def_symbol('FPC_LINK_SMART');
  834. undef_symbol('FPC_LINK_STATIC');
  835. undef_symbol('FPC_LINK_DYNAMIC');
  836. exclude(initglobalswitches,cs_link_static);
  837. include(initglobalswitches,cs_link_smart);
  838. exclude(initglobalswitches,cs_link_shared);
  839. LinkTypeSetExplicitly:=true;
  840. end;
  841. '-' : begin
  842. exclude(initglobalswitches,cs_link_staticflag);
  843. exclude(initglobalswitches,cs_link_strip);
  844. exclude(initglobalswitches,cs_link_map);
  845. set_default_link_type;
  846. end;
  847. else
  848. IllegalPara(opt);
  849. end;
  850. end;
  851. { give processor specific options a chance }
  852. else
  853. interpret_proc_specific_options(opt);
  854. end;
  855. end;
  856. '@' : begin
  857. Message(option_no_nested_response_file);
  858. StopOptions;
  859. end;
  860. else
  861. begin
  862. if (length(param_file)<>0) then
  863. Message(option_only_one_source_support);
  864. param_file:=opt;
  865. end;
  866. end;
  867. end;
  868. procedure Toption.Interpret_file(const filename : string);
  869. procedure RemoveSep(var fn:string);
  870. var
  871. i : longint;
  872. begin
  873. i:=0;
  874. while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do
  875. inc(i);
  876. Delete(fn,1,i);
  877. i:=length(fn);
  878. while (i>0) and (fn[i] in [',',' ',#9]) do
  879. dec(i);
  880. fn:=copy(fn,1,i);
  881. end;
  882. function GetName(var fn:string):string;
  883. var
  884. i : longint;
  885. begin
  886. i:=0;
  887. while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do
  888. inc(i);
  889. GetName:=Copy(fn,1,i);
  890. Delete(fn,1,i);
  891. end;
  892. const
  893. maxlevel=16;
  894. var
  895. f : text;
  896. s,
  897. opts : string;
  898. skip : array[0..maxlevel-1] of boolean;
  899. level : longint;
  900. option_read : boolean;
  901. begin
  902. { avoid infinite loop }
  903. Inc(FileLevel);
  904. Option_read:=false;
  905. If FileLevel>MaxLevel then
  906. Message(option_too_many_cfg_files);
  907. { open file }
  908. Message1(option_using_file,filename);
  909. assign(f,filename);
  910. {$I-}
  911. reset(f);
  912. {$I+}
  913. if ioresult<>0 then
  914. begin
  915. Message1(option_unable_open_file,filename);
  916. exit;
  917. end;
  918. fillchar(skip,sizeof(skip),0);
  919. level:=0;
  920. while not eof(f) do
  921. begin
  922. readln(f,opts);
  923. RemoveSep(opts);
  924. if (opts<>'') and (opts[1]<>';') then
  925. begin
  926. if opts[1]='#' then
  927. begin
  928. Delete(opts,1,1);
  929. s:=upper(GetName(opts));
  930. if (s='SECTION') then
  931. begin
  932. RemoveSep(opts);
  933. s:=upper(GetName(opts));
  934. if level=0 then
  935. skip[level]:=not (check_symbol(s) or (s='COMMON'));
  936. end
  937. else
  938. if (s='IFDEF') then
  939. begin
  940. RemoveSep(opts);
  941. if Level>=maxlevel then
  942. begin
  943. Message(option_too_many_ifdef);
  944. stopOptions;
  945. end;
  946. inc(Level);
  947. skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts)))));
  948. end
  949. else
  950. if (s='IFNDEF') then
  951. begin
  952. RemoveSep(opts);
  953. if Level>=maxlevel then
  954. begin
  955. Message(option_too_many_ifdef);
  956. stopOptions;
  957. end;
  958. inc(Level);
  959. skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts)))));
  960. end
  961. else
  962. if (s='ELSE') then
  963. skip[level]:=skip[level-1] or (not skip[level])
  964. else
  965. if (s='ENDIF') then
  966. begin
  967. skip[level]:=false;
  968. if Level=0 then
  969. begin
  970. Message(option_too_many_endif);
  971. stopOptions;
  972. end;
  973. dec(level);
  974. end
  975. else
  976. if (not skip[level]) then
  977. begin
  978. if (s='DEFINE') then
  979. begin
  980. RemoveSep(opts);
  981. def_symbol(upper(GetName(opts)));
  982. end
  983. else
  984. if (s='UNDEF') then
  985. begin
  986. RemoveSep(opts);
  987. undef_symbol(upper(GetName(opts)));
  988. end
  989. else
  990. if (s='WRITE') then
  991. begin
  992. Delete(opts,1,1);
  993. WriteLn(opts);
  994. end
  995. else
  996. if (s='INCLUDE') then
  997. begin
  998. Delete(opts,1,1);
  999. Interpret_file(opts);
  1000. end;
  1001. end;
  1002. end
  1003. else
  1004. begin
  1005. if (opts[1]='-') or (opts[1]='@') then
  1006. begin
  1007. if (not skip[level]) then
  1008. interpret_option(opts,false);
  1009. Option_read:=true;
  1010. end
  1011. else
  1012. Message1(option_illegal_para,opts);
  1013. end;
  1014. end;
  1015. end;
  1016. if Level>0 then
  1017. Message(option_too_less_endif);
  1018. if Not Option_read then
  1019. Message1(option_no_option_found,filename);
  1020. Close(f);
  1021. Dec(FileLevel);
  1022. end;
  1023. procedure Toption.Interpret_envvar(const envname : string);
  1024. var
  1025. argstart,
  1026. env,
  1027. pc : pchar;
  1028. arglen : longint;
  1029. quote : set of char;
  1030. hs : string;
  1031. begin
  1032. Message1(option_using_env,envname);
  1033. env:=GetEnvPChar(envname);
  1034. pc:=env;
  1035. if assigned(pc) then
  1036. begin
  1037. repeat
  1038. { skip leading spaces }
  1039. while pc^ in [' ',#9,#13] do
  1040. inc(pc);
  1041. case pc^ of
  1042. #0 :
  1043. break;
  1044. '"' :
  1045. begin
  1046. quote:=['"'];
  1047. inc(pc);
  1048. end;
  1049. '''' :
  1050. begin
  1051. quote:=[''''];
  1052. inc(pc);
  1053. end;
  1054. else
  1055. quote:=[' ',#9,#13];
  1056. end;
  1057. { scan until the end of the argument }
  1058. argstart:=pc;
  1059. while (pc^<>#0) and not(pc^ in quote) do
  1060. inc(pc);
  1061. { create argument }
  1062. arglen:=pc-argstart;
  1063. hs[0]:=chr(arglen);
  1064. move(argstart^,hs[1],arglen);
  1065. interpret_option(hs,true);
  1066. { skip quote }
  1067. if pc^ in quote then
  1068. inc(pc);
  1069. until false;
  1070. end
  1071. else
  1072. Message1(option_no_option_found,'(env) '+envname);
  1073. FreeEnvPChar(env);
  1074. end;
  1075. procedure toption.read_parameters;
  1076. var
  1077. opts : string;
  1078. paramindex : longint;
  1079. begin
  1080. paramindex:=0;
  1081. while paramindex<paramcount do
  1082. begin
  1083. inc(paramindex);
  1084. opts:=system.paramstr(paramindex);
  1085. case opts[1] of
  1086. '@' :
  1087. if not firstpass then
  1088. begin
  1089. Delete(opts,1,1);
  1090. Message1(option_reading_further_from,opts);
  1091. interpret_file(opts);
  1092. end;
  1093. '!' :
  1094. if not firstpass then
  1095. begin
  1096. Delete(opts,1,1);
  1097. Message1(option_reading_further_from,'(env) '+opts);
  1098. interpret_envvar(opts);
  1099. end;
  1100. else
  1101. interpret_option(opts,true);
  1102. end;
  1103. end;
  1104. end;
  1105. procedure toption.parsecmd(cmd:string);
  1106. var
  1107. i,ps : longint;
  1108. opts : string;
  1109. begin
  1110. while (cmd<>'') do
  1111. begin
  1112. while cmd[1]=' ' do
  1113. delete(cmd,1,1);
  1114. i:=pos(' ',cmd);
  1115. if i=0 then
  1116. i:=256;
  1117. opts:=Copy(cmd,1,i-1);
  1118. Delete(cmd,1,i);
  1119. case opts[1] of
  1120. '@' :
  1121. if not firstpass then
  1122. begin
  1123. Delete(opts,1,1);
  1124. Message1(option_reading_further_from,opts);
  1125. interpret_file(opts);
  1126. end;
  1127. '!' :
  1128. if not firstpass then
  1129. begin
  1130. Delete(opts,1,1);
  1131. Message1(option_reading_further_from,'(env) '+opts);
  1132. interpret_envvar(opts);
  1133. end;
  1134. '"' :
  1135. begin
  1136. Delete(opts,1,1);
  1137. ps:=pos('"',cmd);
  1138. if (i<>256) and (ps>0) then
  1139. begin
  1140. opts:=opts + ' '+ copy(cmd,1,ps-1);
  1141. cmd:=copy(cmd,ps+1,255);
  1142. end;
  1143. interpret_option(opts,true);
  1144. end;
  1145. else
  1146. interpret_option(opts,true);
  1147. end;
  1148. end;
  1149. end;
  1150. procedure toption.writequickinfo;
  1151. var
  1152. s : string;
  1153. i : longint;
  1154. procedure addinfo(const hs:string);
  1155. begin
  1156. if s<>'' then
  1157. s:=s+' '+hs
  1158. else
  1159. s:=hs;
  1160. end;
  1161. begin
  1162. s:='';
  1163. i:=0;
  1164. while (i<length(quickinfo)) do
  1165. begin
  1166. inc(i);
  1167. case quickinfo[i] of
  1168. 'S' :
  1169. begin
  1170. inc(i);
  1171. case quickinfo[i] of
  1172. 'O' :
  1173. addinfo(lower(source_info.shortname));
  1174. {$ifdef Delphi}
  1175. 'P' :
  1176. addinfo('i386');
  1177. {$else Delphi}
  1178. 'P' :
  1179. addinfo(source_cpu_string);
  1180. {$endif Delphi}
  1181. else
  1182. IllegalPara('-iS'+QuickInfo);
  1183. end;
  1184. end;
  1185. 'T' :
  1186. begin
  1187. inc(i);
  1188. case quickinfo[i] of
  1189. 'O' :
  1190. addinfo(lower(target_info.shortname));
  1191. 'P' :
  1192. AddInfo(target_cpu_string);
  1193. else
  1194. IllegalPara('-iT'+QuickInfo);
  1195. end;
  1196. end;
  1197. 'V' :
  1198. AddInfo(version_string);
  1199. 'D' :
  1200. AddInfo(date_string);
  1201. '_' :
  1202. ;
  1203. else
  1204. IllegalPara('-i'+QuickInfo);
  1205. end;
  1206. end;
  1207. if s<>'' then
  1208. begin
  1209. writeln(s);
  1210. stopoptions;
  1211. end;
  1212. end;
  1213. procedure TOption.TargetDefines(def:boolean);
  1214. var
  1215. s : string;
  1216. i : integer;
  1217. begin
  1218. if def then
  1219. def_symbol(upper(target_info.shortname))
  1220. else
  1221. undef_symbol(upper(target_info.shortname));
  1222. s:=target_info.extradefines;
  1223. while (s<>'') do
  1224. begin
  1225. i:=pos(';',s);
  1226. if i=0 then
  1227. i:=length(s)+1;
  1228. if def then
  1229. def_symbol(Copy(s,1,i-1))
  1230. else
  1231. undef_symbol(Copy(s,1,i-1));
  1232. delete(s,1,i);
  1233. end;
  1234. end;
  1235. constructor TOption.create;
  1236. begin
  1237. DoWriteLogo:=false;
  1238. NoPressEnter:=false;
  1239. FirstPass:=false;
  1240. FileLevel:=0;
  1241. Quickinfo:='';
  1242. ParaIncludePath:=TSearchPathList.Create;
  1243. ParaObjectPath:=TSearchPathList.Create;
  1244. ParaUnitPath:=TSearchPathList.Create;
  1245. ParaLibraryPath:=TSearchPathList.Create;
  1246. FillChar(ParaAlignment,sizeof(ParaAlignment),0);
  1247. end;
  1248. destructor TOption.destroy;
  1249. begin
  1250. ParaIncludePath.Free;
  1251. ParaObjectPath.Free;
  1252. ParaUnitPath.Free;
  1253. ParaLibraryPath.Free;
  1254. end;
  1255. {****************************************************************************
  1256. Callable Routines
  1257. ****************************************************************************}
  1258. procedure read_arguments(cmd:string);
  1259. var
  1260. configpath : pathstr;
  1261. begin
  1262. option:=coption.create;
  1263. disable_configfile:=false;
  1264. { default defines }
  1265. def_symbol(upper(target_info.shortname));
  1266. def_symbol('FPC');
  1267. def_symbol('VER'+version_nr);
  1268. def_symbol('VER'+version_nr+'_'+release_nr);
  1269. def_symbol('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
  1270. {$ifdef newcg}
  1271. def_symbol('WITHNEWCG');
  1272. {$endif}
  1273. { Temporary defines, until things settle down }
  1274. def_symbol('HASWIDECHAR');
  1275. def_symbol('HASWIDESTRING');
  1276. def_symbol('HASOUT');
  1277. def_symbol('HASINTF');
  1278. def_symbol('HASVARIANT');
  1279. def_symbol('INTERNSETLENGTH');
  1280. def_symbol('INTERNLENGTH');
  1281. def_symbol('INT64FUNCRESOK');
  1282. def_symbol('HAS_ADDR_STACK_ON_STACK');
  1283. def_symbol('NOBOUNDCHECK');
  1284. def_symbol('HASCOMPILERPROC');
  1285. def_symbol('VALUEGETMEM');
  1286. def_symbol('VALUEFREEMEM');
  1287. def_symbol('HASCURRENCY');
  1288. { using a case is pretty useless here (FK) }
  1289. { some stuff for TP compatibility }
  1290. {$ifdef i386}
  1291. def_symbol('CPU86');
  1292. def_symbol('CPU87');
  1293. {$endif}
  1294. {$ifdef m68k}
  1295. def_symbol('CPU68');
  1296. {$endif}
  1297. { new processor stuff }
  1298. {$ifdef i386}
  1299. def_symbol('CPUI386');
  1300. {$endif}
  1301. {$ifdef m68k}
  1302. def_symbol('CPU68K');
  1303. {$endif}
  1304. {$ifdef ALPHA}
  1305. def_symbol('CPUALPHA');
  1306. {$endif}
  1307. {$ifdef powerpc}
  1308. def_symbol('CPUPOWERPC');
  1309. {$endif}
  1310. {$ifdef iA64}
  1311. def_symbol('CPUIA64');
  1312. {$endif}
  1313. {$ifdef x64_64}
  1314. def_symbol('CPU 86_64');
  1315. {$endif}
  1316. {$ifdef sparc}
  1317. def_symbol('CPUSPARC');
  1318. {$endif}
  1319. {$ifdef vis}
  1320. def_symbol('CPUVIS');
  1321. {$endif}
  1322. { get default messagefile }
  1323. {$ifdef Delphi}
  1324. msgfilename:=dmisc.getenv('PPC_ERROR_FILE');
  1325. {$else Delphi}
  1326. msgfilename:=dos.getenv('PPC_ERROR_FILE');
  1327. {$endif Delphi}
  1328. { default configfile }
  1329. if (cmd<>'') and (cmd[1]='[') then
  1330. begin
  1331. ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
  1332. Delete(cmd,1,pos(']',cmd));
  1333. end
  1334. else
  1335. begin
  1336. ppcaltcfg:='ppc386.cfg';
  1337. ppccfg:='fpc.cfg';
  1338. end;
  1339. { Order to read configuration file :
  1340. try reading ppc386.cfg in :
  1341. 1 - current dir
  1342. 2 - configpath
  1343. 3 - compiler path
  1344. else try reading fpc.cfg in :
  1345. 1 - current dir
  1346. 2 - configpath
  1347. 3 - compiler path
  1348. }
  1349. {$ifdef Delphi}
  1350. configpath:=FixPath(dmisc.getenv('PPC_CONFIG_PATH'),false);
  1351. {$else Delphi}
  1352. configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false);
  1353. {$endif Delphi}
  1354. {$ifdef Unix}
  1355. if configpath='' then
  1356. configpath:='/etc/';
  1357. {$endif}
  1358. if ppccfg<>'' then
  1359. begin
  1360. read_configfile:=true;
  1361. if not FileExists(ppcaltcfg) then
  1362. begin
  1363. {$ifdef Unix}
  1364. if (dos.getenv('HOME')<>'') and FileExists(FixPath(dos.getenv('HOME'),false)+'.'+ppcaltcfg) then
  1365. ppccfg:=FixPath(dos.getenv('HOME'),false)+'.'+ppcaltcfg
  1366. else
  1367. {$endif}
  1368. if FileExists(configpath+ppcaltcfg) then
  1369. ppccfg:=configpath+ppcaltcfg
  1370. else
  1371. {$ifndef Unix}
  1372. if FileExists(exepath+ppcaltcfg) then
  1373. ppccfg:=exepath+ppcaltcfg
  1374. else
  1375. {$endif}
  1376. read_configfile:=false;
  1377. end
  1378. else
  1379. ppccfg := ppcaltcfg; { file is found, then set it to ppccfg }
  1380. if not read_configfile then
  1381. begin
  1382. read_configfile := true;
  1383. if not FileExists(ppccfg) then
  1384. begin
  1385. {$ifdef Unix}
  1386. if (dos.getenv('HOME')<>'') and FileExists(FixPath(dos.getenv('HOME'),false)+'.'+ppccfg) then
  1387. ppccfg:=FixPath(dos.getenv('HOME'),false)+'.'+ppccfg
  1388. else
  1389. {$endif}
  1390. if FileExists(configpath+ppccfg) then
  1391. ppccfg:=configpath+ppccfg
  1392. else
  1393. {$ifndef Unix}
  1394. if FileExists(exepath+ppccfg) then
  1395. ppccfg:=exepath+ppccfg
  1396. else
  1397. {$endif}
  1398. read_configfile:=false;
  1399. end;
  1400. end
  1401. end
  1402. else
  1403. read_configfile := false;
  1404. { Read commandline and configfile }
  1405. target_is_set:=false;
  1406. asm_is_set:=false;
  1407. param_file:='';
  1408. if read_configfile then
  1409. begin
  1410. { read the parameters quick, only -i -v -T }
  1411. option.firstpass:=true;
  1412. if cmd<>'' then
  1413. option.parsecmd(cmd)
  1414. else
  1415. begin
  1416. option.read_parameters;
  1417. { Write only quickinfo }
  1418. if option.quickinfo<>'' then
  1419. option.writequickinfo;
  1420. end;
  1421. { Read the configfile }
  1422. option.firstpass:=false;
  1423. if read_configfile then
  1424. option.interpret_file(ppccfg);
  1425. end;
  1426. if cmd<>'' then
  1427. option.parsecmd(cmd)
  1428. else
  1429. begin
  1430. option.read_parameters;
  1431. { Write only quickinfo }
  1432. if option.quickinfo<>'' then
  1433. option.writequickinfo;
  1434. end;
  1435. { Write help pages }
  1436. if (cmd='') and (paramcount=0) then
  1437. Option.WriteHelpPages;
  1438. { Stop if errors in options }
  1439. if ErrorCount>0 then
  1440. StopOptions;
  1441. { Non-core target defines }
  1442. Option.TargetDefines(true);
  1443. { endian define }
  1444. case target_info.endian of
  1445. endian_little :
  1446. def_symbol('ENDIAN_LITTLE');
  1447. endian_big :
  1448. def_symbol('ENDIAN_BIG');
  1449. end;
  1450. {$ifdef m68k}
  1451. { Disable fpu emulation for linux and netbsd on m68k machines }
  1452. { FIXME: this overrides possible explicit command line emulation setting,
  1453. but this isn't supported yet anyhow PM }
  1454. if (target_info.target in [target_m68k_netbsd,target_m68k_linux]) then
  1455. exclude(initmoduleswitches,cs_fp_emulation)
  1456. else
  1457. def_symbol('M68K_FPU_EMULATED');
  1458. {$endif m68k}
  1459. { write logo if set }
  1460. if option.DoWriteLogo then
  1461. option.WriteLogo;
  1462. { Check file to compile }
  1463. if param_file='' then
  1464. begin
  1465. Message(option_no_source_found);
  1466. StopOptions;
  1467. end;
  1468. {$ifndef Unix}
  1469. param_file:=FixFileName(param_file);
  1470. {$endif}
  1471. fsplit(param_file,inputdir,inputfile,inputextension);
  1472. if inputextension='' then
  1473. begin
  1474. if FileExists(inputdir+inputfile+target_info.sourceext) then
  1475. inputextension:=target_info.sourceext
  1476. else
  1477. if FileExists(inputdir+inputfile+target_info.pasext) then
  1478. inputextension:=target_info.pasext;
  1479. end;
  1480. { Add paths specified with parameters to the searchpaths }
  1481. UnitSearchPath.AddList(option.ParaUnitPath,true);
  1482. ObjectSearchPath.AddList(option.ParaObjectPath,true);
  1483. IncludeSearchPath.AddList(option.ParaIncludePath,true);
  1484. LibrarySearchPath.AddList(option.ParaLibraryPath,true);
  1485. { add unit environment and exepath to the unit search path }
  1486. if inputdir<>'' then
  1487. Unitsearchpath.AddPath(inputdir,true);
  1488. if not disable_configfile then
  1489. {$ifdef Delphi}
  1490. UnitSearchPath.AddPath(dmisc.getenv(target_info.unit_env),false);
  1491. {$else}
  1492. UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false);
  1493. {$endif Delphi}
  1494. {$ifdef Unix}
  1495. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1496. if fpcdir='' then
  1497. begin
  1498. if PathExists('/usr/local/lib/fpc/'+version_string) then
  1499. fpcdir:='/usr/local/lib/fpc/'+version_string+'/'
  1500. else
  1501. fpcdir:='/usr/lib/fpc/'+version_string+'/';
  1502. end;
  1503. {$else}
  1504. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1505. if fpcdir='' then
  1506. begin
  1507. fpcdir:=ExePath+'../';
  1508. if not(PathExists(fpcdir+'/units')) and
  1509. not(PathExists(fpcdir+'/rtl')) then
  1510. fpcdir:=fpcdir+'../';
  1511. end;
  1512. {$endif}
  1513. { first try development RTL, else use the default installation path }
  1514. if not disable_configfile then
  1515. begin
  1516. if PathExists(FpcDir+'rtl/'+lower(target_info.shortname)) then
  1517. UnitSearchPath.AddPath(FpcDir+'rtl/'+lower(target_info.shortname),false)
  1518. else
  1519. begin
  1520. UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname),false);
  1521. UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname)+'/rtl',false);
  1522. end;
  1523. end;
  1524. { Add exepath if the exe is not in the current dir, because that is always searched already }
  1525. if ExePath<>GetCurrentDir then
  1526. UnitSearchPath.AddPath(ExePath,false);
  1527. { Add unit dir to the object and library path }
  1528. objectsearchpath.AddList(unitsearchpath,false);
  1529. librarysearchpath.AddList(unitsearchpath,false);
  1530. { switch assembler if it's binary and we got -a on the cmdline }
  1531. if (cs_asm_leave in initglobalswitches) and
  1532. (target_asm.outputbinary) then
  1533. begin
  1534. Message(option_switch_bin_to_src_assembler);
  1535. set_target_asm(target_info.assemextern);
  1536. end;
  1537. if (target_asm.supported_target <> target_any) and
  1538. (target_asm.supported_target <> target_info.target) then
  1539. begin
  1540. Message2(option_incompatible_asm,target_asm.idtxt,target_info.name);
  1541. set_target_asm(target_info.assemextern);
  1542. Message1(option_asm_forced,target_asm.idtxt);
  1543. end;
  1544. { turn off stripping if compiling with debuginfo or profile }
  1545. if (cs_debuginfo in initmoduleswitches) or
  1546. (cs_profile in initmoduleswitches) then
  1547. exclude(initglobalswitches,cs_link_strip);
  1548. if not LinkTypeSetExplicitly then
  1549. set_default_link_type;
  1550. { Default alignment settings,
  1551. 1. load the defaults for the target
  1552. 2. override with generic optimizer setting (little size)
  1553. 3. override with the user specified -Oa }
  1554. UpdateAlignment(initalignment,target_info.alignment);
  1555. if (cs_littlesize in aktglobalswitches) then
  1556. begin
  1557. initalignment.procalign:=1;
  1558. initalignment.jumpalign:=1;
  1559. initalignment.loopalign:=1;
  1560. end;
  1561. UpdateAlignment(initalignment,option.paraalignment);
  1562. option.free;
  1563. Option:=nil;
  1564. end;
  1565. initialization
  1566. coption:=toption;
  1567. finalization
  1568. if assigned(option) then
  1569. option.free;
  1570. end.
  1571. {
  1572. $Log$
  1573. Revision 1.76 2002-07-04 20:43:01 florian
  1574. * first x86-64 patches
  1575. Revision 1.75 2002/07/01 18:46:24 peter
  1576. * internal linker
  1577. * reorganized aasm layer
  1578. Revision 1.74 2002/07/01 16:23:53 peter
  1579. * cg64 patch
  1580. * basics for currency
  1581. * asnode updates for class and interface (not finished)
  1582. Revision 1.73 2002/05/18 13:34:11 peter
  1583. * readded missing revisions
  1584. Revision 1.72 2002/05/16 19:46:41 carl
  1585. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1586. + try to fix temp allocation (still in ifdef)
  1587. + generic constructor calls
  1588. + start of tassembler / tmodulebase class cleanup
  1589. Revision 1.70 2002/05/12 16:53:08 peter
  1590. * moved entry and exitcode to ncgutil and cgobj
  1591. * foreach gets extra argument for passing local data to the
  1592. iterator function
  1593. * -CR checks also class typecasts at runtime by changing them
  1594. into as
  1595. * fixed compiler to cycle with the -CR option
  1596. * fixed stabs with elf writer, finally the global variables can
  1597. be watched
  1598. * removed a lot of routines from cga unit and replaced them by
  1599. calls to cgobj
  1600. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1601. u32bit then the other is typecasted also to u32bit without giving
  1602. a rangecheck warning/error.
  1603. * fixed pascal calling method with reversing also the high tree in
  1604. the parast, detected by tcalcst3 test
  1605. Revision 1.69 2002/04/21 19:02:04 peter
  1606. * removed newn and disposen nodes, the code is now directly
  1607. inlined from pexpr
  1608. * -an option that will write the secondpass nodes to the .s file, this
  1609. requires EXTDEBUG define to actually write the info
  1610. * fixed various internal errors and crashes due recent code changes
  1611. Revision 1.68 2002/04/20 21:32:24 carl
  1612. + generic FPC_CHECKPOINTER
  1613. + first parameter offset in stack now portable
  1614. * rename some constants
  1615. + move some cpu stuff to other units
  1616. - remove unused constents
  1617. * fix stacksize for some targets
  1618. * fix generic size problems which depend now on EXTEND_SIZE constant
  1619. Revision 1.67 2002/04/07 10:22:35 carl
  1620. + CPU defines now depends on current target
  1621. Revision 1.66 2002/04/04 19:05:58 peter
  1622. * removed unused units
  1623. * use tlocation.size in cg.a_*loc*() routines
  1624. Revision 1.65 2002/04/04 18:39:45 carl
  1625. + added wdosx support (patch from Pavel)
  1626. }