options.pas 59 KB

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