options.pas 41 KB

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