options.pas 62 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113
  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,scanner
  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. begin
  828. {$IFDEF USE_SYSUTILS}
  829. OutputExeDir:=SplitPath(More);
  830. OutputFile:=SplitFileName(More);
  831. OutputExtension:=SplitExtension(More);
  832. {$ELSE USE_SYSUTILS}
  833. FSplit(More,OutputExeDir,OutputFile,OutputExtension);
  834. {$ENDIF USE_SYSUTILS}
  835. end
  836. else
  837. IllegalPara(opt);
  838. end;
  839. 'p' :
  840. begin
  841. if UnsetBool(More, 0) then
  842. begin
  843. initmoduleswitches:=initmoduleswitches-[cs_profile];
  844. undef_system_macro('FPC_PROFILE');
  845. end
  846. else
  847. if Length(More)=0 then
  848. IllegalPara(opt)
  849. else
  850. case more[1] of
  851. 'g' : if UnsetBool(more, 1) then
  852. begin
  853. exclude(initmoduleswitches,cs_profile);
  854. undef_system_macro('FPC_PROFILE');
  855. end
  856. else
  857. begin
  858. include(initmoduleswitches,cs_profile);
  859. def_system_macro('FPC_PROFILE');
  860. end;
  861. else
  862. IllegalPara(opt);
  863. end;
  864. end;
  865. 'P' : ; { Ignore used by fpc.pp }
  866. 's' :
  867. begin
  868. if UnsetBool(More, 0) then
  869. begin
  870. initglobalswitches:=initglobalswitches-[cs_asm_extern,cs_link_extern];
  871. if more<>'' then
  872. IllegalPara(opt);
  873. end
  874. else
  875. begin
  876. initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern];
  877. if more='h' then
  878. initglobalswitches:=initglobalswitches-[cs_link_on_target]
  879. else if more='t' then
  880. initglobalswitches:=initglobalswitches+[cs_link_on_target]
  881. else if more='r' then
  882. initglobalswitches:=initglobalswitches+[cs_asm_leave,cs_no_regalloc]
  883. else if more<>'' then
  884. IllegalPara(opt);
  885. end;
  886. end;
  887. 'S' :
  888. begin
  889. if more[1]='I' then
  890. begin
  891. if upper(more)='ICOM' then
  892. initinterfacetype:=it_interfacecom
  893. else if upper(more)='ICORBA' then
  894. initinterfacetype:=it_interfacecorba
  895. else
  896. IllegalPara(opt);
  897. end
  898. else
  899. begin
  900. j:=1;
  901. while j<=length(more) do
  902. begin
  903. case more[j] of
  904. '2' : //an alternative to -Mobjfpc
  905. SetCompileMode('OBJFPC',true);
  906. 'a' :
  907. include(initlocalswitches,cs_do_assertion);
  908. 'c' :
  909. include(initmoduleswitches,cs_support_c_operators);
  910. 'd' : //an alternative to -Mdelphi
  911. SetCompileMode('DELPHI',true);
  912. 'e' :
  913. begin
  914. SetErrorFlags(copy(more,j+1,length(more)));
  915. break;
  916. end;
  917. 'g' :
  918. include(initmoduleswitches,cs_support_goto);
  919. 'h' :
  920. include(initlocalswitches,cs_ansistrings);
  921. 'i' :
  922. include(initmoduleswitches,cs_support_inline);
  923. 'k' :
  924. include(initglobalswitches,cs_load_fpcylix_unit);
  925. 'm' :
  926. include(initmoduleswitches,cs_support_macro);
  927. 'o' : //an alternative to -Mtp
  928. SetCompileMode('TP',true);
  929. 'p' : //an alternative to -Mgpc
  930. SetCompileMode('GPC',true);
  931. 's' :
  932. include(initglobalswitches,cs_constructor_name);
  933. 't' :
  934. include(initmoduleswitches,cs_static_keyword);
  935. '-' :
  936. begin
  937. exclude(initglobalswitches,cs_constructor_name);
  938. initlocalswitches:=InitLocalswitches - [cs_do_assertion, cs_ansistrings];
  939. initmoduleswitches:=initmoduleswitches - [cs_support_c_operators, cs_support_goto,
  940. cs_support_inline, cs_support_macro,
  941. cs_static_keyword];
  942. end;
  943. else
  944. IllegalPara(opt);
  945. end;
  946. inc(j);
  947. end;
  948. end;
  949. end;
  950. 'T' :
  951. begin
  952. more:=Upper(More);
  953. if not target_is_set then
  954. begin
  955. { remove old target define }
  956. TargetDefines(false);
  957. { Save assembler if set }
  958. if asm_is_set then
  959. forceasm:=target_asm.id;
  960. { load new target }
  961. if not(set_target_by_string(More)) then
  962. IllegalPara(opt);
  963. { also initialize assembler if not explicitly set }
  964. if asm_is_set then
  965. set_target_asm(forceasm);
  966. { set new define }
  967. TargetDefines(true);
  968. target_is_set:=true;
  969. end
  970. else
  971. if More<>upper(target_info.shortname) then
  972. Message1(option_target_is_already_set,target_info.shortname);
  973. end;
  974. 'u' :
  975. if more <> '' then
  976. undef_system_macro(more);
  977. 'U' :
  978. begin
  979. j:=1;
  980. while j<=length(more) do
  981. begin
  982. case more[j] of
  983. {$ifdef UNITALIASES}
  984. 'a' :
  985. begin
  986. AddUnitAlias(Copy(More,j+1,255));
  987. break;
  988. end;
  989. {$endif UNITALIASES}
  990. 'n' :
  991. exclude(initglobalswitches,cs_check_unit_name);
  992. 'p' :
  993. begin
  994. Message2(option_obsolete_switch_use_new,'-Up','-Fu');
  995. break;
  996. end;
  997. 'r' :
  998. do_release:=true;
  999. 's' :
  1000. include(initmoduleswitches,cs_compilesystem);
  1001. '-' :
  1002. begin
  1003. exclude(initmoduleswitches,cs_compilesystem);
  1004. exclude(initglobalswitches,cs_check_unit_name);
  1005. end;
  1006. else
  1007. IllegalPara(opt);
  1008. end;
  1009. inc(j);
  1010. end;
  1011. end;
  1012. 'v' :
  1013. begin
  1014. if not setverbosity(More) then
  1015. IllegalPara(opt);
  1016. end;
  1017. 'V' : ; { Ignore used by fpc }
  1018. 'W' :
  1019. begin
  1020. j:=1;
  1021. while j<=length(More) do
  1022. begin
  1023. case More[j] of
  1024. 'B':
  1025. begin
  1026. { -WB200000 means set trefered base address
  1027. to $200000, but does not change relocsection boolean
  1028. this way we can create both relocatble and
  1029. non relocatable DLL at a specific base address PM }
  1030. if (length(More)>j) then
  1031. begin
  1032. if DLLImageBase=nil then
  1033. DLLImageBase:=StringDup(Copy(More,j+1,255));
  1034. end
  1035. else
  1036. begin
  1037. RelocSection:=true;
  1038. RelocSectionSetExplicitly:=true;
  1039. end;
  1040. break;
  1041. end;
  1042. 'C':
  1043. begin
  1044. if UnsetBool(More, j) then
  1045. apptype:=app_gui
  1046. else
  1047. apptype:=app_cui;
  1048. end;
  1049. 'D':
  1050. begin
  1051. UseDeffileForExports:=not UnsetBool(More, j);
  1052. UseDeffileForExportsSetExplicitly:=true;
  1053. end;
  1054. 'F':
  1055. begin
  1056. if UnsetBool(More, j) then
  1057. apptype:=app_cui
  1058. else
  1059. apptype:=app_fs;
  1060. end;
  1061. 'G':
  1062. begin
  1063. if UnsetBool(More, j) then
  1064. apptype:=app_cui
  1065. else
  1066. apptype:=app_gui;
  1067. end;
  1068. 'T':
  1069. begin
  1070. if UnsetBool(More, j) then
  1071. apptype:=app_cui
  1072. else
  1073. apptype:=app_tool;
  1074. end;
  1075. 'N':
  1076. begin
  1077. RelocSection:=UnsetBool(More,j);
  1078. RelocSectionSetExplicitly:=true;
  1079. end;
  1080. 'R':
  1081. begin
  1082. { support -WR+ / -WR- as synonyms to -WR / -WN }
  1083. RelocSection:=not UnsetBool(More,j);
  1084. RelocSectionSetExplicitly:=true;
  1085. end;
  1086. else
  1087. IllegalPara(opt);
  1088. end;
  1089. inc(j);
  1090. end;
  1091. end;
  1092. 'X' :
  1093. begin
  1094. j:=1;
  1095. while j<=length(more) do
  1096. begin
  1097. case More[j] of
  1098. 'i' :
  1099. include(initglobalswitches,cs_link_internal);
  1100. 'm' :
  1101. include(initglobalswitches,cs_link_map);
  1102. 'f' :
  1103. include(initglobalswitches,cs_link_pthread);
  1104. 's' :
  1105. include(initglobalswitches,cs_link_strip);
  1106. 'c' : Cshared:=TRUE;
  1107. 't' :
  1108. include(initglobalswitches,cs_link_staticflag);
  1109. 'D' :
  1110. begin
  1111. def_system_macro('FPC_LINK_DYNAMIC');
  1112. undef_system_macro('FPC_LINK_SMART');
  1113. undef_system_macro('FPC_LINK_STATIC');
  1114. exclude(initglobalswitches,cs_link_static);
  1115. exclude(initglobalswitches,cs_link_smart);
  1116. include(initglobalswitches,cs_link_shared);
  1117. LinkTypeSetExplicitly:=true;
  1118. end;
  1119. 'd' : Dontlinkstdlibpath:=TRUE;
  1120. 'P' : Begin
  1121. utilsprefix:=Copy(more,2,length(More)-1);
  1122. DefaultReplacements(utilsprefix);
  1123. More:='';
  1124. End;
  1125. 'r' : Begin
  1126. rlinkpath:=Copy(more,2,length(More)-1);
  1127. DefaultReplacements(rlinkpath);
  1128. More:='';
  1129. end;
  1130. 'S' :
  1131. begin
  1132. def_system_macro('FPC_LINK_STATIC');
  1133. undef_system_macro('FPC_LINK_SMART');
  1134. undef_system_macro('FPC_LINK_DYNAMIC');
  1135. include(initglobalswitches,cs_link_static);
  1136. exclude(initglobalswitches,cs_link_smart);
  1137. exclude(initglobalswitches,cs_link_shared);
  1138. LinkTypeSetExplicitly:=true;
  1139. end;
  1140. 'X' :
  1141. begin
  1142. def_system_macro('FPC_LINK_SMART');
  1143. undef_system_macro('FPC_LINK_STATIC');
  1144. undef_system_macro('FPC_LINK_DYNAMIC');
  1145. exclude(initglobalswitches,cs_link_static);
  1146. include(initglobalswitches,cs_link_smart);
  1147. exclude(initglobalswitches,cs_link_shared);
  1148. LinkTypeSetExplicitly:=true;
  1149. end;
  1150. 'M' :
  1151. begin
  1152. mainaliasname:=Copy(more,2,length(More)-1);
  1153. More:='';
  1154. end;
  1155. '-' :
  1156. begin
  1157. exclude(initglobalswitches,cs_link_staticflag);
  1158. exclude(initglobalswitches,cs_link_strip);
  1159. exclude(initglobalswitches,cs_link_map);
  1160. set_default_link_type;
  1161. end;
  1162. else
  1163. IllegalPara(opt);
  1164. end;
  1165. inc(j);
  1166. end;
  1167. end;
  1168. { give processor specific options a chance }
  1169. else
  1170. interpret_proc_specific_options(opt);
  1171. end;
  1172. end;
  1173. '@' :
  1174. begin
  1175. Message(option_no_nested_response_file);
  1176. StopOptions(1);
  1177. end;
  1178. else
  1179. begin
  1180. if (length(param_file)<>0) then
  1181. Message(option_only_one_source_support);
  1182. param_file:=opt;
  1183. Message1(option_found_file,opt);
  1184. end;
  1185. end;
  1186. end;
  1187. procedure Toption.Interpret_file(const filename : string);
  1188. procedure RemoveSep(var fn:string);
  1189. var
  1190. i : longint;
  1191. begin
  1192. i:=0;
  1193. while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do
  1194. inc(i);
  1195. Delete(fn,1,i);
  1196. i:=length(fn);
  1197. while (i>0) and (fn[i] in [',',' ',#9]) do
  1198. dec(i);
  1199. fn:=copy(fn,1,i);
  1200. end;
  1201. function GetName(var fn:string):string;
  1202. var
  1203. i : longint;
  1204. begin
  1205. i:=0;
  1206. while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do
  1207. inc(i);
  1208. GetName:=Copy(fn,1,i);
  1209. Delete(fn,1,i);
  1210. end;
  1211. const
  1212. maxlevel=16;
  1213. var
  1214. f : text;
  1215. s, tmp,
  1216. opts : string;
  1217. skip : array[0..maxlevel-1] of boolean;
  1218. level : longint;
  1219. option_read : boolean;
  1220. begin
  1221. { avoid infinite loop }
  1222. Inc(FileLevel);
  1223. Option_read:=false;
  1224. If FileLevel>MaxLevel then
  1225. Message(option_too_many_cfg_files);
  1226. { open file }
  1227. Message1(option_using_file,filename);
  1228. {$ifdef USE_SYSUTILS}
  1229. assign(f,ExpandFileName(filename));
  1230. {$else USE_SYSUTILS}
  1231. assign(f,FExpand(filename));
  1232. {$endif USE_SYsUTILS}
  1233. {$I-}
  1234. reset(f);
  1235. {$I+}
  1236. if ioresult<>0 then
  1237. begin
  1238. Message1(option_unable_open_file,filename);
  1239. exit;
  1240. end;
  1241. Message1(option_start_reading_configfile,filename);
  1242. fillchar(skip,sizeof(skip),0);
  1243. level:=0;
  1244. while not eof(f) do
  1245. begin
  1246. readln(f,opts);
  1247. RemoveSep(opts);
  1248. if (opts<>'') and (opts[1]<>';') then
  1249. begin
  1250. if opts[1]='#' then
  1251. begin
  1252. Message1(option_interpreting_file_option,opts);
  1253. Delete(opts,1,1);
  1254. s:=upper(GetName(opts));
  1255. if (s='SECTION') then
  1256. begin
  1257. RemoveSep(opts);
  1258. s:=upper(GetName(opts));
  1259. if level=0 then
  1260. skip[level]:=not (assigned(search_macro(s)) or (s='COMMON'));
  1261. end
  1262. else
  1263. if (s='IFDEF') then
  1264. begin
  1265. RemoveSep(opts);
  1266. if Level>=maxlevel then
  1267. begin
  1268. Message(option_too_many_ifdef);
  1269. stopOptions(1);
  1270. end;
  1271. inc(Level);
  1272. skip[level]:=(skip[level-1] or not assigned(search_macro(upper(GetName(opts)))));
  1273. end
  1274. else
  1275. if (s='IFNDEF') then
  1276. begin
  1277. RemoveSep(opts);
  1278. if Level>=maxlevel then
  1279. begin
  1280. Message(option_too_many_ifdef);
  1281. stopOptions(1);
  1282. end;
  1283. inc(Level);
  1284. skip[level]:=(skip[level-1] or assigned(search_macro(upper(GetName(opts)))));
  1285. end
  1286. else
  1287. if (s='ELSE') then
  1288. skip[level]:=skip[level-1] or (not skip[level])
  1289. else
  1290. if (s='ENDIF') then
  1291. begin
  1292. skip[level]:=false;
  1293. if Level=0 then
  1294. begin
  1295. Message(option_too_many_endif);
  1296. stopOptions(1);
  1297. end;
  1298. dec(level);
  1299. end
  1300. else
  1301. if (not skip[level]) then
  1302. begin
  1303. if (s='DEFINE') then
  1304. begin
  1305. RemoveSep(opts);
  1306. tmp:= GetName(opts);
  1307. if tmp <> '' then
  1308. def_system_macro(tmp);
  1309. end
  1310. else
  1311. if (s='UNDEF') then
  1312. begin
  1313. RemoveSep(opts);
  1314. tmp:= GetName(opts);
  1315. if tmp <> '' then
  1316. undef_system_macro(tmp);
  1317. end
  1318. else
  1319. if (s='WRITE') then
  1320. begin
  1321. Delete(opts,1,1);
  1322. WriteLn(opts);
  1323. end
  1324. else
  1325. if (s='INCLUDE') then
  1326. begin
  1327. Delete(opts,1,1);
  1328. Interpret_file(opts);
  1329. end;
  1330. end;
  1331. end
  1332. else
  1333. begin
  1334. if (opts[1]='-') or (opts[1]='@') then
  1335. begin
  1336. if (not skip[level]) then
  1337. interpret_option(opts,false);
  1338. Option_read:=true;
  1339. end
  1340. else
  1341. Message1(option_illegal_para,opts);
  1342. end;
  1343. end;
  1344. end;
  1345. if Level>0 then
  1346. Message(option_too_less_endif);
  1347. if Not Option_read then
  1348. Message1(option_no_option_found,filename)
  1349. else
  1350. Message1(option_end_reading_configfile,filename);
  1351. Close(f);
  1352. Dec(FileLevel);
  1353. end;
  1354. procedure Toption.Interpret_envvar(const envname : string);
  1355. var
  1356. argstart,
  1357. env,
  1358. pc : pchar;
  1359. arglen : longint;
  1360. quote : set of char;
  1361. hs : string;
  1362. begin
  1363. Message1(option_using_env,envname);
  1364. env:=GetEnvPChar(envname);
  1365. pc:=env;
  1366. if assigned(pc) then
  1367. begin
  1368. repeat
  1369. { skip leading spaces }
  1370. while pc^ in [' ',#9,#13] do
  1371. inc(pc);
  1372. case pc^ of
  1373. #0 :
  1374. break;
  1375. '"' :
  1376. begin
  1377. quote:=['"'];
  1378. inc(pc);
  1379. end;
  1380. '''' :
  1381. begin
  1382. quote:=[''''];
  1383. inc(pc);
  1384. end;
  1385. else
  1386. quote:=[' ',#9,#13];
  1387. end;
  1388. { scan until the end of the argument }
  1389. argstart:=pc;
  1390. while (pc^<>#0) and not(pc^ in quote) do
  1391. inc(pc);
  1392. { create argument }
  1393. arglen:=pc-argstart;
  1394. hs[0]:=chr(arglen);
  1395. move(argstart^,hs[1],arglen);
  1396. interpret_option(hs,true);
  1397. { skip quote }
  1398. if pc^ in quote then
  1399. inc(pc);
  1400. until false;
  1401. end
  1402. else
  1403. Message1(option_no_option_found,'(env) '+envname);
  1404. FreeEnvPChar(env);
  1405. end;
  1406. procedure toption.read_parameters;
  1407. var
  1408. opts : string;
  1409. paramindex : longint;
  1410. begin
  1411. paramindex:=0;
  1412. while paramindex<paramcount do
  1413. begin
  1414. inc(paramindex);
  1415. opts:=system.paramstr(paramindex);
  1416. case opts[1] of
  1417. '@' :
  1418. if not firstpass then
  1419. begin
  1420. Delete(opts,1,1);
  1421. Message1(option_reading_further_from,opts);
  1422. interpret_file(opts);
  1423. end;
  1424. '!' :
  1425. if not firstpass then
  1426. begin
  1427. Delete(opts,1,1);
  1428. Message1(option_reading_further_from,'(env) '+opts);
  1429. interpret_envvar(opts);
  1430. end;
  1431. else
  1432. interpret_option(opts,true);
  1433. end;
  1434. end;
  1435. end;
  1436. procedure toption.parsecmd(cmd:string);
  1437. var
  1438. i,ps : longint;
  1439. opts : string;
  1440. begin
  1441. while (cmd<>'') do
  1442. begin
  1443. while cmd[1]=' ' do
  1444. delete(cmd,1,1);
  1445. i:=pos(' ',cmd);
  1446. if i=0 then
  1447. i:=256;
  1448. opts:=Copy(cmd,1,i-1);
  1449. Delete(cmd,1,i);
  1450. case opts[1] of
  1451. '@' :
  1452. if not firstpass then
  1453. begin
  1454. Delete(opts,1,1);
  1455. Message1(option_reading_further_from,opts);
  1456. interpret_file(opts);
  1457. end;
  1458. '!' :
  1459. if not firstpass then
  1460. begin
  1461. Delete(opts,1,1);
  1462. Message1(option_reading_further_from,'(env) '+opts);
  1463. interpret_envvar(opts);
  1464. end;
  1465. '"' :
  1466. begin
  1467. Delete(opts,1,1);
  1468. ps:=pos('"',cmd);
  1469. if (i<>256) and (ps>0) then
  1470. begin
  1471. opts:=opts + ' '+ copy(cmd,1,ps-1);
  1472. cmd:=copy(cmd,ps+1,255);
  1473. end;
  1474. interpret_option(opts,true);
  1475. end;
  1476. else
  1477. interpret_option(opts,true);
  1478. end;
  1479. end;
  1480. end;
  1481. procedure toption.writequickinfo;
  1482. var
  1483. s : string;
  1484. i : longint;
  1485. procedure addinfo(const hs:string);
  1486. begin
  1487. if s<>'' then
  1488. s:=s+' '+hs
  1489. else
  1490. s:=hs;
  1491. end;
  1492. begin
  1493. s:='';
  1494. i:=0;
  1495. while (i<length(quickinfo)) do
  1496. begin
  1497. inc(i);
  1498. case quickinfo[i] of
  1499. 'S' :
  1500. begin
  1501. inc(i);
  1502. case quickinfo[i] of
  1503. 'O' :
  1504. addinfo(lower(source_info.shortname));
  1505. 'P' :
  1506. addinfo(source_cpu_string);
  1507. else
  1508. IllegalPara('-i'+QuickInfo);
  1509. end;
  1510. end;
  1511. 'T' :
  1512. begin
  1513. inc(i);
  1514. case quickinfo[i] of
  1515. 'O' :
  1516. addinfo(lower(target_info.shortname));
  1517. 'P' :
  1518. AddInfo(target_cpu_string);
  1519. else
  1520. IllegalPara('-i'+QuickInfo);
  1521. end;
  1522. end;
  1523. 'V' :
  1524. AddInfo(version_string);
  1525. 'D' :
  1526. AddInfo(date_string);
  1527. '_' :
  1528. ;
  1529. else
  1530. IllegalPara('-i'+QuickInfo);
  1531. end;
  1532. end;
  1533. if s<>'' then
  1534. begin
  1535. writeln(s);
  1536. stopoptions(0);
  1537. end;
  1538. end;
  1539. procedure TOption.TargetDefines(def:boolean);
  1540. var
  1541. s : string;
  1542. i : integer;
  1543. begin
  1544. if def then
  1545. def_system_macro(target_info.shortname)
  1546. else
  1547. undef_system_macro(target_info.shortname);
  1548. s:=target_info.extradefines;
  1549. while (s<>'') do
  1550. begin
  1551. i:=pos(';',s);
  1552. if i=0 then
  1553. i:=length(s)+1;
  1554. if def then
  1555. def_system_macro(Copy(s,1,i-1))
  1556. else
  1557. undef_system_macro(Copy(s,1,i-1));
  1558. delete(s,1,i);
  1559. end;
  1560. end;
  1561. constructor TOption.create;
  1562. begin
  1563. LogoWritten:=false;
  1564. NoPressEnter:=false;
  1565. FirstPass:=false;
  1566. FileLevel:=0;
  1567. Quickinfo:='';
  1568. ParaIncludePath:=TSearchPathList.Create;
  1569. ParaObjectPath:=TSearchPathList.Create;
  1570. ParaUnitPath:=TSearchPathList.Create;
  1571. ParaLibraryPath:=TSearchPathList.Create;
  1572. FillChar(ParaAlignment,sizeof(ParaAlignment),0);
  1573. end;
  1574. destructor TOption.destroy;
  1575. begin
  1576. ParaIncludePath.Free;
  1577. ParaObjectPath.Free;
  1578. ParaUnitPath.Free;
  1579. ParaLibraryPath.Free;
  1580. end;
  1581. {****************************************************************************
  1582. Callable Routines
  1583. ****************************************************************************}
  1584. function check_configfile(const fn:string;var foundfn:string):boolean;
  1585. function CfgFileExists(const fn:string):boolean;
  1586. begin
  1587. Comment(V_Tried,'Configfile search: '+fn);
  1588. CfgFileExists:=FileExists(fn);
  1589. end;
  1590. var
  1591. configpath : pathstr;
  1592. begin
  1593. foundfn:=fn;
  1594. check_configfile:=true;
  1595. { retrieve configpath }
  1596. {$IFDEF USE_SYSUTILS}
  1597. configpath:=FixPath(GetEnvironmentVariable('PPC_CONFIG_PATH'),false);
  1598. {$ELSE USE_SYSUTILS}
  1599. configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false);
  1600. {$ENDIF USE_SYSUTILS}
  1601. {$ifdef Unix}
  1602. if configpath='' then
  1603. configpath:=CleanPath(FixPath(exepath+'../etc/',false));
  1604. {$endif}
  1605. {
  1606. Order to read configuration file :
  1607. try reading fpc.cfg in :
  1608. 1 - current dir
  1609. 2 - configpath
  1610. 3 - compiler path
  1611. }
  1612. if not FileExists(fn) then
  1613. begin
  1614. {$ifdef Unix}
  1615. {$IFDEF USE_SYSUTILS}
  1616. if (GetEnvironmentVariable('HOME')<>'') and CfgFileExists(FixPath(GetEnvironmentVariable('HOME'),false)+'.'+fn) then
  1617. foundfn:=FixPath(GetEnvironmentVariable('HOME'),false)+'.'+fn
  1618. {$ELSE USE_SYSUTILS}
  1619. if (dos.getenv('HOME')<>'') and CfgFileExists(FixPath(dos.getenv('HOME'),false)+'.'+fn) then
  1620. foundfn:=FixPath(dos.getenv('HOME'),false)+'.'+fn
  1621. {$ENDIF USE_SYSUTILS}
  1622. else
  1623. {$endif}
  1624. if CfgFileExists(configpath+fn) then
  1625. foundfn:=configpath+fn
  1626. else
  1627. {$ifndef Unix}
  1628. if CfgFileExists(exepath+fn) then
  1629. foundfn:=exepath+fn
  1630. else
  1631. {$else}
  1632. if CfgFileExists('/etc/'+fn) then
  1633. foundfn:='/etc/'+fn
  1634. else
  1635. {$endif}
  1636. check_configfile:=false;
  1637. end;
  1638. end;
  1639. procedure read_arguments(cmd:string);
  1640. begin
  1641. option:=coption.create;
  1642. disable_configfile:=false;
  1643. { get default messagefile }
  1644. {$IFDEF USE_SYSUTILS}
  1645. msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE');
  1646. {$ELSE USE_SYSUTILS}
  1647. msgfilename:=dos.getenv('PPC_ERROR_FILE');
  1648. {$ENDIF USE_SYSUTILS}
  1649. { default configfile can be specified on the commandline,
  1650. remove it first }
  1651. if (cmd<>'') and (cmd[1]='[') then
  1652. begin
  1653. ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
  1654. Delete(cmd,1,pos(']',cmd));
  1655. end
  1656. else
  1657. begin
  1658. ppccfg:='fpc.cfg';
  1659. ppcaltcfg:='ppc386.cfg';
  1660. end;
  1661. { first pass reading of parameters, only -i -v -T etc.}
  1662. option.firstpass:=true;
  1663. if cmd<>'' then
  1664. option.parsecmd(cmd)
  1665. else
  1666. begin
  1667. option.read_parameters;
  1668. { Write only quickinfo }
  1669. if option.quickinfo<>'' then
  1670. option.writequickinfo;
  1671. end;
  1672. option.firstpass:=false;
  1673. { default defines }
  1674. def_system_macro(target_info.shortname);
  1675. def_system_macro('FPC');
  1676. def_system_macro('VER'+version_nr);
  1677. def_system_macro('VER'+version_nr+'_'+release_nr);
  1678. def_system_macro('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
  1679. { Temporary defines, until things settle down }
  1680. def_system_macro('COMPPROCINLINEFIXED');
  1681. { "main" symbol is generated in the main program, and left out of the system unit }
  1682. def_system_macro('FPC_DARWIN_PASCALMAIN');
  1683. if pocall_default = pocall_register then
  1684. def_system_macro('REGCALL');
  1685. { using a case is pretty useless here (FK) }
  1686. { some stuff for TP compatibility }
  1687. {$ifdef i386}
  1688. def_system_macro('CPU86');
  1689. def_system_macro('CPU87');
  1690. {$endif}
  1691. {$ifdef m68k}
  1692. def_system_macro('CPU68');
  1693. {$endif}
  1694. { new processor stuff }
  1695. {$ifdef i386}
  1696. def_system_macro('CPUI386');
  1697. def_system_macro('CPU32');
  1698. def_system_macro('FPC_HAS_TYPE_EXTENDED');
  1699. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1700. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1701. def_system_macro('FPC_HAS_RESOURCES');
  1702. {$endif}
  1703. {$ifdef m68k}
  1704. def_system_macro('CPU68K');
  1705. def_system_macro('CPUM68K');
  1706. def_system_macro('CPU32');
  1707. def_system_macro('FPC_CURRENCY_IS_INT64');
  1708. def_system_macro('FPC_COMP_IS_INT64');
  1709. {$endif}
  1710. {$ifdef ALPHA}
  1711. def_system_macro('CPUALPHA');
  1712. def_system_macro('CPU64');
  1713. {$endif}
  1714. {$ifdef powerpc}
  1715. def_system_macro('CPUPOWERPC');
  1716. def_system_macro('CPUPOWERPC32');
  1717. def_system_macro('CPU32');
  1718. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1719. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1720. def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1721. def_system_macro('FPC_CURRENCY_IS_INT64');
  1722. def_system_macro('FPC_COMP_IS_INT64');
  1723. {$endif}
  1724. {$ifdef iA64}
  1725. def_system_macro('CPUIA64');
  1726. def_system_macro('CPU64');
  1727. {$endif}
  1728. {$ifdef x86_64}
  1729. def_system_macro('CPUX86_64');
  1730. def_system_macro('CPUAMD64');
  1731. def_system_macro('CPU64');
  1732. { not supported for now, afaik (FK)
  1733. def_system_macro('FPC_HAS_TYPE_FLOAT128'); }
  1734. def_system_macro('FPC_HAS_TYPE_EXTENDED');
  1735. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1736. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1737. {$endif}
  1738. {$ifdef sparc}
  1739. def_system_macro('CPUSPARC');
  1740. def_system_macro('CPUSPARC32');
  1741. def_system_macro('CPU32');
  1742. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1743. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1744. def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1745. def_system_macro('FPC_CURRENCY_IS_INT64');
  1746. def_system_macro('FPC_COMP_IS_INT64');
  1747. def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
  1748. {$endif}
  1749. {$ifdef vis}
  1750. def_system_macro('CPUVIS');
  1751. def_system_macro('CPU32');
  1752. {$endif}
  1753. {$ifdef arm}
  1754. def_system_macro('CPUARM');
  1755. def_system_macro('FPUFPA');
  1756. def_system_macro('CPU32');
  1757. def_system_macro('FPC_HAS_TYPE_DOUBLE');
  1758. def_system_macro('FPC_HAS_TYPE_SINGLE');
  1759. def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
  1760. def_system_macro('FPC_CURRENCY_IS_INT64');
  1761. def_system_macro('FPC_COMP_IS_INT64');
  1762. def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
  1763. {$endif arm}
  1764. if source_info.system<>target_info.system then
  1765. def_system_macro('FPC_CROSSCOMPILING');
  1766. if source_info.cpu<>target_info.cpu then
  1767. def_system_macro('FPC_CPUCROSSCOMPILING');
  1768. { read configuration file }
  1769. if (not disable_configfile) and
  1770. (ppccfg<>'') then
  1771. begin
  1772. read_configfile:=check_configfile(ppccfg,ppccfg);
  1773. { Maybe alternative configfile ? }
  1774. if (not read_configfile) and
  1775. (ppcaltcfg<>'') then
  1776. read_configfile:=check_configfile(ppcaltcfg,ppccfg);
  1777. end
  1778. else
  1779. read_configfile := false;
  1780. { Read commandline and configfile }
  1781. target_is_set:=false;
  1782. asm_is_set:=false;
  1783. param_file:='';
  1784. { read configfile }
  1785. if read_configfile then
  1786. option.interpret_file(ppccfg);
  1787. { read parameters again to override config file }
  1788. if cmd<>'' then
  1789. option.parsecmd(cmd)
  1790. else
  1791. begin
  1792. { Write help pages if no parameters are passed }
  1793. if (paramcount=0) then
  1794. Option.WriteHelpPages;
  1795. option.read_parameters;
  1796. { Write only quickinfo }
  1797. if option.quickinfo<>'' then
  1798. option.writequickinfo;
  1799. end;
  1800. { Stop if errors in options }
  1801. if ErrorCount>0 then
  1802. StopOptions(1);
  1803. { Write logo }
  1804. if option.ParaLogo then
  1805. option.writelogo;
  1806. { Non-core target defines }
  1807. Option.TargetDefines(true);
  1808. { endian define }
  1809. case target_info.endian of
  1810. endian_little :
  1811. begin
  1812. def_system_macro('ENDIAN_LITTLE');
  1813. def_system_macro('FPC_LITTLE_ENDIAN');
  1814. end;
  1815. endian_big :
  1816. begin
  1817. def_system_macro('ENDIAN_BIG');
  1818. def_system_macro('FPC_BIG_ENDIAN');
  1819. end;
  1820. end;
  1821. { abi define }
  1822. case target_info.abi of
  1823. abi_powerpc_sysv :
  1824. def_system_macro('FPC_ABI_SYSV');
  1825. abi_powerpc_aix :
  1826. def_system_macro('FPC_ABI_AIX');
  1827. end;
  1828. {$ifdef m68k}
  1829. if initoptprocessor=MC68020 then
  1830. def_system_macro('CPUM68020');
  1831. {$endif m68k}
  1832. { Check file to compile }
  1833. if param_file='' then
  1834. begin
  1835. Message(option_no_source_found);
  1836. StopOptions(1);
  1837. end;
  1838. {$ifndef Unix}
  1839. param_file:=FixFileName(param_file);
  1840. {$endif}
  1841. {$IFDEF USE_SYSUTILS}
  1842. inputdir := SplitPath(param_file);
  1843. inputfile := SplitName(param_file);
  1844. inputextension := SplitExtension(param_file);
  1845. {$ELSE USE_SYSUTILS}
  1846. fsplit(param_file,inputdir,inputfile,inputextension);
  1847. {$ENDIF USE_SYSUTILS}
  1848. if inputextension='' then
  1849. begin
  1850. if FileExists(inputdir+inputfile+sourceext) then
  1851. inputextension:=sourceext
  1852. else if FileExists(inputdir+inputfile+pasext) then
  1853. inputextension:=pasext
  1854. else if ((m_mac in aktmodeswitches) or target_info.p_ext_support)
  1855. and FileExists(inputdir+inputfile+pext) then
  1856. inputextension:=pext;
  1857. end;
  1858. { Check output dir }
  1859. if (OutputExeDir<>'') and
  1860. not PathExists(OutputExeDir) then
  1861. begin
  1862. Message1(general_e_path_does_not_exist,OutputExeDir);
  1863. StopOptions(1);
  1864. end;
  1865. { Add paths specified with parameters to the searchpaths }
  1866. UnitSearchPath.AddList(option.ParaUnitPath,true);
  1867. ObjectSearchPath.AddList(option.ParaObjectPath,true);
  1868. IncludeSearchPath.AddList(option.ParaIncludePath,true);
  1869. LibrarySearchPath.AddList(option.ParaLibraryPath,true);
  1870. { add unit environment and exepath to the unit search path }
  1871. if inputdir<>'' then
  1872. Unitsearchpath.AddPath(inputdir,true);
  1873. if not disable_configfile then
  1874. begin
  1875. {$IFDEF USE_SYSUTILS}
  1876. UnitSearchPath.AddPath(GetEnvironmentVariable(target_info.unit_env),false);
  1877. {$ELSE USE_SYSUTILS}
  1878. UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false);
  1879. {$ENDIF USE_SYSUTILS}
  1880. end;
  1881. {$ifdef Unix}
  1882. {$IFDEF USE_SYSUTILS}
  1883. fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false);
  1884. {$ELSE USE_SYSUTILS}
  1885. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1886. {$ENDIF USE_SYSUTILS}
  1887. if fpcdir='' then
  1888. begin
  1889. if PathExists('/usr/local/lib/fpc/'+version_string) then
  1890. fpcdir:='/usr/local/lib/fpc/'+version_string+'/'
  1891. else
  1892. fpcdir:='/usr/lib/fpc/'+version_string+'/';
  1893. end;
  1894. {$else}
  1895. {$IFDEF USE_SYSUTILS}
  1896. fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false);
  1897. {$ELSE USE_SYSUTILS}
  1898. fpcdir:=FixPath(getenv('FPCDIR'),false);
  1899. {$ENDIF USE_SYSUTILS}
  1900. if fpcdir='' then
  1901. begin
  1902. fpcdir:=ExePath+'../';
  1903. if not(PathExists(fpcdir+'/units')) and
  1904. not(PathExists(fpcdir+'/rtl')) then
  1905. fpcdir:=fpcdir+'../';
  1906. end;
  1907. {$endif}
  1908. { first try development RTL, else use the default installation path }
  1909. if not disable_configfile then
  1910. begin
  1911. if PathExists(FpcDir+'rtl') then
  1912. if tf_use_8_3 in Source_Info.Flags then
  1913. UnitSearchPath.AddPath(FpcDir+'rtl/'+target_os_string,false)
  1914. else
  1915. UnitSearchPath.AddPath(FpcDir+'rtl/'+target_full_string,false)
  1916. else
  1917. if tf_use_8_3 in Source_Info.Flags then
  1918. UnitSearchPath.AddPath(FpcDir+'units/'+target_os_string+'/rtl',false)
  1919. else
  1920. UnitSearchPath.AddPath(FpcDir+'units/'+target_full_string+'/rtl',false);
  1921. end;
  1922. { Add exepath if the exe is not in the current dir, because that is always searched already.
  1923. Do not add it when linking on the target because then we can maybe already find
  1924. .o files that are not for the target }
  1925. if (ExePath<>GetCurrentDir) and
  1926. not(cs_link_on_target in initglobalswitches) then
  1927. UnitSearchPath.AddPath(ExePath,false);
  1928. { Add unit dir to the object and library path }
  1929. objectsearchpath.AddList(unitsearchpath,false);
  1930. librarysearchpath.AddList(unitsearchpath,false);
  1931. { switch assembler if it's binary and we got -a on the cmdline }
  1932. if (cs_asm_leave in initglobalswitches) and
  1933. (af_outputbinary in target_asm.flags) then
  1934. begin
  1935. Message(option_switch_bin_to_src_assembler);
  1936. set_target_asm(target_info.assemextern);
  1937. end;
  1938. if (target_asm.supported_target <> system_any) and
  1939. (target_asm.supported_target <> target_info.system) then
  1940. begin
  1941. Message2(option_incompatible_asm,target_asm.idtxt,target_info.name);
  1942. set_target_asm(target_info.assemextern);
  1943. Message1(option_asm_forced,target_asm.idtxt);
  1944. end;
  1945. { turn off stripping if compiling with debuginfo or profile }
  1946. if (cs_debuginfo in initmoduleswitches) or
  1947. (cs_profile in initmoduleswitches) then
  1948. exclude(initglobalswitches,cs_link_strip);
  1949. {$ifdef x86_64}
  1950. {$warning HACK: turn off smartlinking}
  1951. exclude(initmoduleswitches,cs_create_smart);
  1952. {$endif}
  1953. if not LinkTypeSetExplicitly then
  1954. set_default_link_type;
  1955. { Default alignment settings,
  1956. 1. load the defaults for the target
  1957. 2. override with generic optimizer setting (little size)
  1958. 3. override with the user specified -Oa }
  1959. UpdateAlignment(initalignment,target_info.alignment);
  1960. if (cs_littlesize in aktglobalswitches) then
  1961. begin
  1962. initalignment.procalign:=1;
  1963. initalignment.jumpalign:=1;
  1964. initalignment.loopalign:=1;
  1965. end;
  1966. UpdateAlignment(initalignment,option.paraalignment);
  1967. set_system_macro('FPC_VERSION',version_nr);
  1968. set_system_macro('FPC_RELEASE',release_nr);
  1969. set_system_macro('FPC_PATCH',patch_nr);
  1970. option.free;
  1971. Option:=nil;
  1972. end;
  1973. initialization
  1974. coption:=toption;
  1975. finalization
  1976. if assigned(option) then
  1977. option.free;
  1978. end.