options.pas 60 KB

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