options.pas 61 KB

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