options.pas 61 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
  3. Reads command line options and config files
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit options;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype,globals,verbose,systems,cpuinfo;
  22. type
  23. TOption=class
  24. FirstPass,
  25. ParaLogo,
  26. NoPressEnter,
  27. LogoWritten : boolean;
  28. FileLevel : longint;
  29. QuickInfo : string;
  30. ParaIncludePath,
  31. ParaUnitPath,
  32. ParaObjectPath,
  33. ParaLibraryPath : TSearchPathList;
  34. ParaAlignment : TAlignmentInfo;
  35. Constructor Create;
  36. Destructor Destroy;override;
  37. procedure WriteLogo;
  38. procedure WriteInfo;
  39. procedure WriteHelpPages;
  40. procedure WriteQuickInfo;
  41. procedure IllegalPara(const opt:string);
  42. function Unsetbool(var Opts:string; Pos: Longint):boolean;
  43. procedure interpret_proc_specific_options(const opt:string);virtual;
  44. procedure interpret_option(const opt :string;ispara:boolean);
  45. procedure Interpret_envvar(const envname : string);
  46. procedure Interpret_file(const filename : string);
  47. procedure Read_Parameters;
  48. procedure parsecmd(cmd:string);
  49. procedure TargetDefines(def:boolean);
  50. end;
  51. TOptionClass=class of toption;
  52. var
  53. coption : TOptionClass;
  54. procedure read_arguments(cmd:string);
  55. implementation
  56. uses
  57. widestr,
  58. {$IFDEF USE_SYSUTILS}
  59. SysUtils,
  60. {$ELSE USE_SYSUTILS}
  61. dos,
  62. {$ENDIF USE_SYSUTILS}
  63. version,
  64. cutils,cmsgs,
  65. comphook,
  66. symtable
  67. {$ifdef BrowserLog}
  68. ,browlog
  69. {$endif BrowserLog}
  70. ;
  71. const
  72. page_size = 24;
  73. var
  74. option : toption;
  75. read_configfile, { read config file, set when a cfgfile is found }
  76. disable_configfile,
  77. target_is_set : boolean; { do not allow contradictory target settings }
  78. asm_is_set : boolean; { -T also change initoutputformat if not set idrectly }
  79. fpcdir,
  80. ppccfg,
  81. ppcaltcfg,
  82. param_file : string; { file to compile specified on the commandline }
  83. {****************************************************************************
  84. Defines
  85. ****************************************************************************}
  86. procedure set_default_link_type;
  87. begin
  88. { win32 and wdosx need smartlinking by default to prevent including too much
  89. dll dependencies }
  90. if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  91. begin
  92. def_system_macro('FPC_LINK_SMART');
  93. undef_system_macro('FPC_LINK_STATIC');
  94. undef_system_macro('FPC_LINK_DYNAMIC');
  95. initglobalswitches:=initglobalswitches+[cs_link_smart];
  96. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_static];
  97. end
  98. else
  99. begin
  100. undef_system_macro('FPC_LINK_SMART');
  101. def_system_macro('FPC_LINK_STATIC');
  102. undef_system_macro('FPC_LINK_DYNAMIC');
  103. initglobalswitches:=initglobalswitches+[cs_link_static];
  104. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_smart];
  105. end;
  106. end;
  107. {****************************************************************************
  108. Toption
  109. ****************************************************************************}
  110. procedure StopOptions(err:longint);
  111. begin
  112. if assigned(Option) then
  113. begin
  114. Option.free;
  115. Option:=nil;
  116. end;
  117. raise ECompilerAbortSilent.Create;
  118. end;
  119. procedure Toption.WriteLogo;
  120. var
  121. p : pchar;
  122. begin
  123. if not LogoWritten then
  124. begin
  125. p:=MessagePchar(option_logo);
  126. while assigned(p) do
  127. Comment(V_Normal,GetMsgLine(p));
  128. LogoWritten:= true;
  129. end;
  130. end;
  131. procedure Toption.WriteInfo;
  132. var
  133. p : pchar;
  134. hs,hs1,s : TCmdStr;
  135. target : tsystem;
  136. cpu : tprocessors;
  137. fpu : tfputype;
  138. begin
  139. p:=MessagePchar(option_info);
  140. while assigned(p) do
  141. begin
  142. s:=GetMsgLine(p);
  143. { list OS Targets }
  144. if pos('$OSTARGETS',s)>0 then
  145. begin
  146. for target:=low(tsystem) to high(tsystem) do
  147. if assigned(targetinfos[target]) then
  148. begin
  149. hs:=s;
  150. hs1:=targetinfos[target]^.name;
  151. if tf_under_development in targetinfos[target]^.flags then
  152. hs1:=hs1+' (under development)';
  153. Replace(hs,'$OSTARGETS',hs1);
  154. Comment(V_Normal,hs);
  155. end;
  156. end
  157. else if pos('$INSTRUCTIONSETS',s)>0 then
  158. begin
  159. for cpu:=low(tprocessors) to high(tprocessors) do
  160. begin
  161. hs:=s;
  162. hs1:=processorsstr[cpu];
  163. if hs1<>'' then
  164. begin
  165. Replace(hs,'$INSTRUCTIONSETS',hs1);
  166. Comment(V_Normal,hs);
  167. end;
  168. end;
  169. end
  170. else if pos('$FPUINSTRUCTIONSETS',s)>0 then
  171. begin
  172. for fpu:=low(tfputype) to high(tfputype) do
  173. begin
  174. hs:=s;
  175. hs1:=fputypestr[fpu];
  176. if hs1<>'' then
  177. begin
  178. Replace(hs,'$FPUINSTRUCTIONSETS',hs1);
  179. Comment(V_Normal,hs);
  180. end;
  181. end;
  182. end
  183. else
  184. Comment(V_Normal,s);
  185. end;
  186. StopOptions(0);
  187. end;
  188. procedure Toption.WriteHelpPages;
  189. function PadEnd(s:string;i:longint):string;
  190. begin
  191. while (length(s)<i) do
  192. s:=s+' ';
  193. PadEnd:=s;
  194. end;
  195. var
  196. lastident,
  197. j,outline,
  198. ident,
  199. lines : longint;
  200. show : boolean;
  201. opt : string[32];
  202. input,
  203. s : string;
  204. p : pchar;
  205. begin
  206. WriteLogo;
  207. Lines:=4;
  208. Message1(option_usage,FixFileName(system.paramstr(0)));
  209. lastident:=0;
  210. p:=MessagePChar(option_help_pages);
  211. while assigned(p) do
  212. begin
  213. { get a line and reset }
  214. s:=GetMsgLine(p);
  215. ident:=0;
  216. show:=false;
  217. { parse options }
  218. case s[1] of
  219. {$ifdef UNITALIASES}
  220. 'a',
  221. {$endif}
  222. {$ifdef EXTDEBUG}
  223. 'e',
  224. {$endif EXTDEBUG}
  225. {$ifdef i386}
  226. '3',
  227. {$endif}
  228. {$ifdef x86_64}
  229. '4',
  230. {$endif}
  231. {$ifdef m68k}
  232. '6',
  233. {$endif}
  234. {$ifdef arm}
  235. 'A',
  236. {$endif}
  237. {$ifdef powerpc}
  238. 'P',
  239. {$endif}
  240. {$ifdef sparc}
  241. 'S',
  242. {$endif}
  243. {$ifdef vis}
  244. 'V',
  245. {$endif}
  246. '*' : show:=true;
  247. end;
  248. if show then
  249. begin
  250. case s[2] of
  251. {$ifdef GDB}
  252. 'g',
  253. {$endif}
  254. {$ifdef Unix}
  255. 'L',
  256. {$endif}
  257. {$ifdef os2}
  258. 'O',
  259. {$endif}
  260. '*' : show:=true;
  261. else
  262. show:=false;
  263. end;
  264. end;
  265. { now we may show the message or not }
  266. if show then
  267. begin
  268. case s[3] of
  269. '0' : begin
  270. ident:=0;
  271. outline:=0;
  272. end;
  273. '1' : begin
  274. ident:=2;
  275. outline:=7;
  276. end;
  277. '2' : begin
  278. ident:=6;
  279. outline:=11;
  280. end;
  281. '3' : begin
  282. ident:=9;
  283. outline:=11;
  284. end;
  285. end;
  286. j:=pos('_',s);
  287. opt:=Copy(s,4,j-4);
  288. if opt='*' then
  289. opt:=''
  290. else
  291. if opt=' ' then
  292. opt:=PadEnd(opt,outline)
  293. else
  294. opt:=PadEnd('-'+opt,outline);
  295. if (ident=0) and (lastident<>0) then
  296. begin
  297. Comment(V_Normal,'');
  298. inc(Lines);
  299. end;
  300. { page full ? }
  301. if (lines >= page_size - 1) then
  302. begin
  303. if not NoPressEnter then
  304. begin
  305. Message(option_help_press_enter);
  306. readln(input);
  307. if upper(input)='Q' then
  308. StopOptions(0);
  309. end;
  310. lines:=0;
  311. end;
  312. Comment(V_Normal,PadEnd('',ident)+opt+Copy(s,j+1,255));
  313. LastIdent:=Ident;
  314. inc(Lines);
  315. end;
  316. end;
  317. StopOptions(0);
  318. end;
  319. procedure Toption.IllegalPara(const opt:string);
  320. begin
  321. Message1(option_illegal_para,opt);
  322. Message(option_help_pages_para);
  323. StopOptions(1);
  324. end;
  325. function Toption.Unsetbool(var Opts:string; Pos: Longint):boolean;
  326. { checks if the character after pos in Opts is a + or a - and returns resp.
  327. false or true. If it is another character (or none), it also returns false }
  328. begin
  329. UnsetBool := false;
  330. if Length(Opts)>Pos then
  331. begin
  332. inc(Pos);
  333. UnsetBool := Opts[Pos] = '-';
  334. if Opts[Pos] in ['-','+']then
  335. delete(Opts,Pos,1);
  336. end;
  337. end;
  338. procedure TOption.interpret_proc_specific_options(const opt:string);
  339. begin
  340. end;
  341. procedure TOption.interpret_option(const opt:string;ispara:boolean);
  342. var
  343. code : integer;
  344. c : char;
  345. more : string;
  346. major,minor : longint;
  347. error : integer;
  348. j,l : longint;
  349. d : DirStr;
  350. e : ExtStr;
  351. s : string;
  352. forceasm : tasm;
  353. begin
  354. if opt='' then
  355. exit;
  356. { only parse define,undef,target,verbosity,link etc options the firsttime }
  357. if firstpass and
  358. not(
  359. (opt[1]='-') and
  360. (
  361. ((length(opt)>1) and (opt[2] in ['i','d','v','T','u','n','X','l'])) or
  362. ((length(opt)>3) and (opt[2]='F') and (opt[3]='e'))
  363. )
  364. ) then
  365. exit;
  366. Message1(option_handling_option,opt);
  367. case opt[1] of
  368. '-' :
  369. begin
  370. more:=Copy(opt,3,255);
  371. if firstpass then
  372. Message1(option_interpreting_firstpass_option,opt)
  373. else
  374. Message1(option_interpreting_option,opt);
  375. case opt[2] of
  376. '?' :
  377. WriteHelpPages;
  378. 'a' :
  379. begin
  380. include(initglobalswitches,cs_asm_leave);
  381. j:=1;
  382. while j<=length(more) do
  383. begin
  384. case more[j] of
  385. 'l' :
  386. include(initglobalswitches,cs_asm_source);
  387. 'r' :
  388. include(initglobalswitches,cs_asm_regalloc);
  389. 't' :
  390. include(initglobalswitches,cs_asm_tempalloc);
  391. 'n' :
  392. include(initglobalswitches,cs_asm_nodes);
  393. 'p' :
  394. begin
  395. exclude(initglobalswitches,cs_asm_leave);
  396. if UnsetBool(More, 0) then
  397. exclude(initglobalswitches,cs_asm_pipe)
  398. else
  399. include(initglobalswitches,cs_asm_pipe);
  400. end;
  401. '-' :
  402. initglobalswitches:=initglobalswitches -
  403. [cs_asm_leave, cs_asm_source,cs_asm_regalloc, cs_asm_tempalloc,
  404. cs_asm_nodes, cs_asm_pipe];
  405. else
  406. IllegalPara(opt);
  407. end;
  408. inc(j);
  409. end;
  410. end;
  411. 'A' :
  412. begin
  413. if set_target_asm_by_string(More) then
  414. asm_is_set:=true
  415. else
  416. IllegalPara(opt);
  417. end;
  418. 'b' :
  419. begin
  420. {$ifdef supportbrowser}
  421. if UnsetBool(More,0) then
  422. begin
  423. exclude(initmoduleswitches,cs_browser);
  424. exclude(initmoduleswitches,cs_local_browser);
  425. {$ifdef BrowserLog}
  426. exclude(initglobalswitches,cs_browser_log);
  427. {$endif}
  428. end
  429. else
  430. begin
  431. include(initmoduleswitches,cs_browser);
  432. {$ifdef BrowserLog}
  433. include(initglobalswitches,cs_browser_log);
  434. {$endif}
  435. end;
  436. if More<>'' then
  437. if (More='l') or (More='l+') then
  438. include(initmoduleswitches,cs_local_browser)
  439. else
  440. if More='l-' then
  441. exclude(initmoduleswitches,cs_local_browser)
  442. else
  443. {$ifdef BrowserLog}
  444. browserlog.elements_to_list.insert(more);
  445. {$else}
  446. IllegalPara(opt);
  447. {$endif}
  448. {$endif supportbrowser}
  449. end;
  450. 'B' :
  451. do_build:=not UnSetBool(more,0);
  452. 'C' :
  453. begin
  454. j:=1;
  455. while j<=length(more) do
  456. begin
  457. case more[j] of
  458. 'a' :
  459. Message2(option_obsolete_switch_use_new,'-Ca','-Or');
  460. 'c' :
  461. begin
  462. if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),true) then
  463. IllegalPara(opt);
  464. break;
  465. end;
  466. {$ifdef cpufpemu}
  467. 'e' :
  468. begin
  469. If UnsetBool(More, j) then
  470. exclude(initmoduleswitches,cs_fp_emulation)
  471. Else
  472. include(initmoduleswitches,cs_fp_emulation);
  473. end;
  474. {$endif cpufpemu}
  475. 'f' :
  476. begin
  477. s:=upper(copy(more,j+1,length(more)-j));
  478. if not(SetFpuType(s,true)) then
  479. IllegalPara(opt);
  480. break;
  481. end;
  482. 'g' :
  483. include(initmoduleswitches,cs_create_pic);
  484. 'h' :
  485. begin
  486. val(copy(more,j+1,length(more)-j),heapsize,code);
  487. if (code<>0) or (heapsize<1024) then
  488. IllegalPara(opt);
  489. break;
  490. end;
  491. 'i' :
  492. If UnsetBool(More, j) then
  493. exclude(initlocalswitches,cs_check_io)
  494. else
  495. include(initlocalswitches,cs_check_io);
  496. 'n' :
  497. If UnsetBool(More, j) then
  498. exclude(initglobalswitches,cs_link_extern)
  499. Else
  500. include(initglobalswitches,cs_link_extern);
  501. 'o' :
  502. If UnsetBool(More, j) then
  503. exclude(initlocalswitches,cs_check_overflow)
  504. Else
  505. include(initlocalswitches,cs_check_overflow);
  506. 'p' :
  507. begin
  508. s:=upper(copy(more,j+1,length(more)-j));
  509. if not(SetProcessor(s,true)) then
  510. IllegalPara(opt);
  511. break;
  512. end;
  513. 'r' :
  514. If UnsetBool(More, j) then
  515. exclude(initlocalswitches,cs_check_range)
  516. Else
  517. include(initlocalswitches,cs_check_range);
  518. 'R' :
  519. If UnsetBool(More, j) then
  520. begin
  521. exclude(initlocalswitches,cs_check_range);
  522. exclude(initlocalswitches,cs_check_object);
  523. end
  524. Else
  525. begin
  526. include(initlocalswitches,cs_check_range);
  527. include(initlocalswitches,cs_check_object);
  528. end;
  529. 's' :
  530. begin
  531. val(copy(more,j+1,length(more)-j),stacksize,code);
  532. if (code<>0) or (stacksize>=67107840) or (stacksize<1024) then
  533. IllegalPara(opt);
  534. break;
  535. end;
  536. 't' :
  537. If UnsetBool(More, j) then
  538. exclude(initlocalswitches,cs_check_stack)
  539. Else
  540. include(initlocalswitches,cs_check_stack);
  541. 'D' :
  542. If UnsetBool(More, j) then
  543. exclude(initmoduleswitches,cs_create_dynamic)
  544. Else
  545. include(initmoduleswitches,cs_create_dynamic);
  546. 'X' :
  547. If UnsetBool(More, j) then
  548. exclude(initmoduleswitches,cs_create_smart)
  549. Else
  550. include(initmoduleswitches,cs_create_smart);
  551. else
  552. IllegalPara(opt);
  553. end;
  554. inc(j);
  555. end;
  556. end;
  557. 'd' :
  558. if more <> '' then
  559. begin
  560. l:=Pos(':=',more);
  561. if l>0 then
  562. set_system_compvar(Copy(more,1,l-1),Copy(more,l+2,255))
  563. else
  564. def_system_macro(more);
  565. end;
  566. 'D' :
  567. begin
  568. include(initglobalswitches,cs_link_deffile);
  569. j:=1;
  570. while j<=length(more) do
  571. begin
  572. case more[j] of
  573. 'd' :
  574. begin
  575. description:=Copy(more,j+1,255);
  576. break;
  577. end;
  578. 'v' :
  579. begin
  580. dllversion:=Copy(more,j+1,255);
  581. l:=pos('.',dllversion);
  582. dllminor:=0;
  583. error:=0;
  584. if l>0 then
  585. begin
  586. val(copy(dllversion,l+1,255),minor,error);
  587. if (error=0) and
  588. (minor>=0) and (minor<=$ffff) then
  589. dllminor:=minor
  590. else
  591. if error=0 then
  592. error:=1;
  593. end;
  594. if l=0 then
  595. l:=256;
  596. dllmajor:=1;
  597. if error=0 then
  598. val(copy(dllversion,1,l-1),major,error);
  599. if (error=0) and (major>=0) and (major<=$ffff) then
  600. dllmajor:=major
  601. else
  602. if error=0 then
  603. error:=1;
  604. if error<>0 then
  605. Message1(scan_w_wrong_version_ignored,dllversion);
  606. break;
  607. end;
  608. 'w' :
  609. usewindowapi:=true;
  610. '-' :
  611. begin
  612. exclude(initglobalswitches,cs_link_deffile);
  613. usewindowapi:=false;
  614. end;
  615. else
  616. IllegalPara(opt);
  617. end;
  618. inc(j);
  619. end;
  620. end;
  621. 'e' :
  622. exepath:=FixPath(More,true);
  623. 'E' :
  624. begin
  625. if UnsetBool(More, 0) then
  626. exclude(initglobalswitches,cs_link_extern)
  627. else
  628. include(initglobalswitches,cs_link_extern);
  629. end;
  630. 'F' :
  631. begin
  632. c:=more[1];
  633. Delete(more,1,1);
  634. DefaultReplacements(More);
  635. case c of
  636. 'a' :
  637. autoloadunits:=more;
  638. 'c' :
  639. begin
  640. if (upper(more)='UTF8') or (upper(more)='UTF-8') then
  641. initsourcecodepage:='utf8'
  642. else if not(cpavailable(more)) then
  643. Message1(option_code_page_not_available,more)
  644. else
  645. initsourcecodepage:=more;
  646. end;
  647. 'D' :
  648. utilsdirectory:=FixPath(More,true);
  649. 'e' :
  650. SetRedirectFile(More);
  651. 'E' :
  652. OutputExeDir:=FixPath(More,true);
  653. 'i' :
  654. begin
  655. if ispara then
  656. ParaIncludePath.AddPath(More,false)
  657. else
  658. includesearchpath.AddPath(More,true);
  659. end;
  660. 'g' :
  661. Message2(option_obsolete_switch_use_new,'-Fg','-Fl');
  662. 'l' :
  663. begin
  664. if ispara then
  665. ParaLibraryPath.AddPath(More,false)
  666. else
  667. LibrarySearchPath.AddPath(More,true);
  668. end;
  669. 'L' :
  670. begin
  671. if More<>'' then
  672. ParaDynamicLinker:=More
  673. else
  674. IllegalPara(opt);
  675. end;
  676. 'o' :
  677. begin
  678. if ispara then
  679. ParaObjectPath.AddPath(More,false)
  680. else
  681. ObjectSearchPath.AddPath(More,true);
  682. end;
  683. 'r' :
  684. Msgfilename:=More;
  685. 'u' :
  686. begin
  687. if ispara then
  688. ParaUnitPath.AddPath(More,false)
  689. else
  690. unitsearchpath.AddPath(More,true);
  691. end;
  692. 'U' :
  693. OutputUnitDir:=FixPath(More,true);
  694. else
  695. IllegalPara(opt);
  696. end;
  697. end;
  698. 'g' : begin
  699. if UnsetBool(More, 0) then
  700. begin
  701. exclude(initmoduleswitches,cs_debuginfo);
  702. exclude(initglobalswitches,cs_gdb_dbx);
  703. exclude(initglobalswitches,cs_gdb_gsym);
  704. exclude(initglobalswitches,cs_gdb_heaptrc);
  705. exclude(initglobalswitches,cs_gdb_lineinfo);
  706. exclude(initlocalswitches,cs_checkpointer);
  707. end
  708. else
  709. begin
  710. {$ifdef GDB}
  711. include(initmoduleswitches,cs_debuginfo);
  712. {$else GDB}
  713. Message(option_no_debug_support);
  714. Message(option_no_debug_support_recompile_fpc);
  715. {$endif GDB}
  716. end;
  717. {$ifdef GDB}
  718. if not RelocSectionSetExplicitly then
  719. RelocSection:=false;
  720. j:=1;
  721. while j<=length(more) do
  722. begin
  723. case more[j] of
  724. 'd' :
  725. begin
  726. if UnsetBool(More, j) then
  727. exclude(initglobalswitches,cs_gdb_dbx)
  728. else
  729. include(initglobalswitches,cs_gdb_dbx);
  730. end;
  731. 'g' :
  732. begin
  733. if UnsetBool(More, j) then
  734. exclude(initglobalswitches,cs_gdb_gsym)
  735. else
  736. include(initglobalswitches,cs_gdb_gsym);
  737. end;
  738. 'h' :
  739. begin
  740. if UnsetBool(More, j) then
  741. exclude(initglobalswitches,cs_gdb_heaptrc)
  742. else
  743. include(initglobalswitches,cs_gdb_heaptrc);
  744. end;
  745. 'l' :
  746. begin
  747. if UnsetBool(More, j) then
  748. exclude(initglobalswitches,cs_gdb_lineinfo)
  749. else
  750. include(initglobalswitches,cs_gdb_lineinfo);
  751. end;
  752. 'c' :
  753. begin
  754. if UnsetBool(More, j) then
  755. exclude(initlocalswitches,cs_checkpointer)
  756. else
  757. include(initlocalswitches,cs_checkpointer);
  758. end;
  759. 'v' :
  760. begin
  761. if UnsetBool(More, j) then
  762. exclude(initglobalswitches,cs_gdb_valgrind)
  763. else
  764. include(initglobalswitches,cs_gdb_valgrind);
  765. end;
  766. 'w' :
  767. begin
  768. if UnsetBool(More, j) then
  769. exclude(initglobalswitches,cs_gdb_dwarf)
  770. else
  771. include(initglobalswitches,cs_gdb_dwarf);
  772. end;
  773. else
  774. IllegalPara(opt);
  775. end;
  776. inc(j);
  777. end;
  778. {$endif GDB}
  779. end;
  780. 'h' :
  781. begin
  782. NoPressEnter:=true;
  783. WriteHelpPages;
  784. end;
  785. 'i' :
  786. begin
  787. if More='' then
  788. WriteInfo
  789. else
  790. QuickInfo:=QuickInfo+More;
  791. end;
  792. 'I' :
  793. begin
  794. if ispara then
  795. ParaIncludePath.AddPath(More,false)
  796. else
  797. includesearchpath.AddPath(More,false);
  798. end;
  799. 'k' :
  800. begin
  801. if more<>'' then
  802. ParaLinkOptions:=ParaLinkOptions+' '+More
  803. else
  804. IllegalPara(opt);
  805. end;
  806. 'l' :
  807. if not UnSetBool(more,0) then
  808. ParaLogo:=true;
  809. 'm' :
  810. parapreprocess:=not UnSetBool(more,0);
  811. 'M' :
  812. begin
  813. more:=Upper(more);
  814. if not SetCompileMode(more, true) then
  815. IllegalPara(opt);
  816. end;
  817. 'n' :
  818. begin
  819. if More='' then
  820. disable_configfile:=true
  821. else
  822. IllegalPara(opt);
  823. end;
  824. 'o' :
  825. begin
  826. if More<>'' then
  827. {$IFDEF USE_SYSUTILS}
  828. begin
  829. d := SplitPath(More);
  830. OutputFile := SplitFileName(More);
  831. end
  832. {$ELSE USE_SYSUTILS}
  833. Fsplit(More,d,OutputFile,e)
  834. {$ENDIF USE_SYSUTILS}
  835. else
  836. IllegalPara(opt);
  837. end;
  838. 'p' :
  839. begin
  840. if UnsetBool(More, 0) then
  841. begin
  842. initmoduleswitches:=initmoduleswitches-[cs_profile];
  843. undef_system_macro('FPC_PROFILE');
  844. end
  845. else
  846. if Length(More)=0 then
  847. IllegalPara(opt)
  848. else
  849. case more[1] of
  850. 'g' : if UnsetBool(more, 1) then
  851. begin
  852. exclude(initmoduleswitches,cs_profile);
  853. undef_system_macro('FPC_PROFILE');
  854. end
  855. else
  856. begin
  857. include(initmoduleswitches,cs_profile);
  858. def_system_macro('FPC_PROFILE');
  859. end;
  860. else
  861. IllegalPara(opt);
  862. end;
  863. end;
  864. 'P' : ; { Ignore used by fpc.pp }
  865. 's' :
  866. begin
  867. if UnsetBool(More, 0) then
  868. begin
  869. initglobalswitches:=initglobalswitches-[cs_asm_extern,cs_link_extern];
  870. if more<>'' then
  871. IllegalPara(opt);
  872. end
  873. else
  874. begin
  875. initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern];
  876. if more='h' then
  877. initglobalswitches:=initglobalswitches-[cs_link_on_target]
  878. else if more='t' then
  879. initglobalswitches:=initglobalswitches+[cs_link_on_target]
  880. else if more='r' then
  881. initglobalswitches:=initglobalswitches+[cs_asm_leave,cs_no_regalloc]
  882. else if more<>'' then
  883. IllegalPara(opt);
  884. end;
  885. end;
  886. 'S' :
  887. begin
  888. if more[1]='I' then
  889. begin
  890. if upper(more)='ICOM' then
  891. initinterfacetype:=it_interfacecom
  892. else if upper(more)='ICORBA' then
  893. initinterfacetype:=it_interfacecorba
  894. else
  895. IllegalPara(opt);
  896. end
  897. else
  898. begin
  899. j:=1;
  900. while j<=length(more) do
  901. begin
  902. case more[j] of
  903. '2' : //an alternative to -Mobjfpc
  904. SetCompileMode('OBJFPC',true);
  905. 'a' :
  906. include(initlocalswitches,cs_do_assertion);
  907. 'c' :
  908. include(initmoduleswitches,cs_support_c_operators);
  909. 'd' : //an alternative to -Mdelphi
  910. SetCompileMode('DELPHI',true);
  911. 'e' :
  912. begin
  913. SetErrorFlags(copy(more,j+1,length(more)));
  914. break;
  915. end;
  916. 'g' :
  917. include(initmoduleswitches,cs_support_goto);
  918. 'h' :
  919. include(initlocalswitches,cs_ansistrings);
  920. 'i' :
  921. include(initmoduleswitches,cs_support_inline);
  922. 'm' :
  923. include(initmoduleswitches,cs_support_macro);
  924. 'o' : //an alternative to -Mtp
  925. SetCompileMode('TP',true);
  926. 'p' : //an alternative to -Mgpc
  927. SetCompileMode('GPC',true);
  928. 's' :
  929. include(initglobalswitches,cs_constructor_name);
  930. 't' :
  931. include(initmoduleswitches,cs_static_keyword);
  932. '-' :
  933. begin
  934. exclude(initglobalswitches,cs_constructor_name);
  935. initlocalswitches:=InitLocalswitches - [cs_do_assertion, cs_ansistrings];
  936. initmoduleswitches:=initmoduleswitches - [cs_support_c_operators, cs_support_goto,
  937. cs_support_inline, cs_support_macro,
  938. cs_static_keyword];
  939. end;
  940. else
  941. IllegalPara(opt);
  942. end;
  943. inc(j);
  944. end;
  945. end;
  946. end;
  947. 'T' :
  948. begin
  949. more:=Upper(More);
  950. if not target_is_set then
  951. begin
  952. { remove old target define }
  953. TargetDefines(false);
  954. { Save assembler if set }
  955. if asm_is_set then
  956. forceasm:=target_asm.id;
  957. { load new target }
  958. if not(set_target_by_string(More)) then
  959. IllegalPara(opt);
  960. { also initialize assembler if not explicitly set }
  961. if asm_is_set then
  962. set_target_asm(forceasm);
  963. { set new define }
  964. TargetDefines(true);
  965. target_is_set:=true;
  966. end
  967. else
  968. if More<>upper(target_info.shortname) then
  969. Message1(option_target_is_already_set,target_info.shortname);
  970. end;
  971. 'u' :
  972. if more <> '' then
  973. undef_system_macro(more);
  974. 'U' :
  975. begin
  976. j:=1;
  977. while j<=length(more) do
  978. begin
  979. case more[j] of
  980. {$ifdef UNITALIASES}
  981. 'a' :
  982. begin
  983. AddUnitAlias(Copy(More,j+1,255));
  984. break;
  985. end;
  986. {$endif UNITALIASES}
  987. 'n' :
  988. exclude(initglobalswitches,cs_check_unit_name);
  989. 'p' :
  990. begin
  991. Message2(option_obsolete_switch_use_new,'-Up','-Fu');
  992. break;
  993. end;
  994. 'r' :
  995. do_release:=true;
  996. 's' :
  997. include(initmoduleswitches,cs_compilesystem);
  998. '-' :
  999. begin
  1000. exclude(initmoduleswitches,cs_compilesystem);
  1001. exclude(initglobalswitches,cs_check_unit_name);
  1002. end;
  1003. else
  1004. IllegalPara(opt);
  1005. end;
  1006. inc(j);
  1007. end;
  1008. end;
  1009. 'v' :
  1010. begin
  1011. if not setverbosity(More) then
  1012. IllegalPara(opt);
  1013. end;
  1014. 'V' : ; { Ignore used by fpc }
  1015. 'W' :
  1016. begin
  1017. j:=1;
  1018. while j<=length(More) do
  1019. begin
  1020. case More[j] of
  1021. 'B':
  1022. begin
  1023. { -WB200000 means set trefered base address
  1024. to $200000, but does not change relocsection boolean
  1025. this way we can create both relocatble and
  1026. non relocatable DLL at a specific base address PM }
  1027. if (length(More)>j) then
  1028. begin
  1029. if DLLImageBase=nil then
  1030. DLLImageBase:=StringDup(Copy(More,j+1,255));
  1031. end
  1032. else
  1033. begin
  1034. RelocSection:=true;
  1035. RelocSectionSetExplicitly:=true;
  1036. end;
  1037. break;
  1038. end;
  1039. 'C':
  1040. begin
  1041. if UnsetBool(More, j) then
  1042. apptype:=app_gui
  1043. else
  1044. apptype:=app_cui;
  1045. end;
  1046. 'D':
  1047. begin
  1048. UseDeffileForExports:=not UnsetBool(More, j);
  1049. UseDeffileForExportsSetExplicitly:=true;
  1050. end;
  1051. 'F':
  1052. begin
  1053. if UnsetBool(More, j) then
  1054. apptype:=app_cui
  1055. else
  1056. apptype:=app_fs;
  1057. end;
  1058. 'G':
  1059. begin
  1060. if UnsetBool(More, j) then
  1061. apptype:=app_cui
  1062. else
  1063. apptype:=app_gui;
  1064. end;
  1065. 'T':
  1066. begin
  1067. if UnsetBool(More, j) then
  1068. apptype:=app_cui
  1069. else
  1070. apptype:=app_tool;
  1071. end;
  1072. 'N':
  1073. begin
  1074. RelocSection:=UnsetBool(More,j);
  1075. RelocSectionSetExplicitly:=true;
  1076. end;
  1077. 'R':
  1078. begin
  1079. { support -WR+ / -WR- as synonyms to -WR / -WN }
  1080. RelocSection:=not UnsetBool(More,j);
  1081. RelocSectionSetExplicitly:=true;
  1082. end;
  1083. else
  1084. IllegalPara(opt);
  1085. end;
  1086. inc(j);
  1087. end;
  1088. end;
  1089. 'X' :
  1090. begin
  1091. j:=1;
  1092. while j<=length(more) do
  1093. begin
  1094. case More[j] of
  1095. 'i' :
  1096. include(initglobalswitches,cs_link_internal);
  1097. 'm' :
  1098. include(initglobalswitches,cs_link_map);
  1099. 'f' :
  1100. include(initglobalswitches,cs_link_pthread);
  1101. 's' :
  1102. include(initglobalswitches,cs_link_strip);
  1103. 'c' : Cshared:=TRUE;
  1104. 't' :
  1105. include(initglobalswitches,cs_link_staticflag);
  1106. 'D' :
  1107. begin
  1108. def_system_macro('FPC_LINK_DYNAMIC');
  1109. undef_system_macro('FPC_LINK_SMART');
  1110. undef_system_macro('FPC_LINK_STATIC');
  1111. exclude(initglobalswitches,cs_link_static);
  1112. exclude(initglobalswitches,cs_link_smart);
  1113. include(initglobalswitches,cs_link_shared);
  1114. LinkTypeSetExplicitly:=true;
  1115. end;
  1116. 'd' : Dontlinkstdlibpath:=TRUE;
  1117. 'P' : Begin
  1118. utilsprefix:=Copy(more,2,length(More)-1);
  1119. DefaultReplacements(utilsprefix);
  1120. More:='';
  1121. End;
  1122. 'r' : Begin
  1123. rlinkpath:=Copy(more,2,length(More)-1);
  1124. DefaultReplacements(rlinkpath);
  1125. More:='';
  1126. end;
  1127. 'S' :
  1128. begin
  1129. def_system_macro('FPC_LINK_STATIC');
  1130. undef_system_macro('FPC_LINK_SMART');
  1131. undef_system_macro('FPC_LINK_DYNAMIC');
  1132. include(initglobalswitches,cs_link_static);
  1133. exclude(initglobalswitches,cs_link_smart);
  1134. exclude(initglobalswitches,cs_link_shared);
  1135. LinkTypeSetExplicitly:=true;
  1136. end;
  1137. 'X' :
  1138. begin
  1139. def_system_macro('FPC_LINK_SMART');
  1140. undef_system_macro('FPC_LINK_STATIC');
  1141. undef_system_macro('FPC_LINK_DYNAMIC');
  1142. exclude(initglobalswitches,cs_link_static);
  1143. include(initglobalswitches,cs_link_smart);
  1144. exclude(initglobalswitches,cs_link_shared);
  1145. LinkTypeSetExplicitly:=true;
  1146. end;
  1147. 'M' :
  1148. begin
  1149. mainaliasname:=Copy(more,2,length(More)-1);
  1150. More:='';
  1151. end;
  1152. '-' :
  1153. begin
  1154. exclude(initglobalswitches,cs_link_staticflag);
  1155. exclude(initglobalswitches,cs_link_strip);
  1156. exclude(initglobalswitches,cs_link_map);
  1157. set_default_link_type;
  1158. end;
  1159. else
  1160. IllegalPara(opt);
  1161. end;
  1162. inc(j);
  1163. end;
  1164. end;
  1165. { give processor specific options a chance }
  1166. else
  1167. interpret_proc_specific_options(opt);
  1168. end;
  1169. end;
  1170. '@' :
  1171. begin
  1172. Message(option_no_nested_response_file);
  1173. StopOptions(1);
  1174. end;
  1175. else
  1176. begin
  1177. if (length(param_file)<>0) then
  1178. Message(option_only_one_source_support);
  1179. param_file:=opt;
  1180. Message1(option_found_file,opt);
  1181. end;
  1182. end;
  1183. end;
  1184. procedure Toption.Interpret_file(const filename : string);
  1185. procedure RemoveSep(var fn:string);
  1186. var
  1187. i : longint;
  1188. begin
  1189. i:=0;
  1190. while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do
  1191. inc(i);
  1192. Delete(fn,1,i);
  1193. i:=length(fn);
  1194. while (i>0) and (fn[i] in [',',' ',#9]) do
  1195. dec(i);
  1196. fn:=copy(fn,1,i);
  1197. end;
  1198. function GetName(var fn:string):string;
  1199. var
  1200. i : longint;
  1201. begin
  1202. i:=0;
  1203. while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do
  1204. inc(i);
  1205. GetName:=Copy(fn,1,i);
  1206. Delete(fn,1,i);
  1207. end;
  1208. const
  1209. maxlevel=16;
  1210. var
  1211. f : text;
  1212. s, tmp,
  1213. opts : string;
  1214. skip : array[0..maxlevel-1] of boolean;
  1215. level : longint;
  1216. option_read : boolean;
  1217. begin
  1218. { avoid infinite loop }
  1219. Inc(FileLevel);
  1220. Option_read:=false;
  1221. If FileLevel>MaxLevel then
  1222. Message(option_too_many_cfg_files);
  1223. { open file }
  1224. Message1(option_using_file,filename);
  1225. {$ifdef USE_SYSUTILS}
  1226. assign(f,ExpandFileName(filename));
  1227. {$else USE_SYSUTILS}
  1228. assign(f,FExpand(filename));
  1229. {$endif USE_SYsUTILS}
  1230. {$I-}
  1231. reset(f);
  1232. {$I+}
  1233. if ioresult<>0 then
  1234. begin
  1235. Message1(option_unable_open_file,filename);
  1236. exit;
  1237. end;
  1238. Message1(option_start_reading_configfile,filename);
  1239. fillchar(skip,sizeof(skip),0);
  1240. level:=0;
  1241. while not eof(f) do
  1242. begin
  1243. readln(f,opts);
  1244. RemoveSep(opts);
  1245. if (opts<>'') and (opts[1]<>';') then
  1246. begin
  1247. if opts[1]='#' then
  1248. begin
  1249. Message1(option_interpreting_file_option,opts);
  1250. Delete(opts,1,1);
  1251. s:=upper(GetName(opts));
  1252. if (s='SECTION') then
  1253. begin
  1254. RemoveSep(opts);
  1255. s:=upper(GetName(opts));
  1256. if level=0 then
  1257. skip[level]:=not (assigned(search_macro(s)) or (s='COMMON'));
  1258. end
  1259. else
  1260. if (s='IFDEF') then
  1261. begin
  1262. RemoveSep(opts);
  1263. if Level>=maxlevel then
  1264. begin
  1265. Message(option_too_many_ifdef);
  1266. stopOptions(1);
  1267. end;
  1268. inc(Level);
  1269. skip[level]:=(skip[level-1] or not assigned(search_macro(upper(GetName(opts)))));
  1270. end
  1271. else
  1272. if (s='IFNDEF') then
  1273. begin
  1274. RemoveSep(opts);
  1275. if Level>=maxlevel then
  1276. begin
  1277. Message(option_too_many_ifdef);
  1278. stopOptions(1);
  1279. end;
  1280. inc(Level);
  1281. skip[level]:=(skip[level-1] or assigned(search_macro(upper(GetName(opts)))));
  1282. end
  1283. else
  1284. if (s='ELSE') then
  1285. skip[level]:=skip[level-1] or (not skip[level])
  1286. else
  1287. if (s='ENDIF') then
  1288. begin
  1289. skip[level]:=false;
  1290. if Level=0 then
  1291. begin
  1292. Message(option_too_many_endif);
  1293. stopOptions(1);
  1294. end;
  1295. dec(level);
  1296. end
  1297. else
  1298. if (not skip[level]) then
  1299. begin
  1300. if (s='DEFINE') then
  1301. begin
  1302. RemoveSep(opts);
  1303. tmp:= GetName(opts);
  1304. if tmp <> '' then
  1305. def_system_macro(tmp);
  1306. end
  1307. else
  1308. if (s='UNDEF') then
  1309. begin
  1310. RemoveSep(opts);
  1311. tmp:= GetName(opts);
  1312. if tmp <> '' then
  1313. undef_system_macro(tmp);
  1314. end
  1315. else
  1316. if (s='WRITE') then
  1317. begin
  1318. Delete(opts,1,1);
  1319. WriteLn(opts);
  1320. end
  1321. else
  1322. if (s='INCLUDE') then
  1323. begin
  1324. Delete(opts,1,1);
  1325. Interpret_file(opts);
  1326. end;
  1327. end;
  1328. end
  1329. else
  1330. begin
  1331. if (opts[1]='-') or (opts[1]='@') then
  1332. begin
  1333. if (not skip[level]) then
  1334. interpret_option(opts,false);
  1335. Option_read:=true;
  1336. end
  1337. else
  1338. Message1(option_illegal_para,opts);
  1339. end;
  1340. end;
  1341. end;
  1342. if Level>0 then
  1343. Message(option_too_less_endif);
  1344. if Not Option_read then
  1345. Message1(option_no_option_found,filename)
  1346. else
  1347. Message1(option_end_reading_configfile,filename);
  1348. Close(f);
  1349. Dec(FileLevel);
  1350. end;
  1351. procedure Toption.Interpret_envvar(const envname : string);
  1352. var
  1353. argstart,
  1354. env,
  1355. pc : pchar;
  1356. arglen : longint;
  1357. quote : set of char;
  1358. hs : string;
  1359. begin
  1360. Message1(option_using_env,envname);
  1361. env:=GetEnvPChar(envname);
  1362. pc:=env;
  1363. if assigned(pc) then
  1364. begin
  1365. repeat
  1366. { skip leading spaces }
  1367. while pc^ in [' ',#9,#13] do
  1368. inc(pc);
  1369. case pc^ of
  1370. #0 :
  1371. break;
  1372. '"' :
  1373. begin
  1374. quote:=['"'];
  1375. inc(pc);
  1376. end;
  1377. '''' :
  1378. begin
  1379. quote:=[''''];
  1380. inc(pc);
  1381. end;
  1382. else
  1383. quote:=[' ',#9,#13];
  1384. end;
  1385. { scan until the end of the argument }
  1386. argstart:=pc;
  1387. while (pc^<>#0) and not(pc^ in quote) do
  1388. inc(pc);
  1389. { create argument }
  1390. arglen:=pc-argstart;
  1391. hs[0]:=chr(arglen);
  1392. move(argstart^,hs[1],arglen);
  1393. interpret_option(hs,true);
  1394. { skip quote }
  1395. if pc^ in quote then
  1396. inc(pc);
  1397. until false;
  1398. end
  1399. else
  1400. Message1(option_no_option_found,'(env) '+envname);
  1401. FreeEnvPChar(env);
  1402. end;
  1403. procedure toption.read_parameters;
  1404. var
  1405. opts : string;
  1406. paramindex : longint;
  1407. begin
  1408. paramindex:=0;
  1409. while paramindex<paramcount do
  1410. begin
  1411. inc(paramindex);
  1412. opts:=system.paramstr(paramindex);
  1413. case opts[1] of
  1414. '@' :
  1415. if not firstpass then
  1416. begin
  1417. Delete(opts,1,1);
  1418. Message1(option_reading_further_from,opts);
  1419. interpret_file(opts);
  1420. end;
  1421. '!' :
  1422. if not firstpass then
  1423. begin
  1424. Delete(opts,1,1);
  1425. Message1(option_reading_further_from,'(env) '+opts);
  1426. interpret_envvar(opts);
  1427. end;
  1428. else
  1429. interpret_option(opts,true);
  1430. end;
  1431. end;
  1432. end;
  1433. procedure toption.parsecmd(cmd:string);
  1434. var
  1435. i,ps : longint;
  1436. opts : string;
  1437. begin
  1438. while (cmd<>'') do
  1439. begin
  1440. while cmd[1]=' ' do
  1441. delete(cmd,1,1);
  1442. i:=pos(' ',cmd);
  1443. if i=0 then
  1444. i:=256;
  1445. opts:=Copy(cmd,1,i-1);
  1446. Delete(cmd,1,i);
  1447. case opts[1] of
  1448. '@' :
  1449. if not firstpass then
  1450. begin
  1451. Delete(opts,1,1);
  1452. Message1(option_reading_further_from,opts);
  1453. interpret_file(opts);
  1454. end;
  1455. '!' :
  1456. if not firstpass then
  1457. begin
  1458. Delete(opts,1,1);
  1459. Message1(option_reading_further_from,'(env) '+opts);
  1460. interpret_envvar(opts);
  1461. end;
  1462. '"' :
  1463. begin
  1464. Delete(opts,1,1);
  1465. ps:=pos('"',cmd);
  1466. if (i<>256) and (ps>0) then
  1467. begin
  1468. opts:=opts + ' '+ copy(cmd,1,ps-1);
  1469. cmd:=copy(cmd,ps+1,255);
  1470. end;
  1471. interpret_option(opts,true);
  1472. end;
  1473. else
  1474. interpret_option(opts,true);
  1475. end;
  1476. end;
  1477. end;
  1478. procedure toption.writequickinfo;
  1479. var
  1480. s : string;
  1481. i : longint;
  1482. procedure addinfo(const hs:string);
  1483. begin
  1484. if s<>'' then
  1485. s:=s+' '+hs
  1486. else
  1487. s:=hs;
  1488. end;
  1489. begin
  1490. s:='';
  1491. i:=0;
  1492. while (i<length(quickinfo)) do
  1493. begin
  1494. inc(i);
  1495. case quickinfo[i] of
  1496. 'S' :
  1497. begin
  1498. inc(i);
  1499. case quickinfo[i] of
  1500. 'O' :
  1501. addinfo(lower(source_info.shortname));
  1502. 'P' :
  1503. addinfo(source_cpu_string);
  1504. else
  1505. IllegalPara('-i'+QuickInfo);
  1506. end;
  1507. end;
  1508. 'T' :
  1509. begin
  1510. inc(i);
  1511. case quickinfo[i] of
  1512. 'O' :
  1513. addinfo(lower(target_info.shortname));
  1514. 'P' :
  1515. AddInfo(target_cpu_string);
  1516. else
  1517. IllegalPara('-i'+QuickInfo);
  1518. end;
  1519. end;
  1520. 'V' :
  1521. AddInfo(version_string);
  1522. 'D' :
  1523. AddInfo(date_string);
  1524. '_' :
  1525. ;
  1526. else
  1527. IllegalPara('-i'+QuickInfo);
  1528. end;
  1529. end;
  1530. if s<>'' then
  1531. begin
  1532. writeln(s);
  1533. stopoptions(0);
  1534. end;
  1535. end;
  1536. procedure TOption.TargetDefines(def:boolean);
  1537. var
  1538. s : string;
  1539. i : integer;
  1540. begin
  1541. if def then
  1542. def_system_macro(target_info.shortname)
  1543. else
  1544. undef_system_macro(target_info.shortname);
  1545. s:=target_info.extradefines;
  1546. while (s<>'') do
  1547. begin
  1548. i:=pos(';',s);
  1549. if i=0 then
  1550. i:=length(s)+1;
  1551. if def then
  1552. def_system_macro(Copy(s,1,i-1))
  1553. else
  1554. undef_system_macro(Copy(s,1,i-1));
  1555. delete(s,1,i);
  1556. end;
  1557. end;
  1558. constructor TOption.create;
  1559. begin
  1560. LogoWritten:=false;
  1561. NoPressEnter:=false;
  1562. FirstPass:=false;
  1563. FileLevel:=0;
  1564. Quickinfo:='';
  1565. ParaIncludePath:=TSearchPathList.Create;
  1566. ParaObjectPath:=TSearchPathList.Create;
  1567. ParaUnitPath:=TSearchPathList.Create;
  1568. ParaLibraryPath:=TSearchPathList.Create;
  1569. FillChar(ParaAlignment,sizeof(ParaAlignment),0);
  1570. end;
  1571. destructor TOption.destroy;
  1572. begin
  1573. ParaIncludePath.Free;
  1574. ParaObjectPath.Free;
  1575. ParaUnitPath.Free;
  1576. ParaLibraryPath.Free;
  1577. end;
  1578. {****************************************************************************
  1579. Callable Routines
  1580. ****************************************************************************}
  1581. function check_configfile(const fn:string;var foundfn:string):boolean;
  1582. function CfgFileExists(const fn:string):boolean;
  1583. begin
  1584. Comment(V_Tried,'Configfile search: '+fn);
  1585. CfgFileExists:=FileExists(fn);
  1586. end;
  1587. var
  1588. configpath : pathstr;
  1589. begin
  1590. foundfn:=fn;
  1591. check_configfile:=true;
  1592. { retrieve configpath }
  1593. {$IFDEF USE_SYSUTILS}
  1594. configpath:=FixPath(GetEnvironmentVariable('PPC_CONFIG_PATH'),false);
  1595. {$ELSE USE_SYSUTILS}
  1596. configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false);
  1597. {$ENDIF USE_SYSUTILS}
  1598. {$ifdef Unix}
  1599. if configpath='' then
  1600. configpath:=CleanPath(FixPath(exepath+'../etc/',false));
  1601. {$endif}
  1602. {
  1603. Order to read configuration file :
  1604. try reading fpc.cfg in :
  1605. 1 - current dir
  1606. 2 - configpath
  1607. 3 - compiler path
  1608. }
  1609. if not FileExists(fn) then
  1610. begin
  1611. {$ifdef Unix}
  1612. {$IFDEF USE_SYSUTILS}
  1613. if (GetEnvironmentVariable('HOME')<>'') and CfgFileExists(FixPath(GetEnvironmentVariable('HOME'),false)+'.'+fn) then
  1614. foundfn:=FixPath(GetEnvironmentVariable('HOME'),false)+'.'+fn
  1615. {$ELSE USE_SYSUTILS}
  1616. if (dos.getenv('HOME')<>'') and CfgFileExists(FixPath(dos.getenv('HOME'),false)+'.'+fn) then
  1617. foundfn:=FixPath(dos.getenv('HOME'),false)+'.'+fn
  1618. {$ENDIF USE_SYSUTILS}
  1619. else
  1620. {$endif}
  1621. if CfgFileExists(configpath+fn) then
  1622. foundfn:=configpath+fn
  1623. else
  1624. {$ifndef Unix}
  1625. if CfgFileExists(exepath+fn) then
  1626. foundfn:=exepath+fn
  1627. else
  1628. {$else}
  1629. if CfgFileExists('/etc/'+fn) then
  1630. foundfn:='/etc/'+fn
  1631. else
  1632. {$endif}
  1633. check_configfile:=false;
  1634. end;
  1635. end;
  1636. procedure read_arguments(cmd:string);
  1637. begin
  1638. option:=coption.create;
  1639. disable_configfile:=false;
  1640. { get default messagefile }
  1641. {$IFDEF USE_SYSUTILS}
  1642. msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE');
  1643. {$ELSE USE_SYSUTILS}
  1644. msgfilename:=dos.getenv('PPC_ERROR_FILE');
  1645. {$ENDIF USE_SYSUTILS}
  1646. { default configfile can be specified on the commandline,
  1647. remove it first }
  1648. if (cmd<>'') and (cmd[1]='[') then
  1649. begin
  1650. ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
  1651. Delete(cmd,1,pos(']',cmd));
  1652. end
  1653. else
  1654. begin
  1655. ppccfg:='fpc.cfg';
  1656. ppcaltcfg:='ppc386.cfg';
  1657. end;
  1658. { first pass reading of parameters, only -i -v -T etc.}
  1659. option.firstpass:=true;
  1660. if cmd<>'' then
  1661. option.parsecmd(cmd)
  1662. else
  1663. begin
  1664. option.read_parameters;
  1665. { Write only quickinfo }
  1666. if option.quickinfo<>'' then
  1667. option.writequickinfo;
  1668. end;
  1669. option.firstpass:=false;
  1670. { default defines }
  1671. def_system_macro(target_info.shortname);
  1672. def_system_macro('FPC');
  1673. def_system_macro('VER'+version_nr);
  1674. def_system_macro('VER'+version_nr+'_'+release_nr);
  1675. def_system_macro('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
  1676. { Temporary defines, until things settle down }
  1677. def_system_macro('COMPPROCINLINEFIXED');
  1678. { "main" symbol is generated in the main program, and left out of the system unit }
  1679. def_system_macro('FPC_DARWIN_PASCALMAIN');
  1680. if pocall_default = pocall_register then
  1681. def_system_macro('REGCALL');
  1682. { using a case is pretty useless here (FK) }
  1683. { some stuff for TP compatibility }
  1684. {$ifdef i386}
  1685. def_system_macro('CPU86');
  1686. def_system_macro('CPU87');
  1687. {$endif}
  1688. {$ifdef m68k}
  1689. def_system_macro('CPU68');
  1690. {$endif}
  1691. { new processor stuff }
  1692. {$ifdef i386}
  1693. def_system_macro('CPUI386');
  1694. def_system_macro('CPU32');
  1695. def_system_macro('FPC_HAS_TYPE_EXTENDED');
  1696. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1697. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1698. def_system_macro('FPC_HAS_RESOURCES');
  1699. {$endif}
  1700. {$ifdef m68k}
  1701. def_system_macro('CPU68K');
  1702. def_system_macro('CPUM68K');
  1703. def_system_macro('CPU32');
  1704. def_system_macro('FPC_CURRENCY_IS_INT64');
  1705. def_system_macro('FPC_COMP_IS_INT64');
  1706. {$endif}
  1707. {$ifdef ALPHA}
  1708. def_system_macro('CPUALPHA');
  1709. def_system_macro('CPU64');
  1710. {$endif}
  1711. {$ifdef powerpc}
  1712. def_system_macro('CPUPOWERPC');
  1713. def_system_macro('CPUPOWERPC32');
  1714. def_system_macro('CPU32');
  1715. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1716. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1717. def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1718. def_system_macro('FPC_CURRENCY_IS_INT64');
  1719. def_system_macro('FPC_COMP_IS_INT64');
  1720. {$endif}
  1721. {$ifdef iA64}
  1722. def_system_macro('CPUIA64');
  1723. def_system_macro('CPU64');
  1724. {$endif}
  1725. {$ifdef x86_64}
  1726. def_system_macro('CPUX86_64');
  1727. def_system_macro('CPUAMD64');
  1728. def_system_macro('CPU64');
  1729. { not supported for now, afaik (FK)
  1730. def_system_macro('FPC_HAS_TYPE_FLOAT128'); }
  1731. def_system_macro('FPC_HAS_TYPE_EXTENDED');
  1732. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1733. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1734. {$endif}
  1735. {$ifdef sparc}
  1736. def_system_macro('CPUSPARC');
  1737. def_system_macro('CPUSPARC32');
  1738. def_system_macro('CPU32');
  1739. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1740. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1741. def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1742. def_system_macro('FPC_CURRENCY_IS_INT64');
  1743. def_system_macro('FPC_COMP_IS_INT64');
  1744. def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
  1745. {$endif}
  1746. {$ifdef vis}
  1747. def_system_macro('CPUVIS');
  1748. def_system_macro('CPU32');
  1749. {$endif}
  1750. {$ifdef arm}
  1751. def_system_macro('CPUARM');
  1752. def_system_macro('FPUFPA');
  1753. def_system_macro('CPU32');
  1754. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1755. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1756. def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1757. def_system_macro('FPC_CURRENCY_IS_INT64');
  1758. def_system_macro('FPC_COMP_IS_INT64');
  1759. def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
  1760. {$endif arm}
  1761. if source_info.system<>target_info.system then
  1762. def_system_macro('FPC_CROSSCOMPILING');
  1763. if source_info.cpu<>target_info.cpu then
  1764. def_system_macro('FPC_CPUCROSSCOMPILING');
  1765. { read configuration file }
  1766. if (not disable_configfile) and
  1767. (ppccfg<>'') then
  1768. begin
  1769. read_configfile:=check_configfile(ppccfg,ppccfg);
  1770. { Maybe alternative configfile ? }
  1771. if (not read_configfile) and
  1772. (ppcaltcfg<>'') then
  1773. read_configfile:=check_configfile(ppcaltcfg,ppccfg);
  1774. end
  1775. else
  1776. read_configfile := false;
  1777. { Read commandline and configfile }
  1778. target_is_set:=false;
  1779. asm_is_set:=false;
  1780. param_file:='';
  1781. { read configfile }
  1782. if read_configfile then
  1783. option.interpret_file(ppccfg);
  1784. { read parameters again to override config file }
  1785. if cmd<>'' then
  1786. option.parsecmd(cmd)
  1787. else
  1788. begin
  1789. { Write help pages if no parameters are passed }
  1790. if (paramcount=0) then
  1791. Option.WriteHelpPages;
  1792. option.read_parameters;
  1793. { Write only quickinfo }
  1794. if option.quickinfo<>'' then
  1795. option.writequickinfo;
  1796. end;
  1797. { Stop if errors in options }
  1798. if ErrorCount>0 then
  1799. StopOptions(1);
  1800. { Write logo }
  1801. if option.ParaLogo then
  1802. option.writelogo;
  1803. { Non-core target defines }
  1804. Option.TargetDefines(true);
  1805. { endian define }
  1806. case target_info.endian of
  1807. endian_little :
  1808. begin
  1809. def_system_macro('ENDIAN_LITTLE');
  1810. def_system_macro('FPC_LITTLE_ENDIAN');
  1811. end;
  1812. endian_big :
  1813. begin
  1814. def_system_macro('ENDIAN_BIG');
  1815. def_system_macro('FPC_BIG_ENDIAN');
  1816. end;
  1817. end;
  1818. { abi define }
  1819. case target_info.abi of
  1820. abi_powerpc_sysv :
  1821. def_system_macro('FPC_ABI_SYSV');
  1822. abi_powerpc_aix :
  1823. def_system_macro('FPC_ABI_AIX');
  1824. end;
  1825. {$ifdef m68k}
  1826. if initoptprocessor=MC68020 then
  1827. def_system_macro('CPUM68020');
  1828. {$endif m68k}
  1829. { Check file to compile }
  1830. if param_file='' then
  1831. begin
  1832. Message(option_no_source_found);
  1833. StopOptions(1);
  1834. end;
  1835. {$ifndef Unix}
  1836. param_file:=FixFileName(param_file);
  1837. {$endif}
  1838. {$IFDEF USE_SYSUTILS}
  1839. inputdir := SplitPath(param_file);
  1840. inputfile := SplitName(param_file);
  1841. inputextension := SplitExtension(param_file);
  1842. {$ELSE USE_SYSUTILS}
  1843. fsplit(param_file,inputdir,inputfile,inputextension);
  1844. {$ENDIF USE_SYSUTILS}
  1845. if inputextension='' then
  1846. begin
  1847. if FileExists(inputdir+inputfile+sourceext) then
  1848. inputextension:=sourceext
  1849. else if FileExists(inputdir+inputfile+pasext) then
  1850. inputextension:=pasext
  1851. else if ((m_mac in aktmodeswitches) or target_info.p_ext_support)
  1852. and FileExists(inputdir+inputfile+pext) then
  1853. inputextension:=pext;
  1854. end;
  1855. { Check output dir }
  1856. if (OutputExeDir<>'') and
  1857. not PathExists(OutputExeDir) then
  1858. begin
  1859. Message1(general_e_path_does_not_exist,OutputExeDir);
  1860. StopOptions(1);
  1861. end;
  1862. { Add paths specified with parameters to the searchpaths }
  1863. UnitSearchPath.AddList(option.ParaUnitPath,true);
  1864. ObjectSearchPath.AddList(option.ParaObjectPath,true);
  1865. IncludeSearchPath.AddList(option.ParaIncludePath,true);
  1866. LibrarySearchPath.AddList(option.ParaLibraryPath,true);
  1867. { add unit environment and exepath to the unit search path }
  1868. if inputdir<>'' then
  1869. Unitsearchpath.AddPath(inputdir,true);
  1870. if not disable_configfile then
  1871. begin
  1872. {$IFDEF USE_SYSUTILS}
  1873. UnitSearchPath.AddPath(GetEnvironmentVariable(target_info.unit_env),false);
  1874. {$ELSE USE_SYSUTILS}
  1875. UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false);
  1876. {$ENDIF USE_SYSUTILS}
  1877. end;
  1878. {$ifdef Unix}
  1879. {$IFDEF USE_SYSUTILS}
  1880. fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false);
  1881. {$ELSE USE_SYSUTILS}
  1882. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1883. {$ENDIF USE_SYSUTILS}
  1884. if fpcdir='' then
  1885. begin
  1886. if PathExists('/usr/local/lib/fpc/'+version_string) then
  1887. fpcdir:='/usr/local/lib/fpc/'+version_string+'/'
  1888. else
  1889. fpcdir:='/usr/lib/fpc/'+version_string+'/';
  1890. end;
  1891. {$else}
  1892. {$IFDEF USE_SYSUTILS}
  1893. fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false);
  1894. {$ELSE USE_SYSUTILS}
  1895. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1896. {$ENDIF USE_SYSUTILS}
  1897. if fpcdir='' then
  1898. begin
  1899. fpcdir:=ExePath+'../';
  1900. if not(PathExists(fpcdir+'/units')) and
  1901. not(PathExists(fpcdir+'/rtl')) then
  1902. fpcdir:=fpcdir+'../';
  1903. end;
  1904. {$endif}
  1905. { first try development RTL, else use the default installation path }
  1906. if not disable_configfile then
  1907. begin
  1908. if PathExists(FpcDir+'rtl') then
  1909. if tf_use_8_3 in Source_Info.Flags then
  1910. UnitSearchPath.AddPath(FpcDir+'rtl/'+target_os_string,false)
  1911. else
  1912. UnitSearchPath.AddPath(FpcDir+'rtl/'+target_full_string,false)
  1913. else
  1914. if tf_use_8_3 in Source_Info.Flags then
  1915. UnitSearchPath.AddPath(FpcDir+'units/'+target_os_string+'/rtl',false)
  1916. else
  1917. UnitSearchPath.AddPath(FpcDir+'units/'+target_full_string+'/rtl',false);
  1918. end;
  1919. { Add exepath if the exe is not in the current dir, because that is always searched already.
  1920. Do not add it when linking on the target because then we can maybe already find
  1921. .o files that are not for the target }
  1922. if (ExePath<>GetCurrentDir) and
  1923. not(cs_link_on_target in initglobalswitches) then
  1924. UnitSearchPath.AddPath(ExePath,false);
  1925. { Add unit dir to the object and library path }
  1926. objectsearchpath.AddList(unitsearchpath,false);
  1927. librarysearchpath.AddList(unitsearchpath,false);
  1928. { switch assembler if it's binary and we got -a on the cmdline }
  1929. if (cs_asm_leave in initglobalswitches) and
  1930. (af_outputbinary in target_asm.flags) then
  1931. begin
  1932. Message(option_switch_bin_to_src_assembler);
  1933. set_target_asm(target_info.assemextern);
  1934. end;
  1935. if (target_asm.supported_target <> system_any) and
  1936. (target_asm.supported_target <> target_info.system) then
  1937. begin
  1938. Message2(option_incompatible_asm,target_asm.idtxt,target_info.name);
  1939. set_target_asm(target_info.assemextern);
  1940. Message1(option_asm_forced,target_asm.idtxt);
  1941. end;
  1942. { turn off stripping if compiling with debuginfo or profile }
  1943. if (cs_debuginfo in initmoduleswitches) or
  1944. (cs_profile in initmoduleswitches) then
  1945. exclude(initglobalswitches,cs_link_strip);
  1946. {$ifdef x86_64}
  1947. {$warning HACK: turn off smartlinking}
  1948. exclude(initmoduleswitches,cs_create_smart);
  1949. {$endif}
  1950. if not LinkTypeSetExplicitly then
  1951. set_default_link_type;
  1952. { Default alignment settings,
  1953. 1. load the defaults for the target
  1954. 2. override with generic optimizer setting (little size)
  1955. 3. override with the user specified -Oa }
  1956. UpdateAlignment(initalignment,target_info.alignment);
  1957. if (cs_littlesize in aktglobalswitches) then
  1958. begin
  1959. initalignment.procalign:=1;
  1960. initalignment.jumpalign:=1;
  1961. initalignment.loopalign:=1;
  1962. end;
  1963. UpdateAlignment(initalignment,option.paraalignment);
  1964. set_system_macro('FPC_VERSION',version_nr);
  1965. set_system_macro('FPC_RELEASE',release_nr);
  1966. set_system_macro('FPC_PATCH',patch_nr);
  1967. option.free;
  1968. Option:=nil;
  1969. end;
  1970. initialization
  1971. coption:=toption;
  1972. finalization
  1973. if assigned(option) then
  1974. option.free;
  1975. end.