options.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121
  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,cpuinfo;
  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. widestr,
  58. {$ifdef Delphi}
  59. dmisc,
  60. {$else Delphi}
  61. dos,
  62. {$endif Delphi}
  63. version,
  64. cutils,cmsgs
  65. {$ifdef BrowserLog}
  66. ,browlog
  67. {$endif BrowserLog}
  68. ;
  69. const
  70. page_size = 24;
  71. var
  72. option : toption;
  73. read_configfile, { read config file, set when a cfgfile is found }
  74. disable_configfile,
  75. target_is_set : boolean; { do not allow contradictory target settings }
  76. asm_is_set : boolean; { -T also change initoutputformat if not set idrectly }
  77. fpcdir,
  78. ppccfg,
  79. ppcaltcfg,
  80. param_file : string; { file to compile specified on the commandline }
  81. {****************************************************************************
  82. Defines
  83. ****************************************************************************}
  84. procedure def_symbol(const s : string);
  85. begin
  86. if s='' then
  87. exit;
  88. initdefines.insert(upper(s));
  89. Message1(option_defining_symbol,s);
  90. end;
  91. procedure undef_symbol(const s : string);
  92. begin
  93. if s='' then
  94. exit;
  95. InitDefines.Remove(s);
  96. Message1(option_undefining_symbol,s);
  97. end;
  98. function check_symbol(const s:string):boolean;
  99. begin
  100. check_symbol:=(initdefines.find(s)<>nil);
  101. end;
  102. procedure set_default_link_type;
  103. begin
  104. { win32 and wdosx need smartlinking by default to prevent including too much
  105. dll dependencies }
  106. if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  107. begin
  108. def_symbol('FPC_LINK_SMART');
  109. undef_symbol('FPC_LINK_STATIC');
  110. undef_symbol('FPC_LINK_DYNAMIC');
  111. initglobalswitches:=initglobalswitches+[cs_link_smart];
  112. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_static];
  113. end
  114. else
  115. begin
  116. undef_symbol('FPC_LINK_SMART');
  117. def_symbol('FPC_LINK_STATIC');
  118. undef_symbol('FPC_LINK_DYNAMIC');
  119. initglobalswitches:=initglobalswitches+[cs_link_static];
  120. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_smart];
  121. end;
  122. end;
  123. {****************************************************************************
  124. Toption
  125. ****************************************************************************}
  126. procedure StopOptions(err:longint);
  127. begin
  128. if assigned(Option) then
  129. begin
  130. Option.free;
  131. Option:=nil;
  132. end;
  133. DoneVerbose;
  134. Stop(err);
  135. end;
  136. procedure Toption.WriteLogo;
  137. var
  138. p : pchar;
  139. begin
  140. p:=MessagePchar(option_logo);
  141. while assigned(p) do
  142. Comment(V_Normal,GetMsgLine(p));
  143. end;
  144. procedure Toption.WriteInfo;
  145. var
  146. p : pchar;
  147. hs,hs1,s : string;
  148. target : tsystem;
  149. begin
  150. p:=MessagePchar(option_info);
  151. while assigned(p) do
  152. begin
  153. s:=GetMsgLine(p);
  154. { list OS Targets }
  155. if pos('$OSTARGETS',s)>0 then
  156. begin
  157. for target:=low(tsystem) to high(tsystem) do
  158. if assigned(targetinfos[target]) then
  159. begin
  160. hs:=s;
  161. hs1:=targetinfos[target]^.name;
  162. if tf_under_development in targetinfos[target]^.flags then
  163. hs1:=hs1+' (under development)';
  164. Replace(hs,'$OSTARGETS',hs1);
  165. Comment(V_Normal,hs);
  166. end;
  167. end
  168. else
  169. Comment(V_Normal,s);
  170. end;
  171. StopOptions(0);
  172. end;
  173. procedure Toption.WriteHelpPages;
  174. function PadEnd(s:string;i:longint):string;
  175. begin
  176. while (length(s)<i) do
  177. s:=s+' ';
  178. PadEnd:=s;
  179. end;
  180. var
  181. lastident,
  182. j,outline,
  183. ident,
  184. lines : longint;
  185. show : boolean;
  186. opt : string[32];
  187. input,
  188. s : string;
  189. p : pchar;
  190. begin
  191. WriteLogo;
  192. Lines:=4;
  193. Message1(option_usage,system.paramstr(0));
  194. lastident:=0;
  195. p:=MessagePChar(option_help_pages);
  196. while assigned(p) do
  197. begin
  198. { get a line and reset }
  199. s:=GetMsgLine(p);
  200. ident:=0;
  201. show:=false;
  202. { parse options }
  203. case s[1] of
  204. {$ifdef UNITALIASES}
  205. 'a',
  206. {$endif}
  207. {$ifdef EXTDEBUG}
  208. 'e',
  209. {$endif EXTDEBUG}
  210. {$ifdef i386}
  211. '3',
  212. {$endif}
  213. {$ifdef powerpc}
  214. 'P',
  215. {$endif}
  216. {$ifdef vis}
  217. 'V',
  218. {$endif}
  219. {$ifdef sparc}
  220. 'S',
  221. {$endif}
  222. {$ifdef m68k}
  223. '6',
  224. {$endif}
  225. '*' : show:=true;
  226. end;
  227. if show then
  228. begin
  229. case s[2] of
  230. {$ifdef GDB}
  231. 'g',
  232. {$endif}
  233. {$ifdef Unix}
  234. 'L',
  235. {$endif}
  236. {$ifdef os2}
  237. 'O',
  238. {$endif}
  239. '*' : show:=true;
  240. else
  241. show:=false;
  242. end;
  243. end;
  244. { now we may show the message or not }
  245. if show then
  246. begin
  247. case s[3] of
  248. '0' : begin
  249. ident:=0;
  250. outline:=0;
  251. end;
  252. '1' : begin
  253. ident:=2;
  254. outline:=7;
  255. end;
  256. '2' : begin
  257. ident:=6;
  258. outline:=11;
  259. end;
  260. '3' : begin
  261. ident:=9;
  262. outline:=6;
  263. end;
  264. end;
  265. j:=pos('_',s);
  266. opt:=Copy(s,4,j-4);
  267. if opt='*' then
  268. opt:=''
  269. else
  270. if opt=' ' then
  271. opt:=PadEnd(opt,outline)
  272. else
  273. opt:=PadEnd('-'+opt,outline);
  274. if (ident=0) and (lastident<>0) then
  275. begin
  276. Comment(V_Normal,'');
  277. inc(Lines);
  278. end;
  279. { page full ? }
  280. if (lines >= page_size - 1) then
  281. begin
  282. if not NoPressEnter then
  283. begin
  284. Message(option_help_press_enter);
  285. readln(input);
  286. if upper(input)='Q' then
  287. StopOptions(0);
  288. end;
  289. lines:=0;
  290. end;
  291. Comment(V_Normal,PadEnd('',ident)+opt+Copy(s,j+1,255));
  292. LastIdent:=Ident;
  293. inc(Lines);
  294. end;
  295. end;
  296. StopOptions(0);
  297. end;
  298. procedure Toption.IllegalPara(const opt:string);
  299. begin
  300. Message1(option_illegal_para,opt);
  301. Message(option_help_pages_para);
  302. StopOptions(1);
  303. end;
  304. function Toption.Unsetbool(var Opts:string; Pos: Longint):boolean;
  305. { checks if the character after pos in Opts is a + or a - and returns resp.
  306. false or true. If it is another character (or none), it also returns false }
  307. begin
  308. UnsetBool := false;
  309. if Length(Opts)>Pos then
  310. begin
  311. inc(Pos);
  312. UnsetBool := Opts[Pos] = '-';
  313. if Opts[Pos] in ['-','+']then
  314. delete(Opts,Pos,1);
  315. end;
  316. end;
  317. procedure TOption.interpret_proc_specific_options(const opt:string);
  318. begin
  319. end;
  320. procedure TOption.interpret_option(const opt:string;ispara:boolean);
  321. var
  322. code : integer;
  323. c : char;
  324. more : string;
  325. major,minor : longint;
  326. error : integer;
  327. j,l : longint;
  328. d : DirStr;
  329. e : ExtStr;
  330. s : string;
  331. forceasm : tasm;
  332. begin
  333. if opt='' then
  334. exit;
  335. { only parse define,undef,target,verbosity and link options the firsttime }
  336. if firstpass and
  337. not((opt[1]='-') and (opt[2] in ['i','d','v','T','u','n','X'])) then
  338. exit;
  339. Message1(option_handling_option,opt);
  340. case opt[1] of
  341. '-' :
  342. begin
  343. more:=Copy(opt,3,255);
  344. if firstpass then
  345. Message1(option_interpreting_firstpass_option,opt)
  346. else
  347. Message1(option_interpreting_option,opt);
  348. case opt[2] of
  349. '?' :
  350. WriteHelpPages;
  351. 'a' :
  352. begin
  353. include(initglobalswitches,cs_asm_leave);
  354. j:=1;
  355. while j<=length(more) do
  356. begin
  357. case more[j] of
  358. 'l' :
  359. include(initglobalswitches,cs_asm_source);
  360. 'r' :
  361. include(initglobalswitches,cs_asm_regalloc);
  362. 't' :
  363. include(initglobalswitches,cs_asm_tempalloc);
  364. 'n' :
  365. include(initglobalswitches,cs_asm_nodes);
  366. 'p' :
  367. begin
  368. exclude(initglobalswitches,cs_asm_leave);
  369. if UnsetBool(More, 0) then
  370. exclude(initglobalswitches,cs_asm_pipe)
  371. else
  372. include(initglobalswitches,cs_asm_pipe);
  373. end;
  374. '-' :
  375. initglobalswitches:=initglobalswitches -
  376. [cs_asm_leave, cs_asm_source,cs_asm_regalloc, cs_asm_tempalloc,
  377. cs_asm_nodes, cs_asm_pipe];
  378. else
  379. IllegalPara(opt);
  380. end;
  381. inc(j);
  382. end;
  383. end;
  384. 'A' :
  385. begin
  386. if set_target_asm_by_string(More) then
  387. asm_is_set:=true
  388. else
  389. IllegalPara(opt);
  390. end;
  391. 'b' :
  392. begin
  393. {$ifdef supportbrowser}
  394. if UnsetBool(More,0) then
  395. begin
  396. exclude(initmoduleswitches,cs_browser);
  397. exclude(initmoduleswitches,cs_local_browser);
  398. {$ifdef BrowserLog}
  399. exclude(initglobalswitches,cs_browser_log);
  400. {$endif}
  401. end
  402. else
  403. begin
  404. include(initmoduleswitches,cs_browser);
  405. {$ifdef BrowserLog}
  406. include(initglobalswitches,cs_browser_log);
  407. {$endif}
  408. end;
  409. if More<>'' then
  410. if (More='l') or (More='l+') then
  411. include(initmoduleswitches,cs_local_browser)
  412. else
  413. if More='l-' then
  414. exclude(initmoduleswitches,cs_local_browser)
  415. else
  416. {$ifdef BrowserLog}
  417. browserlog.elements_to_list.insert(more);
  418. {$else}
  419. IllegalPara(opt);
  420. {$endif}
  421. {$endif supportbrowser}
  422. end;
  423. 'B' :
  424. do_build:=not UnSetBool(more,0);
  425. 'C' :
  426. begin
  427. j:=1;
  428. while j<=length(more) do
  429. begin
  430. case more[j] of
  431. 'a' :
  432. Message2(option_obsolete_switch_use_new,'-Ca','-Or');
  433. 'c' :
  434. begin
  435. if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),true) then
  436. IllegalPara(opt);
  437. break;
  438. end;
  439. {$ifdef cpufpemu}
  440. 'e' :
  441. begin
  442. If UnsetBool(More, j) then
  443. exclude(initmoduleswitches,cs_fp_emulation)
  444. Else
  445. include(initmoduleswitches,cs_fp_emulation);
  446. end;
  447. {$endif cpufpemu}
  448. 'f' :
  449. begin
  450. s:=upper(copy(more,j+1,length(more)-j));
  451. if not(SetFpuType(s,true)) then
  452. IllegalPara(opt);
  453. break;
  454. end;
  455. 'g' :
  456. include(initmoduleswitches,cs_create_pic);
  457. 'h' :
  458. begin
  459. val(copy(more,j+1,length(more)-j),heapsize,code);
  460. if (code<>0) or
  461. {$WARNING Is the upper limit for heapsize needed / useful?}
  462. { (heapsize>=67107840) or }
  463. (heapsize<1024) then
  464. IllegalPara(opt);
  465. break;
  466. end;
  467. 'i' :
  468. If UnsetBool(More, j) then
  469. exclude(initlocalswitches,cs_check_io)
  470. else
  471. include(initlocalswitches,cs_check_io);
  472. 'n' :
  473. If UnsetBool(More, j) then
  474. exclude(initglobalswitches,cs_link_extern)
  475. Else
  476. include(initglobalswitches,cs_link_extern);
  477. 'o' :
  478. If UnsetBool(More, j) then
  479. exclude(initlocalswitches,cs_check_overflow)
  480. Else
  481. include(initlocalswitches,cs_check_overflow);
  482. 'p' :
  483. begin
  484. s:=upper(copy(more,j+1,length(more)-j));
  485. if not(SetProcessor(s,true)) then
  486. IllegalPara(opt);
  487. break;
  488. end;
  489. 'r' :
  490. If UnsetBool(More, j) then
  491. exclude(initlocalswitches,cs_check_range)
  492. Else
  493. include(initlocalswitches,cs_check_range);
  494. 'R' :
  495. If UnsetBool(More, j) then
  496. begin
  497. exclude(initlocalswitches,cs_check_range);
  498. exclude(initlocalswitches,cs_check_object);
  499. end
  500. Else
  501. begin
  502. include(initlocalswitches,cs_check_range);
  503. include(initlocalswitches,cs_check_object);
  504. end;
  505. 's' :
  506. begin
  507. val(copy(more,j+1,length(more)-j),stacksize,code);
  508. if (code<>0) or (stacksize>=67107840) or (stacksize<1024) then
  509. IllegalPara(opt);
  510. break;
  511. end;
  512. 't' :
  513. If UnsetBool(More, j) then
  514. exclude(initlocalswitches,cs_check_stack)
  515. Else
  516. include(initlocalswitches,cs_check_stack);
  517. 'D' :
  518. If UnsetBool(More, j) then
  519. exclude(initmoduleswitches,cs_create_dynamic)
  520. Else
  521. include(initmoduleswitches,cs_create_dynamic);
  522. 'X' :
  523. If UnsetBool(More, j) then
  524. exclude(initmoduleswitches,cs_create_smart)
  525. Else
  526. include(initmoduleswitches,cs_create_smart);
  527. else
  528. IllegalPara(opt);
  529. end;
  530. inc(j);
  531. end;
  532. end;
  533. 'd' :
  534. def_symbol(more);
  535. 'D' :
  536. begin
  537. include(initglobalswitches,cs_link_deffile);
  538. j:=1;
  539. while j<=length(more) do
  540. begin
  541. case more[j] of
  542. 'd' :
  543. begin
  544. description:=Copy(more,j+1,255);
  545. break;
  546. end;
  547. 'v' :
  548. begin
  549. dllversion:=Copy(more,j+1,255);
  550. l:=pos('.',dllversion);
  551. dllminor:=0;
  552. error:=0;
  553. if l>0 then
  554. begin
  555. valint(copy(dllversion,l+1,255),minor,error);
  556. if (error=0) and
  557. (minor>=0) and (minor<=$ffff) then
  558. dllminor:=minor
  559. else
  560. if error=0 then
  561. error:=1;
  562. end;
  563. if l=0 then
  564. l:=256;
  565. dllmajor:=1;
  566. if error=0 then
  567. valint(copy(dllversion,1,l-1),major,error);
  568. if (error=0) and (major>=0) and (major<=$ffff) then
  569. dllmajor:=major
  570. else
  571. if error=0 then
  572. error:=1;
  573. if error<>0 then
  574. Message1(scan_w_wrong_version_ignored,dllversion);
  575. break;
  576. end;
  577. 'w' :
  578. usewindowapi:=true;
  579. '-' :
  580. begin
  581. exclude(initglobalswitches,cs_link_deffile);
  582. usewindowapi:=false;
  583. end;
  584. else
  585. IllegalPara(opt);
  586. end;
  587. inc(j);
  588. end;
  589. end;
  590. 'e' :
  591. exepath:=FixPath(More,true);
  592. 'E' :
  593. begin
  594. if UnsetBool(More, 0) then
  595. exclude(initglobalswitches,cs_link_extern)
  596. else
  597. include(initglobalswitches,cs_link_extern);
  598. end;
  599. 'F' :
  600. begin
  601. c:=more[1];
  602. Delete(more,1,1);
  603. DefaultReplacements(More);
  604. case c of
  605. 'c' :
  606. begin
  607. if not(cpavailable(more)) then
  608. Message1(option_code_page_not_available,more)
  609. else
  610. initsourcecodepage:=more;
  611. end;
  612. 'D' :
  613. utilsdirectory:=FixPath(More,true);
  614. 'e' :
  615. SetRedirectFile(More);
  616. 'E' :
  617. OutputExeDir:=FixPath(More,true);
  618. 'i' :
  619. begin
  620. if ispara then
  621. ParaIncludePath.AddPath(More,false)
  622. else
  623. includesearchpath.AddPath(More,true);
  624. end;
  625. 'g' :
  626. Message2(option_obsolete_switch_use_new,'-Fg','-Fl');
  627. 'l' :
  628. begin
  629. if ispara then
  630. ParaLibraryPath.AddPath(More,false)
  631. else
  632. LibrarySearchPath.AddPath(More,true);
  633. end;
  634. 'L' :
  635. begin
  636. if More<>'' then
  637. ParaDynamicLinker:=More
  638. else
  639. IllegalPara(opt);
  640. end;
  641. 'o' :
  642. begin
  643. if ispara then
  644. ParaObjectPath.AddPath(More,false)
  645. else
  646. ObjectSearchPath.AddPath(More,true);
  647. end;
  648. 'r' :
  649. Msgfilename:=More;
  650. 'u' :
  651. begin
  652. if ispara then
  653. ParaUnitPath.AddPath(More,false)
  654. else
  655. unitsearchpath.AddPath(More,true);
  656. end;
  657. 'U' :
  658. OutputUnitDir:=FixPath(More,true);
  659. else
  660. IllegalPara(opt);
  661. end;
  662. end;
  663. 'g' : begin
  664. if UnsetBool(More, 0) then
  665. begin
  666. exclude(initmoduleswitches,cs_debuginfo);
  667. exclude(initglobalswitches,cs_gdb_dbx);
  668. exclude(initglobalswitches,cs_gdb_gsym);
  669. exclude(initglobalswitches,cs_gdb_heaptrc);
  670. exclude(initglobalswitches,cs_gdb_lineinfo);
  671. exclude(initglobalswitches,cs_checkpointer);
  672. end
  673. {$ifdef GDB}
  674. else
  675. begin
  676. include(initmoduleswitches,cs_debuginfo);
  677. end;
  678. if not RelocSectionSetExplicitly then
  679. RelocSection:=false;
  680. j:=1;
  681. while j<=length(more) do
  682. begin
  683. case more[j] of
  684. 'd' :
  685. begin
  686. if UnsetBool(More, j) then
  687. exclude(initglobalswitches,cs_gdb_dbx)
  688. else
  689. include(initglobalswitches,cs_gdb_dbx);
  690. end;
  691. 'g' :
  692. begin
  693. if UnsetBool(More, j) then
  694. exclude(initglobalswitches,cs_gdb_gsym)
  695. else
  696. include(initglobalswitches,cs_gdb_gsym);
  697. end;
  698. 'h' :
  699. begin
  700. if UnsetBool(More, j) then
  701. exclude(initglobalswitches,cs_gdb_heaptrc)
  702. else
  703. include(initglobalswitches,cs_gdb_heaptrc);
  704. end;
  705. 'l' :
  706. begin
  707. if UnsetBool(More, j) then
  708. exclude(initglobalswitches,cs_gdb_lineinfo)
  709. else
  710. include(initglobalswitches,cs_gdb_lineinfo);
  711. end;
  712. 'c' :
  713. begin
  714. if UnsetBool(More, j) then
  715. exclude(initglobalswitches,cs_checkpointer)
  716. else
  717. include(initglobalswitches,cs_checkpointer);
  718. end;
  719. 'v' :
  720. begin
  721. if UnsetBool(More, j) then
  722. exclude(initglobalswitches,cs_gdb_valgrind)
  723. else
  724. include(initglobalswitches,cs_gdb_valgrind);
  725. end;
  726. 'w' :
  727. begin
  728. if UnsetBool(More, j) then
  729. exclude(initglobalswitches,cs_gdb_dwarf)
  730. else
  731. include(initglobalswitches,cs_gdb_dwarf);
  732. end;
  733. else
  734. IllegalPara(opt);
  735. end;
  736. inc(j);
  737. end;
  738. {$else GDB}
  739. Message(option_no_debug_support);
  740. Message(option_no_debug_support_recompile_fpc);
  741. {$endif GDB}
  742. end;
  743. 'h' :
  744. begin
  745. NoPressEnter:=true;
  746. WriteHelpPages;
  747. end;
  748. 'i' :
  749. begin
  750. if More='' then
  751. WriteInfo
  752. else
  753. QuickInfo:=QuickInfo+More;
  754. end;
  755. 'I' :
  756. begin
  757. if ispara then
  758. ParaIncludePath.AddPath(More,false)
  759. else
  760. includesearchpath.AddPath(More,false);
  761. end;
  762. 'k' :
  763. begin
  764. if more<>'' then
  765. ParaLinkOptions:=ParaLinkOptions+' '+More
  766. else
  767. IllegalPara(opt);
  768. end;
  769. 'l' :
  770. DoWriteLogo:=not UnSetBool(more,0);
  771. 'm' :
  772. parapreprocess:=not UnSetBool(more,0);
  773. 'n' :
  774. begin
  775. if More='' then
  776. disable_configfile:=true
  777. else
  778. IllegalPara(opt);
  779. end;
  780. 'o' :
  781. begin
  782. if More<>'' then
  783. Fsplit(More,d,OutputFile,e)
  784. else
  785. IllegalPara(opt);
  786. end;
  787. 'p' :
  788. begin
  789. if UnsetBool(More, 0) then
  790. begin
  791. initmoduleswitches:=initmoduleswitches-[cs_profile];
  792. undef_symbol('FPC_PROFILE');
  793. end
  794. else
  795. if Length(More)=0 then
  796. IllegalPara(opt)
  797. else
  798. case more[1] of
  799. 'g' : if UnsetBool(more, 1) then
  800. begin
  801. exclude(initmoduleswitches,cs_profile);
  802. undef_symbol('FPC_PROFILE');
  803. end
  804. else
  805. begin
  806. include(initmoduleswitches,cs_profile);
  807. def_symbol('FPC_PROFILE');
  808. end;
  809. else
  810. IllegalPara(opt);
  811. end;
  812. end;
  813. {$ifdef Unix}
  814. 'P' : ; { Ignore used by fpc.pp }
  815. {$endif Unix}
  816. 's' :
  817. begin
  818. if UnsetBool(More, 0) then
  819. begin
  820. initglobalswitches:=initglobalswitches-[cs_asm_extern,cs_link_extern];
  821. if more<>'' then
  822. IllegalPara(opt);
  823. end
  824. else
  825. begin
  826. initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern];
  827. if more='h' then
  828. initglobalswitches:=initglobalswitches-[cs_link_on_target]
  829. else if more='t' then
  830. initglobalswitches:=initglobalswitches+[cs_link_on_target]
  831. else if more='r' then
  832. initglobalswitches:=initglobalswitches+[cs_asm_leave,cs_no_regalloc]
  833. else if more<>'' then
  834. IllegalPara(opt);
  835. end;
  836. end;
  837. 'M' :
  838. begin
  839. more:=Upper(more);
  840. if not SetCompileMode(more, true) then
  841. IllegalPara(opt);
  842. end;
  843. 'S' :
  844. begin
  845. if more[1]='I' then
  846. begin
  847. if upper(more)='ICOM' then
  848. initinterfacetype:=it_interfacecom
  849. else if upper(more)='ICORBA' then
  850. initinterfacetype:=it_interfacecorba
  851. else
  852. IllegalPara(opt);
  853. end
  854. else
  855. begin
  856. j:=1;
  857. while j<=length(more) do
  858. begin
  859. case more[j] of
  860. '2' : //an alternative to -Mobjfpc
  861. SetCompileMode('OBJFPC',true);
  862. 'a' :
  863. include(initlocalswitches,cs_do_assertion);
  864. 'c' :
  865. include(initmoduleswitches,cs_support_c_operators);
  866. 'd' : //an alternative to -Mdelphi
  867. SetCompileMode('DELPHI',true);
  868. 'e' :
  869. begin
  870. SetErrorFlags(copy(more,j+1,length(more)));
  871. break;
  872. end;
  873. 'g' :
  874. include(initmoduleswitches,cs_support_goto);
  875. 'h' :
  876. include(initlocalswitches,cs_ansistrings);
  877. 'i' :
  878. include(initmoduleswitches,cs_support_inline);
  879. 'm' :
  880. include(initmoduleswitches,cs_support_macro);
  881. 'o' : //an alternative to -Mtp
  882. SetCompileMode('TP',true);
  883. 'p' : //an alternative to -Mgpc
  884. SetCompileMode('GPC',true);
  885. 's' :
  886. include(initglobalswitches,cs_constructor_name);
  887. 't' :
  888. include(initmoduleswitches,cs_static_keyword);
  889. '-' :
  890. begin
  891. exclude(initglobalswitches,cs_constructor_name);
  892. initlocalswitches:=InitLocalswitches - [cs_do_assertion, cs_ansistrings];
  893. initmoduleswitches:=initmoduleswitches - [cs_support_c_operators, cs_support_goto,
  894. cs_support_inline, cs_support_macro,
  895. cs_static_keyword];
  896. end;
  897. else
  898. IllegalPara(opt);
  899. end;
  900. inc(j);
  901. end;
  902. end;
  903. end;
  904. 'T' :
  905. begin
  906. more:=Upper(More);
  907. if not target_is_set then
  908. begin
  909. { remove old target define }
  910. TargetDefines(false);
  911. { Save assembler if set }
  912. if asm_is_set then
  913. forceasm:=target_asm.id;
  914. { load new target }
  915. if not(set_target_by_string(More)) then
  916. IllegalPara(opt);
  917. { also initialize assembler if not explicitly set }
  918. if asm_is_set then
  919. set_target_asm(forceasm);
  920. { set new define }
  921. TargetDefines(true);
  922. target_is_set:=true;
  923. end
  924. else
  925. if More<>upper(target_info.shortname) then
  926. Message1(option_target_is_already_set,target_info.shortname);
  927. end;
  928. 'u' :
  929. undef_symbol(upper(More));
  930. 'U' :
  931. begin
  932. j:=1;
  933. while j<=length(more) do
  934. begin
  935. case more[j] of
  936. {$ifdef UNITALIASES}
  937. 'a' :
  938. begin
  939. AddUnitAlias(Copy(More,j+1,255));
  940. break;
  941. end;
  942. {$endif UNITALIASES}
  943. 'n' :
  944. exclude(initglobalswitches,cs_check_unit_name);
  945. 'p' :
  946. begin
  947. Message2(option_obsolete_switch_use_new,'-Up','-Fu');
  948. break;
  949. end;
  950. 'r' :
  951. do_release:=true;
  952. 's' :
  953. include(initmoduleswitches,cs_compilesystem);
  954. '-' :
  955. begin
  956. exclude(initmoduleswitches,cs_compilesystem);
  957. exclude(initglobalswitches,cs_check_unit_name);
  958. end;
  959. else
  960. IllegalPara(opt);
  961. end;
  962. inc(j);
  963. end;
  964. end;
  965. 'v' :
  966. begin
  967. if not setverbosity(More) then
  968. IllegalPara(opt);
  969. end;
  970. 'V' : ; { Ignore used by fpc }
  971. 'W' :
  972. begin
  973. j:=1;
  974. while j<=length(More) do
  975. begin
  976. case More[j] of
  977. 'B':
  978. begin
  979. { -WB200000 means set trefered base address
  980. to $200000, but does not change relocsection boolean
  981. this way we can create both relocatble and
  982. non relocatable DLL at a specific base address PM }
  983. if (length(More)>j) then
  984. begin
  985. if DLLImageBase=nil then
  986. DLLImageBase:=StringDup(Copy(More,j+1,255));
  987. end
  988. else
  989. begin
  990. RelocSection:=true;
  991. RelocSectionSetExplicitly:=true;
  992. end;
  993. break;
  994. end;
  995. 'C':
  996. begin
  997. if UnsetBool(More, j) then
  998. apptype:=app_gui
  999. else
  1000. apptype:=app_cui;
  1001. end;
  1002. 'D':
  1003. begin
  1004. UseDeffileForExports:=not UnsetBool(More, j);
  1005. UseDeffileForExportsSetExplicitly:=true;
  1006. end;
  1007. 'F':
  1008. begin
  1009. if UnsetBool(More, j) then
  1010. apptype:=app_cui
  1011. else
  1012. apptype:=app_fs;
  1013. end;
  1014. 'G':
  1015. begin
  1016. if UnsetBool(More, j) then
  1017. apptype:=app_cui
  1018. else
  1019. apptype:=app_gui;
  1020. end;
  1021. 'T':
  1022. begin
  1023. if UnsetBool(More, j) then
  1024. apptype:=app_cui
  1025. else
  1026. apptype:=app_tool;
  1027. end;
  1028. 'N':
  1029. begin
  1030. RelocSection:=UnsetBool(More,j);
  1031. RelocSectionSetExplicitly:=true;
  1032. end;
  1033. 'R':
  1034. begin
  1035. { support -WR+ / -WR- as synonyms to -WR / -WN }
  1036. RelocSection:=not UnsetBool(More,j);
  1037. RelocSectionSetExplicitly:=true;
  1038. end;
  1039. else
  1040. IllegalPara(opt);
  1041. end;
  1042. inc(j);
  1043. end;
  1044. end;
  1045. 'X' :
  1046. begin
  1047. j:=1;
  1048. while j<=length(more) do
  1049. begin
  1050. case More[j] of
  1051. 'i' :
  1052. include(initglobalswitches,cs_link_internal);
  1053. 'm' :
  1054. include(initglobalswitches,cs_link_map);
  1055. 'f' :
  1056. include(initglobalswitches,cs_link_pthread);
  1057. 's' :
  1058. include(initglobalswitches,cs_link_strip);
  1059. 'c' : Cshared:=TRUE;
  1060. 't' :
  1061. include(initglobalswitches,cs_link_staticflag);
  1062. 'D' :
  1063. begin
  1064. def_symbol('FPC_LINK_DYNAMIC');
  1065. undef_symbol('FPC_LINK_SMART');
  1066. undef_symbol('FPC_LINK_STATIC');
  1067. exclude(initglobalswitches,cs_link_static);
  1068. exclude(initglobalswitches,cs_link_smart);
  1069. include(initglobalswitches,cs_link_shared);
  1070. LinkTypeSetExplicitly:=true;
  1071. end;
  1072. 'd' : Dontlinkstdlibpath:=TRUE;
  1073. 'P' : Begin
  1074. utilsprefix:=Copy(more,2,length(More)-1);
  1075. More:='';
  1076. End;
  1077. 'r' : Begin
  1078. rlinkpath:=Copy(more,2,length(More)-1);
  1079. More:='';
  1080. end;
  1081. 'S' :
  1082. begin
  1083. def_symbol('FPC_LINK_STATIC');
  1084. undef_symbol('FPC_LINK_SMART');
  1085. undef_symbol('FPC_LINK_DYNAMIC');
  1086. include(initglobalswitches,cs_link_static);
  1087. exclude(initglobalswitches,cs_link_smart);
  1088. exclude(initglobalswitches,cs_link_shared);
  1089. LinkTypeSetExplicitly:=true;
  1090. end;
  1091. 'X' :
  1092. begin
  1093. def_symbol('FPC_LINK_SMART');
  1094. undef_symbol('FPC_LINK_STATIC');
  1095. undef_symbol('FPC_LINK_DYNAMIC');
  1096. exclude(initglobalswitches,cs_link_static);
  1097. include(initglobalswitches,cs_link_smart);
  1098. exclude(initglobalswitches,cs_link_shared);
  1099. LinkTypeSetExplicitly:=true;
  1100. end;
  1101. '-' :
  1102. begin
  1103. exclude(initglobalswitches,cs_link_staticflag);
  1104. exclude(initglobalswitches,cs_link_strip);
  1105. exclude(initglobalswitches,cs_link_map);
  1106. set_default_link_type;
  1107. end;
  1108. else
  1109. IllegalPara(opt);
  1110. end;
  1111. inc(j);
  1112. end;
  1113. end;
  1114. { give processor specific options a chance }
  1115. else
  1116. interpret_proc_specific_options(opt);
  1117. end;
  1118. end;
  1119. '@' :
  1120. begin
  1121. Message(option_no_nested_response_file);
  1122. StopOptions(1);
  1123. end;
  1124. else
  1125. begin
  1126. if (length(param_file)<>0) then
  1127. Message(option_only_one_source_support);
  1128. param_file:=opt;
  1129. Message1(option_found_file,opt);
  1130. end;
  1131. end;
  1132. end;
  1133. procedure Toption.Interpret_file(const filename : string);
  1134. procedure RemoveSep(var fn:string);
  1135. var
  1136. i : longint;
  1137. begin
  1138. i:=0;
  1139. while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do
  1140. inc(i);
  1141. Delete(fn,1,i);
  1142. i:=length(fn);
  1143. while (i>0) and (fn[i] in [',',' ',#9]) do
  1144. dec(i);
  1145. fn:=copy(fn,1,i);
  1146. end;
  1147. function GetName(var fn:string):string;
  1148. var
  1149. i : longint;
  1150. begin
  1151. i:=0;
  1152. while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do
  1153. inc(i);
  1154. GetName:=Copy(fn,1,i);
  1155. Delete(fn,1,i);
  1156. end;
  1157. const
  1158. maxlevel=16;
  1159. var
  1160. f : text;
  1161. s,
  1162. opts : string;
  1163. skip : array[0..maxlevel-1] of boolean;
  1164. level : longint;
  1165. option_read : boolean;
  1166. begin
  1167. { avoid infinite loop }
  1168. Inc(FileLevel);
  1169. Option_read:=false;
  1170. If FileLevel>MaxLevel then
  1171. Message(option_too_many_cfg_files);
  1172. { open file }
  1173. Message1(option_using_file,filename);
  1174. assign(f,filename);
  1175. {$I-}
  1176. reset(f);
  1177. {$I+}
  1178. if ioresult<>0 then
  1179. begin
  1180. Message1(option_unable_open_file,filename);
  1181. exit;
  1182. end;
  1183. Message1(option_start_reading_configfile,filename);
  1184. fillchar(skip,sizeof(skip),0);
  1185. level:=0;
  1186. while not eof(f) do
  1187. begin
  1188. readln(f,opts);
  1189. RemoveSep(opts);
  1190. if (opts<>'') and (opts[1]<>';') then
  1191. begin
  1192. if opts[1]='#' then
  1193. begin
  1194. Message1(option_interpreting_file_option,opts);
  1195. Delete(opts,1,1);
  1196. s:=upper(GetName(opts));
  1197. if (s='SECTION') then
  1198. begin
  1199. RemoveSep(opts);
  1200. s:=upper(GetName(opts));
  1201. if level=0 then
  1202. skip[level]:=not (check_symbol(s) or (s='COMMON'));
  1203. end
  1204. else
  1205. if (s='IFDEF') then
  1206. begin
  1207. RemoveSep(opts);
  1208. if Level>=maxlevel then
  1209. begin
  1210. Message(option_too_many_ifdef);
  1211. stopOptions(1);
  1212. end;
  1213. inc(Level);
  1214. skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts)))));
  1215. end
  1216. else
  1217. if (s='IFNDEF') then
  1218. begin
  1219. RemoveSep(opts);
  1220. if Level>=maxlevel then
  1221. begin
  1222. Message(option_too_many_ifdef);
  1223. stopOptions(1);
  1224. end;
  1225. inc(Level);
  1226. skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts)))));
  1227. end
  1228. else
  1229. if (s='ELSE') then
  1230. skip[level]:=skip[level-1] or (not skip[level])
  1231. else
  1232. if (s='ENDIF') then
  1233. begin
  1234. skip[level]:=false;
  1235. if Level=0 then
  1236. begin
  1237. Message(option_too_many_endif);
  1238. stopOptions(1);
  1239. end;
  1240. dec(level);
  1241. end
  1242. else
  1243. if (not skip[level]) then
  1244. begin
  1245. if (s='DEFINE') then
  1246. begin
  1247. RemoveSep(opts);
  1248. def_symbol(upper(GetName(opts)));
  1249. end
  1250. else
  1251. if (s='UNDEF') then
  1252. begin
  1253. RemoveSep(opts);
  1254. undef_symbol(upper(GetName(opts)));
  1255. end
  1256. else
  1257. if (s='WRITE') then
  1258. begin
  1259. Delete(opts,1,1);
  1260. WriteLn(opts);
  1261. end
  1262. else
  1263. if (s='INCLUDE') then
  1264. begin
  1265. Delete(opts,1,1);
  1266. Interpret_file(opts);
  1267. end;
  1268. end;
  1269. end
  1270. else
  1271. begin
  1272. if (opts[1]='-') or (opts[1]='@') then
  1273. begin
  1274. if (not skip[level]) then
  1275. interpret_option(opts,false);
  1276. Option_read:=true;
  1277. end
  1278. else
  1279. Message1(option_illegal_para,opts);
  1280. end;
  1281. end;
  1282. end;
  1283. if Level>0 then
  1284. Message(option_too_less_endif);
  1285. if Not Option_read then
  1286. Message1(option_no_option_found,filename)
  1287. else
  1288. Message1(option_end_reading_configfile,filename);
  1289. Close(f);
  1290. Dec(FileLevel);
  1291. end;
  1292. procedure Toption.Interpret_envvar(const envname : string);
  1293. var
  1294. argstart,
  1295. env,
  1296. pc : pchar;
  1297. arglen : longint;
  1298. quote : set of char;
  1299. hs : string;
  1300. begin
  1301. Message1(option_using_env,envname);
  1302. env:=GetEnvPChar(envname);
  1303. pc:=env;
  1304. if assigned(pc) then
  1305. begin
  1306. repeat
  1307. { skip leading spaces }
  1308. while pc^ in [' ',#9,#13] do
  1309. inc(pc);
  1310. case pc^ of
  1311. #0 :
  1312. break;
  1313. '"' :
  1314. begin
  1315. quote:=['"'];
  1316. inc(pc);
  1317. end;
  1318. '''' :
  1319. begin
  1320. quote:=[''''];
  1321. inc(pc);
  1322. end;
  1323. else
  1324. quote:=[' ',#9,#13];
  1325. end;
  1326. { scan until the end of the argument }
  1327. argstart:=pc;
  1328. while (pc^<>#0) and not(pc^ in quote) do
  1329. inc(pc);
  1330. { create argument }
  1331. arglen:=pc-argstart;
  1332. hs[0]:=chr(arglen);
  1333. move(argstart^,hs[1],arglen);
  1334. interpret_option(hs,true);
  1335. { skip quote }
  1336. if pc^ in quote then
  1337. inc(pc);
  1338. until false;
  1339. end
  1340. else
  1341. Message1(option_no_option_found,'(env) '+envname);
  1342. FreeEnvPChar(env);
  1343. end;
  1344. procedure toption.read_parameters;
  1345. var
  1346. opts : string;
  1347. paramindex : longint;
  1348. begin
  1349. paramindex:=0;
  1350. while paramindex<paramcount do
  1351. begin
  1352. inc(paramindex);
  1353. opts:=system.paramstr(paramindex);
  1354. case opts[1] of
  1355. '@' :
  1356. if not firstpass then
  1357. begin
  1358. Delete(opts,1,1);
  1359. Message1(option_reading_further_from,opts);
  1360. interpret_file(opts);
  1361. end;
  1362. '!' :
  1363. if not firstpass then
  1364. begin
  1365. Delete(opts,1,1);
  1366. Message1(option_reading_further_from,'(env) '+opts);
  1367. interpret_envvar(opts);
  1368. end;
  1369. else
  1370. interpret_option(opts,true);
  1371. end;
  1372. end;
  1373. end;
  1374. procedure toption.parsecmd(cmd:string);
  1375. var
  1376. i,ps : longint;
  1377. opts : string;
  1378. begin
  1379. while (cmd<>'') do
  1380. begin
  1381. while cmd[1]=' ' do
  1382. delete(cmd,1,1);
  1383. i:=pos(' ',cmd);
  1384. if i=0 then
  1385. i:=256;
  1386. opts:=Copy(cmd,1,i-1);
  1387. Delete(cmd,1,i);
  1388. case opts[1] of
  1389. '@' :
  1390. if not firstpass then
  1391. begin
  1392. Delete(opts,1,1);
  1393. Message1(option_reading_further_from,opts);
  1394. interpret_file(opts);
  1395. end;
  1396. '!' :
  1397. if not firstpass then
  1398. begin
  1399. Delete(opts,1,1);
  1400. Message1(option_reading_further_from,'(env) '+opts);
  1401. interpret_envvar(opts);
  1402. end;
  1403. '"' :
  1404. begin
  1405. Delete(opts,1,1);
  1406. ps:=pos('"',cmd);
  1407. if (i<>256) and (ps>0) then
  1408. begin
  1409. opts:=opts + ' '+ copy(cmd,1,ps-1);
  1410. cmd:=copy(cmd,ps+1,255);
  1411. end;
  1412. interpret_option(opts,true);
  1413. end;
  1414. else
  1415. interpret_option(opts,true);
  1416. end;
  1417. end;
  1418. end;
  1419. procedure toption.writequickinfo;
  1420. var
  1421. s : string;
  1422. i : longint;
  1423. procedure addinfo(const hs:string);
  1424. begin
  1425. if s<>'' then
  1426. s:=s+' '+hs
  1427. else
  1428. s:=hs;
  1429. end;
  1430. begin
  1431. s:='';
  1432. i:=0;
  1433. while (i<length(quickinfo)) do
  1434. begin
  1435. inc(i);
  1436. case quickinfo[i] of
  1437. 'S' :
  1438. begin
  1439. inc(i);
  1440. case quickinfo[i] of
  1441. 'O' :
  1442. addinfo(lower(source_info.shortname));
  1443. {$ifdef Delphi}
  1444. 'P' :
  1445. addinfo('i386');
  1446. {$else Delphi}
  1447. 'P' :
  1448. addinfo(source_cpu_string);
  1449. {$endif Delphi}
  1450. else
  1451. IllegalPara('-i'+QuickInfo);
  1452. end;
  1453. end;
  1454. 'T' :
  1455. begin
  1456. inc(i);
  1457. case quickinfo[i] of
  1458. 'O' :
  1459. addinfo(lower(target_info.shortname));
  1460. 'P' :
  1461. AddInfo(target_cpu_string);
  1462. else
  1463. IllegalPara('-i'+QuickInfo);
  1464. end;
  1465. end;
  1466. 'V' :
  1467. AddInfo(version_string);
  1468. 'D' :
  1469. AddInfo(date_string);
  1470. '_' :
  1471. ;
  1472. else
  1473. IllegalPara('-i'+QuickInfo);
  1474. end;
  1475. end;
  1476. if s<>'' then
  1477. begin
  1478. writeln(s);
  1479. stopoptions(1);
  1480. end;
  1481. end;
  1482. procedure TOption.TargetDefines(def:boolean);
  1483. var
  1484. s : string;
  1485. i : integer;
  1486. begin
  1487. if def then
  1488. def_symbol(upper(target_info.shortname))
  1489. else
  1490. undef_symbol(upper(target_info.shortname));
  1491. s:=target_info.extradefines;
  1492. while (s<>'') do
  1493. begin
  1494. i:=pos(';',s);
  1495. if i=0 then
  1496. i:=length(s)+1;
  1497. if def then
  1498. def_symbol(Copy(s,1,i-1))
  1499. else
  1500. undef_symbol(Copy(s,1,i-1));
  1501. delete(s,1,i);
  1502. end;
  1503. end;
  1504. constructor TOption.create;
  1505. begin
  1506. DoWriteLogo:=false;
  1507. NoPressEnter:=false;
  1508. FirstPass:=false;
  1509. FileLevel:=0;
  1510. Quickinfo:='';
  1511. ParaIncludePath:=TSearchPathList.Create;
  1512. ParaObjectPath:=TSearchPathList.Create;
  1513. ParaUnitPath:=TSearchPathList.Create;
  1514. ParaLibraryPath:=TSearchPathList.Create;
  1515. FillChar(ParaAlignment,sizeof(ParaAlignment),0);
  1516. end;
  1517. destructor TOption.destroy;
  1518. begin
  1519. ParaIncludePath.Free;
  1520. ParaObjectPath.Free;
  1521. ParaUnitPath.Free;
  1522. ParaLibraryPath.Free;
  1523. end;
  1524. {****************************************************************************
  1525. Callable Routines
  1526. ****************************************************************************}
  1527. function check_configfile(const fn:string;var foundfn:string):boolean;
  1528. function CfgFileExists(const fn:string):boolean;
  1529. begin
  1530. Comment(V_Tried,'Configfile search: '+fn);
  1531. CfgFileExists:=FileExists(fn);
  1532. end;
  1533. var
  1534. configpath : pathstr;
  1535. begin
  1536. foundfn:=fn;
  1537. check_configfile:=true;
  1538. { retrieve configpath }
  1539. {$ifdef Delphi}
  1540. configpath:=FixPath(dmisc.getenv('PPC_CONFIG_PATH'),false);
  1541. {$else Delphi}
  1542. configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false);
  1543. {$endif Delphi}
  1544. {$ifdef Unix}
  1545. if configpath='' then
  1546. configpath:='/etc/';
  1547. {$endif}
  1548. {
  1549. Order to read configuration file :
  1550. try reading fpc.cfg in :
  1551. 1 - current dir
  1552. 2 - configpath
  1553. 3 - compiler path
  1554. }
  1555. if not FileExists(fn) then
  1556. begin
  1557. {$ifdef Unix}
  1558. if (dos.getenv('HOME')<>'') and CfgFileExists(FixPath(dos.getenv('HOME'),false)+'.'+fn) then
  1559. foundfn:=FixPath(dos.getenv('HOME'),false)+'.'+fn
  1560. else
  1561. {$endif}
  1562. if CfgFileExists(configpath+fn) then
  1563. foundfn:=configpath+fn
  1564. else
  1565. {$ifndef Unix}
  1566. if CfgFileExists(exepath+fn) then
  1567. foundfn:=exepath+fn
  1568. else
  1569. {$endif}
  1570. check_configfile:=false;
  1571. end;
  1572. end;
  1573. procedure read_arguments(cmd:string);
  1574. begin
  1575. option:=coption.create;
  1576. disable_configfile:=false;
  1577. { default defines }
  1578. def_symbol(upper(target_info.shortname));
  1579. def_symbol('FPC');
  1580. def_symbol('VER'+version_nr);
  1581. def_symbol('VER'+version_nr+'_'+release_nr);
  1582. def_symbol('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
  1583. { Temporary defines, until things settle down }
  1584. def_symbol('HASWIDECHAR');
  1585. def_symbol('HASWIDESTRING');
  1586. def_symbol('HASOUT');
  1587. def_symbol('HASGLOBALPROPERTY');
  1588. def_symbol('FPC_HASPREFETCH');
  1589. {$ifdef i386}
  1590. def_symbol('HASINTF');
  1591. def_symbol('HASVARIANT');
  1592. {$endif i386}
  1593. {$ifdef x86_64}
  1594. def_symbol('HASINTF');
  1595. def_symbol('HASVARIANT');
  1596. {$endif x86_64}
  1597. {$ifdef powerpc}
  1598. def_symbol('HASINTF');
  1599. def_symbol('HASVARIANT');
  1600. def_symbol('FPC_MTFSB0_CORRECTED');
  1601. {$endif powerpc}
  1602. {$ifdef arm}
  1603. def_symbol('HASINTF');
  1604. def_symbol('HASVARIANT');
  1605. {$endif arm}
  1606. {$ifdef sparc}
  1607. def_symbol('HASINTF');
  1608. def_symbol('HASVARIANT');
  1609. {$endif sparc}
  1610. def_symbol('INTERNSETLENGTH');
  1611. def_symbol('INTERNLENGTH');
  1612. def_symbol('INTERNCOPY');
  1613. def_symbol('INT64FUNCRESOK');
  1614. def_symbol('HAS_ADDR_STACK_ON_STACK');
  1615. def_symbol('NOBOUNDCHECK');
  1616. def_symbol('HASCOMPILERPROC');
  1617. def_symbol('VALUEGETMEM');
  1618. def_symbol('VALUEFREEMEM');
  1619. def_symbol('HASCURRENCY');
  1620. def_symbol('HASTHREADVAR');
  1621. def_symbol('HAS_GENERICCONSTRUCTOR');
  1622. def_symbol('NOCLASSHELPERS');
  1623. if pocall_default = pocall_register then
  1624. def_symbol('REGCALL');
  1625. def_symbol('DECRREFNOTNIL');
  1626. def_symbol('HAS_INTERNAL_INTTYPES');
  1627. def_symbol('STR_USES_VALINT');
  1628. { using a case is pretty useless here (FK) }
  1629. { some stuff for TP compatibility }
  1630. {$ifdef i386}
  1631. def_symbol('CPU86');
  1632. def_symbol('CPU87');
  1633. {$endif}
  1634. {$ifdef m68k}
  1635. def_symbol('CPU68');
  1636. {$endif}
  1637. { new processor stuff }
  1638. {$ifdef i386}
  1639. def_symbol('CPUI386');
  1640. def_symbol('CPU32');
  1641. def_symbol('FPC_HAS_TYPE_EXTENDED');
  1642. def_symbol('FPC_HAS_TYPE_DOUBLE');
  1643. def_symbol('FPC_HAS_TYPE_SINGLE');
  1644. {$endif}
  1645. {$ifdef m68k}
  1646. def_symbol('CPU68K');
  1647. def_symbol('CPUM68K');
  1648. def_symbol('CPU32');
  1649. def_symbol('FPC_CURRENCY_IS_INT64');
  1650. def_symbol('FPC_COMP_IS_INT64');
  1651. {$endif}
  1652. {$ifdef ALPHA}
  1653. def_symbol('CPUALPHA');
  1654. def_symbol('CPU64');
  1655. {$endif}
  1656. {$ifdef powerpc}
  1657. def_symbol('CPUPOWERPC');
  1658. def_symbol('CPUPOWERPC32');
  1659. def_symbol('CPU32');
  1660. def_symbol('FPC_HAS_TYPE_DOUBLE');
  1661. def_symbol('FPC_HAS_TYPE_SINGLE');
  1662. def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1663. def_symbol('FPC_CURRENCY_IS_INT64');
  1664. def_symbol('FPC_COMP_IS_INT64');
  1665. {$endif}
  1666. {$ifdef iA64}
  1667. def_symbol('CPUIA64');
  1668. def_symbol('CPU64');
  1669. {$endif}
  1670. {$ifdef x86_64}
  1671. def_symbol('CPUX86_64');
  1672. def_symbol('CPUAMD64');
  1673. def_symbol('CPU64');
  1674. { not supported for now, afaik (FK)
  1675. def_symbol('FPC_HAS_TYPE_FLOAT128'); }
  1676. def_symbol('FPC_HAS_TYPE_EXTENDED');
  1677. def_symbol('FPC_HAS_TYPE_DOUBLE');
  1678. def_symbol('FPC_HAS_TYPE_SINGLE');
  1679. {$endif}
  1680. {$ifdef sparc}
  1681. def_symbol('CPUSPARC');
  1682. def_symbol('CPUSPARC32');
  1683. def_symbol('CPU32');
  1684. def_symbol('FPC_HAS_TYPE_DOUBLE');
  1685. def_symbol('FPC_HAS_TYPE_SINGLE');
  1686. def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1687. def_symbol('FPC_CURRENCY_IS_INT64');
  1688. def_symbol('FPC_COMP_IS_INT64');
  1689. def_symbol('FPC_REQUIRES_PROPER_ALIGNMENT');
  1690. {$endif}
  1691. {$ifdef vis}
  1692. def_symbol('CPUVIS');
  1693. def_symbol('CPU32');
  1694. {$endif}
  1695. {$ifdef arm}
  1696. def_symbol('CPUARM');
  1697. def_symbol('CPU32');
  1698. def_symbol('FPC_HAS_TYPE_DOUBLE');
  1699. def_symbol('FPC_HAS_TYPE_SINGLE');
  1700. def_symbol('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1701. def_symbol('FPC_CURRENCY_IS_INT64');
  1702. def_symbol('FPC_COMP_IS_INT64');
  1703. def_symbol('FPC_REQUIRES_PROPER_ALIGNMENT');
  1704. {$endif arm}
  1705. { get default messagefile }
  1706. {$ifdef Delphi}
  1707. msgfilename:=dmisc.getenv('PPC_ERROR_FILE');
  1708. {$else Delphi}
  1709. msgfilename:=dos.getenv('PPC_ERROR_FILE');
  1710. {$endif Delphi}
  1711. { default configfile can be specified on the commandline,
  1712. remove it first }
  1713. if (cmd<>'') and (cmd[1]='[') then
  1714. begin
  1715. ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
  1716. Delete(cmd,1,pos(']',cmd));
  1717. end
  1718. else
  1719. begin
  1720. ppccfg:='fpc.cfg';
  1721. ppcaltcfg:='ppc386.cfg';
  1722. end;
  1723. { read the parameters quick, only -i -v -T }
  1724. option.firstpass:=true;
  1725. if cmd<>'' then
  1726. option.parsecmd(cmd)
  1727. else
  1728. begin
  1729. option.read_parameters;
  1730. { Write only quickinfo }
  1731. if option.quickinfo<>'' then
  1732. option.writequickinfo;
  1733. end;
  1734. option.firstpass:=false;
  1735. { read configuration file }
  1736. if (not disable_configfile) and
  1737. (ppccfg<>'') then
  1738. begin
  1739. read_configfile:=check_configfile(ppccfg,ppccfg);
  1740. { Maybe alternative configfile ? }
  1741. if (not read_configfile) and
  1742. (ppcaltcfg<>'') then
  1743. read_configfile:=check_configfile(ppcaltcfg,ppccfg);
  1744. end
  1745. else
  1746. read_configfile := false;
  1747. { Read commandline and configfile }
  1748. target_is_set:=false;
  1749. asm_is_set:=false;
  1750. param_file:='';
  1751. { read configfile }
  1752. if read_configfile then
  1753. option.interpret_file(ppccfg);
  1754. { read parameters again to override config file }
  1755. if cmd<>'' then
  1756. option.parsecmd(cmd)
  1757. else
  1758. begin
  1759. option.read_parameters;
  1760. { Write only quickinfo }
  1761. if option.quickinfo<>'' then
  1762. option.writequickinfo;
  1763. end;
  1764. { Write help pages }
  1765. if (cmd='') and (paramcount=0) then
  1766. Option.WriteHelpPages;
  1767. { Stop if errors in options }
  1768. if ErrorCount>0 then
  1769. StopOptions(1);
  1770. { Non-core target defines }
  1771. Option.TargetDefines(true);
  1772. { endian define }
  1773. case target_info.endian of
  1774. endian_little :
  1775. begin
  1776. def_symbol('ENDIAN_LITTLE');
  1777. def_symbol('FPC_LITTLE_ENDIAN');
  1778. end;
  1779. endian_big :
  1780. begin
  1781. def_symbol('ENDIAN_BIG');
  1782. def_symbol('FPC_BIG_ENDIAN');
  1783. end;
  1784. end;
  1785. { abi define }
  1786. case target_info.abi of
  1787. abi_powerpc_sysv :
  1788. def_symbol('FPC_ABI_SYSV');
  1789. abi_powerpc_aix :
  1790. def_symbol('FPC_ABI_AIX');
  1791. end;
  1792. {$ifdef m68k}
  1793. if initoptprocessor=MC68020 then
  1794. def_symbol('CPUM68020');
  1795. {$endif m68k}
  1796. { write logo if set }
  1797. if option.DoWriteLogo then
  1798. option.WriteLogo;
  1799. { Check file to compile }
  1800. if param_file='' then
  1801. begin
  1802. Message(option_no_source_found);
  1803. StopOptions(1);
  1804. end;
  1805. {$ifndef Unix}
  1806. param_file:=FixFileName(param_file);
  1807. {$endif}
  1808. fsplit(param_file,inputdir,inputfile,inputextension);
  1809. if inputextension='' then
  1810. begin
  1811. if FileExists(inputdir+inputfile+target_info.sourceext) then
  1812. inputextension:=target_info.sourceext
  1813. else if FileExists(inputdir+inputfile+target_info.pasext) then
  1814. inputextension:=target_info.pasext
  1815. else if (m_mac in aktmodeswitches) and FileExists(inputdir+inputfile+'.p') then
  1816. inputextension:='.p';
  1817. end;
  1818. { Check output dir }
  1819. if (OutputExeDir<>'') and
  1820. not PathExists(OutputExeDir) then
  1821. begin
  1822. Message1(general_e_path_does_not_exists,OutputExeDir);
  1823. StopOptions(1);
  1824. end;
  1825. { Add paths specified with parameters to the searchpaths }
  1826. UnitSearchPath.AddList(option.ParaUnitPath,true);
  1827. ObjectSearchPath.AddList(option.ParaObjectPath,true);
  1828. IncludeSearchPath.AddList(option.ParaIncludePath,true);
  1829. LibrarySearchPath.AddList(option.ParaLibraryPath,true);
  1830. { add unit environment and exepath to the unit search path }
  1831. if inputdir<>'' then
  1832. Unitsearchpath.AddPath(inputdir,true);
  1833. if not disable_configfile then
  1834. begin
  1835. {$ifdef Delphi}
  1836. UnitSearchPath.AddPath(dmisc.getenv(target_info.unit_env),false);
  1837. {$else}
  1838. UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false);
  1839. {$endif Delphi}
  1840. end;
  1841. {$ifdef Unix}
  1842. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1843. if fpcdir='' then
  1844. begin
  1845. if source_info.cpu<>target_info.cpu then
  1846. begin
  1847. if PathExists('/usr/local/lib/fpc/'+version_string+'/cross/'+cpu2str[target_info.cpu]+'-'+target_info.shortname) then
  1848. fpcdir:='/usr/local/lib/fpc/'+version_string+'/cross/'+cpu2str[target_info.cpu]+'-'+target_info.shortname+'/'
  1849. else
  1850. fpcdir:='/usr/lib/fpc/'+version_string+'/cross/'+cpu2str[target_info.cpu]+'-'+target_info.shortname+'/';
  1851. end
  1852. else
  1853. begin
  1854. if PathExists('/usr/local/lib/fpc/'+version_string) then
  1855. fpcdir:='/usr/local/lib/fpc/'+version_string+'/'
  1856. else
  1857. fpcdir:='/usr/lib/fpc/'+version_string+'/';
  1858. end;
  1859. end;
  1860. {$else}
  1861. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1862. if fpcdir='' then
  1863. begin
  1864. fpcdir:=ExePath+'../';
  1865. if not(PathExists(fpcdir+'/units')) and
  1866. not(PathExists(fpcdir+'/rtl')) then
  1867. fpcdir:=fpcdir+'../';
  1868. end;
  1869. {$endif}
  1870. { first try development RTL, else use the default installation path }
  1871. if not disable_configfile then
  1872. begin
  1873. if source_info.cpu<>target_info.cpu then
  1874. begin
  1875. if PathExists(FpcDir+'rtl/'+lower(target_info.shortname)) then
  1876. UnitSearchPath.AddPath(FpcDir+'rtl/'+lower(target_info.shortname),false)
  1877. else
  1878. begin
  1879. UnitSearchPath.AddPath(FpcDir+'units/',false);
  1880. UnitSearchPath.AddPath(FpcDir+'units/rtl',false);
  1881. end;
  1882. end
  1883. else
  1884. begin
  1885. if PathExists(FpcDir+'rtl/'+lower(target_info.shortname)) then
  1886. UnitSearchPath.AddPath(FpcDir+'rtl/'+lower(target_info.shortname),false)
  1887. else
  1888. begin
  1889. UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname),false);
  1890. UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname)+'/rtl',false);
  1891. end;
  1892. end;
  1893. end;
  1894. { Add exepath if the exe is not in the current dir, because that is always searched already.
  1895. Do not add it when linking on the target because then we can maybe already find
  1896. .o files that are not for the target }
  1897. if (ExePath<>GetCurrentDir) and
  1898. not(cs_link_on_target in initglobalswitches) then
  1899. UnitSearchPath.AddPath(ExePath,false);
  1900. { Add unit dir to the object and library path }
  1901. objectsearchpath.AddList(unitsearchpath,false);
  1902. librarysearchpath.AddList(unitsearchpath,false);
  1903. { switch assembler if it's binary and we got -a on the cmdline }
  1904. if (cs_asm_leave in initglobalswitches) and
  1905. (af_outputbinary in target_asm.flags) then
  1906. begin
  1907. Message(option_switch_bin_to_src_assembler);
  1908. set_target_asm(target_info.assemextern);
  1909. end;
  1910. if (target_asm.supported_target <> system_any) and
  1911. (target_asm.supported_target <> target_info.system) then
  1912. begin
  1913. Message2(option_incompatible_asm,target_asm.idtxt,target_info.name);
  1914. set_target_asm(target_info.assemextern);
  1915. Message1(option_asm_forced,target_asm.idtxt);
  1916. end;
  1917. { turn off stripping if compiling with debuginfo or profile }
  1918. if (cs_debuginfo in initmoduleswitches) or
  1919. (cs_profile in initmoduleswitches) then
  1920. exclude(initglobalswitches,cs_link_strip);
  1921. {$ifdef x86_64}
  1922. {$warning HACK: turn off smartlinking}
  1923. exclude(initmoduleswitches,cs_create_smart);
  1924. {$endif}
  1925. if not LinkTypeSetExplicitly then
  1926. set_default_link_type;
  1927. { Default alignment settings,
  1928. 1. load the defaults for the target
  1929. 2. override with generic optimizer setting (little size)
  1930. 3. override with the user specified -Oa }
  1931. UpdateAlignment(initalignment,target_info.alignment);
  1932. if (cs_littlesize in aktglobalswitches) then
  1933. begin
  1934. initalignment.procalign:=1;
  1935. initalignment.jumpalign:=1;
  1936. initalignment.loopalign:=1;
  1937. end;
  1938. UpdateAlignment(initalignment,option.paraalignment);
  1939. option.free;
  1940. Option:=nil;
  1941. end;
  1942. initialization
  1943. coption:=toption;
  1944. finalization
  1945. if assigned(option) then
  1946. option.free;
  1947. end.
  1948. {
  1949. $Log$
  1950. Revision 1.140 2004-09-08 11:23:31 michael
  1951. + Check if outputdir exists, Fix exitcode when displaying help pages
  1952. Revision 1.139 2004/08/27 21:59:26 peter
  1953. browser disabled
  1954. uf_local_symtable ppu flag when a localsymtable is stored
  1955. Revision 1.138 2004/07/05 21:26:28 olle
  1956. + allow fileextension .p, in mode macpas
  1957. Revision 1.137 2004/07/04 12:24:04 jonas
  1958. * fixed "-g-l" (and other "-g-*" combinations)
  1959. Revision 1.136 2004/06/20 08:55:30 florian
  1960. * logs truncated
  1961. Revision 1.135 2004/06/16 20:07:09 florian
  1962. * dwarf branch merged
  1963. Revision 1.134 2004/05/06 20:30:51 florian
  1964. * m68k compiler compilation fixed
  1965. Revision 1.133.2.10 2004/05/18 20:24:03 florian
  1966. * fixed crash with unknown symbols
  1967. Revision 1.133.2.9 2004/05/13 20:10:38 florian
  1968. * released variant and interface support
  1969. Revision 1.133.2.8 2004/05/03 14:59:57 peter
  1970. * no dlltool needed for win32 linking executables
  1971. }