options.pas 54 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725
  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. 's' : include(initglobalswitches,cs_link_strip);
  811. 't' : include(initglobalswitches,cs_link_staticflag);
  812. 'D' : begin
  813. def_symbol('FPC_LINK_DYNAMIC');
  814. undef_symbol('FPC_LINK_SMART');
  815. undef_symbol('FPC_LINK_STATIC');
  816. exclude(initglobalswitches,cs_link_static);
  817. exclude(initglobalswitches,cs_link_smart);
  818. include(initglobalswitches,cs_link_shared);
  819. LinkTypeSetExplicitly:=true;
  820. end;
  821. 'S' : begin
  822. def_symbol('FPC_LINK_STATIC');
  823. undef_symbol('FPC_LINK_SMART');
  824. undef_symbol('FPC_LINK_DYNAMIC');
  825. include(initglobalswitches,cs_link_static);
  826. exclude(initglobalswitches,cs_link_smart);
  827. exclude(initglobalswitches,cs_link_shared);
  828. LinkTypeSetExplicitly:=true;
  829. end;
  830. 'X' : begin
  831. def_symbol('FPC_LINK_SMART');
  832. undef_symbol('FPC_LINK_STATIC');
  833. undef_symbol('FPC_LINK_DYNAMIC');
  834. exclude(initglobalswitches,cs_link_static);
  835. include(initglobalswitches,cs_link_smart);
  836. exclude(initglobalswitches,cs_link_shared);
  837. LinkTypeSetExplicitly:=true;
  838. end;
  839. '-' : begin
  840. exclude(initglobalswitches,cs_link_staticflag);
  841. exclude(initglobalswitches,cs_link_strip);
  842. set_default_link_type;
  843. end;
  844. else
  845. IllegalPara(opt);
  846. end;
  847. end;
  848. { give processor specific options a chance }
  849. else
  850. interpret_proc_specific_options(opt);
  851. end;
  852. end;
  853. '@' : begin
  854. Message(option_no_nested_response_file);
  855. StopOptions;
  856. end;
  857. else
  858. begin
  859. if (length(param_file)<>0) then
  860. Message(option_only_one_source_support);
  861. param_file:=opt;
  862. end;
  863. end;
  864. end;
  865. procedure Toption.Interpret_file(const filename : string);
  866. procedure RemoveSep(var fn:string);
  867. var
  868. i : longint;
  869. begin
  870. i:=0;
  871. while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do
  872. inc(i);
  873. Delete(fn,1,i);
  874. i:=length(fn);
  875. while (i>0) and (fn[i] in [',',' ',#9]) do
  876. dec(i);
  877. fn:=copy(fn,1,i);
  878. end;
  879. function GetName(var fn:string):string;
  880. var
  881. i : longint;
  882. begin
  883. i:=0;
  884. while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do
  885. inc(i);
  886. GetName:=Copy(fn,1,i);
  887. Delete(fn,1,i);
  888. end;
  889. const
  890. maxlevel=16;
  891. var
  892. f : text;
  893. s,
  894. opts : string;
  895. skip : array[0..maxlevel-1] of boolean;
  896. level : longint;
  897. option_read : boolean;
  898. begin
  899. { avoid infinite loop }
  900. Inc(FileLevel);
  901. Option_read:=false;
  902. If FileLevel>MaxLevel then
  903. Message(option_too_many_cfg_files);
  904. { open file }
  905. Message1(option_using_file,filename);
  906. assign(f,filename);
  907. {$I-}
  908. reset(f);
  909. {$I+}
  910. if ioresult<>0 then
  911. begin
  912. Message1(option_unable_open_file,filename);
  913. exit;
  914. end;
  915. fillchar(skip,sizeof(skip),0);
  916. level:=0;
  917. while not eof(f) do
  918. begin
  919. readln(f,opts);
  920. RemoveSep(opts);
  921. if (opts<>'') and (opts[1]<>';') then
  922. begin
  923. if opts[1]='#' then
  924. begin
  925. Delete(opts,1,1);
  926. s:=upper(GetName(opts));
  927. if (s='SECTION') then
  928. begin
  929. RemoveSep(opts);
  930. s:=upper(GetName(opts));
  931. if level=0 then
  932. skip[level]:=not (check_symbol(s) or (s='COMMON'));
  933. end
  934. else
  935. if (s='IFDEF') then
  936. begin
  937. RemoveSep(opts);
  938. if Level>=maxlevel then
  939. begin
  940. Message(option_too_many_ifdef);
  941. stopOptions;
  942. end;
  943. inc(Level);
  944. skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts)))));
  945. end
  946. else
  947. if (s='IFNDEF') then
  948. begin
  949. RemoveSep(opts);
  950. if Level>=maxlevel then
  951. begin
  952. Message(option_too_many_ifdef);
  953. stopOptions;
  954. end;
  955. inc(Level);
  956. skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts)))));
  957. end
  958. else
  959. if (s='ELSE') then
  960. skip[level]:=skip[level-1] or (not skip[level])
  961. else
  962. if (s='ENDIF') then
  963. begin
  964. skip[level]:=false;
  965. if Level=0 then
  966. begin
  967. Message(option_too_many_endif);
  968. stopOptions;
  969. end;
  970. dec(level);
  971. end
  972. else
  973. if (not skip[level]) then
  974. begin
  975. if (s='DEFINE') then
  976. begin
  977. RemoveSep(opts);
  978. def_symbol(upper(GetName(opts)));
  979. end
  980. else
  981. if (s='UNDEF') then
  982. begin
  983. RemoveSep(opts);
  984. undef_symbol(upper(GetName(opts)));
  985. end
  986. else
  987. if (s='WRITE') then
  988. begin
  989. Delete(opts,1,1);
  990. WriteLn(opts);
  991. end
  992. else
  993. if (s='INCLUDE') then
  994. begin
  995. Delete(opts,1,1);
  996. Interpret_file(opts);
  997. end;
  998. end;
  999. end
  1000. else
  1001. begin
  1002. if (opts[1]='-') or (opts[1]='@') then
  1003. begin
  1004. if (not skip[level]) then
  1005. interpret_option(opts,false);
  1006. Option_read:=true;
  1007. end
  1008. else
  1009. Message1(option_illegal_para,opts);
  1010. end;
  1011. end;
  1012. end;
  1013. if Level>0 then
  1014. Message(option_too_less_endif);
  1015. if Not Option_read then
  1016. Message1(option_no_option_found,filename);
  1017. Close(f);
  1018. Dec(FileLevel);
  1019. end;
  1020. procedure Toption.Interpret_envvar(const envname : string);
  1021. var
  1022. argstart,
  1023. env,
  1024. pc : pchar;
  1025. arglen : longint;
  1026. quote : set of char;
  1027. hs : string;
  1028. begin
  1029. Message1(option_using_env,envname);
  1030. env:=GetEnvPChar(envname);
  1031. pc:=env;
  1032. if assigned(pc) then
  1033. begin
  1034. repeat
  1035. { skip leading spaces }
  1036. while pc^ in [' ',#9,#13] do
  1037. inc(pc);
  1038. case pc^ of
  1039. #0 :
  1040. break;
  1041. '"' :
  1042. begin
  1043. quote:=['"'];
  1044. inc(pc);
  1045. end;
  1046. '''' :
  1047. begin
  1048. quote:=[''''];
  1049. inc(pc);
  1050. end;
  1051. else
  1052. quote:=[' ',#9,#13];
  1053. end;
  1054. { scan until the end of the argument }
  1055. argstart:=pc;
  1056. while (pc^<>#0) and not(pc^ in quote) do
  1057. inc(pc);
  1058. { create argument }
  1059. arglen:=pc-argstart;
  1060. hs[0]:=chr(arglen);
  1061. move(argstart^,hs[1],arglen);
  1062. interpret_option(hs,true);
  1063. { skip quote }
  1064. if pc^ in quote then
  1065. inc(pc);
  1066. until false;
  1067. end
  1068. else
  1069. Message1(option_no_option_found,'(env) '+envname);
  1070. FreeEnvPChar(env);
  1071. end;
  1072. procedure toption.read_parameters;
  1073. var
  1074. opts : string;
  1075. paramindex : longint;
  1076. begin
  1077. paramindex:=0;
  1078. while paramindex<paramcount do
  1079. begin
  1080. inc(paramindex);
  1081. opts:=system.paramstr(paramindex);
  1082. case opts[1] of
  1083. '@' :
  1084. if not firstpass then
  1085. begin
  1086. Delete(opts,1,1);
  1087. Message1(option_reading_further_from,opts);
  1088. interpret_file(opts);
  1089. end;
  1090. '!' :
  1091. if not firstpass then
  1092. begin
  1093. Delete(opts,1,1);
  1094. Message1(option_reading_further_from,'(env) '+opts);
  1095. interpret_envvar(opts);
  1096. end;
  1097. else
  1098. interpret_option(opts,true);
  1099. end;
  1100. end;
  1101. end;
  1102. procedure toption.parsecmd(cmd:string);
  1103. var
  1104. i,ps : longint;
  1105. opts : string;
  1106. begin
  1107. while (cmd<>'') do
  1108. begin
  1109. while cmd[1]=' ' do
  1110. delete(cmd,1,1);
  1111. i:=pos(' ',cmd);
  1112. if i=0 then
  1113. i:=256;
  1114. opts:=Copy(cmd,1,i-1);
  1115. Delete(cmd,1,i);
  1116. case opts[1] of
  1117. '@' :
  1118. if not firstpass then
  1119. begin
  1120. Delete(opts,1,1);
  1121. Message1(option_reading_further_from,opts);
  1122. interpret_file(opts);
  1123. end;
  1124. '!' :
  1125. if not firstpass then
  1126. begin
  1127. Delete(opts,1,1);
  1128. Message1(option_reading_further_from,'(env) '+opts);
  1129. interpret_envvar(opts);
  1130. end;
  1131. '"' :
  1132. begin
  1133. Delete(opts,1,1);
  1134. ps:=pos('"',cmd);
  1135. if (i<>256) and (ps>0) then
  1136. begin
  1137. opts:=opts + ' '+ copy(cmd,1,ps-1);
  1138. cmd:=copy(cmd,ps+1,255);
  1139. end;
  1140. interpret_option(opts,true);
  1141. end;
  1142. else
  1143. interpret_option(opts,true);
  1144. end;
  1145. end;
  1146. end;
  1147. procedure toption.writequickinfo;
  1148. var
  1149. s : string;
  1150. i : longint;
  1151. procedure addinfo(const hs:string);
  1152. begin
  1153. if s<>'' then
  1154. s:=s+' '+hs
  1155. else
  1156. s:=hs;
  1157. end;
  1158. begin
  1159. s:='';
  1160. i:=0;
  1161. while (i<length(quickinfo)) do
  1162. begin
  1163. inc(i);
  1164. case quickinfo[i] of
  1165. 'S' :
  1166. begin
  1167. inc(i);
  1168. case quickinfo[i] of
  1169. 'O' :
  1170. addinfo(lower(source_info.shortname));
  1171. {$ifdef Delphi}
  1172. 'P' :
  1173. addinfo('i386');
  1174. {$else Delphi}
  1175. 'P' :
  1176. addinfo(source_cpu_string);
  1177. {$endif Delphi}
  1178. else
  1179. IllegalPara('-iS'+QuickInfo);
  1180. end;
  1181. end;
  1182. 'T' :
  1183. begin
  1184. inc(i);
  1185. case quickinfo[i] of
  1186. 'O' :
  1187. addinfo(lower(target_info.shortname));
  1188. 'P' :
  1189. AddInfo(target_cpu_string);
  1190. else
  1191. IllegalPara('-iT'+QuickInfo);
  1192. end;
  1193. end;
  1194. 'V' :
  1195. AddInfo(version_string);
  1196. 'D' :
  1197. AddInfo(date_string);
  1198. '_' :
  1199. ;
  1200. else
  1201. IllegalPara('-i'+QuickInfo);
  1202. end;
  1203. end;
  1204. if s<>'' then
  1205. begin
  1206. writeln(s);
  1207. stopoptions;
  1208. end;
  1209. end;
  1210. procedure TOption.TargetDefines(def:boolean);
  1211. var
  1212. s : string;
  1213. i : integer;
  1214. begin
  1215. if def then
  1216. def_symbol(upper(target_info.shortname))
  1217. else
  1218. undef_symbol(upper(target_info.shortname));
  1219. s:=target_info.extradefines;
  1220. while (s<>'') do
  1221. begin
  1222. i:=pos(';',s);
  1223. if i=0 then
  1224. i:=length(s)+1;
  1225. if def then
  1226. def_symbol(Copy(s,1,i-1))
  1227. else
  1228. undef_symbol(Copy(s,1,i-1));
  1229. delete(s,1,i);
  1230. end;
  1231. end;
  1232. constructor TOption.create;
  1233. begin
  1234. DoWriteLogo:=false;
  1235. NoPressEnter:=false;
  1236. FirstPass:=false;
  1237. FileLevel:=0;
  1238. Quickinfo:='';
  1239. ParaIncludePath:=TSearchPathList.Create;
  1240. ParaObjectPath:=TSearchPathList.Create;
  1241. ParaUnitPath:=TSearchPathList.Create;
  1242. ParaLibraryPath:=TSearchPathList.Create;
  1243. FillChar(ParaAlignment,sizeof(ParaAlignment),0);
  1244. end;
  1245. destructor TOption.destroy;
  1246. begin
  1247. ParaIncludePath.Free;
  1248. ParaObjectPath.Free;
  1249. ParaUnitPath.Free;
  1250. ParaLibraryPath.Free;
  1251. end;
  1252. {****************************************************************************
  1253. Callable Routines
  1254. ****************************************************************************}
  1255. procedure read_arguments(cmd:string);
  1256. var
  1257. configpath : pathstr;
  1258. begin
  1259. option:=coption.create;
  1260. disable_configfile:=false;
  1261. { default defines }
  1262. def_symbol(upper(target_info.shortname));
  1263. def_symbol('FPC');
  1264. def_symbol('VER'+version_nr);
  1265. def_symbol('VER'+version_nr+'_'+release_nr);
  1266. def_symbol('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
  1267. {$ifdef newcg}
  1268. def_symbol('WITHNEWCG');
  1269. {$endif}
  1270. { Temporary defines, until things settle down }
  1271. def_symbol('HASWIDECHAR');
  1272. def_symbol('HASWIDESTRING');
  1273. def_symbol('HASOUT');
  1274. def_symbol('HASINTF');
  1275. def_symbol('HASVARIANT');
  1276. def_symbol('INTERNSETLENGTH');
  1277. def_symbol('INTERNLENGTH');
  1278. def_symbol('INT64FUNCRESOK');
  1279. def_symbol('HAS_ADDR_STACK_ON_STACK');
  1280. def_symbol('NOBOUNDCHECK');
  1281. def_symbol('HASCOMPILERPROC');
  1282. def_symbol('VALUEGETMEM');
  1283. def_symbol('VALUEFREEMEM');
  1284. def_symbol('HASCURRENCY');
  1285. { some stuff for TP compatibility }
  1286. case target_info.cpu of
  1287. cpu_i386:
  1288. begin
  1289. def_symbol('CPU86');
  1290. def_symbol('CPU87');
  1291. def_symbol('CPUI386');
  1292. end;
  1293. cpu_m68k:
  1294. begin
  1295. def_symbol('CPU68');
  1296. def_symbol('CPU68K');
  1297. end;
  1298. cpu_alpha:
  1299. begin
  1300. def_symbol('CPUALPHA');
  1301. end;
  1302. cpu_powerpc:
  1303. begin
  1304. def_symbol('CPUPOWERPC');
  1305. end;
  1306. cpu_sparc:
  1307. begin
  1308. def_symbol('CPUSPARC');
  1309. end;
  1310. cpu_vm:
  1311. begin
  1312. def_symbol('CPUVIS');
  1313. end;
  1314. else
  1315. internalerror(1295969);
  1316. end;
  1317. { get default messagefile }
  1318. {$ifdef Delphi}
  1319. msgfilename:=dmisc.getenv('PPC_ERROR_FILE');
  1320. {$else Delphi}
  1321. msgfilename:=dos.getenv('PPC_ERROR_FILE');
  1322. {$endif Delphi}
  1323. { default configfile }
  1324. if (cmd<>'') and (cmd[1]='[') then
  1325. begin
  1326. ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
  1327. Delete(cmd,1,pos(']',cmd));
  1328. end
  1329. else
  1330. begin
  1331. ppcaltcfg:='ppc386.cfg';
  1332. ppccfg:='fpc.cfg';
  1333. end;
  1334. { Order to read configuration file :
  1335. try reading ppc386.cfg in :
  1336. 1 - current dir
  1337. 2 - configpath
  1338. 3 - compiler path
  1339. else try reading fpc.cfg in :
  1340. 1 - current dir
  1341. 2 - configpath
  1342. 3 - compiler path
  1343. }
  1344. {$ifdef Delphi}
  1345. configpath:=FixPath(dmisc.getenv('PPC_CONFIG_PATH'),false);
  1346. {$else Delphi}
  1347. configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false);
  1348. {$endif Delphi}
  1349. {$ifdef Unix}
  1350. if configpath='' then
  1351. configpath:='/etc/';
  1352. {$endif}
  1353. if ppccfg<>'' then
  1354. begin
  1355. read_configfile:=true;
  1356. if not FileExists(ppcaltcfg) then
  1357. begin
  1358. {$ifdef Unix}
  1359. if (dos.getenv('HOME')<>'') and FileExists(FixPath(dos.getenv('HOME'),false)+'.'+ppcaltcfg) then
  1360. ppccfg:=FixPath(dos.getenv('HOME'),false)+'.'+ppcaltcfg
  1361. else
  1362. {$endif}
  1363. if FileExists(configpath+ppcaltcfg) then
  1364. ppccfg:=configpath+ppcaltcfg
  1365. else
  1366. {$ifndef Unix}
  1367. if FileExists(exepath+ppcaltcfg) then
  1368. ppccfg:=exepath+ppcaltcfg
  1369. else
  1370. {$endif}
  1371. read_configfile:=false;
  1372. end
  1373. else
  1374. ppccfg := ppcaltcfg; { file is found, then set it to ppccfg }
  1375. if not read_configfile then
  1376. begin
  1377. read_configfile := true;
  1378. if not FileExists(ppccfg) then
  1379. begin
  1380. {$ifdef Unix}
  1381. if (dos.getenv('HOME')<>'') and FileExists(FixPath(dos.getenv('HOME'),false)+'.'+ppccfg) then
  1382. ppccfg:=FixPath(dos.getenv('HOME'),false)+'.'+ppccfg
  1383. else
  1384. {$endif}
  1385. if FileExists(configpath+ppccfg) then
  1386. ppccfg:=configpath+ppccfg
  1387. else
  1388. {$ifndef Unix}
  1389. if FileExists(exepath+ppccfg) then
  1390. ppccfg:=exepath+ppccfg
  1391. else
  1392. {$endif}
  1393. read_configfile:=false;
  1394. end;
  1395. end
  1396. end
  1397. else
  1398. read_configfile := false;
  1399. { Read commandline and configfile }
  1400. target_is_set:=false;
  1401. asm_is_set:=false;
  1402. param_file:='';
  1403. if read_configfile then
  1404. begin
  1405. { read the parameters quick, only -i -v -T }
  1406. option.firstpass:=true;
  1407. if cmd<>'' then
  1408. option.parsecmd(cmd)
  1409. else
  1410. begin
  1411. option.read_parameters;
  1412. { Write only quickinfo }
  1413. if option.quickinfo<>'' then
  1414. option.writequickinfo;
  1415. end;
  1416. { Read the configfile }
  1417. option.firstpass:=false;
  1418. if read_configfile then
  1419. option.interpret_file(ppccfg);
  1420. end;
  1421. if cmd<>'' then
  1422. option.parsecmd(cmd)
  1423. else
  1424. begin
  1425. option.read_parameters;
  1426. { Write only quickinfo }
  1427. if option.quickinfo<>'' then
  1428. option.writequickinfo;
  1429. end;
  1430. { Write help pages }
  1431. if (cmd='') and (paramcount=0) then
  1432. Option.WriteHelpPages;
  1433. { Stop if errors in options }
  1434. if ErrorCount>0 then
  1435. StopOptions;
  1436. { Non-core target defines }
  1437. Option.TargetDefines(true);
  1438. { endian define }
  1439. case target_info.endian of
  1440. endian_little :
  1441. def_symbol('ENDIAN_LITTLE');
  1442. endian_big :
  1443. def_symbol('ENDIAN_BIG');
  1444. end;
  1445. {$ifdef m68k}
  1446. { Disable fpu emulation for linux and netbsd on m68k machines }
  1447. { FIXME: this overrides possible explicit command line emulation setting,
  1448. but this isn't supported yet anyhow PM }
  1449. if (target_info.target in [target_m68k_netbsd,target_m68k_linux]) then
  1450. exclude(initmoduleswitches,cs_fp_emulation)
  1451. else
  1452. def_symbol('M68K_FPU_EMULATED');
  1453. {$endif m68k}
  1454. { write logo if set }
  1455. if option.DoWriteLogo then
  1456. option.WriteLogo;
  1457. { Check file to compile }
  1458. if param_file='' then
  1459. begin
  1460. Message(option_no_source_found);
  1461. StopOptions;
  1462. end;
  1463. {$ifndef Unix}
  1464. param_file:=FixFileName(param_file);
  1465. {$endif}
  1466. fsplit(param_file,inputdir,inputfile,inputextension);
  1467. if inputextension='' then
  1468. begin
  1469. if FileExists(inputdir+inputfile+target_info.sourceext) then
  1470. inputextension:=target_info.sourceext
  1471. else
  1472. if FileExists(inputdir+inputfile+target_info.pasext) then
  1473. inputextension:=target_info.pasext;
  1474. end;
  1475. { Add paths specified with parameters to the searchpaths }
  1476. UnitSearchPath.AddList(option.ParaUnitPath,true);
  1477. ObjectSearchPath.AddList(option.ParaObjectPath,true);
  1478. IncludeSearchPath.AddList(option.ParaIncludePath,true);
  1479. LibrarySearchPath.AddList(option.ParaLibraryPath,true);
  1480. { add unit environment and exepath to the unit search path }
  1481. if inputdir<>'' then
  1482. Unitsearchpath.AddPath(inputdir,true);
  1483. if not disable_configfile then
  1484. {$ifdef Delphi}
  1485. UnitSearchPath.AddPath(dmisc.getenv(target_info.unit_env),false);
  1486. {$else}
  1487. UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false);
  1488. {$endif Delphi}
  1489. {$ifdef Unix}
  1490. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1491. if fpcdir='' then
  1492. begin
  1493. if PathExists('/usr/local/lib/fpc/'+version_string) then
  1494. fpcdir:='/usr/local/lib/fpc/'+version_string+'/'
  1495. else
  1496. fpcdir:='/usr/lib/fpc/'+version_string+'/';
  1497. end;
  1498. {$else}
  1499. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1500. if fpcdir='' then
  1501. begin
  1502. fpcdir:=ExePath+'../';
  1503. if not(PathExists(fpcdir+'/units')) and
  1504. not(PathExists(fpcdir+'/rtl')) then
  1505. fpcdir:=fpcdir+'../';
  1506. end;
  1507. {$endif}
  1508. { first try development RTL, else use the default installation path }
  1509. if not disable_configfile then
  1510. begin
  1511. if PathExists(FpcDir+'rtl/'+lower(target_info.shortname)) then
  1512. UnitSearchPath.AddPath(FpcDir+'rtl/'+lower(target_info.shortname),false)
  1513. else
  1514. begin
  1515. UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname),false);
  1516. UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname)+'/rtl',false);
  1517. end;
  1518. end;
  1519. { Add exepath if the exe is not in the current dir, because that is always searched already }
  1520. if ExePath<>GetCurrentDir then
  1521. UnitSearchPath.AddPath(ExePath,false);
  1522. { Add unit dir to the object and library path }
  1523. objectsearchpath.AddList(unitsearchpath,false);
  1524. librarysearchpath.AddList(unitsearchpath,false);
  1525. { switch assembler if it's binary and we got -a on the cmdline }
  1526. if (cs_asm_leave in initglobalswitches) and
  1527. (target_asm.outputbinary) then
  1528. begin
  1529. Message(option_switch_bin_to_src_assembler);
  1530. set_target_asm(target_info.assemextern);
  1531. end;
  1532. if (target_asm.supported_target <> target_any) and
  1533. (target_asm.supported_target <> target_info.target) then
  1534. begin
  1535. Message2(option_incompatible_asm,target_asm.idtxt,target_info.name);
  1536. set_target_asm(target_info.assemextern);
  1537. Message1(option_asm_forced,target_asm.idtxt);
  1538. end;
  1539. { turn off stripping if compiling with debuginfo or profile }
  1540. if (cs_debuginfo in initmoduleswitches) or
  1541. (cs_profile in initmoduleswitches) then
  1542. exclude(initglobalswitches,cs_link_strip);
  1543. if not LinkTypeSetExplicitly then
  1544. set_default_link_type;
  1545. { Default alignment settings,
  1546. 1. load the defaults for the target
  1547. 2. override with generic optimizer setting (little size)
  1548. 3. override with the user specified -Oa }
  1549. UpdateAlignment(initalignment,target_info.alignment);
  1550. if (cs_littlesize in aktglobalswitches) then
  1551. begin
  1552. initalignment.procalign:=1;
  1553. initalignment.jumpalign:=1;
  1554. initalignment.loopalign:=1;
  1555. end;
  1556. UpdateAlignment(initalignment,option.paraalignment);
  1557. option.free;
  1558. Option:=nil;
  1559. end;
  1560. initialization
  1561. coption:=toption;
  1562. finalization
  1563. if assigned(option) then
  1564. option.free;
  1565. end.
  1566. {
  1567. $Log$
  1568. Revision 1.74 2002-07-01 16:23:53 peter
  1569. * cg64 patch
  1570. * basics for currency
  1571. * asnode updates for class and interface (not finished)
  1572. Revision 1.73 2002/05/18 13:34:11 peter
  1573. * readded missing revisions
  1574. Revision 1.72 2002/05/16 19:46:41 carl
  1575. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1576. + try to fix temp allocation (still in ifdef)
  1577. + generic constructor calls
  1578. + start of tassembler / tmodulebase class cleanup
  1579. Revision 1.70 2002/05/12 16:53:08 peter
  1580. * moved entry and exitcode to ncgutil and cgobj
  1581. * foreach gets extra argument for passing local data to the
  1582. iterator function
  1583. * -CR checks also class typecasts at runtime by changing them
  1584. into as
  1585. * fixed compiler to cycle with the -CR option
  1586. * fixed stabs with elf writer, finally the global variables can
  1587. be watched
  1588. * removed a lot of routines from cga unit and replaced them by
  1589. calls to cgobj
  1590. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1591. u32bit then the other is typecasted also to u32bit without giving
  1592. a rangecheck warning/error.
  1593. * fixed pascal calling method with reversing also the high tree in
  1594. the parast, detected by tcalcst3 test
  1595. Revision 1.69 2002/04/21 19:02:04 peter
  1596. * removed newn and disposen nodes, the code is now directly
  1597. inlined from pexpr
  1598. * -an option that will write the secondpass nodes to the .s file, this
  1599. requires EXTDEBUG define to actually write the info
  1600. * fixed various internal errors and crashes due recent code changes
  1601. Revision 1.68 2002/04/20 21:32:24 carl
  1602. + generic FPC_CHECKPOINTER
  1603. + first parameter offset in stack now portable
  1604. * rename some constants
  1605. + move some cpu stuff to other units
  1606. - remove unused constents
  1607. * fix stacksize for some targets
  1608. * fix generic size problems which depend now on EXTEND_SIZE constant
  1609. Revision 1.67 2002/04/07 10:22:35 carl
  1610. + CPU defines now depends on current target
  1611. Revision 1.66 2002/04/04 19:05:58 peter
  1612. * removed unused units
  1613. * use tlocation.size in cg.a_*loc*() routines
  1614. Revision 1.65 2002/04/04 18:39:45 carl
  1615. + added wdosx support (patch from Pavel)
  1616. }