options.pas 56 KB

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