options.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103
  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. 'A',
  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. begin
  560. l:=Pos(':=',more);
  561. if l>0 then
  562. set_system_compvar(Copy(more,1,l-1),Copy(more,l+2,255))
  563. else
  564. def_system_macro(more);
  565. end;
  566. 'D' :
  567. begin
  568. include(initglobalswitches,cs_link_deffile);
  569. j:=1;
  570. while j<=length(more) do
  571. begin
  572. case more[j] of
  573. 'd' :
  574. begin
  575. description:=Copy(more,j+1,255);
  576. break;
  577. end;
  578. 'v' :
  579. begin
  580. dllversion:=Copy(more,j+1,255);
  581. l:=pos('.',dllversion);
  582. dllminor:=0;
  583. error:=0;
  584. if l>0 then
  585. begin
  586. val(copy(dllversion,l+1,255),minor,error);
  587. if (error=0) and
  588. (minor>=0) and (minor<=$ffff) then
  589. dllminor:=minor
  590. else
  591. if error=0 then
  592. error:=1;
  593. end;
  594. if l=0 then
  595. l:=256;
  596. dllmajor:=1;
  597. if error=0 then
  598. val(copy(dllversion,1,l-1),major,error);
  599. if (error=0) and (major>=0) and (major<=$ffff) then
  600. dllmajor:=major
  601. else
  602. if error=0 then
  603. error:=1;
  604. if error<>0 then
  605. Message1(scan_w_wrong_version_ignored,dllversion);
  606. break;
  607. end;
  608. 'w' :
  609. usewindowapi:=true;
  610. '-' :
  611. begin
  612. exclude(initglobalswitches,cs_link_deffile);
  613. usewindowapi:=false;
  614. end;
  615. else
  616. IllegalPara(opt);
  617. end;
  618. inc(j);
  619. end;
  620. end;
  621. 'e' :
  622. exepath:=FixPath(More,true);
  623. 'E' :
  624. begin
  625. if UnsetBool(More, 0) then
  626. exclude(initglobalswitches,cs_link_extern)
  627. else
  628. include(initglobalswitches,cs_link_extern);
  629. end;
  630. 'F' :
  631. begin
  632. c:=more[1];
  633. Delete(more,1,1);
  634. DefaultReplacements(More);
  635. case c of
  636. 'a' :
  637. autoloadunits:=more;
  638. 'c' :
  639. begin
  640. if (upper(more)='UTF8') or (upper(more)='UTF-8') then
  641. initsourcecodepage:='utf8'
  642. else if not(cpavailable(more)) then
  643. Message1(option_code_page_not_available,more)
  644. else
  645. initsourcecodepage:=more;
  646. end;
  647. 'D' :
  648. utilsdirectory:=FixPath(More,true);
  649. 'e' :
  650. SetRedirectFile(More);
  651. 'E' :
  652. OutputExeDir:=FixPath(More,true);
  653. 'i' :
  654. begin
  655. if ispara then
  656. ParaIncludePath.AddPath(More,false)
  657. else
  658. includesearchpath.AddPath(More,true);
  659. end;
  660. 'g' :
  661. Message2(option_obsolete_switch_use_new,'-Fg','-Fl');
  662. 'l' :
  663. begin
  664. if ispara then
  665. ParaLibraryPath.AddPath(More,false)
  666. else
  667. LibrarySearchPath.AddPath(More,true);
  668. end;
  669. 'L' :
  670. begin
  671. if More<>'' then
  672. ParaDynamicLinker:=More
  673. else
  674. IllegalPara(opt);
  675. end;
  676. 'o' :
  677. begin
  678. if ispara then
  679. ParaObjectPath.AddPath(More,false)
  680. else
  681. ObjectSearchPath.AddPath(More,true);
  682. end;
  683. 'r' :
  684. Msgfilename:=More;
  685. 'u' :
  686. begin
  687. if ispara then
  688. ParaUnitPath.AddPath(More,false)
  689. else
  690. unitsearchpath.AddPath(More,true);
  691. end;
  692. 'U' :
  693. OutputUnitDir:=FixPath(More,true);
  694. else
  695. IllegalPara(opt);
  696. end;
  697. end;
  698. 'g' : begin
  699. if UnsetBool(More, 0) then
  700. begin
  701. exclude(initmoduleswitches,cs_debuginfo);
  702. exclude(initglobalswitches,cs_gdb_dbx);
  703. exclude(initglobalswitches,cs_gdb_gsym);
  704. exclude(initglobalswitches,cs_gdb_heaptrc);
  705. exclude(initglobalswitches,cs_gdb_lineinfo);
  706. exclude(initlocalswitches,cs_checkpointer);
  707. end
  708. else
  709. begin
  710. {$ifdef GDB}
  711. include(initmoduleswitches,cs_debuginfo);
  712. {$else GDB}
  713. Message(option_no_debug_support);
  714. Message(option_no_debug_support_recompile_fpc);
  715. {$endif GDB}
  716. end;
  717. {$ifdef GDB}
  718. if not RelocSectionSetExplicitly then
  719. RelocSection:=false;
  720. j:=1;
  721. while j<=length(more) do
  722. begin
  723. case more[j] of
  724. 'd' :
  725. begin
  726. if UnsetBool(More, j) then
  727. exclude(initglobalswitches,cs_gdb_dbx)
  728. else
  729. include(initglobalswitches,cs_gdb_dbx);
  730. end;
  731. 'g' :
  732. begin
  733. if UnsetBool(More, j) then
  734. exclude(initglobalswitches,cs_gdb_gsym)
  735. else
  736. include(initglobalswitches,cs_gdb_gsym);
  737. end;
  738. 'h' :
  739. begin
  740. if UnsetBool(More, j) then
  741. exclude(initglobalswitches,cs_gdb_heaptrc)
  742. else
  743. include(initglobalswitches,cs_gdb_heaptrc);
  744. end;
  745. 'l' :
  746. begin
  747. if UnsetBool(More, j) then
  748. exclude(initglobalswitches,cs_gdb_lineinfo)
  749. else
  750. include(initglobalswitches,cs_gdb_lineinfo);
  751. end;
  752. 'c' :
  753. begin
  754. if UnsetBool(More, j) then
  755. exclude(initlocalswitches,cs_checkpointer)
  756. else
  757. include(initlocalswitches,cs_checkpointer);
  758. end;
  759. 'v' :
  760. begin
  761. if UnsetBool(More, j) then
  762. exclude(initglobalswitches,cs_gdb_valgrind)
  763. else
  764. include(initglobalswitches,cs_gdb_valgrind);
  765. end;
  766. 'w' :
  767. begin
  768. if UnsetBool(More, j) then
  769. exclude(initglobalswitches,cs_gdb_dwarf)
  770. else
  771. include(initglobalswitches,cs_gdb_dwarf);
  772. end;
  773. else
  774. IllegalPara(opt);
  775. end;
  776. inc(j);
  777. end;
  778. {$endif GDB}
  779. end;
  780. 'h' :
  781. begin
  782. NoPressEnter:=true;
  783. WriteHelpPages;
  784. end;
  785. 'i' :
  786. begin
  787. if More='' then
  788. WriteInfo
  789. else
  790. QuickInfo:=QuickInfo+More;
  791. end;
  792. 'I' :
  793. begin
  794. if ispara then
  795. ParaIncludePath.AddPath(More,false)
  796. else
  797. includesearchpath.AddPath(More,false);
  798. end;
  799. 'k' :
  800. begin
  801. if more<>'' then
  802. ParaLinkOptions:=ParaLinkOptions+' '+More
  803. else
  804. IllegalPara(opt);
  805. end;
  806. 'l' :
  807. if not UnSetBool(more,0) then
  808. ParaLogo:=true;
  809. 'm' :
  810. parapreprocess:=not UnSetBool(more,0);
  811. 'M' :
  812. begin
  813. more:=Upper(more);
  814. if not SetCompileMode(more, true) then
  815. IllegalPara(opt);
  816. end;
  817. 'n' :
  818. begin
  819. if More='' then
  820. disable_configfile:=true
  821. else
  822. IllegalPara(opt);
  823. end;
  824. 'o' :
  825. begin
  826. if More<>'' then
  827. {$IFDEF USE_SYSUTILS}
  828. begin
  829. d := SplitPath(More);
  830. OutputFile := SplitFileName(More);
  831. end
  832. {$ELSE USE_SYSUTILS}
  833. Fsplit(More,d,OutputFile,e)
  834. {$ENDIF USE_SYSUTILS}
  835. else
  836. IllegalPara(opt);
  837. end;
  838. 'p' :
  839. begin
  840. if UnsetBool(More, 0) then
  841. begin
  842. initmoduleswitches:=initmoduleswitches-[cs_profile];
  843. undef_system_macro('FPC_PROFILE');
  844. end
  845. else
  846. if Length(More)=0 then
  847. IllegalPara(opt)
  848. else
  849. case more[1] of
  850. 'g' : if UnsetBool(more, 1) then
  851. begin
  852. exclude(initmoduleswitches,cs_profile);
  853. undef_system_macro('FPC_PROFILE');
  854. end
  855. else
  856. begin
  857. include(initmoduleswitches,cs_profile);
  858. def_system_macro('FPC_PROFILE');
  859. end;
  860. else
  861. IllegalPara(opt);
  862. end;
  863. end;
  864. 'P' : ; { Ignore used by fpc.pp }
  865. 's' :
  866. begin
  867. if UnsetBool(More, 0) then
  868. begin
  869. initglobalswitches:=initglobalswitches-[cs_asm_extern,cs_link_extern];
  870. if more<>'' then
  871. IllegalPara(opt);
  872. end
  873. else
  874. begin
  875. initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern];
  876. if more='h' then
  877. initglobalswitches:=initglobalswitches-[cs_link_on_target]
  878. else if more='t' then
  879. initglobalswitches:=initglobalswitches+[cs_link_on_target]
  880. else if more='r' then
  881. initglobalswitches:=initglobalswitches+[cs_asm_leave,cs_no_regalloc]
  882. else if more<>'' then
  883. IllegalPara(opt);
  884. end;
  885. end;
  886. 'S' :
  887. begin
  888. if more[1]='I' then
  889. begin
  890. if upper(more)='ICOM' then
  891. initinterfacetype:=it_interfacecom
  892. else if upper(more)='ICORBA' then
  893. initinterfacetype:=it_interfacecorba
  894. else
  895. IllegalPara(opt);
  896. end
  897. else
  898. begin
  899. j:=1;
  900. while j<=length(more) do
  901. begin
  902. case more[j] of
  903. '2' : //an alternative to -Mobjfpc
  904. SetCompileMode('OBJFPC',true);
  905. 'a' :
  906. include(initlocalswitches,cs_do_assertion);
  907. 'c' :
  908. include(initmoduleswitches,cs_support_c_operators);
  909. 'd' : //an alternative to -Mdelphi
  910. SetCompileMode('DELPHI',true);
  911. 'e' :
  912. begin
  913. SetErrorFlags(copy(more,j+1,length(more)));
  914. break;
  915. end;
  916. 'g' :
  917. include(initmoduleswitches,cs_support_goto);
  918. 'h' :
  919. include(initlocalswitches,cs_ansistrings);
  920. 'i' :
  921. include(initmoduleswitches,cs_support_inline);
  922. 'm' :
  923. include(initmoduleswitches,cs_support_macro);
  924. 'o' : //an alternative to -Mtp
  925. SetCompileMode('TP',true);
  926. 'p' : //an alternative to -Mgpc
  927. SetCompileMode('GPC',true);
  928. 's' :
  929. include(initglobalswitches,cs_constructor_name);
  930. 't' :
  931. include(initmoduleswitches,cs_static_keyword);
  932. '-' :
  933. begin
  934. exclude(initglobalswitches,cs_constructor_name);
  935. initlocalswitches:=InitLocalswitches - [cs_do_assertion, cs_ansistrings];
  936. initmoduleswitches:=initmoduleswitches - [cs_support_c_operators, cs_support_goto,
  937. cs_support_inline, cs_support_macro,
  938. cs_static_keyword];
  939. end;
  940. else
  941. IllegalPara(opt);
  942. end;
  943. inc(j);
  944. end;
  945. end;
  946. end;
  947. 'T' :
  948. begin
  949. more:=Upper(More);
  950. if not target_is_set then
  951. begin
  952. { remove old target define }
  953. TargetDefines(false);
  954. { Save assembler if set }
  955. if asm_is_set then
  956. forceasm:=target_asm.id;
  957. { load new target }
  958. if not(set_target_by_string(More)) then
  959. IllegalPara(opt);
  960. { also initialize assembler if not explicitly set }
  961. if asm_is_set then
  962. set_target_asm(forceasm);
  963. { set new define }
  964. TargetDefines(true);
  965. target_is_set:=true;
  966. end
  967. else
  968. if More<>upper(target_info.shortname) then
  969. Message1(option_target_is_already_set,target_info.shortname);
  970. end;
  971. 'u' :
  972. if more <> '' then
  973. undef_system_macro(more);
  974. 'U' :
  975. begin
  976. j:=1;
  977. while j<=length(more) do
  978. begin
  979. case more[j] of
  980. {$ifdef UNITALIASES}
  981. 'a' :
  982. begin
  983. AddUnitAlias(Copy(More,j+1,255));
  984. break;
  985. end;
  986. {$endif UNITALIASES}
  987. 'n' :
  988. exclude(initglobalswitches,cs_check_unit_name);
  989. 'p' :
  990. begin
  991. Message2(option_obsolete_switch_use_new,'-Up','-Fu');
  992. break;
  993. end;
  994. 'r' :
  995. do_release:=true;
  996. 's' :
  997. include(initmoduleswitches,cs_compilesystem);
  998. '-' :
  999. begin
  1000. exclude(initmoduleswitches,cs_compilesystem);
  1001. exclude(initglobalswitches,cs_check_unit_name);
  1002. end;
  1003. else
  1004. IllegalPara(opt);
  1005. end;
  1006. inc(j);
  1007. end;
  1008. end;
  1009. 'v' :
  1010. begin
  1011. if not setverbosity(More) then
  1012. IllegalPara(opt);
  1013. end;
  1014. 'V' : ; { Ignore used by fpc }
  1015. 'W' :
  1016. begin
  1017. j:=1;
  1018. while j<=length(More) do
  1019. begin
  1020. case More[j] of
  1021. 'B':
  1022. begin
  1023. { -WB200000 means set trefered base address
  1024. to $200000, but does not change relocsection boolean
  1025. this way we can create both relocatble and
  1026. non relocatable DLL at a specific base address PM }
  1027. if (length(More)>j) then
  1028. begin
  1029. if DLLImageBase=nil then
  1030. DLLImageBase:=StringDup(Copy(More,j+1,255));
  1031. end
  1032. else
  1033. begin
  1034. RelocSection:=true;
  1035. RelocSectionSetExplicitly:=true;
  1036. end;
  1037. break;
  1038. end;
  1039. 'C':
  1040. begin
  1041. if UnsetBool(More, j) then
  1042. apptype:=app_gui
  1043. else
  1044. apptype:=app_cui;
  1045. end;
  1046. 'D':
  1047. begin
  1048. UseDeffileForExports:=not UnsetBool(More, j);
  1049. UseDeffileForExportsSetExplicitly:=true;
  1050. end;
  1051. 'F':
  1052. begin
  1053. if UnsetBool(More, j) then
  1054. apptype:=app_cui
  1055. else
  1056. apptype:=app_fs;
  1057. end;
  1058. 'G':
  1059. begin
  1060. if UnsetBool(More, j) then
  1061. apptype:=app_cui
  1062. else
  1063. apptype:=app_gui;
  1064. end;
  1065. 'T':
  1066. begin
  1067. if UnsetBool(More, j) then
  1068. apptype:=app_cui
  1069. else
  1070. apptype:=app_tool;
  1071. end;
  1072. 'N':
  1073. begin
  1074. RelocSection:=UnsetBool(More,j);
  1075. RelocSectionSetExplicitly:=true;
  1076. end;
  1077. 'R':
  1078. begin
  1079. { support -WR+ / -WR- as synonyms to -WR / -WN }
  1080. RelocSection:=not UnsetBool(More,j);
  1081. RelocSectionSetExplicitly:=true;
  1082. end;
  1083. else
  1084. IllegalPara(opt);
  1085. end;
  1086. inc(j);
  1087. end;
  1088. end;
  1089. 'X' :
  1090. begin
  1091. j:=1;
  1092. while j<=length(more) do
  1093. begin
  1094. case More[j] of
  1095. 'i' :
  1096. include(initglobalswitches,cs_link_internal);
  1097. 'm' :
  1098. include(initglobalswitches,cs_link_map);
  1099. 'f' :
  1100. include(initglobalswitches,cs_link_pthread);
  1101. 's' :
  1102. include(initglobalswitches,cs_link_strip);
  1103. 'c' : Cshared:=TRUE;
  1104. 't' :
  1105. include(initglobalswitches,cs_link_staticflag);
  1106. 'D' :
  1107. begin
  1108. def_system_macro('FPC_LINK_DYNAMIC');
  1109. undef_system_macro('FPC_LINK_SMART');
  1110. undef_system_macro('FPC_LINK_STATIC');
  1111. exclude(initglobalswitches,cs_link_static);
  1112. exclude(initglobalswitches,cs_link_smart);
  1113. include(initglobalswitches,cs_link_shared);
  1114. LinkTypeSetExplicitly:=true;
  1115. end;
  1116. 'd' : Dontlinkstdlibpath:=TRUE;
  1117. 'P' : Begin
  1118. utilsprefix:=Copy(more,2,length(More)-1);
  1119. DefaultReplacements(utilsprefix);
  1120. More:='';
  1121. End;
  1122. 'r' : Begin
  1123. rlinkpath:=Copy(more,2,length(More)-1);
  1124. DefaultReplacements(rlinkpath);
  1125. More:='';
  1126. end;
  1127. 'S' :
  1128. begin
  1129. def_system_macro('FPC_LINK_STATIC');
  1130. undef_system_macro('FPC_LINK_SMART');
  1131. undef_system_macro('FPC_LINK_DYNAMIC');
  1132. include(initglobalswitches,cs_link_static);
  1133. exclude(initglobalswitches,cs_link_smart);
  1134. exclude(initglobalswitches,cs_link_shared);
  1135. LinkTypeSetExplicitly:=true;
  1136. end;
  1137. 'X' :
  1138. begin
  1139. def_system_macro('FPC_LINK_SMART');
  1140. undef_system_macro('FPC_LINK_STATIC');
  1141. undef_system_macro('FPC_LINK_DYNAMIC');
  1142. exclude(initglobalswitches,cs_link_static);
  1143. include(initglobalswitches,cs_link_smart);
  1144. exclude(initglobalswitches,cs_link_shared);
  1145. LinkTypeSetExplicitly:=true;
  1146. end;
  1147. '-' :
  1148. begin
  1149. exclude(initglobalswitches,cs_link_staticflag);
  1150. exclude(initglobalswitches,cs_link_strip);
  1151. exclude(initglobalswitches,cs_link_map);
  1152. set_default_link_type;
  1153. end;
  1154. else
  1155. IllegalPara(opt);
  1156. end;
  1157. inc(j);
  1158. end;
  1159. end;
  1160. { give processor specific options a chance }
  1161. else
  1162. interpret_proc_specific_options(opt);
  1163. end;
  1164. end;
  1165. '@' :
  1166. begin
  1167. Message(option_no_nested_response_file);
  1168. StopOptions(1);
  1169. end;
  1170. else
  1171. begin
  1172. if (length(param_file)<>0) then
  1173. Message(option_only_one_source_support);
  1174. param_file:=opt;
  1175. Message1(option_found_file,opt);
  1176. end;
  1177. end;
  1178. end;
  1179. procedure Toption.Interpret_file(const filename : string);
  1180. procedure RemoveSep(var fn:string);
  1181. var
  1182. i : longint;
  1183. begin
  1184. i:=0;
  1185. while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do
  1186. inc(i);
  1187. Delete(fn,1,i);
  1188. i:=length(fn);
  1189. while (i>0) and (fn[i] in [',',' ',#9]) do
  1190. dec(i);
  1191. fn:=copy(fn,1,i);
  1192. end;
  1193. function GetName(var fn:string):string;
  1194. var
  1195. i : longint;
  1196. begin
  1197. i:=0;
  1198. while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do
  1199. inc(i);
  1200. GetName:=Copy(fn,1,i);
  1201. Delete(fn,1,i);
  1202. end;
  1203. const
  1204. maxlevel=16;
  1205. var
  1206. f : text;
  1207. s, tmp,
  1208. opts : string;
  1209. skip : array[0..maxlevel-1] of boolean;
  1210. level : longint;
  1211. option_read : boolean;
  1212. begin
  1213. { avoid infinite loop }
  1214. Inc(FileLevel);
  1215. Option_read:=false;
  1216. If FileLevel>MaxLevel then
  1217. Message(option_too_many_cfg_files);
  1218. { open file }
  1219. Message1(option_using_file,filename);
  1220. {$ifdef USE_SYSUTILS}
  1221. assign(f,ExpandFileName(filename));
  1222. {$else USE_SYSUTILS}
  1223. assign(f,FExpand(filename));
  1224. {$endif USE_SYsUTILS}
  1225. {$I-}
  1226. reset(f);
  1227. {$I+}
  1228. if ioresult<>0 then
  1229. begin
  1230. Message1(option_unable_open_file,filename);
  1231. exit;
  1232. end;
  1233. Message1(option_start_reading_configfile,filename);
  1234. fillchar(skip,sizeof(skip),0);
  1235. level:=0;
  1236. while not eof(f) do
  1237. begin
  1238. readln(f,opts);
  1239. RemoveSep(opts);
  1240. if (opts<>'') and (opts[1]<>';') then
  1241. begin
  1242. if opts[1]='#' then
  1243. begin
  1244. Message1(option_interpreting_file_option,opts);
  1245. Delete(opts,1,1);
  1246. s:=upper(GetName(opts));
  1247. if (s='SECTION') then
  1248. begin
  1249. RemoveSep(opts);
  1250. s:=upper(GetName(opts));
  1251. if level=0 then
  1252. skip[level]:=not (assigned(search_macro(s)) or (s='COMMON'));
  1253. end
  1254. else
  1255. if (s='IFDEF') then
  1256. begin
  1257. RemoveSep(opts);
  1258. if Level>=maxlevel then
  1259. begin
  1260. Message(option_too_many_ifdef);
  1261. stopOptions(1);
  1262. end;
  1263. inc(Level);
  1264. skip[level]:=(skip[level-1] or not assigned(search_macro(upper(GetName(opts)))));
  1265. end
  1266. else
  1267. if (s='IFNDEF') then
  1268. begin
  1269. RemoveSep(opts);
  1270. if Level>=maxlevel then
  1271. begin
  1272. Message(option_too_many_ifdef);
  1273. stopOptions(1);
  1274. end;
  1275. inc(Level);
  1276. skip[level]:=(skip[level-1] or assigned(search_macro(upper(GetName(opts)))));
  1277. end
  1278. else
  1279. if (s='ELSE') then
  1280. skip[level]:=skip[level-1] or (not skip[level])
  1281. else
  1282. if (s='ENDIF') then
  1283. begin
  1284. skip[level]:=false;
  1285. if Level=0 then
  1286. begin
  1287. Message(option_too_many_endif);
  1288. stopOptions(1);
  1289. end;
  1290. dec(level);
  1291. end
  1292. else
  1293. if (not skip[level]) then
  1294. begin
  1295. if (s='DEFINE') then
  1296. begin
  1297. RemoveSep(opts);
  1298. tmp:= GetName(opts);
  1299. if tmp <> '' then
  1300. def_system_macro(tmp);
  1301. end
  1302. else
  1303. if (s='UNDEF') then
  1304. begin
  1305. RemoveSep(opts);
  1306. tmp:= GetName(opts);
  1307. if tmp <> '' then
  1308. undef_system_macro(tmp);
  1309. end
  1310. else
  1311. if (s='WRITE') then
  1312. begin
  1313. Delete(opts,1,1);
  1314. WriteLn(opts);
  1315. end
  1316. else
  1317. if (s='INCLUDE') then
  1318. begin
  1319. Delete(opts,1,1);
  1320. Interpret_file(opts);
  1321. end;
  1322. end;
  1323. end
  1324. else
  1325. begin
  1326. if (opts[1]='-') or (opts[1]='@') then
  1327. begin
  1328. if (not skip[level]) then
  1329. interpret_option(opts,false);
  1330. Option_read:=true;
  1331. end
  1332. else
  1333. Message1(option_illegal_para,opts);
  1334. end;
  1335. end;
  1336. end;
  1337. if Level>0 then
  1338. Message(option_too_less_endif);
  1339. if Not Option_read then
  1340. Message1(option_no_option_found,filename)
  1341. else
  1342. Message1(option_end_reading_configfile,filename);
  1343. Close(f);
  1344. Dec(FileLevel);
  1345. end;
  1346. procedure Toption.Interpret_envvar(const envname : string);
  1347. var
  1348. argstart,
  1349. env,
  1350. pc : pchar;
  1351. arglen : longint;
  1352. quote : set of char;
  1353. hs : string;
  1354. begin
  1355. Message1(option_using_env,envname);
  1356. env:=GetEnvPChar(envname);
  1357. pc:=env;
  1358. if assigned(pc) then
  1359. begin
  1360. repeat
  1361. { skip leading spaces }
  1362. while pc^ in [' ',#9,#13] do
  1363. inc(pc);
  1364. case pc^ of
  1365. #0 :
  1366. break;
  1367. '"' :
  1368. begin
  1369. quote:=['"'];
  1370. inc(pc);
  1371. end;
  1372. '''' :
  1373. begin
  1374. quote:=[''''];
  1375. inc(pc);
  1376. end;
  1377. else
  1378. quote:=[' ',#9,#13];
  1379. end;
  1380. { scan until the end of the argument }
  1381. argstart:=pc;
  1382. while (pc^<>#0) and not(pc^ in quote) do
  1383. inc(pc);
  1384. { create argument }
  1385. arglen:=pc-argstart;
  1386. hs[0]:=chr(arglen);
  1387. move(argstart^,hs[1],arglen);
  1388. interpret_option(hs,true);
  1389. { skip quote }
  1390. if pc^ in quote then
  1391. inc(pc);
  1392. until false;
  1393. end
  1394. else
  1395. Message1(option_no_option_found,'(env) '+envname);
  1396. FreeEnvPChar(env);
  1397. end;
  1398. procedure toption.read_parameters;
  1399. var
  1400. opts : string;
  1401. paramindex : longint;
  1402. begin
  1403. paramindex:=0;
  1404. while paramindex<paramcount do
  1405. begin
  1406. inc(paramindex);
  1407. opts:=system.paramstr(paramindex);
  1408. case opts[1] of
  1409. '@' :
  1410. if not firstpass then
  1411. begin
  1412. Delete(opts,1,1);
  1413. Message1(option_reading_further_from,opts);
  1414. interpret_file(opts);
  1415. end;
  1416. '!' :
  1417. if not firstpass then
  1418. begin
  1419. Delete(opts,1,1);
  1420. Message1(option_reading_further_from,'(env) '+opts);
  1421. interpret_envvar(opts);
  1422. end;
  1423. else
  1424. interpret_option(opts,true);
  1425. end;
  1426. end;
  1427. end;
  1428. procedure toption.parsecmd(cmd:string);
  1429. var
  1430. i,ps : longint;
  1431. opts : string;
  1432. begin
  1433. while (cmd<>'') do
  1434. begin
  1435. while cmd[1]=' ' do
  1436. delete(cmd,1,1);
  1437. i:=pos(' ',cmd);
  1438. if i=0 then
  1439. i:=256;
  1440. opts:=Copy(cmd,1,i-1);
  1441. Delete(cmd,1,i);
  1442. case opts[1] of
  1443. '@' :
  1444. if not firstpass then
  1445. begin
  1446. Delete(opts,1,1);
  1447. Message1(option_reading_further_from,opts);
  1448. interpret_file(opts);
  1449. end;
  1450. '!' :
  1451. if not firstpass then
  1452. begin
  1453. Delete(opts,1,1);
  1454. Message1(option_reading_further_from,'(env) '+opts);
  1455. interpret_envvar(opts);
  1456. end;
  1457. '"' :
  1458. begin
  1459. Delete(opts,1,1);
  1460. ps:=pos('"',cmd);
  1461. if (i<>256) and (ps>0) then
  1462. begin
  1463. opts:=opts + ' '+ copy(cmd,1,ps-1);
  1464. cmd:=copy(cmd,ps+1,255);
  1465. end;
  1466. interpret_option(opts,true);
  1467. end;
  1468. else
  1469. interpret_option(opts,true);
  1470. end;
  1471. end;
  1472. end;
  1473. procedure toption.writequickinfo;
  1474. var
  1475. s : string;
  1476. i : longint;
  1477. procedure addinfo(const hs:string);
  1478. begin
  1479. if s<>'' then
  1480. s:=s+' '+hs
  1481. else
  1482. s:=hs;
  1483. end;
  1484. begin
  1485. s:='';
  1486. i:=0;
  1487. while (i<length(quickinfo)) do
  1488. begin
  1489. inc(i);
  1490. case quickinfo[i] of
  1491. 'S' :
  1492. begin
  1493. inc(i);
  1494. case quickinfo[i] of
  1495. 'O' :
  1496. addinfo(lower(source_info.shortname));
  1497. 'P' :
  1498. addinfo(source_cpu_string);
  1499. else
  1500. IllegalPara('-i'+QuickInfo);
  1501. end;
  1502. end;
  1503. 'T' :
  1504. begin
  1505. inc(i);
  1506. case quickinfo[i] of
  1507. 'O' :
  1508. addinfo(lower(target_info.shortname));
  1509. 'P' :
  1510. AddInfo(target_cpu_string);
  1511. else
  1512. IllegalPara('-i'+QuickInfo);
  1513. end;
  1514. end;
  1515. 'V' :
  1516. AddInfo(version_string);
  1517. 'D' :
  1518. AddInfo(date_string);
  1519. '_' :
  1520. ;
  1521. else
  1522. IllegalPara('-i'+QuickInfo);
  1523. end;
  1524. end;
  1525. if s<>'' then
  1526. begin
  1527. writeln(s);
  1528. stopoptions(0);
  1529. end;
  1530. end;
  1531. procedure TOption.TargetDefines(def:boolean);
  1532. var
  1533. s : string;
  1534. i : integer;
  1535. begin
  1536. if def then
  1537. def_system_macro(target_info.shortname)
  1538. else
  1539. undef_system_macro(target_info.shortname);
  1540. s:=target_info.extradefines;
  1541. while (s<>'') do
  1542. begin
  1543. i:=pos(';',s);
  1544. if i=0 then
  1545. i:=length(s)+1;
  1546. if def then
  1547. def_system_macro(Copy(s,1,i-1))
  1548. else
  1549. undef_system_macro(Copy(s,1,i-1));
  1550. delete(s,1,i);
  1551. end;
  1552. end;
  1553. constructor TOption.create;
  1554. begin
  1555. LogoWritten:=false;
  1556. NoPressEnter:=false;
  1557. FirstPass:=false;
  1558. FileLevel:=0;
  1559. Quickinfo:='';
  1560. ParaIncludePath:=TSearchPathList.Create;
  1561. ParaObjectPath:=TSearchPathList.Create;
  1562. ParaUnitPath:=TSearchPathList.Create;
  1563. ParaLibraryPath:=TSearchPathList.Create;
  1564. FillChar(ParaAlignment,sizeof(ParaAlignment),0);
  1565. end;
  1566. destructor TOption.destroy;
  1567. begin
  1568. ParaIncludePath.Free;
  1569. ParaObjectPath.Free;
  1570. ParaUnitPath.Free;
  1571. ParaLibraryPath.Free;
  1572. end;
  1573. {****************************************************************************
  1574. Callable Routines
  1575. ****************************************************************************}
  1576. function check_configfile(const fn:string;var foundfn:string):boolean;
  1577. function CfgFileExists(const fn:string):boolean;
  1578. begin
  1579. Comment(V_Tried,'Configfile search: '+fn);
  1580. CfgFileExists:=FileExists(fn);
  1581. end;
  1582. var
  1583. configpath : pathstr;
  1584. begin
  1585. foundfn:=fn;
  1586. check_configfile:=true;
  1587. { retrieve configpath }
  1588. {$IFDEF USE_SYSUTILS}
  1589. configpath:=FixPath(GetEnvironmentVariable('PPC_CONFIG_PATH'),false);
  1590. {$ELSE USE_SYSUTILS}
  1591. configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false);
  1592. {$ENDIF USE_SYSUTILS}
  1593. {$ifdef Unix}
  1594. if configpath='' then
  1595. configpath:=CleanPath(FixPath(exepath+'../etc/',false));
  1596. {$endif}
  1597. {
  1598. Order to read configuration file :
  1599. try reading fpc.cfg in :
  1600. 1 - current dir
  1601. 2 - configpath
  1602. 3 - compiler path
  1603. }
  1604. if not FileExists(fn) then
  1605. begin
  1606. {$ifdef Unix}
  1607. {$IFDEF USE_SYSUTILS}
  1608. if (GetEnvironmentVariable('HOME')<>'') and CfgFileExists(FixPath(GetEnvironmentVariable('HOME'),false)+'.'+fn) then
  1609. foundfn:=FixPath(GetEnvironmentVariable('HOME'),false)+'.'+fn
  1610. {$ELSE USE_SYSUTILS}
  1611. if (dos.getenv('HOME')<>'') and CfgFileExists(FixPath(dos.getenv('HOME'),false)+'.'+fn) then
  1612. foundfn:=FixPath(dos.getenv('HOME'),false)+'.'+fn
  1613. {$ENDIF USE_SYSUTILS}
  1614. else
  1615. {$endif}
  1616. if CfgFileExists(configpath+fn) then
  1617. foundfn:=configpath+fn
  1618. else
  1619. {$ifndef Unix}
  1620. if CfgFileExists(exepath+fn) then
  1621. foundfn:=exepath+fn
  1622. else
  1623. {$else}
  1624. if CfgFileExists('/etc/'+fn) then
  1625. foundfn:='/etc/'+fn
  1626. else
  1627. {$endif}
  1628. check_configfile:=false;
  1629. end;
  1630. end;
  1631. procedure read_arguments(cmd:string);
  1632. begin
  1633. option:=coption.create;
  1634. disable_configfile:=false;
  1635. { get default messagefile }
  1636. {$IFDEF USE_SYSUTILS}
  1637. msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE');
  1638. {$ELSE USE_SYSUTILS}
  1639. msgfilename:=dos.getenv('PPC_ERROR_FILE');
  1640. {$ENDIF USE_SYSUTILS}
  1641. { default configfile can be specified on the commandline,
  1642. remove it first }
  1643. if (cmd<>'') and (cmd[1]='[') then
  1644. begin
  1645. ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
  1646. Delete(cmd,1,pos(']',cmd));
  1647. end
  1648. else
  1649. begin
  1650. ppccfg:='fpc.cfg';
  1651. ppcaltcfg:='ppc386.cfg';
  1652. end;
  1653. { first pass reading of parameters, only -i -v -T etc.}
  1654. option.firstpass:=true;
  1655. if cmd<>'' then
  1656. option.parsecmd(cmd)
  1657. else
  1658. begin
  1659. option.read_parameters;
  1660. { Write only quickinfo }
  1661. if option.quickinfo<>'' then
  1662. option.writequickinfo;
  1663. end;
  1664. option.firstpass:=false;
  1665. { default defines }
  1666. def_system_macro(target_info.shortname);
  1667. def_system_macro('FPC');
  1668. def_system_macro('VER'+version_nr);
  1669. def_system_macro('VER'+version_nr+'_'+release_nr);
  1670. def_system_macro('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
  1671. { Temporary defines, until things settle down }
  1672. def_system_macro('COMPPROCINLINEFIXED');
  1673. if pocall_default = pocall_register then
  1674. def_system_macro('REGCALL');
  1675. { using a case is pretty useless here (FK) }
  1676. { some stuff for TP compatibility }
  1677. {$ifdef i386}
  1678. def_system_macro('CPU86');
  1679. def_system_macro('CPU87');
  1680. {$endif}
  1681. {$ifdef m68k}
  1682. def_system_macro('CPU68');
  1683. {$endif}
  1684. { new processor stuff }
  1685. {$ifdef i386}
  1686. def_system_macro('CPUI386');
  1687. def_system_macro('CPU32');
  1688. def_system_macro('FPC_HAS_TYPE_EXTENDED');
  1689. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1690. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1691. def_system_macro('FPC_HAS_RESOURCES');
  1692. {$endif}
  1693. {$ifdef m68k}
  1694. def_system_macro('CPU68K');
  1695. def_system_macro('CPUM68K');
  1696. def_system_macro('CPU32');
  1697. def_system_macro('FPC_CURRENCY_IS_INT64');
  1698. def_system_macro('FPC_COMP_IS_INT64');
  1699. {$endif}
  1700. {$ifdef ALPHA}
  1701. def_system_macro('CPUALPHA');
  1702. def_system_macro('CPU64');
  1703. {$endif}
  1704. {$ifdef powerpc}
  1705. def_system_macro('CPUPOWERPC');
  1706. def_system_macro('CPUPOWERPC32');
  1707. def_system_macro('CPU32');
  1708. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1709. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1710. def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1711. def_system_macro('FPC_CURRENCY_IS_INT64');
  1712. def_system_macro('FPC_COMP_IS_INT64');
  1713. {$endif}
  1714. {$ifdef iA64}
  1715. def_system_macro('CPUIA64');
  1716. def_system_macro('CPU64');
  1717. {$endif}
  1718. {$ifdef x86_64}
  1719. def_system_macro('CPUX86_64');
  1720. def_system_macro('CPUAMD64');
  1721. def_system_macro('CPU64');
  1722. { not supported for now, afaik (FK)
  1723. def_system_macro('FPC_HAS_TYPE_FLOAT128'); }
  1724. def_system_macro('FPC_HAS_TYPE_EXTENDED');
  1725. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1726. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1727. {$endif}
  1728. {$ifdef sparc}
  1729. def_system_macro('CPUSPARC');
  1730. def_system_macro('CPUSPARC32');
  1731. def_system_macro('CPU32');
  1732. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1733. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1734. def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1735. def_system_macro('FPC_CURRENCY_IS_INT64');
  1736. def_system_macro('FPC_COMP_IS_INT64');
  1737. def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
  1738. {$endif}
  1739. {$ifdef vis}
  1740. def_system_macro('CPUVIS');
  1741. def_system_macro('CPU32');
  1742. {$endif}
  1743. {$ifdef arm}
  1744. def_system_macro('CPUARM');
  1745. def_system_macro('FPUFPA');
  1746. def_system_macro('CPU32');
  1747. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1748. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1749. def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1750. def_system_macro('FPC_CURRENCY_IS_INT64');
  1751. def_system_macro('FPC_COMP_IS_INT64');
  1752. def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
  1753. {$endif arm}
  1754. if source_info.system<>target_info.system then
  1755. def_system_macro('FPC_CROSSCOMPILING');
  1756. if source_info.cpu<>target_info.cpu then
  1757. def_system_macro('FPC_CPUCROSSCOMPILING');
  1758. { read configuration file }
  1759. if (not disable_configfile) and
  1760. (ppccfg<>'') then
  1761. begin
  1762. read_configfile:=check_configfile(ppccfg,ppccfg);
  1763. { Maybe alternative configfile ? }
  1764. if (not read_configfile) and
  1765. (ppcaltcfg<>'') then
  1766. read_configfile:=check_configfile(ppcaltcfg,ppccfg);
  1767. end
  1768. else
  1769. read_configfile := false;
  1770. { Read commandline and configfile }
  1771. target_is_set:=false;
  1772. asm_is_set:=false;
  1773. param_file:='';
  1774. { read configfile }
  1775. if read_configfile then
  1776. option.interpret_file(ppccfg);
  1777. { read parameters again to override config file }
  1778. if cmd<>'' then
  1779. option.parsecmd(cmd)
  1780. else
  1781. begin
  1782. { Write help pages if no parameters are passed }
  1783. if (paramcount=0) then
  1784. Option.WriteHelpPages;
  1785. option.read_parameters;
  1786. { Write only quickinfo }
  1787. if option.quickinfo<>'' then
  1788. option.writequickinfo;
  1789. end;
  1790. { Stop if errors in options }
  1791. if ErrorCount>0 then
  1792. StopOptions(1);
  1793. { Write logo }
  1794. if option.ParaLogo then
  1795. option.writelogo;
  1796. { Non-core target defines }
  1797. Option.TargetDefines(true);
  1798. { endian define }
  1799. case target_info.endian of
  1800. endian_little :
  1801. begin
  1802. def_system_macro('ENDIAN_LITTLE');
  1803. def_system_macro('FPC_LITTLE_ENDIAN');
  1804. end;
  1805. endian_big :
  1806. begin
  1807. def_system_macro('ENDIAN_BIG');
  1808. def_system_macro('FPC_BIG_ENDIAN');
  1809. end;
  1810. end;
  1811. { abi define }
  1812. case target_info.abi of
  1813. abi_powerpc_sysv :
  1814. def_system_macro('FPC_ABI_SYSV');
  1815. abi_powerpc_aix :
  1816. def_system_macro('FPC_ABI_AIX');
  1817. end;
  1818. {$ifdef m68k}
  1819. if initoptprocessor=MC68020 then
  1820. def_system_macro('CPUM68020');
  1821. {$endif m68k}
  1822. { Check file to compile }
  1823. if param_file='' then
  1824. begin
  1825. Message(option_no_source_found);
  1826. StopOptions(1);
  1827. end;
  1828. {$ifndef Unix}
  1829. param_file:=FixFileName(param_file);
  1830. {$endif}
  1831. {$IFDEF USE_SYSUTILS}
  1832. inputdir := SplitPath(param_file);
  1833. inputfile := SplitName(param_file);
  1834. inputextension := SplitExtension(param_file);
  1835. {$ELSE USE_SYSUTILS}
  1836. fsplit(param_file,inputdir,inputfile,inputextension);
  1837. {$ENDIF USE_SYSUTILS}
  1838. if inputextension='' then
  1839. begin
  1840. if FileExists(inputdir+inputfile+sourceext) then
  1841. inputextension:=sourceext
  1842. else if FileExists(inputdir+inputfile+pasext) then
  1843. inputextension:=pasext
  1844. else if ((m_mac in aktmodeswitches) or target_info.p_ext_support)
  1845. and FileExists(inputdir+inputfile+pext) then
  1846. inputextension:=pext;
  1847. end;
  1848. { Check output dir }
  1849. if (OutputExeDir<>'') and
  1850. not PathExists(OutputExeDir) then
  1851. begin
  1852. Message1(general_e_path_does_not_exist,OutputExeDir);
  1853. StopOptions(1);
  1854. end;
  1855. { Add paths specified with parameters to the searchpaths }
  1856. UnitSearchPath.AddList(option.ParaUnitPath,true);
  1857. ObjectSearchPath.AddList(option.ParaObjectPath,true);
  1858. IncludeSearchPath.AddList(option.ParaIncludePath,true);
  1859. LibrarySearchPath.AddList(option.ParaLibraryPath,true);
  1860. { add unit environment and exepath to the unit search path }
  1861. if inputdir<>'' then
  1862. Unitsearchpath.AddPath(inputdir,true);
  1863. if not disable_configfile then
  1864. begin
  1865. {$IFDEF USE_SYSUTILS}
  1866. UnitSearchPath.AddPath(GetEnvironmentVariable(target_info.unit_env),false);
  1867. {$ELSE USE_SYSUTILS}
  1868. UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false);
  1869. {$ENDIF USE_SYSUTILS}
  1870. end;
  1871. {$ifdef Unix}
  1872. {$IFDEF USE_SYSUTILS}
  1873. fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false);
  1874. {$ELSE USE_SYSUTILS}
  1875. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1876. {$ENDIF USE_SYSUTILS}
  1877. if fpcdir='' then
  1878. begin
  1879. if PathExists('/usr/local/lib/fpc/'+version_string) then
  1880. fpcdir:='/usr/local/lib/fpc/'+version_string+'/'
  1881. else
  1882. fpcdir:='/usr/lib/fpc/'+version_string+'/';
  1883. end;
  1884. {$else}
  1885. {$IFDEF USE_SYSUTILS}
  1886. fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false);
  1887. {$ELSE USE_SYSUTILS}
  1888. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1889. {$ENDIF USE_SYSUTILS}
  1890. if fpcdir='' then
  1891. begin
  1892. fpcdir:=ExePath+'../';
  1893. if not(PathExists(fpcdir+'/units')) and
  1894. not(PathExists(fpcdir+'/rtl')) then
  1895. fpcdir:=fpcdir+'../';
  1896. end;
  1897. {$endif}
  1898. { first try development RTL, else use the default installation path }
  1899. if not disable_configfile then
  1900. begin
  1901. if PathExists(FpcDir+'rtl') then
  1902. if tf_use_8_3 in Source_Info.Flags then
  1903. UnitSearchPath.AddPath(FpcDir+'rtl/'+target_os_string,false)
  1904. else
  1905. UnitSearchPath.AddPath(FpcDir+'rtl/'+target_full_string,false)
  1906. else
  1907. if tf_use_8_3 in Source_Info.Flags then
  1908. UnitSearchPath.AddPath(FpcDir+'units/'+target_os_string+'/rtl',false)
  1909. else
  1910. UnitSearchPath.AddPath(FpcDir+'units/'+target_full_string+'/rtl',false);
  1911. end;
  1912. { Add exepath if the exe is not in the current dir, because that is always searched already.
  1913. Do not add it when linking on the target because then we can maybe already find
  1914. .o files that are not for the target }
  1915. if (ExePath<>GetCurrentDir) and
  1916. not(cs_link_on_target in initglobalswitches) then
  1917. UnitSearchPath.AddPath(ExePath,false);
  1918. { Add unit dir to the object and library path }
  1919. objectsearchpath.AddList(unitsearchpath,false);
  1920. librarysearchpath.AddList(unitsearchpath,false);
  1921. { switch assembler if it's binary and we got -a on the cmdline }
  1922. if (cs_asm_leave in initglobalswitches) and
  1923. (af_outputbinary in target_asm.flags) then
  1924. begin
  1925. Message(option_switch_bin_to_src_assembler);
  1926. set_target_asm(target_info.assemextern);
  1927. end;
  1928. if (target_asm.supported_target <> system_any) and
  1929. (target_asm.supported_target <> target_info.system) then
  1930. begin
  1931. Message2(option_incompatible_asm,target_asm.idtxt,target_info.name);
  1932. set_target_asm(target_info.assemextern);
  1933. Message1(option_asm_forced,target_asm.idtxt);
  1934. end;
  1935. { turn off stripping if compiling with debuginfo or profile }
  1936. if (cs_debuginfo in initmoduleswitches) or
  1937. (cs_profile in initmoduleswitches) then
  1938. exclude(initglobalswitches,cs_link_strip);
  1939. {$ifdef x86_64}
  1940. {$warning HACK: turn off smartlinking}
  1941. exclude(initmoduleswitches,cs_create_smart);
  1942. {$endif}
  1943. if not LinkTypeSetExplicitly then
  1944. set_default_link_type;
  1945. { Default alignment settings,
  1946. 1. load the defaults for the target
  1947. 2. override with generic optimizer setting (little size)
  1948. 3. override with the user specified -Oa }
  1949. UpdateAlignment(initalignment,target_info.alignment);
  1950. if (cs_littlesize in aktglobalswitches) then
  1951. begin
  1952. initalignment.procalign:=1;
  1953. initalignment.jumpalign:=1;
  1954. initalignment.loopalign:=1;
  1955. end;
  1956. UpdateAlignment(initalignment,option.paraalignment);
  1957. set_system_macro('FPC_VERSION',version_nr);
  1958. set_system_macro('FPC_RELEASE',release_nr);
  1959. set_system_macro('FPC_PATCH',patch_nr);
  1960. option.free;
  1961. Option:=nil;
  1962. end;
  1963. initialization
  1964. coption:=toption;
  1965. finalization
  1966. if assigned(option) then
  1967. option.free;
  1968. end.