options.pas 42 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by the FPC development team
  4. Reads command line options and config files
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit options;
  19. interface
  20. uses
  21. globtype,globals,verbose;
  22. type
  23. POption=^TOption;
  24. TOption=object
  25. FirstPass,
  26. NoPressEnter,
  27. DoWriteLogo : boolean;
  28. FileLevel : longint;
  29. ParaIncludePath,
  30. ParaUnitPath,
  31. ParaObjectPath,
  32. ParaLibraryPath : TSearchPathList;
  33. Constructor Init;
  34. Destructor Done;
  35. procedure WriteLogo;
  36. procedure WriteInfo;
  37. procedure WriteHelpPages;
  38. procedure QuickInfo(const s:string);
  39. procedure IllegalPara(const opt:string);
  40. function Unsetbool(const opts:string; pos: Longint):boolean;
  41. procedure interpret_proc_specific_options(const opt:string);virtual;
  42. procedure interpret_option(const opt :string);
  43. procedure Interpret_file(const filename : string);
  44. procedure Read_Parameters;
  45. procedure parsecmd(cmd:string);
  46. end;
  47. procedure read_arguments(cmd:string);
  48. implementation
  49. uses
  50. {$ifdef Delphi}
  51. dmisc,
  52. {$else Delphi}
  53. dos,
  54. {$endif Delphi}
  55. version,systems,
  56. cobjects,
  57. symtable,scanner,link,messages
  58. {$ifdef BrowserLog}
  59. ,browlog
  60. {$endif BrowserLog}
  61. {$ifdef i386}
  62. ,opts386
  63. {$endif}
  64. {$ifdef m68k}
  65. ,opts68k
  66. {$endif}
  67. ;
  68. const
  69. page_size = 24;
  70. var
  71. read_configfile, { read config file, set when a cfgfile is found }
  72. target_is_set : boolean; { do not allow contradictory target settings }
  73. asm_is_set : boolean; { -T also change initoutputformat if not set idrectly }
  74. ppccfg,
  75. msgfilename,
  76. param_file : string; { file to compile specified on the commandline }
  77. {****************************************************************************
  78. Defines
  79. ****************************************************************************}
  80. procedure def_symbol(const s : string);
  81. begin
  82. if s='' then
  83. exit;
  84. initdefines.concat(new(pstring_item,init(upper(s))));
  85. end;
  86. procedure undef_symbol(const s : string);
  87. var
  88. item,next : pstring_item;
  89. begin
  90. if s='' then
  91. exit;
  92. item:=pstring_item(initdefines.first);
  93. while assigned(item) do
  94. begin
  95. if (item^.str^=s) then
  96. begin
  97. next:=pstring_item(item^.next);
  98. initdefines.remove(item);
  99. dispose(item,done);
  100. item:=next;
  101. end
  102. else
  103. if item<>pstring_item(item^.next) then
  104. item:=pstring_item(item^.next)
  105. else
  106. break;
  107. end;
  108. end;
  109. function check_symbol(const s:string):boolean;
  110. var
  111. hp : pstring_item;
  112. begin
  113. hp:=pstring_item(initdefines.first);
  114. while assigned(hp) do
  115. begin
  116. if (hp^.str^=s) then
  117. begin
  118. check_symbol:=true;
  119. exit;
  120. end;
  121. hp:=pstring_item(hp^.next);
  122. end;
  123. check_symbol:=false;
  124. end;
  125. procedure MaybeLoadMessageFile;
  126. begin
  127. { Load new message file }
  128. if (msgfilename<>'') then
  129. begin
  130. if fileexists(msgfilename) then
  131. LoadMsgFile(msgfilename);
  132. msgfilename:='';
  133. end;
  134. end;
  135. {****************************************************************************
  136. Toption
  137. ****************************************************************************}
  138. procedure Toption.WriteLogo;
  139. var
  140. i : tmsgconst;
  141. begin
  142. MaybeLoadMessageFile;
  143. for i:=option_logo_start to option_logo_end do
  144. Message1(i,target_cpu_string);
  145. end;
  146. procedure Toption.WriteInfo;
  147. var
  148. i : tmsgconst;
  149. begin
  150. MaybeLoadMessageFile;
  151. for i:=option_info_start to option_info_end do
  152. Message(i);
  153. Stop;
  154. end;
  155. procedure Toption.WriteHelpPages;
  156. function PadEnd(s:string;i:longint):string;
  157. begin
  158. while (length(s)<i) do
  159. s:=s+' ';
  160. PadEnd:=s;
  161. end;
  162. var
  163. idx,
  164. lastident,
  165. j,outline,
  166. ident,
  167. lines : longint;
  168. show : boolean;
  169. opt : string[32];
  170. input,
  171. s : string;
  172. begin
  173. MaybeLoadMessageFile;
  174. Message1(option_usage,paramstr(0));
  175. lastident:=0;
  176. if DoWriteLogo then
  177. lines:=3
  178. else
  179. lines:=1;
  180. for idx:=ord(ol_begin) to ord(ol_end) do
  181. begin
  182. { get a line and reset }
  183. s:=msg^.Get(idx);
  184. ident:=0;
  185. show:=false;
  186. { parse options }
  187. case s[1] of
  188. {$ifdef i386}
  189. '3',
  190. {$endif}
  191. {$ifdef m68k}
  192. '6',
  193. {$endif}
  194. '*' : show:=true;
  195. end;
  196. if show then
  197. begin
  198. case s[2] of
  199. {$ifdef TP}
  200. 't',
  201. {$endif}
  202. {$ifdef GDB}
  203. 'g',
  204. {$endif}
  205. {$ifdef linux}
  206. 'L',
  207. {$endif}
  208. {$ifdef os2}
  209. 'O',
  210. {$endif}
  211. '*' : show:=true;
  212. else
  213. show:=false;
  214. end;
  215. end;
  216. { now we may show the message or not }
  217. if show then
  218. begin
  219. case s[3] of
  220. '0' : begin
  221. ident:=0;
  222. outline:=0;
  223. end;
  224. '1' : begin
  225. ident:=2;
  226. outline:=7;
  227. end;
  228. '2' : begin
  229. ident:=11;
  230. outline:=11;
  231. end;
  232. '3' : begin
  233. ident:=21;
  234. outline:=6;
  235. end;
  236. end;
  237. j:=pos('_',s);
  238. opt:=Copy(s,4,j-4);
  239. if opt='*' then
  240. opt:=''
  241. else
  242. opt:=PadEnd('-'+opt,outline);
  243. if (ident=0) and (lastident<>0) then
  244. begin
  245. Comment(V_Normal,'');
  246. inc(Lines);
  247. end;
  248. { page full ? }
  249. if (lines>=page_size) then
  250. begin
  251. if not NoPressEnter then
  252. begin
  253. write('*** press enter ***');
  254. readln(input);
  255. if upper(input)='Q' then
  256. stop;
  257. end;
  258. lines:=0;
  259. end;
  260. Comment(V_Normal,PadEnd('',ident)+opt+Copy(s,j+1,255));
  261. LastIdent:=Ident;
  262. inc(Lines);
  263. end;
  264. end;
  265. stop;
  266. end;
  267. procedure Toption.QuickInfo(const s:string);
  268. begin
  269. if source_os.newline=#13#10 then
  270. Write(s+#10)
  271. else
  272. Writeln(s);
  273. Stop;
  274. end;
  275. procedure Toption.IllegalPara(const opt:string);
  276. begin
  277. Message1(option_illegal_para,opt);
  278. Message(option_help_pages_para);
  279. stop;
  280. end;
  281. function Toption.Unsetbool(const opts:string; pos: Longint):boolean;
  282. { checks if the character after pos in Opts is a + or a - and returns resp.
  283. false or true. If it is another character (or none), it also returns false }
  284. begin
  285. UnsetBool := (Length(Opts) > Pos) And (Opts[Succ(Pos)] = '-');
  286. end;
  287. procedure TOption.interpret_proc_specific_options(const opt:string);
  288. begin
  289. end;
  290. procedure TOption.interpret_option(const opt:string);
  291. var
  292. code : integer;
  293. c : char;
  294. more : string;
  295. j,l : longint;
  296. d : DirStr;
  297. e : ExtStr;
  298. begin
  299. if opt='' then
  300. exit;
  301. case opt[1] of
  302. '-' : begin
  303. more:=Copy(opt,3,255);
  304. case opt[2] of
  305. '!' : initlocalswitches:=initlocalswitches+[cs_ansistrings];
  306. '?' : WriteHelpPages;
  307. 'a' : begin
  308. initglobalswitches:=initglobalswitches+[cs_asm_leave];
  309. for j:=1 to length(more) do
  310. case more[j] of
  311. 'l' : initglobalswitches:=initglobalswitches+[cs_asm_source];
  312. 'r' : initglobalswitches:=initglobalswitches+[cs_asm_regalloc];
  313. 't' : initglobalswitches:=initglobalswitches+[cs_asm_tempalloc];
  314. '-' : initglobalswitches:=initglobalswitches-[cs_asm_leave,cs_asm_source,cs_asm_regalloc];
  315. else
  316. IllegalPara(opt);
  317. end;
  318. end;
  319. 'A' : begin
  320. if set_string_asm(More) then
  321. begin
  322. initoutputformat:=target_asm.id;
  323. asm_is_set:=true;
  324. end
  325. else
  326. IllegalPara(opt);
  327. end;
  328. 'b' : begin
  329. {$ifdef BrowserLog}
  330. initglobalswitches:=initglobalswitches+[cs_browser_log];
  331. {$endif}
  332. if More<>'' then
  333. if More='l' then
  334. initmoduleswitches:=initmoduleswitches+[cs_local_browser]
  335. else if More='-' then
  336. begin
  337. initmoduleswitches:=initmoduleswitches-[cs_browser,cs_local_browser];
  338. {$ifdef BrowserLog}
  339. initglobalswitches:=initglobalswitches-[cs_browser_log];
  340. {$endif}
  341. end
  342. else if More<>'+' then
  343. {$ifdef BrowserLog}
  344. browserlog.elements_to_list^.insert(more);
  345. {$else}
  346. IllegalPara(opt);
  347. {$endif}
  348. end;
  349. 'B' : if more='' then
  350. do_build:=true
  351. else
  352. if more = '-' then
  353. do_build := False
  354. else
  355. IllegalPara(opt);
  356. 'C' : begin
  357. j := 1;
  358. while j <= length(more) Do
  359. Begin
  360. case more[j] of
  361. 'a' : Simplify_ppu:=true;
  362. 'h' :
  363. begin
  364. val(copy(more,j+1,length(more)-j),heapsize,code);
  365. if (code<>0) or (heapsize>=67107840) or (heapsize<1024) then
  366. IllegalPara(opt);
  367. break;
  368. end;
  369. 'i' : If UnsetBool(More, j) then
  370. Begin
  371. initlocalswitches:=initlocalswitches-[cs_check_io];
  372. inc(j)
  373. End
  374. else initlocalswitches:=initlocalswitches+[cs_check_io];
  375. 'n' : If UnsetBool(More, j) then
  376. Begin
  377. initglobalswitches:=initglobalswitches-[cs_link_extern];
  378. inc(j)
  379. End
  380. Else initglobalswitches:=initglobalswitches+[cs_link_extern];
  381. 'o' :
  382. If UnsetBool(More, j) then
  383. Begin
  384. initlocalswitches:=initlocalswitches-[cs_check_overflow];
  385. inc(j);
  386. End
  387. Else
  388. initlocalswitches:=initlocalswitches+[cs_check_overflow];
  389. 'r' :
  390. If UnsetBool(More, j) then
  391. Begin
  392. initlocalswitches:=initlocalswitches-[cs_check_range];
  393. inc(j);
  394. End
  395. Else
  396. initlocalswitches:=initlocalswitches+[cs_check_range];
  397. 's' :
  398. begin
  399. val(copy(more,j+1,length(more)-j),stacksize,code);
  400. if (code<>0) or (stacksize>=67107840) or (stacksize<1024) then
  401. IllegalPara(opt);
  402. break;
  403. end;
  404. 't' :
  405. If UnsetBool(More, j) then
  406. Begin
  407. initlocalswitches:=initlocalswitches-[cs_check_stack];
  408. inc(j)
  409. End
  410. Else
  411. initlocalswitches:=initlocalswitches+[cs_check_stack];
  412. 'D' :
  413. If UnsetBool(More, j) then
  414. Begin
  415. initmoduleswitches:=initmoduleswitches-[cs_create_dynamic];
  416. inc(j)
  417. End
  418. Else
  419. initmoduleswitches:=initmoduleswitches+[cs_create_dynamic];
  420. 'X' :
  421. If UnsetBool(More, j) then
  422. Begin
  423. initmoduleswitches:=initmoduleswitches-[cs_create_smart];
  424. inc(j)
  425. End
  426. Else
  427. initmoduleswitches:=initmoduleswitches+[cs_create_smart];
  428. else
  429. IllegalPara(opt);
  430. end;
  431. inc(j);
  432. end;
  433. end;
  434. 'd' : def_symbol(more);
  435. 'D' : begin
  436. initglobalswitches:=initglobalswitches+[cs_link_deffile];
  437. for j:=1 to length(more) do
  438. case more[j] of
  439. 'd' : begin
  440. description:=Copy(more,j+1,255);
  441. break;
  442. end;
  443. 'w' : usewindowapi:=true;
  444. else
  445. IllegalPara(opt);
  446. end;
  447. end;
  448. 'e' : exepath:=FixPath(More,true);
  449. { Just used by RHIDE }
  450. 'E' : if (length(more)=0) or (UnsetBool(More, 0)) then
  451. initglobalswitches:=initglobalswitches+[cs_link_extern]
  452. else
  453. initglobalswitches:=initglobalswitches-[cs_link_extern];
  454. 'F' : begin
  455. c:=more[1];
  456. Delete(more,1,1);
  457. case c of
  458. 'D' : utilsdirectory:=FixPath(More,true);
  459. 'e' : SetRedirectFile(More);
  460. 'E' : OutputExeDir:=FixPath(More,true);
  461. 'i' : if firstpass then
  462. includesearchpath.AddPath(More,false)
  463. else
  464. ParaIncludePath.AddPath(More,false);
  465. 'g' : Message2(option_obsolete_switch_use_new,'-Fg','-Fl');
  466. 'l' : if firstpass then
  467. LibrarySearchPath.AddPath(More,false)
  468. else
  469. ParaLibraryPath.AddPath(More,false);
  470. 'L' : if More<>'' then
  471. ParaDynamicLinker:=More
  472. else
  473. IllegalPara(opt);
  474. 'o' : if firstpass then
  475. ObjectSearchPath.AddPath(More,false)
  476. else
  477. ParaObjectPath.AddPath(More,false);
  478. 'r' : Msgfilename:=More;
  479. 'u' : if firstpass then
  480. unitsearchpath.AddPath(More,false)
  481. else
  482. ParaUnitPath.AddPath(More,false);
  483. 'U' : OutputUnitDir:=FixPath(More,true);
  484. else
  485. IllegalPara(opt);
  486. end;
  487. end;
  488. 'g' : begin
  489. if UnsetBool(More, 0) then
  490. initmoduleswitches:=initmoduleswitches-[cs_debuginfo]
  491. else
  492. begin
  493. {$ifdef GDB}
  494. initmoduleswitches:=initmoduleswitches+[cs_debuginfo];
  495. if not RelocSectionSetExplicitly then
  496. RelocSection:=false;
  497. for j:=1 to length(more) do
  498. case more[j] of
  499. 'd' : initglobalswitches:=initglobalswitches+[cs_gdb_dbx];
  500. 'g' : initglobalswitches:=initglobalswitches+[cs_gdb_gsym];
  501. 'h' : initglobalswitches:=initglobalswitches+[cs_gdb_heaptrc];
  502. 'c' : initglobalswitches:=initglobalswitches+[cs_checkpointer];
  503. {$ifdef EXTDEBUG}
  504. 'p' : only_one_pass:=true;
  505. {$endif EXTDEBUG}
  506. else
  507. IllegalPara(opt);
  508. end;
  509. {$else GDB}
  510. Message(option_no_debug_support);
  511. Message(option_no_debug_support_recompile_fpc);
  512. {$endif GDB}
  513. end;
  514. end;
  515. 'h' : begin
  516. NoPressEnter:=true;
  517. WriteHelpPages;
  518. end;
  519. 'i' : if more='' then
  520. WriteInfo
  521. else
  522. begin
  523. { Specific info, which can be used in Makefiles }
  524. case More[1] of
  525. 'S' : begin
  526. case More[2] of
  527. 'O' : QuickInfo(source_os.shortname);
  528. {$ifdef Delphi !!!!!!!!!}
  529. 'P' : QuickInfo('unknown');
  530. {$else}
  531. 'P' : QuickInfo(source_cpu_string);
  532. {$endif}
  533. end;
  534. end;
  535. 'T' : begin
  536. case More[2] of
  537. 'O' : QuickInfo(target_os.shortname);
  538. 'P' : QuickInfo(target_cpu_string);
  539. end;
  540. end;
  541. 'V' : QuickInfo(version_string);
  542. 'D' : QuickInfo(date_string);
  543. else
  544. IllegalPara(Opt);
  545. end;
  546. end;
  547. 'I' : if firstpass then
  548. includesearchpath.AddPath(More,false)
  549. else
  550. ParaIncludePath.AddPath(More,false);
  551. 'k' : if more<>'' then
  552. ParaLinkOptions:=ParaLinkOptions+' '+More
  553. else
  554. IllegalPara(opt);
  555. 'l' : if more='' then
  556. DoWriteLogo:=true
  557. else
  558. IllegalPara(opt);
  559. 'n' : if More='' then
  560. read_configfile:=false
  561. else
  562. IllegalPara(opt);
  563. 'o' : if More<>'' then
  564. Fsplit(More,d,OutputFile,e)
  565. else
  566. IllegalPara(opt);
  567. 'p' : begin
  568. if UnsetBool(More, 0) then
  569. begin
  570. initmoduleswitches:=initmoduleswitches-[cs_profile];
  571. undef_symbol('FPC_PROFILE');
  572. end
  573. else
  574. case more[1] of
  575. 'g' : if (length(opt)=3) and UnsetBool(more, 1) then
  576. begin
  577. initmoduleswitches:=initmoduleswitches-[cs_profile];
  578. undef_symbol('FPC_PROFILE');
  579. end
  580. else
  581. begin
  582. initmoduleswitches:=initmoduleswitches+[cs_profile];
  583. def_symbol('FPC_PROFILE');
  584. end;
  585. else
  586. IllegalPara(opt);
  587. end;
  588. end;
  589. {$ifdef linux}
  590. 'P' : initglobalswitches:=initglobalswitches+[cs_asm_pipe];
  591. {$endif}
  592. 's' : initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern];
  593. 'S' : begin
  594. for j:=1 to length(more) do
  595. case more[j] of
  596. '2' : initmodeswitches:=objfpcmodeswitches;
  597. 'c' : initmoduleswitches:=initmoduleswitches+[cs_support_c_operators];
  598. 'd' : initmodeswitches:=delphimodeswitches;
  599. 'e' : begin
  600. val(copy(more,j+1,length(more)-j),l,code);
  601. if (code<>0) then
  602. SetMaxErrorCount(1)
  603. else
  604. begin
  605. SetMaxErrorCount(l);
  606. break;
  607. end;
  608. end;
  609. 'g' : initmoduleswitches:=initmoduleswitches+[cs_support_goto];
  610. 'h' : initlocalswitches:=initlocalswitches+[cs_ansistrings];
  611. 'i' : initmoduleswitches:=initmoduleswitches+[cs_support_inline];
  612. 'm' : initmoduleswitches:=initmoduleswitches+[cs_support_macro];
  613. 'o': initmodeswitches:=tpmodeswitches;
  614. 'p' : initmodeswitches:=gpcmodeswitches;
  615. 's' : initglobalswitches:=initglobalswitches+[cs_constructor_name];
  616. 't' : initmoduleswitches:=initmoduleswitches+[cs_static_keyword];
  617. 'v' : Message1(option_obsolete_switch,'-Sv');
  618. else
  619. IllegalPara(opt);
  620. end;
  621. end;
  622. 'T' : begin
  623. more:=Upper(More);
  624. if not target_is_set then
  625. begin
  626. { remove old target define }
  627. undef_symbol(target_info.short_name);
  628. { load new target }
  629. if not(set_string_target(More)) then
  630. IllegalPara(opt);
  631. { set new define }
  632. def_symbol(target_info.short_name);
  633. if not asm_is_set then
  634. initoutputformat:=target_asm.id;
  635. target_is_set:=true;
  636. end
  637. else
  638. if More<>target_info.short_name then
  639. Message1(option_target_is_already_set,target_info.short_name);
  640. end;
  641. 'u' : undef_symbol(upper(More));
  642. 'U' : begin
  643. for j:=1 to length(more) do
  644. case more[j] of
  645. {$ifdef UNITALIASES}
  646. 'a' : begin
  647. AddUnitAlias(Copy(More,j+1,255));
  648. break;
  649. end;
  650. {$endif UNITALIASES}
  651. 'n' : initglobalswitches:=initglobalswitches-[cs_check_unit_name];
  652. 'p' : begin
  653. Message2(option_obsolete_switch_use_new,'-Up','-Fu');
  654. break;
  655. end;
  656. 's' : initmoduleswitches:=initmoduleswitches+[cs_compilesystem];
  657. else
  658. IllegalPara(opt);
  659. end;
  660. end;
  661. 'v' : if not setverbosity(More) then
  662. IllegalPara(opt);
  663. 'W' : begin
  664. for j:=1 to length(More) do
  665. case More[j] of
  666. 'B': {bind_win32_dll:=true}
  667. begin
  668. { -WB200000 means set prefered base address
  669. to $200000, but does not change relocsection boolean
  670. this way we can create both relocatble and
  671. non relocatable DLL at a specific base address PM }
  672. if (length(More)>j) then
  673. begin
  674. if DLLImageBase=nil then
  675. DLLImageBase:=StringDup(Copy(More,j+1,255));
  676. end
  677. else
  678. begin
  679. RelocSection:=true;
  680. RelocSectionSetExplicitly:=true;
  681. end;
  682. break;
  683. end;
  684. 'C': apptype:=at_cui;
  685. 'G': apptype:=at_gui;
  686. 'N': begin
  687. RelocSection:=false;
  688. RelocSectionSetExplicitly:=true;
  689. end;
  690. 'R': begin
  691. RelocSection:=true;
  692. RelocSectionSetExplicitly:=true;
  693. end;
  694. else
  695. IllegalPara(opt);
  696. end;
  697. end;
  698. 'X' : begin
  699. for j:=1 to length(More) do
  700. case More[j] of
  701. 'c' : initglobalswitches:=initglobalswitches+[cs_link_toc];
  702. 's' : initglobalswitches:=initglobalswitches+[cs_link_strip];
  703. 'D' : begin
  704. def_symbol('FPC_LINK_DYNAMIC');
  705. undef_symbol('FPC_LINK_SMART');
  706. undef_symbol('FPC_LINK_STATIC');
  707. initglobalswitches:=initglobalswitches+[cs_link_shared];
  708. initglobalswitches:=initglobalswitches-[cs_link_static,cs_link_smart];
  709. end;
  710. 'S' : begin
  711. def_symbol('FPC_LINK_STATIC');
  712. undef_symbol('FPC_LINK_SMART');
  713. undef_symbol('FPC_LINK_DYNAMIC');
  714. initglobalswitches:=initglobalswitches+[cs_link_static];
  715. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_smart];
  716. end;
  717. 'X' : begin
  718. def_symbol('FPC_LINK_SMART');
  719. undef_symbol('FPC_LINK_STATIC');
  720. undef_symbol('FPC_LINK_DYNAMIC');
  721. initglobalswitches:=initglobalswitches+[cs_link_smart];
  722. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_static];
  723. end;
  724. else
  725. IllegalPara(opt);
  726. end;
  727. end;
  728. { give processor specific options a chance }
  729. else
  730. interpret_proc_specific_options(opt);
  731. end;
  732. end;
  733. '@' : begin
  734. Message(option_no_nested_response_file);
  735. Stop;
  736. end;
  737. else
  738. begin
  739. if (length(param_file)<>0) then
  740. Message(option_only_one_source_support);
  741. param_file:=opt;
  742. end;
  743. end;
  744. end;
  745. procedure Toption.Interpret_file(const filename : string);
  746. procedure RemoveSep(var fn:string);
  747. var
  748. i : longint;
  749. begin
  750. i:=0;
  751. while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do
  752. inc(i);
  753. Delete(fn,1,i);
  754. i:=length(fn);
  755. while (i>0) and (fn[i] in [',',' ',#9]) do
  756. dec(i);
  757. fn:=copy(fn,1,i);
  758. end;
  759. function GetName(var fn:string):string;
  760. var
  761. i : longint;
  762. begin
  763. i:=0;
  764. while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do
  765. inc(i);
  766. GetName:=Copy(fn,1,i);
  767. Delete(fn,1,i);
  768. end;
  769. const
  770. maxlevel=16;
  771. var
  772. f : text;
  773. s,
  774. opts : string;
  775. skip : array[0..maxlevel-1] of boolean;
  776. level : longint;
  777. begin
  778. { avoid infinite loop }
  779. Inc(FileLevel);
  780. If FileLevel>MaxLevel then
  781. Message(option_too_many_cfg_files);
  782. { open file }
  783. assign(f,filename);
  784. {$ifdef extdebug}
  785. Comment(V_Info,'trying to open file: '+filename);
  786. {$endif extdebug}
  787. {$I-}
  788. reset(f);
  789. {$I+}
  790. if ioresult<>0 then
  791. begin
  792. Message1(option_unable_open_file,filename);
  793. exit;
  794. end;
  795. fillchar(skip,sizeof(skip),0);
  796. level:=0;
  797. while not eof(f) do
  798. begin
  799. readln(f,opts);
  800. RemoveSep(opts);
  801. if (opts<>'') then
  802. begin
  803. if opts[1]='#' then
  804. begin
  805. Delete(opts,1,1);
  806. s:=upper(GetName(opts));
  807. if (s='SECTION') then
  808. begin
  809. RemoveSep(opts);
  810. s:=upper(GetName(opts));
  811. if level=0 then
  812. skip[level]:=not (check_symbol(s) or (s='COMMON'));
  813. end
  814. else
  815. if (s='IFDEF') then
  816. begin
  817. RemoveSep(opts);
  818. if Level>=maxlevel then
  819. begin
  820. Message(option_too_many_ifdef);
  821. stop;
  822. end;
  823. inc(Level);
  824. skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts)))));
  825. end
  826. else
  827. if (s='IFNDEF') then
  828. begin
  829. RemoveSep(opts);
  830. if Level>=maxlevel then
  831. begin
  832. Message(option_too_many_ifdef);
  833. stop;
  834. end;
  835. inc(Level);
  836. skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts)))));
  837. end
  838. else
  839. if (s='ELSE') then
  840. skip[level]:=skip[level-1] or (not skip[level])
  841. else
  842. if (s='ENDIF') then
  843. begin
  844. skip[level]:=false;
  845. if Level=0 then
  846. begin
  847. Message(option_too_many_endif);
  848. stop;
  849. end;
  850. dec(level);
  851. end
  852. else
  853. if (not skip[level]) then
  854. begin
  855. if (s='DEFINE') then
  856. begin
  857. RemoveSep(opts);
  858. def_symbol(upper(GetName(opts)));
  859. end
  860. else
  861. if (s='UNDEF') then
  862. begin
  863. RemoveSep(opts);
  864. undef_symbol(upper(GetName(opts)));
  865. end
  866. else
  867. if (s='WRITE') then
  868. begin
  869. Delete(opts,1,1);
  870. WriteLn(opts);
  871. end
  872. else
  873. if (s='INCLUDE') then
  874. begin
  875. Delete(opts,1,1);
  876. Interpret_file(opts);
  877. end;
  878. end;
  879. end
  880. else
  881. begin
  882. if (not skip[level]) and (opts[1]='-') then
  883. interpret_option(opts)
  884. end;
  885. end;
  886. end;
  887. if Level>0 then
  888. Message(option_too_less_endif);
  889. Close(f);
  890. Dec(FileLevel);
  891. end;
  892. procedure toption.read_parameters;
  893. var
  894. opts : string;
  895. paramindex : longint;
  896. begin
  897. paramindex:=0;
  898. while paramindex<paramcount do
  899. begin
  900. inc(paramindex);
  901. opts:=paramstr(paramindex);
  902. if firstpass then
  903. begin
  904. { only parse define,undef,target,verbosity and link options }
  905. if (opts[1]='-') and (opts[2] in ['i','d','v','T','u','n','X']) then
  906. interpret_option(opts);
  907. end
  908. else
  909. begin
  910. if opts[1]='@' then
  911. begin
  912. Delete(opts,1,1);
  913. Message1(option_reading_further_from,opts);
  914. interpret_file(opts);
  915. end
  916. else
  917. interpret_option(opts);
  918. end;
  919. end;
  920. end;
  921. procedure toption.parsecmd(cmd:string);
  922. var
  923. i : longint;
  924. opts : string;
  925. begin
  926. while (cmd<>'') do
  927. begin
  928. while cmd[1]=' ' do
  929. delete(cmd,1,1);
  930. i:=pos(' ',cmd);
  931. if i=0 then
  932. i:=255;
  933. opts:=Copy(cmd,1,i-1);
  934. Delete(cmd,1,i);
  935. if firstpass then
  936. begin
  937. { only parse define,undef,target,verbosity and link options }
  938. if (opts[1]='-') and (opts[2] in ['d','v','T','u','n','X']) then
  939. interpret_option(opts);
  940. end
  941. else
  942. begin
  943. if opts[1]='@' then
  944. begin
  945. Delete(opts,1,1);
  946. Message1(option_reading_further_from,opts);
  947. interpret_file(opts);
  948. end
  949. else
  950. interpret_option(opts);
  951. end;
  952. end;
  953. end;
  954. constructor TOption.Init;
  955. begin
  956. DoWriteLogo:=false;
  957. NoPressEnter:=false;
  958. FirstPass:=false;
  959. FileLevel:=0;
  960. ParaIncludePath.Init;
  961. ParaObjectPath.Init;
  962. ParaUnitPath.Init;
  963. ParaLibraryPath.Init;
  964. end;
  965. destructor TOption.Done;
  966. begin
  967. ParaIncludePath.Done;
  968. ParaObjectPath.Done;
  969. ParaUnitPath.Done;
  970. ParaLibraryPath.Done;
  971. end;
  972. {****************************************************************************
  973. Callable Routines
  974. ****************************************************************************}
  975. procedure read_arguments(cmd:string);
  976. var
  977. configpath : pathstr;
  978. option : poption;
  979. begin
  980. {$ifdef Delphi}
  981. option:=new(poption386,Init);
  982. {$endif Delphi}
  983. {$ifdef i386}
  984. option:=new(poption386,Init);
  985. {$endif}
  986. {$ifdef m68k}
  987. option:=new(poption68k,Init);
  988. {$endif}
  989. {$ifdef alpha}
  990. option:=new(poption,Init);
  991. {$endif}
  992. {$ifdef powerpc}
  993. option:=new(poption,Init);
  994. {$endif}
  995. { Load messages }
  996. if (cmd='') and (paramcount=0) then
  997. Option^.WriteHelpPages;
  998. { default defines }
  999. def_symbol(target_info.short_name);
  1000. def_symbol('FPK');
  1001. def_symbol('FPC');
  1002. def_symbol('VER'+version_nr);
  1003. def_symbol('VER'+version_nr+'_'+release_nr);
  1004. def_symbol('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
  1005. {$ifdef newcg}
  1006. def_symbol('WITHNEWCG');
  1007. {$endif}
  1008. { Temporary defines, until things settle down }
  1009. def_symbol('INT64');
  1010. def_symbol('HASRESOURCESTRINGS');
  1011. def_symbol('HASSAVEREGISTERS');
  1012. def_symbol('NEWVMTOFFSET');
  1013. def_symbol('HASINTERNMATH');
  1014. def_symbol('SYSTEMTVARREC');
  1015. def_symbol('INCLUDEOK');
  1016. def_symbol('NEWMM');
  1017. { some stuff for TP compatibility }
  1018. {$ifdef i386}
  1019. def_symbol('CPU86');
  1020. def_symbol('CPU87');
  1021. {$endif}
  1022. {$ifdef m68k}
  1023. def_symbol('CPU68');
  1024. {$endif}
  1025. { new processor stuff }
  1026. {$ifdef i386}
  1027. def_symbol('CPUI386');
  1028. {$endif}
  1029. {$ifdef m68k}
  1030. def_symbol('CPU68K');
  1031. {$endif}
  1032. {$ifdef ALPHA}
  1033. def_symbol('CPUALPHA');
  1034. {$endif}
  1035. {$ifdef powerpc}
  1036. def_symbol('CPUPOWERPC');
  1037. {$endif}
  1038. { get default messagefile }
  1039. {$ifdef Delphi}
  1040. msgfilename:=dmisc.getenv('PPC_ERROR_FILE');
  1041. {$else Delphi}
  1042. msgfilename:=dos.getenv('PPC_ERROR_FILE');
  1043. {$endif Delphi}
  1044. { default configfile }
  1045. if (cmd<>'') and (cmd[1]='[') then
  1046. begin
  1047. ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
  1048. Delete(cmd,1,pos(']',cmd));
  1049. end
  1050. else
  1051. begin
  1052. {$ifdef i386}
  1053. ppccfg:='ppc386.cfg';
  1054. {$endif i386}
  1055. {$ifdef m68k}
  1056. ppccfg:='ppc.cfg';
  1057. {$endif}
  1058. {$ifdef alpha}
  1059. ppccfg:='ppcalpha.cfg';
  1060. {$endif}
  1061. {$ifdef powerpc}
  1062. ppccfg:='ppcppc.cfg';
  1063. {$endif}
  1064. end;
  1065. { Order to read ppc386.cfg:
  1066. 1 - current dir
  1067. 2 - configpath
  1068. 3 - compiler path }
  1069. {$ifdef Delphi}
  1070. configpath:=FixPath(dmisc.getenv('PPC_CONFIG_PATH'),false);
  1071. {$else Delphi}
  1072. configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false);
  1073. {$endif Delphi}
  1074. {$ifdef linux}
  1075. if configpath='' then
  1076. configpath:='/etc/';
  1077. {$endif}
  1078. if ppccfg<>'' then
  1079. begin
  1080. read_configfile:=true;
  1081. if not FileExists(ppccfg) then
  1082. begin
  1083. {$ifdef linux}
  1084. if (dos.getenv('HOME')<>'') and FileExists(FixPath(dos.getenv('HOME'),false)+'.'+ppccfg) then
  1085. ppccfg:=FixPath(dos.getenv('HOME'),false)+'.'+ppccfg
  1086. else
  1087. {$endif}
  1088. if FileExists(configpath+ppccfg) then
  1089. ppccfg:=configpath+ppccfg
  1090. else
  1091. {$ifndef linux}
  1092. if FileExists(exepath+ppccfg) then
  1093. ppccfg:=exepath+ppccfg
  1094. else
  1095. {$endif}
  1096. read_configfile:=false;
  1097. end;
  1098. end
  1099. else
  1100. read_configfile:=false;
  1101. { Read commandline and configfile }
  1102. target_is_set:=false;
  1103. asm_is_set:=false;
  1104. param_file:='';
  1105. if read_configfile then
  1106. begin
  1107. { read the parameters quick, only -v -T }
  1108. option^.firstpass:=true;
  1109. if cmd<>'' then
  1110. option^.parsecmd(cmd)
  1111. else
  1112. option^.read_parameters;
  1113. if read_configfile then
  1114. begin
  1115. {$ifdef EXTDEBUG}
  1116. Comment(V_Debug,'read config file: '+ppccfg);
  1117. {$endif EXTDEBUG}
  1118. option^.interpret_file(ppccfg);
  1119. end;
  1120. end;
  1121. option^.firstpass:=false;
  1122. if cmd<>'' then
  1123. option^.parsecmd(cmd)
  1124. else
  1125. option^.read_parameters;
  1126. { Stop if errors in options }
  1127. if ErrorCount>0 then
  1128. Stop;
  1129. { write logo if set }
  1130. if option^.DoWriteLogo then
  1131. option^.WriteLogo;
  1132. { Check file to compile }
  1133. if param_file='' then
  1134. begin
  1135. Message(option_no_source_found);
  1136. Stop;
  1137. end;
  1138. {$ifndef linux}
  1139. param_file:=FixFileName(param_file);
  1140. {$endif}
  1141. fsplit(param_file,inputdir,inputfile,inputextension);
  1142. if inputextension='' then
  1143. begin
  1144. if FileExists(inputdir+inputfile+target_os.sourceext) then
  1145. inputextension:=target_os.sourceext
  1146. else
  1147. if FileExists(inputdir+inputfile+target_os.pasext) then
  1148. inputextension:=target_os.pasext;
  1149. end;
  1150. { Add paths specified with parameters to the searchpaths }
  1151. UnitSearchPath.AddList(Option^.ParaUnitPath,true);
  1152. ObjectSearchPath.AddList(Option^.ParaObjectPath,true);
  1153. IncludeSearchPath.AddList(Option^.ParaIncludePath,true);
  1154. LibrarySearchPath.AddList(Option^.ParaLibraryPath,true);
  1155. { add unit environment and exepath to the unit search path }
  1156. if inputdir<>'' then
  1157. Unitsearchpath.AddPath(inputdir,true);
  1158. {$ifdef Delphi}
  1159. UnitSearchPath.AddPath(dmisc.getenv(target_info.unit_env),false);
  1160. {$else}
  1161. UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false);
  1162. {$endif Delphi}
  1163. {$ifdef linux}
  1164. UnitSearchPath.AddPath('/usr/lib/fpc/'+version_string+'/units/'+lower(target_info.short_name),false);
  1165. UnitSearchPath.AddPath('/usr/lib/fpc/'+version_string+'/rtl/'+lower(target_info.short_name),false);
  1166. {$else}
  1167. UnitSearchPath.AddPath(ExePath+'../units/'+lower(target_info.short_name),false);
  1168. UnitSearchPath.AddPath(ExePath+'../rtl/'+lower(target_info.short_name),false);
  1169. {$endif}
  1170. UnitSearchPath.AddPath(ExePath,false);
  1171. { Add unit dir to the object and library path }
  1172. objectsearchpath.AddList(unitsearchpath,false);
  1173. librarysearchpath.AddList(unitsearchpath,false);
  1174. { switch assembler if it's binary and we got -a on the cmdline }
  1175. if (cs_asm_leave in initglobalswitches) and
  1176. (target_asm.id in binassem) then
  1177. begin
  1178. Message(option_switch_bin_to_src_assembler);
  1179. set_target_asm(target_info.assemsrc);
  1180. initoutputformat:=target_asm.id;
  1181. end;
  1182. { turn off stripping if compiling with debuginfo or profile }
  1183. if (cs_debuginfo in initmoduleswitches) or
  1184. (cs_profile in initmoduleswitches) then
  1185. initglobalswitches:=initglobalswitches-[cs_link_strip];
  1186. { Set defines depending on the target }
  1187. if (target_info.target in [target_i386_GO32V1,target_i386_GO32V2]) then
  1188. def_symbol('DPMI'); { MSDOS is not defined in BP when target is DPMI }
  1189. MaybeLoadMessageFile;
  1190. dispose(option,Done);
  1191. end;
  1192. end.
  1193. {
  1194. $Log$
  1195. Revision 1.36 1999-11-15 17:42:40 pierre
  1196. * -g disables reloc section for win32
  1197. Revision 1.35 1999/11/12 11:03:50 peter
  1198. * searchpaths changed to stringqueue object
  1199. Revision 1.34 1999/11/09 23:06:45 peter
  1200. * esi_offset -> selfpointer_offset to be newcg compatible
  1201. * hcogegen -> cgbase fixes for newcg
  1202. Revision 1.33 1999/11/06 14:34:21 peter
  1203. * truncated log to 20 revs
  1204. Revision 1.32 1999/11/04 23:13:25 peter
  1205. * moved unit alias support into ifdef
  1206. Revision 1.31 1999/11/04 10:54:03 peter
  1207. + -Ua<oldname>=<newname> unit alias support
  1208. Revision 1.30 1999/11/03 23:43:09 peter
  1209. * default units/rtl paths
  1210. Revision 1.29 1999/10/30 17:35:26 peter
  1211. * fpc_freemem fpc_getmem new callings updated
  1212. Revision 1.28 1999/10/28 11:13:36 pierre
  1213. * fix for cygwin make problem with -iTP
  1214. Revision 1.27 1999/10/26 13:13:47 peter
  1215. * define INCLUDEOK, which seems to work correct
  1216. Revision 1.26 1999/10/14 14:57:52 florian
  1217. - removed the hcodegen use in the new cg, use cgbase instead
  1218. Revision 1.25 1999/10/13 10:24:49 peter
  1219. * dpmi can only be set after reading the options
  1220. Revision 1.24 1999/10/03 19:44:41 peter
  1221. * removed objpasunit reference, tvarrec is now searched in systemunit
  1222. where it already was located
  1223. Revision 1.23 1999/09/20 16:38:59 peter
  1224. * cs_create_smart instead of cs_smartlink
  1225. * -CX is create smartlink
  1226. * -CD is create dynamic, but does nothing atm.
  1227. Revision 1.22 1999/09/16 11:34:56 pierre
  1228. * typo correction
  1229. Revision 1.21 1999/09/15 20:35:40 florian
  1230. * small fix to operator overloading when in MMX mode
  1231. + the compiler uses now fldz and fld1 if possible
  1232. + some fixes to floating point registers
  1233. + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
  1234. * .... ???
  1235. Revision 1.20 1999/09/03 09:31:22 peter
  1236. * reading of search paths fixed to work as expected
  1237. Revision 1.19 1999/09/01 22:07:20 peter
  1238. * turn off stripping if profiling or debugging
  1239. Revision 1.18 1999/08/28 17:46:10 peter
  1240. * resources are working correct
  1241. Revision 1.17 1999/08/28 15:34:19 florian
  1242. * bug 519 fixed
  1243. Revision 1.16 1999/08/27 10:45:03 pierre
  1244. options -Ca sets simply_ppu to true
  1245. Revision 1.15 1999/08/25 22:51:00 pierre
  1246. * remove trailing space in cfg files
  1247. Revision 1.14 1999/08/16 15:35:26 pierre
  1248. * fix for DLL relocation problems
  1249. * external bss vars had wrong stabs for pecoff
  1250. + -WB11000000 to specify default image base, allows to
  1251. load several DLLs with debugging info included
  1252. (relocatable DLL are stripped because the relocation
  1253. of the .Stab section is misplaced by ldw)
  1254. Revision 1.13 1999/08/11 17:26:35 peter
  1255. * tlinker object is now inherited for win32 and dos
  1256. * postprocessexecutable is now a method of tlinker
  1257. }