options.pas 42 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370
  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. {$ifdef FPC_USE_CPREFIX}
  526. 'C' : QuickInfo('use C prefix');
  527. {$endif FPC_USE_CPREFIX}
  528. 'S' : begin
  529. case More[2] of
  530. 'O' : QuickInfo(source_os.shortname);
  531. {$ifdef Delphi !!!!!!!!!}
  532. 'P' : QuickInfo('unknown');
  533. {$else}
  534. 'P' : QuickInfo(source_cpu_string);
  535. {$endif}
  536. end;
  537. end;
  538. 'T' : begin
  539. case More[2] of
  540. 'O' : QuickInfo(target_os.shortname);
  541. 'P' : QuickInfo(target_cpu_string);
  542. end;
  543. end;
  544. 'V' : QuickInfo(version_string);
  545. 'D' : QuickInfo(date_string);
  546. else
  547. IllegalPara(Opt);
  548. end;
  549. end;
  550. 'I' : if firstpass then
  551. includesearchpath.AddPath(More,false)
  552. else
  553. ParaIncludePath.AddPath(More,false);
  554. 'k' : if more<>'' then
  555. ParaLinkOptions:=ParaLinkOptions+' '+More
  556. else
  557. IllegalPara(opt);
  558. 'l' : if more='' then
  559. DoWriteLogo:=true
  560. else
  561. IllegalPara(opt);
  562. 'n' : if More='' then
  563. read_configfile:=false
  564. else
  565. IllegalPara(opt);
  566. 'o' : if More<>'' then
  567. Fsplit(More,d,OutputFile,e)
  568. else
  569. IllegalPara(opt);
  570. 'p' : begin
  571. if UnsetBool(More, 0) then
  572. begin
  573. initmoduleswitches:=initmoduleswitches-[cs_profile];
  574. undef_symbol('FPC_PROFILE');
  575. end
  576. else
  577. case more[1] of
  578. 'g' : if (length(opt)=3) and UnsetBool(more, 1) then
  579. begin
  580. initmoduleswitches:=initmoduleswitches-[cs_profile];
  581. undef_symbol('FPC_PROFILE');
  582. end
  583. else
  584. begin
  585. initmoduleswitches:=initmoduleswitches+[cs_profile];
  586. def_symbol('FPC_PROFILE');
  587. end;
  588. else
  589. IllegalPara(opt);
  590. end;
  591. end;
  592. {$ifdef linux}
  593. 'P' : initglobalswitches:=initglobalswitches+[cs_asm_pipe];
  594. {$endif}
  595. 's' : initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern];
  596. 'S' : begin
  597. for j:=1 to length(more) do
  598. case more[j] of
  599. '2' : initmodeswitches:=objfpcmodeswitches;
  600. 'c' : initmoduleswitches:=initmoduleswitches+[cs_support_c_operators];
  601. 'd' : initmodeswitches:=delphimodeswitches;
  602. 'e' : begin
  603. val(copy(more,j+1,length(more)-j),l,code);
  604. if (code<>0) then
  605. SetMaxErrorCount(1)
  606. else
  607. begin
  608. SetMaxErrorCount(l);
  609. break;
  610. end;
  611. end;
  612. 'g' : initmoduleswitches:=initmoduleswitches+[cs_support_goto];
  613. 'h' : initlocalswitches:=initlocalswitches+[cs_ansistrings];
  614. 'i' : initmoduleswitches:=initmoduleswitches+[cs_support_inline];
  615. 'm' : initmoduleswitches:=initmoduleswitches+[cs_support_macro];
  616. 'o': initmodeswitches:=tpmodeswitches;
  617. 'p' : initmodeswitches:=gpcmodeswitches;
  618. 's' : initglobalswitches:=initglobalswitches+[cs_constructor_name];
  619. 't' : initmoduleswitches:=initmoduleswitches+[cs_static_keyword];
  620. 'v' : Message1(option_obsolete_switch,'-Sv');
  621. else
  622. IllegalPara(opt);
  623. end;
  624. end;
  625. 'T' : begin
  626. more:=Upper(More);
  627. if not target_is_set then
  628. begin
  629. { remove old target define }
  630. undef_symbol(target_info.short_name);
  631. { load new target }
  632. if not(set_string_target(More)) then
  633. IllegalPara(opt);
  634. { set new define }
  635. def_symbol(target_info.short_name);
  636. if not asm_is_set then
  637. initoutputformat:=target_asm.id;
  638. target_is_set:=true;
  639. end
  640. else
  641. if More<>target_info.short_name then
  642. Message1(option_target_is_already_set,target_info.short_name);
  643. end;
  644. 'u' : undef_symbol(upper(More));
  645. 'U' : begin
  646. for j:=1 to length(more) do
  647. case more[j] of
  648. {$ifdef UNITALIASES}
  649. 'a' : begin
  650. AddUnitAlias(Copy(More,j+1,255));
  651. break;
  652. end;
  653. {$endif UNITALIASES}
  654. 'n' : initglobalswitches:=initglobalswitches-[cs_check_unit_name];
  655. 'p' : begin
  656. Message2(option_obsolete_switch_use_new,'-Up','-Fu');
  657. break;
  658. end;
  659. 's' : initmoduleswitches:=initmoduleswitches+[cs_compilesystem];
  660. else
  661. IllegalPara(opt);
  662. end;
  663. end;
  664. 'v' : if not setverbosity(More) then
  665. IllegalPara(opt);
  666. 'W' : begin
  667. for j:=1 to length(More) do
  668. case More[j] of
  669. 'B': {bind_win32_dll:=true}
  670. begin
  671. { -WB200000 means set prefered base address
  672. to $200000, but does not change relocsection boolean
  673. this way we can create both relocatble and
  674. non relocatable DLL at a specific base address PM }
  675. if (length(More)>j) then
  676. begin
  677. if DLLImageBase=nil then
  678. DLLImageBase:=StringDup(Copy(More,j+1,255));
  679. end
  680. else
  681. begin
  682. RelocSection:=true;
  683. RelocSectionSetExplicitly:=true;
  684. end;
  685. break;
  686. end;
  687. 'C': apptype:=at_cui;
  688. 'G': apptype:=at_gui;
  689. 'N': begin
  690. RelocSection:=false;
  691. RelocSectionSetExplicitly:=true;
  692. end;
  693. 'R': begin
  694. RelocSection:=true;
  695. RelocSectionSetExplicitly:=true;
  696. end;
  697. else
  698. IllegalPara(opt);
  699. end;
  700. end;
  701. 'X' : begin
  702. for j:=1 to length(More) do
  703. case More[j] of
  704. 'c' : initglobalswitches:=initglobalswitches+[cs_link_toc];
  705. 's' : initglobalswitches:=initglobalswitches+[cs_link_strip];
  706. 'D' : begin
  707. def_symbol('FPC_LINK_DYNAMIC');
  708. undef_symbol('FPC_LINK_SMART');
  709. undef_symbol('FPC_LINK_STATIC');
  710. initglobalswitches:=initglobalswitches+[cs_link_shared];
  711. initglobalswitches:=initglobalswitches-[cs_link_static,cs_link_smart];
  712. end;
  713. 'S' : begin
  714. def_symbol('FPC_LINK_STATIC');
  715. undef_symbol('FPC_LINK_SMART');
  716. undef_symbol('FPC_LINK_DYNAMIC');
  717. initglobalswitches:=initglobalswitches+[cs_link_static];
  718. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_smart];
  719. end;
  720. 'X' : begin
  721. def_symbol('FPC_LINK_SMART');
  722. undef_symbol('FPC_LINK_STATIC');
  723. undef_symbol('FPC_LINK_DYNAMIC');
  724. initglobalswitches:=initglobalswitches+[cs_link_smart];
  725. initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_static];
  726. end;
  727. else
  728. IllegalPara(opt);
  729. end;
  730. end;
  731. { give processor specific options a chance }
  732. else
  733. interpret_proc_specific_options(opt);
  734. end;
  735. end;
  736. '@' : begin
  737. Message(option_no_nested_response_file);
  738. Stop;
  739. end;
  740. else
  741. begin
  742. if (length(param_file)<>0) then
  743. Message(option_only_one_source_support);
  744. param_file:=opt;
  745. end;
  746. end;
  747. end;
  748. procedure Toption.Interpret_file(const filename : string);
  749. procedure RemoveSep(var fn:string);
  750. var
  751. i : longint;
  752. begin
  753. i:=0;
  754. while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do
  755. inc(i);
  756. Delete(fn,1,i);
  757. i:=length(fn);
  758. while (i>0) and (fn[i] in [',',' ',#9]) do
  759. dec(i);
  760. fn:=copy(fn,1,i);
  761. end;
  762. function GetName(var fn:string):string;
  763. var
  764. i : longint;
  765. begin
  766. i:=0;
  767. while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do
  768. inc(i);
  769. GetName:=Copy(fn,1,i);
  770. Delete(fn,1,i);
  771. end;
  772. const
  773. maxlevel=16;
  774. var
  775. f : text;
  776. s,
  777. opts : string;
  778. skip : array[0..maxlevel-1] of boolean;
  779. level : longint;
  780. begin
  781. { avoid infinite loop }
  782. Inc(FileLevel);
  783. If FileLevel>MaxLevel then
  784. Message(option_too_many_cfg_files);
  785. { open file }
  786. assign(f,filename);
  787. {$ifdef extdebug}
  788. Comment(V_Info,'trying to open file: '+filename);
  789. {$endif extdebug}
  790. {$I-}
  791. reset(f);
  792. {$I+}
  793. if ioresult<>0 then
  794. begin
  795. Message1(option_unable_open_file,filename);
  796. exit;
  797. end;
  798. fillchar(skip,sizeof(skip),0);
  799. level:=0;
  800. while not eof(f) do
  801. begin
  802. readln(f,opts);
  803. RemoveSep(opts);
  804. if (opts<>'') then
  805. begin
  806. if opts[1]='#' then
  807. begin
  808. Delete(opts,1,1);
  809. s:=upper(GetName(opts));
  810. if (s='SECTION') then
  811. begin
  812. RemoveSep(opts);
  813. s:=upper(GetName(opts));
  814. if level=0 then
  815. skip[level]:=not (check_symbol(s) or (s='COMMON'));
  816. end
  817. else
  818. if (s='IFDEF') then
  819. begin
  820. RemoveSep(opts);
  821. if Level>=maxlevel then
  822. begin
  823. Message(option_too_many_ifdef);
  824. stop;
  825. end;
  826. inc(Level);
  827. skip[level]:=(skip[level-1] or (not check_symbol(upper(GetName(opts)))));
  828. end
  829. else
  830. if (s='IFNDEF') then
  831. begin
  832. RemoveSep(opts);
  833. if Level>=maxlevel then
  834. begin
  835. Message(option_too_many_ifdef);
  836. stop;
  837. end;
  838. inc(Level);
  839. skip[level]:=(skip[level-1] or (check_symbol(upper(GetName(opts)))));
  840. end
  841. else
  842. if (s='ELSE') then
  843. skip[level]:=skip[level-1] or (not skip[level])
  844. else
  845. if (s='ENDIF') then
  846. begin
  847. skip[level]:=false;
  848. if Level=0 then
  849. begin
  850. Message(option_too_many_endif);
  851. stop;
  852. end;
  853. dec(level);
  854. end
  855. else
  856. if (not skip[level]) then
  857. begin
  858. if (s='DEFINE') then
  859. begin
  860. RemoveSep(opts);
  861. def_symbol(upper(GetName(opts)));
  862. end
  863. else
  864. if (s='UNDEF') then
  865. begin
  866. RemoveSep(opts);
  867. undef_symbol(upper(GetName(opts)));
  868. end
  869. else
  870. if (s='WRITE') then
  871. begin
  872. Delete(opts,1,1);
  873. WriteLn(opts);
  874. end
  875. else
  876. if (s='INCLUDE') then
  877. begin
  878. Delete(opts,1,1);
  879. Interpret_file(opts);
  880. end;
  881. end;
  882. end
  883. else
  884. begin
  885. if (not skip[level]) and (opts[1]='-') then
  886. interpret_option(opts)
  887. end;
  888. end;
  889. end;
  890. if Level>0 then
  891. Message(option_too_less_endif);
  892. Close(f);
  893. Dec(FileLevel);
  894. end;
  895. procedure toption.read_parameters;
  896. var
  897. opts : string;
  898. paramindex : longint;
  899. begin
  900. paramindex:=0;
  901. while paramindex<paramcount do
  902. begin
  903. inc(paramindex);
  904. opts:=paramstr(paramindex);
  905. if firstpass then
  906. begin
  907. { only parse define,undef,target,verbosity and link options }
  908. if (opts[1]='-') and (opts[2] in ['i','d','v','T','u','n','X']) then
  909. interpret_option(opts);
  910. end
  911. else
  912. begin
  913. if opts[1]='@' then
  914. begin
  915. Delete(opts,1,1);
  916. Message1(option_reading_further_from,opts);
  917. interpret_file(opts);
  918. end
  919. else
  920. interpret_option(opts);
  921. end;
  922. end;
  923. end;
  924. procedure toption.parsecmd(cmd:string);
  925. var
  926. i : longint;
  927. opts : string;
  928. begin
  929. while (cmd<>'') do
  930. begin
  931. while cmd[1]=' ' do
  932. delete(cmd,1,1);
  933. i:=pos(' ',cmd);
  934. if i=0 then
  935. i:=255;
  936. opts:=Copy(cmd,1,i-1);
  937. Delete(cmd,1,i);
  938. if firstpass then
  939. begin
  940. { only parse define,undef,target,verbosity and link options }
  941. if (opts[1]='-') and (opts[2] in ['d','v','T','u','n','X']) then
  942. interpret_option(opts);
  943. end
  944. else
  945. begin
  946. if opts[1]='@' then
  947. begin
  948. Delete(opts,1,1);
  949. Message1(option_reading_further_from,opts);
  950. interpret_file(opts);
  951. end
  952. else
  953. interpret_option(opts);
  954. end;
  955. end;
  956. end;
  957. constructor TOption.Init;
  958. begin
  959. DoWriteLogo:=false;
  960. NoPressEnter:=false;
  961. FirstPass:=false;
  962. FileLevel:=0;
  963. ParaIncludePath.Init;
  964. ParaObjectPath.Init;
  965. ParaUnitPath.Init;
  966. ParaLibraryPath.Init;
  967. end;
  968. destructor TOption.Done;
  969. begin
  970. ParaIncludePath.Done;
  971. ParaObjectPath.Done;
  972. ParaUnitPath.Done;
  973. ParaLibraryPath.Done;
  974. end;
  975. {****************************************************************************
  976. Callable Routines
  977. ****************************************************************************}
  978. procedure read_arguments(cmd:string);
  979. var
  980. configpath : pathstr;
  981. option : poption;
  982. begin
  983. {$ifdef Delphi}
  984. option:=new(poption386,Init);
  985. {$endif Delphi}
  986. {$ifdef i386}
  987. option:=new(poption386,Init);
  988. {$endif}
  989. {$ifdef m68k}
  990. option:=new(poption68k,Init);
  991. {$endif}
  992. {$ifdef alpha}
  993. option:=new(poption,Init);
  994. {$endif}
  995. {$ifdef powerpc}
  996. option:=new(poption,Init);
  997. {$endif}
  998. { Load messages }
  999. if (cmd='') and (paramcount=0) then
  1000. Option^.WriteHelpPages;
  1001. { default defines }
  1002. def_symbol(target_info.short_name);
  1003. def_symbol('FPK');
  1004. def_symbol('FPC');
  1005. def_symbol('VER'+version_nr);
  1006. def_symbol('VER'+version_nr+'_'+release_nr);
  1007. def_symbol('VER'+version_nr+'_'+release_nr+'_'+patch_nr);
  1008. {$ifdef newcg}
  1009. def_symbol('WITHNEWCG');
  1010. {$endif}
  1011. { Temporary defines, until things settle down }
  1012. def_symbol('INT64');
  1013. def_symbol('HASRESOURCESTRINGS');
  1014. def_symbol('HASSAVEREGISTERS');
  1015. def_symbol('NEWVMTOFFSET');
  1016. def_symbol('HASINTERNMATH');
  1017. def_symbol('SYSTEMTVARREC');
  1018. def_symbol('INCLUDEOK');
  1019. def_symbol('NEWMM');
  1020. {$ifdef FPC_USE_CPREFIX}
  1021. { default on next round }
  1022. def_symbol('FPC_USE_CPREFIX');
  1023. {$endif FPC_USE_CPREFIX}
  1024. { some stuff for TP compatibility }
  1025. {$ifdef i386}
  1026. def_symbol('CPU86');
  1027. def_symbol('CPU87');
  1028. {$endif}
  1029. {$ifdef m68k}
  1030. def_symbol('CPU68');
  1031. {$endif}
  1032. { new processor stuff }
  1033. {$ifdef i386}
  1034. def_symbol('CPUI386');
  1035. {$endif}
  1036. {$ifdef m68k}
  1037. def_symbol('CPU68K');
  1038. {$endif}
  1039. {$ifdef ALPHA}
  1040. def_symbol('CPUALPHA');
  1041. {$endif}
  1042. {$ifdef powerpc}
  1043. def_symbol('CPUPOWERPC');
  1044. {$endif}
  1045. { get default messagefile }
  1046. {$ifdef Delphi}
  1047. msgfilename:=dmisc.getenv('PPC_ERROR_FILE');
  1048. {$else Delphi}
  1049. msgfilename:=dos.getenv('PPC_ERROR_FILE');
  1050. {$endif Delphi}
  1051. { default configfile }
  1052. if (cmd<>'') and (cmd[1]='[') then
  1053. begin
  1054. ppccfg:=Copy(cmd,2,pos(']',cmd)-2);
  1055. Delete(cmd,1,pos(']',cmd));
  1056. end
  1057. else
  1058. begin
  1059. {$ifdef i386}
  1060. ppccfg:='ppc386.cfg';
  1061. {$endif i386}
  1062. {$ifdef m68k}
  1063. ppccfg:='ppc.cfg';
  1064. {$endif}
  1065. {$ifdef alpha}
  1066. ppccfg:='ppcalpha.cfg';
  1067. {$endif}
  1068. {$ifdef powerpc}
  1069. ppccfg:='ppcppc.cfg';
  1070. {$endif}
  1071. end;
  1072. { Order to read ppc386.cfg:
  1073. 1 - current dir
  1074. 2 - configpath
  1075. 3 - compiler path }
  1076. {$ifdef Delphi}
  1077. configpath:=FixPath(dmisc.getenv('PPC_CONFIG_PATH'),false);
  1078. {$else Delphi}
  1079. configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false);
  1080. {$endif Delphi}
  1081. {$ifdef linux}
  1082. if configpath='' then
  1083. configpath:='/etc/';
  1084. {$endif}
  1085. if ppccfg<>'' then
  1086. begin
  1087. read_configfile:=true;
  1088. if not FileExists(ppccfg) then
  1089. begin
  1090. {$ifdef linux}
  1091. if (dos.getenv('HOME')<>'') and FileExists(FixPath(dos.getenv('HOME'),false)+'.'+ppccfg) then
  1092. ppccfg:=FixPath(dos.getenv('HOME'),false)+'.'+ppccfg
  1093. else
  1094. {$endif}
  1095. if FileExists(configpath+ppccfg) then
  1096. ppccfg:=configpath+ppccfg
  1097. else
  1098. {$ifndef linux}
  1099. if FileExists(exepath+ppccfg) then
  1100. ppccfg:=exepath+ppccfg
  1101. else
  1102. {$endif}
  1103. read_configfile:=false;
  1104. end;
  1105. end
  1106. else
  1107. read_configfile:=false;
  1108. { Read commandline and configfile }
  1109. target_is_set:=false;
  1110. asm_is_set:=false;
  1111. param_file:='';
  1112. if read_configfile then
  1113. begin
  1114. { read the parameters quick, only -v -T }
  1115. option^.firstpass:=true;
  1116. if cmd<>'' then
  1117. option^.parsecmd(cmd)
  1118. else
  1119. option^.read_parameters;
  1120. if read_configfile then
  1121. begin
  1122. {$ifdef EXTDEBUG}
  1123. Comment(V_Debug,'read config file: '+ppccfg);
  1124. {$endif EXTDEBUG}
  1125. option^.interpret_file(ppccfg);
  1126. end;
  1127. end;
  1128. option^.firstpass:=false;
  1129. if cmd<>'' then
  1130. option^.parsecmd(cmd)
  1131. else
  1132. option^.read_parameters;
  1133. { Stop if errors in options }
  1134. if ErrorCount>0 then
  1135. Stop;
  1136. { write logo if set }
  1137. if option^.DoWriteLogo then
  1138. option^.WriteLogo;
  1139. { Check file to compile }
  1140. if param_file='' then
  1141. begin
  1142. Message(option_no_source_found);
  1143. Stop;
  1144. end;
  1145. {$ifndef linux}
  1146. param_file:=FixFileName(param_file);
  1147. {$endif}
  1148. fsplit(param_file,inputdir,inputfile,inputextension);
  1149. if inputextension='' then
  1150. begin
  1151. if FileExists(inputdir+inputfile+target_os.sourceext) then
  1152. inputextension:=target_os.sourceext
  1153. else
  1154. if FileExists(inputdir+inputfile+target_os.pasext) then
  1155. inputextension:=target_os.pasext;
  1156. end;
  1157. { Add paths specified with parameters to the searchpaths }
  1158. UnitSearchPath.AddList(Option^.ParaUnitPath,true);
  1159. ObjectSearchPath.AddList(Option^.ParaObjectPath,true);
  1160. IncludeSearchPath.AddList(Option^.ParaIncludePath,true);
  1161. LibrarySearchPath.AddList(Option^.ParaLibraryPath,true);
  1162. { add unit environment and exepath to the unit search path }
  1163. if inputdir<>'' then
  1164. Unitsearchpath.AddPath(inputdir,true);
  1165. {$ifdef Delphi}
  1166. UnitSearchPath.AddPath(dmisc.getenv(target_info.unit_env),false);
  1167. {$else}
  1168. UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false);
  1169. {$endif Delphi}
  1170. {$ifdef linux}
  1171. UnitSearchPath.AddPath('/usr/lib/fpc/'+version_string+'/units/'+lower(target_info.short_name),false);
  1172. UnitSearchPath.AddPath('/usr/lib/fpc/'+version_string+'/rtl/'+lower(target_info.short_name),false);
  1173. {$else}
  1174. UnitSearchPath.AddPath(ExePath+'../units/'+lower(target_info.short_name),false);
  1175. UnitSearchPath.AddPath(ExePath+'../rtl/'+lower(target_info.short_name),false);
  1176. {$endif}
  1177. UnitSearchPath.AddPath(ExePath,false);
  1178. { Add unit dir to the object and library path }
  1179. objectsearchpath.AddList(unitsearchpath,false);
  1180. librarysearchpath.AddList(unitsearchpath,false);
  1181. { switch assembler if it's binary and we got -a on the cmdline }
  1182. if (cs_asm_leave in initglobalswitches) and
  1183. (target_asm.id in binassem) then
  1184. begin
  1185. Message(option_switch_bin_to_src_assembler);
  1186. set_target_asm(target_info.assemsrc);
  1187. initoutputformat:=target_asm.id;
  1188. end;
  1189. { turn off stripping if compiling with debuginfo or profile }
  1190. if (cs_debuginfo in initmoduleswitches) or
  1191. (cs_profile in initmoduleswitches) then
  1192. initglobalswitches:=initglobalswitches-[cs_link_strip];
  1193. { Set defines depending on the target }
  1194. if (target_info.target in [target_i386_GO32V1,target_i386_GO32V2]) then
  1195. def_symbol('DPMI'); { MSDOS is not defined in BP when target is DPMI }
  1196. MaybeLoadMessageFile;
  1197. dispose(option,Done);
  1198. end;
  1199. end.
  1200. {
  1201. $Log$
  1202. Revision 1.37 1999-11-20 01:22:19 pierre
  1203. + cond FPC_USE_CPREFIX (needs also some RTL changes)
  1204. this allows to use unit global vars as DLL exports
  1205. (the underline prefix seems needed by dlltool)
  1206. Revision 1.36 1999/11/15 17:42:40 pierre
  1207. * -g disables reloc section for win32
  1208. Revision 1.35 1999/11/12 11:03:50 peter
  1209. * searchpaths changed to stringqueue object
  1210. Revision 1.34 1999/11/09 23:06:45 peter
  1211. * esi_offset -> selfpointer_offset to be newcg compatible
  1212. * hcogegen -> cgbase fixes for newcg
  1213. Revision 1.33 1999/11/06 14:34:21 peter
  1214. * truncated log to 20 revs
  1215. Revision 1.32 1999/11/04 23:13:25 peter
  1216. * moved unit alias support into ifdef
  1217. Revision 1.31 1999/11/04 10:54:03 peter
  1218. + -Ua<oldname>=<newname> unit alias support
  1219. Revision 1.30 1999/11/03 23:43:09 peter
  1220. * default units/rtl paths
  1221. Revision 1.29 1999/10/30 17:35:26 peter
  1222. * fpc_freemem fpc_getmem new callings updated
  1223. Revision 1.28 1999/10/28 11:13:36 pierre
  1224. * fix for cygwin make problem with -iTP
  1225. Revision 1.27 1999/10/26 13:13:47 peter
  1226. * define INCLUDEOK, which seems to work correct
  1227. Revision 1.26 1999/10/14 14:57:52 florian
  1228. - removed the hcodegen use in the new cg, use cgbase instead
  1229. Revision 1.25 1999/10/13 10:24:49 peter
  1230. * dpmi can only be set after reading the options
  1231. Revision 1.24 1999/10/03 19:44:41 peter
  1232. * removed objpasunit reference, tvarrec is now searched in systemunit
  1233. where it already was located
  1234. Revision 1.23 1999/09/20 16:38:59 peter
  1235. * cs_create_smart instead of cs_smartlink
  1236. * -CX is create smartlink
  1237. * -CD is create dynamic, but does nothing atm.
  1238. Revision 1.22 1999/09/16 11:34:56 pierre
  1239. * typo correction
  1240. Revision 1.21 1999/09/15 20:35:40 florian
  1241. * small fix to operator overloading when in MMX mode
  1242. + the compiler uses now fldz and fld1 if possible
  1243. + some fixes to floating point registers
  1244. + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
  1245. * .... ???
  1246. Revision 1.20 1999/09/03 09:31:22 peter
  1247. * reading of search paths fixed to work as expected
  1248. Revision 1.19 1999/09/01 22:07:20 peter
  1249. * turn off stripping if profiling or debugging
  1250. Revision 1.18 1999/08/28 17:46:10 peter
  1251. * resources are working correct
  1252. Revision 1.17 1999/08/28 15:34:19 florian
  1253. * bug 519 fixed
  1254. Revision 1.16 1999/08/27 10:45:03 pierre
  1255. options -Ca sets simply_ppu to true
  1256. Revision 1.15 1999/08/25 22:51:00 pierre
  1257. * remove trailing space in cfg files
  1258. Revision 1.14 1999/08/16 15:35:26 pierre
  1259. * fix for DLL relocation problems
  1260. * external bss vars had wrong stabs for pecoff
  1261. + -WB11000000 to specify default image base, allows to
  1262. load several DLLs with debugging info included
  1263. (relocatable DLL are stripped because the relocation
  1264. of the .Stab section is misplaced by ldw)
  1265. Revision 1.13 1999/08/11 17:26:35 peter
  1266. * tlinker object is now inherited for win32 and dos
  1267. * postprocessexecutable is now a method of tlinker
  1268. }