options.pas 61 KB

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