scandir.pas 33 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Peter Vreman
  4. This unit implements directive parsing for the scanner
  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 scandir;
  19. {$i fpcdefs.inc}
  20. interface
  21. procedure InitScannerDirectives;
  22. implementation
  23. uses
  24. cutils,
  25. globtype,globals,systems,widestr,
  26. verbose,comphook,
  27. scanner,switches,
  28. fmodule,
  29. rabase;
  30. {*****************************************************************************
  31. Helpers
  32. *****************************************************************************}
  33. procedure do_delphiswitch(sw:char);
  34. var
  35. state : char;
  36. begin
  37. { c contains the next char, a + or - would be fine }
  38. state:=current_scanner.readstate;
  39. if state in ['-','+'] then
  40. HandleSwitch(sw,state);
  41. end;
  42. procedure do_setverbose(flag:char);
  43. var
  44. state : char;
  45. begin
  46. { support ON/OFF }
  47. state:=current_scanner.ReadState;
  48. SetVerbosity(flag+state);
  49. end;
  50. procedure do_moduleswitch(sw:tmoduleswitch);
  51. var
  52. state : char;
  53. begin
  54. state:=current_scanner.readstate;
  55. if (sw<>cs_modulenone) and (state in ['-','+']) then
  56. begin
  57. if state='-' then
  58. exclude(aktmoduleswitches,sw)
  59. else
  60. include(aktmoduleswitches,sw);
  61. end;
  62. end;
  63. procedure do_localswitch(sw:tlocalswitch);
  64. var
  65. state : char;
  66. begin
  67. state:=current_scanner.readstate;
  68. if (sw<>cs_localnone) and (state in ['-','+']) then
  69. begin
  70. if not localswitcheschanged then
  71. nextaktlocalswitches:=aktlocalswitches;
  72. if state='-' then
  73. exclude(nextaktlocalswitches,sw)
  74. else
  75. include(nextaktlocalswitches,sw);
  76. localswitcheschanged:=true;
  77. end;
  78. end;
  79. procedure do_message(w:integer);
  80. begin
  81. current_scanner.skipspace;
  82. Message1(w,current_scanner.readcomment);
  83. end;
  84. {*****************************************************************************
  85. Directive Callbacks
  86. *****************************************************************************}
  87. procedure dir_align;
  88. var
  89. hs : string;
  90. begin
  91. current_scanner.skipspace;
  92. if not(c in ['0'..'9']) then
  93. begin
  94. { Support also the ON and OFF as switch }
  95. hs:=current_scanner.readid;
  96. if (hs='ON') then
  97. aktpackrecords:=4
  98. else if (hs='OFF') then
  99. aktpackrecords:=1
  100. else if m_mac in aktmodeswitches then
  101. begin
  102. { Support switches used in Apples Universal Interfaces}
  103. if (hs='MAC68K') then
  104. aktpackrecords:=2
  105. else if (hs='POWER') then
  106. aktpackrecords:=4
  107. else if (hs='RESET') then
  108. aktpackrecords:=0
  109. end
  110. else
  111. Message(scan_w_only_pack_records);
  112. end
  113. else
  114. begin
  115. case current_scanner.readval of
  116. 1 : aktpackrecords:=1;
  117. 2 : aktpackrecords:=2;
  118. 4 : aktpackrecords:=4;
  119. 8 : aktpackrecords:=8;
  120. 16 : aktpackrecords:=16;
  121. 32 : aktpackrecords:=32;
  122. else
  123. Message(scan_w_only_pack_records);
  124. end;
  125. end;
  126. end;
  127. procedure dir_asmmode;
  128. var
  129. s : string;
  130. begin
  131. current_scanner.skipspace;
  132. s:=current_scanner.readid;
  133. If Inside_asm_statement then
  134. Message1(scan_w_no_asm_reader_switch_inside_asm,s);
  135. if s='DEFAULT' then
  136. aktasmmode:=initasmmode
  137. else
  138. if not SetAsmReadMode(s,aktasmmode) then
  139. Message1(scan_e_illegal_asmmode_specifier,s);
  140. end;
  141. {$ifdef m68k}
  142. procedure dir_appid;
  143. begin
  144. if target_info.system<>system_m68k_palmos then
  145. Message(scan_w_appid_not_support);
  146. { change description global var in all cases }
  147. { it not used but in win32 and os2 }
  148. current_scanner.skipspace;
  149. palmos_applicationid:=current_scanner.readcomment;
  150. end;
  151. procedure dir_appname;
  152. begin
  153. if target_info.system<>system_m68k_palmos then
  154. Message(scan_w_appname_not_support);
  155. { change description global var in all cases }
  156. { it not used but in win32 and os2 }
  157. current_scanner.skipspace;
  158. palmos_applicationname:=current_scanner.readcomment;
  159. end;
  160. {$endif m68k}
  161. procedure dir_apptype;
  162. var
  163. hs : string;
  164. begin
  165. if not (target_info.system in [system_i386_win32,system_i386_os2,
  166. system_i386_emx, system_powerpc_macos]) then
  167. Message(scan_w_app_type_not_support);
  168. if not current_module.in_global then
  169. Message(scan_w_switch_is_global)
  170. else
  171. begin
  172. current_scanner.skipspace;
  173. hs:=current_scanner.readid;
  174. if hs='GUI' then
  175. apptype:=app_gui
  176. else if hs='CONSOLE' then
  177. apptype:=app_cui
  178. else if (hs='FS') and (target_info.system in [system_i386_os2,
  179. system_i386_emx]) then
  180. apptype:=app_fs
  181. else if (hs='TOOL') and (target_info.system in [system_powerpc_macos]) then
  182. apptype:=app_tool
  183. else
  184. Message1(scan_w_unsupported_app_type,hs);
  185. end;
  186. end;
  187. procedure dir_calling;
  188. var
  189. hs : string;
  190. begin
  191. current_scanner.skipspace;
  192. hs:=current_scanner.readid;
  193. if not SetAktProcCall(hs,false) then
  194. Message1(parser_w_unknown_proc_directive_ignored,hs);
  195. end;
  196. procedure dir_objectchecks;
  197. begin
  198. do_localswitch(cs_check_object);
  199. end;
  200. procedure dir_assertions;
  201. begin
  202. do_delphiswitch('C');
  203. end;
  204. procedure dir_booleval;
  205. begin
  206. do_delphiswitch('B');
  207. end;
  208. procedure dir_debuginfo;
  209. begin
  210. do_delphiswitch('D');
  211. end;
  212. procedure dir_description;
  213. begin
  214. if not (target_info.system in [system_i386_os2,system_i386_emx,
  215. system_i386_win32,system_i386_netware,system_i386_wdosx]) then
  216. Message(scan_w_description_not_support);
  217. { change description global var in all cases }
  218. { it not used but in win32, os2 and netware }
  219. current_scanner.skipspace;
  220. description:=current_scanner.readcomment;
  221. DescriptionSetExplicity:=true;
  222. end;
  223. procedure dir_screenname; {ad}
  224. begin
  225. if target_info.system <> system_i386_netware then
  226. {Message(scan_w_decription_not_support);}
  227. comment (V_Warning,'Screenname only supported for target netware');
  228. current_scanner.skipspace;
  229. nwscreenname:=current_scanner.readcomment;
  230. end;
  231. procedure dir_threadname; {ad}
  232. begin
  233. if target_info.system <> system_i386_netware then
  234. {Message(scan_w_decription_not_support);}
  235. comment (V_Warning,'Threadname only supported for target netware');
  236. current_scanner.skipspace;
  237. nwthreadname:=current_scanner.readcomment;
  238. end;
  239. procedure dir_copyright; {ad}
  240. begin
  241. if target_info.system <> system_i386_netware then
  242. {Message(scan_w_decription_not_support);}
  243. comment (V_Warning,'Copyright only supported for target netware');
  244. current_scanner.skipspace;
  245. nwcopyright:=current_scanner.readcomment;
  246. end;
  247. procedure dir_error;
  248. begin
  249. do_message(scan_e_user_defined);
  250. end;
  251. procedure dir_extendedsyntax;
  252. begin
  253. do_delphiswitch('X');
  254. end;
  255. procedure dir_fatal;
  256. begin
  257. do_message(scan_f_user_defined);
  258. end;
  259. procedure dir_fputype;
  260. begin
  261. current_scanner.skipspace;
  262. if not(SetFPUType(upper(current_scanner.readcomment),false)) then
  263. comment(V_Error,'Illegal FPU type');
  264. end;
  265. procedure dir_goto;
  266. begin
  267. do_moduleswitch(cs_support_goto);
  268. end;
  269. procedure dir_hint;
  270. begin
  271. do_message(scan_h_user_defined);
  272. end;
  273. procedure dir_hints;
  274. begin
  275. do_setverbose('H');
  276. end;
  277. procedure dir_implicitexceptions;
  278. begin
  279. do_moduleswitch(cs_implicit_exceptions);
  280. end;
  281. procedure dir_includepath;
  282. begin
  283. if not current_module.in_global then
  284. Message(scan_w_switch_is_global)
  285. else
  286. begin
  287. current_scanner.skipspace;
  288. current_module.localincludesearchpath.AddPath(current_scanner.readcomment,false);
  289. end;
  290. end;
  291. procedure dir_info;
  292. begin
  293. do_message(scan_i_user_defined);
  294. end;
  295. procedure dir_inline;
  296. begin
  297. do_moduleswitch(cs_support_inline);
  298. end;
  299. procedure dir_interfaces;
  300. var
  301. hs : string;
  302. begin
  303. {corba/com/default}
  304. current_scanner.skipspace;
  305. hs:=current_scanner.readid;
  306. if (hs='CORBA') then
  307. aktinterfacetype:=it_interfacecorba
  308. else if (hs='COM') then
  309. aktinterfacetype:=it_interfacecom
  310. else if (hs='DEFAULT') then
  311. aktinterfacetype:=initinterfacetype
  312. else
  313. Message(scan_e_invalid_interface_type);
  314. end;
  315. procedure dir_iochecks;
  316. begin
  317. do_delphiswitch('I');
  318. end;
  319. procedure dir_librarypath;
  320. begin
  321. if not current_module.in_global then
  322. Message(scan_w_switch_is_global)
  323. else
  324. begin
  325. current_scanner.skipspace;
  326. current_module.locallibrarysearchpath.AddPath(current_scanner.readcomment,false);
  327. end;
  328. end;
  329. procedure dir_link;
  330. var
  331. s : string;
  332. begin
  333. current_scanner.skipspace;
  334. s:=AddExtension(FixFileName(current_scanner.readcomment),target_info.objext);
  335. current_module.linkotherofiles.add(s,link_allways);
  336. end;
  337. procedure dir_linklib;
  338. type
  339. tLinkMode=(lm_shared,lm_static);
  340. var
  341. s : string;
  342. quote : char;
  343. libname,
  344. linkmodestr : string;
  345. p : longint;
  346. linkMode : tLinkMode;
  347. begin
  348. current_scanner.skipspace;
  349. s:=current_scanner.readcomment;
  350. p:=pos(',',s);
  351. if p=0 then
  352. begin
  353. libname:=TrimSpace(s);
  354. linkmodeStr:='';
  355. end
  356. else
  357. begin
  358. libname:=TrimSpace(copy(s,1,p-1));
  359. linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
  360. end;
  361. if (libname='') or (libname='''''') or (libname='""') then
  362. exit;
  363. { get linkmode, default is shared linking }
  364. if linkModeStr='STATIC' then
  365. linkmode:=lm_static
  366. else if (LinkModeStr='SHARED') or (LinkModeStr='') then
  367. linkmode:=lm_shared
  368. else
  369. begin
  370. Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
  371. exit;
  372. end;
  373. { create library name }
  374. if libname[1] in ['''','"'] then
  375. begin
  376. quote:=libname[1];
  377. Delete(libname,1,1);
  378. p:=pos(quote,libname);
  379. if p>0 then
  380. Delete(libname,p,1);
  381. end;
  382. { add to the list of libraries to link }
  383. if linkMode=lm_static then
  384. current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
  385. else
  386. current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
  387. end;
  388. procedure dir_localsymbols;
  389. begin
  390. do_delphiswitch('L');
  391. end;
  392. procedure dir_longstrings;
  393. begin
  394. do_delphiswitch('H');
  395. end;
  396. procedure dir_macro;
  397. begin
  398. do_moduleswitch(cs_support_macro);
  399. end;
  400. procedure dir_maxfpuregisters;
  401. var
  402. l : integer;
  403. hs : string;
  404. begin
  405. current_scanner.skipspace;
  406. if not(c in ['0'..'9']) then
  407. begin
  408. hs:=current_scanner.readid;
  409. if (hs='NORMAL') or (hs='DEFAULT') then
  410. aktmaxfpuregisters:=-1
  411. else
  412. Message(scan_e_invalid_maxfpureg_value);
  413. end
  414. else
  415. begin
  416. l:=current_scanner.readval;
  417. case l of
  418. 0..8:
  419. aktmaxfpuregisters:=l;
  420. else
  421. Message(scan_e_invalid_maxfpureg_value);
  422. end;
  423. end;
  424. end;
  425. procedure dir_memory;
  426. var
  427. l : longint;
  428. begin
  429. current_scanner.skipspace;
  430. l:=current_scanner.readval;
  431. if l>1024 then
  432. stacksize:=l;
  433. current_scanner.skipspace;
  434. if c=',' then
  435. begin
  436. current_scanner.readchar;
  437. current_scanner.skipspace;
  438. l:=current_scanner.readval;
  439. if l>1024 then
  440. heapsize:=l;
  441. end;
  442. if c=',' then
  443. begin
  444. current_scanner.readchar;
  445. current_scanner.skipspace;
  446. l:=current_scanner.readval;
  447. { Ignore this value, because the limit is set by the OS
  448. info and shouldn't be changed by the user (PFV) }
  449. end;
  450. end;
  451. procedure dir_message;
  452. var
  453. hs : string;
  454. w : longint;
  455. begin
  456. w:=0;
  457. current_scanner.skipspace;
  458. { Message level specified? }
  459. if c='''' then
  460. w:=scan_n_user_defined
  461. else
  462. begin
  463. hs:=current_scanner.readid;
  464. if (hs='WARN') or (hs='WARNING') then
  465. w:=scan_w_user_defined
  466. else
  467. if (hs='ERROR') then
  468. w:=scan_e_user_defined
  469. else
  470. if (hs='FATAL') then
  471. w:=scan_f_user_defined
  472. else
  473. if (hs='HINT') then
  474. w:=scan_h_user_defined
  475. else
  476. if (hs='NOTE') then
  477. w:=scan_n_user_defined
  478. else
  479. Message1(scan_w_illegal_directive,hs);
  480. end;
  481. { Only print message when there was no error }
  482. if w<>0 then
  483. begin
  484. current_scanner.skipspace;
  485. if c='''' then
  486. hs:=current_scanner.readquotedstring
  487. else
  488. hs:=current_scanner.readcomment;
  489. Message1(w,hs);
  490. end
  491. else
  492. current_scanner.readcomment;
  493. end;
  494. procedure dir_mode;
  495. begin
  496. if not current_module.in_global then
  497. Message(scan_w_switch_is_global)
  498. else
  499. begin
  500. current_scanner.skipspace;
  501. current_scanner.readstring;
  502. if not SetCompileMode(pattern,false) then
  503. Message1(scan_w_illegal_switch,pattern);
  504. end;
  505. end;
  506. procedure dir_mmx;
  507. begin
  508. do_localswitch(cs_mmx);
  509. end;
  510. procedure dir_note;
  511. begin
  512. do_message(scan_n_user_defined);
  513. end;
  514. procedure dir_notes;
  515. begin
  516. do_setverbose('N');
  517. end;
  518. procedure dir_objectpath;
  519. begin
  520. if not current_module.in_global then
  521. Message(scan_w_switch_is_global)
  522. else
  523. begin
  524. current_scanner.skipspace;
  525. current_module.localobjectsearchpath.AddPath(current_scanner.readcomment,false);
  526. end;
  527. end;
  528. procedure dir_openstrings;
  529. begin
  530. do_delphiswitch('P');
  531. end;
  532. procedure dir_output_format;
  533. begin
  534. if not current_module.in_global then
  535. Message(scan_w_switch_is_global)
  536. else
  537. begin
  538. current_scanner.skipspace;
  539. if set_target_asm_by_string(current_scanner.readid) then
  540. aktoutputformat:=target_asm.id
  541. else
  542. Message1(scan_w_illegal_switch,pattern);
  543. end;
  544. end;
  545. procedure dir_overflowchecks;
  546. begin
  547. do_delphiswitch('Q');
  548. end;
  549. procedure dir_packenum;
  550. var
  551. hs : string;
  552. begin
  553. current_scanner.skipspace;
  554. if not(c in ['0'..'9']) then
  555. begin
  556. hs:=current_scanner.readid;
  557. if (hs='NORMAL') or (hs='DEFAULT') then
  558. aktpackenum:=4
  559. else
  560. Message(scan_w_only_pack_enum);
  561. end
  562. else
  563. begin
  564. case current_scanner.readval of
  565. 1 : aktpackenum:=1;
  566. 2 : aktpackenum:=2;
  567. 4 : aktpackenum:=4;
  568. else
  569. Message(scan_w_only_pack_enum);
  570. end;
  571. end;
  572. end;
  573. procedure dir_packrecords;
  574. var
  575. hs : string;
  576. begin
  577. current_scanner.skipspace;
  578. if not(c in ['0'..'9']) then
  579. begin
  580. hs:=current_scanner.readid;
  581. { C has the special recordalignmax of -1 }
  582. if (hs='C') then
  583. aktpackrecords:=-1
  584. else
  585. if (hs='NORMAL') or (hs='DEFAULT') then
  586. aktpackrecords:=0
  587. else
  588. Message(scan_w_only_pack_records);
  589. end
  590. else
  591. begin
  592. case current_scanner.readval of
  593. 1 : aktpackrecords:=1;
  594. 2 : aktpackrecords:=2;
  595. 4 : aktpackrecords:=4;
  596. 8 : aktpackrecords:=8;
  597. 16 : aktpackrecords:=16;
  598. 32 : aktpackrecords:=32;
  599. else
  600. Message(scan_w_only_pack_records);
  601. end;
  602. end;
  603. end;
  604. {$ifdef testvarsets}
  605. procedure dir_packset;
  606. var
  607. hs : string;
  608. begin
  609. current_scanner.skipspace;
  610. if not(c in ['1','2','4']) then
  611. begin
  612. hs:=current_scanner.readid;
  613. if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then
  614. aktsetalloc:=0 {Fixed mode, sets are 4 or 32 bytes}
  615. else
  616. Message(scan_w_only_packset);
  617. end
  618. else
  619. begin
  620. case current_scanner.readval of
  621. 1 : aktsetalloc:=1;
  622. 2 : aktsetalloc:=2;
  623. 4 : aktsetalloc:=4;
  624. else
  625. Message(scan_w_only_packset);
  626. end;
  627. end;
  628. end;
  629. {$ENDIF}
  630. procedure dir_profile;
  631. var
  632. mac : tmacro;
  633. begin
  634. do_moduleswitch(cs_profile);
  635. { defined/undefine FPC_PROFILE }
  636. mac:=tmacro(current_scanner.macros.search('FPC_PROFILE'));
  637. if not assigned(mac) then
  638. begin
  639. mac:=tmacro.create('FPC_PROFILE');
  640. current_scanner.macros.insert(mac);
  641. end;
  642. mac.defined:=(cs_profile in aktmoduleswitches);
  643. end;
  644. procedure dir_rangechecks;
  645. begin
  646. do_delphiswitch('R');
  647. end;
  648. procedure dir_referenceinfo;
  649. begin
  650. do_delphiswitch('Y');
  651. end;
  652. procedure dir_resource;
  653. var
  654. s : string;
  655. begin
  656. current_scanner.skipspace;
  657. s:=current_scanner.readcomment;
  658. { replace * with current module name.
  659. This should always be defined. }
  660. if s[1]='*' then
  661. if Assigned(Current_Module) then
  662. begin
  663. delete(S,1,1);
  664. insert(lower(current_module.modulename^),S,1);
  665. end;
  666. s:=AddExtension(FixFileName(s),target_info.resext);
  667. if target_info.res<>res_none then
  668. if (target_info.res = res_emxbind) and
  669. not (Current_module.ResourceFiles.Empty) then
  670. Message(scan_w_only_one_resourcefile_supported)
  671. else
  672. current_module.resourcefiles.insert(FixFileName(s))
  673. else
  674. Message(scan_e_resourcefiles_not_supported);
  675. end;
  676. procedure dir_saturation;
  677. begin
  678. do_localswitch(cs_mmx_saturation);
  679. end;
  680. procedure dir_smartlink;
  681. begin
  682. do_moduleswitch(cs_create_smart);
  683. end;
  684. procedure dir_stackframes;
  685. begin
  686. do_delphiswitch('W');
  687. end;
  688. procedure dir_static;
  689. begin
  690. do_moduleswitch(cs_static_keyword);
  691. end;
  692. procedure dir_stop;
  693. begin
  694. do_message(scan_f_user_defined);
  695. end;
  696. procedure dir_threading;
  697. var
  698. mac : tmacro;
  699. begin
  700. do_moduleswitch(cs_threading);
  701. { defined/undefine FPC_THREADING }
  702. mac:=tmacro(current_scanner.macros.search('FPC_THREADING'));
  703. if not assigned(mac) then
  704. begin
  705. mac:=tmacro.create('FPC_THREADING');
  706. current_scanner.macros.insert(mac);
  707. end;
  708. mac.defined:=(cs_threading in aktmoduleswitches);
  709. end;
  710. procedure dir_typedaddress;
  711. begin
  712. do_delphiswitch('T');
  713. end;
  714. procedure dir_typeinfo;
  715. begin
  716. do_delphiswitch('M');
  717. end;
  718. procedure dir_unitpath;
  719. begin
  720. if not current_module.in_global then
  721. Message(scan_w_switch_is_global)
  722. else
  723. with current_scanner,current_module,localunitsearchpath do
  724. begin
  725. skipspace;
  726. AddPath(path^,readcomment,false);
  727. end;
  728. end;
  729. procedure dir_varstringchecks;
  730. begin
  731. do_delphiswitch('V');
  732. end;
  733. procedure dir_version;
  734. var
  735. major, minor, revision : longint;
  736. error : integer;
  737. begin
  738. if not (target_info.system in [system_i386_os2,system_i386_emx,
  739. system_i386_win32,system_i386_netware,system_i386_wdosx]) then
  740. begin
  741. Message(scan_n_version_not_support);
  742. exit;
  743. end;
  744. if (compile_level<>1) then
  745. Message(scan_n_only_exe_version)
  746. else
  747. begin
  748. { change description global var in all cases }
  749. { it not used but in win32, os2 and netware }
  750. current_scanner.skipspace;
  751. { we should only accept Major.Minor format for win32 and os2 }
  752. current_scanner.readnumber;
  753. major:=0;
  754. minor:=0;
  755. revision:=0;
  756. valint(pattern,major,error);
  757. if (error<>0) or (major > high(word)) or (major < 0) then
  758. begin
  759. Message1(scan_w_wrong_version_ignored,pattern);
  760. exit;
  761. end;
  762. if c='.' then
  763. begin
  764. current_scanner.readchar;
  765. current_scanner.readnumber;
  766. valint(pattern,minor,error);
  767. if (error<>0) or (minor > high(word)) or (minor < 0) then
  768. begin
  769. Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
  770. exit;
  771. end;
  772. if (c='.') and
  773. (target_info.system = system_i386_netware) then
  774. begin
  775. current_scanner.readchar;
  776. current_scanner.readnumber;
  777. valint(pattern,revision,error);
  778. if (error<>0) or (revision > high(word)) or (revision < 0) then
  779. begin
  780. Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
  781. exit;
  782. end;
  783. dllmajor:=word(major);
  784. dllminor:=word(minor);
  785. dllrevision:=word(revision);
  786. dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
  787. end
  788. else
  789. begin
  790. dllmajor:=word(major);
  791. dllminor:=word(minor);
  792. dllversion:=tostr(major)+'.'+tostr(minor);
  793. end;
  794. end
  795. else
  796. dllversion:=tostr(major);
  797. end;
  798. end;
  799. procedure dir_wait;
  800. var
  801. had_info : boolean;
  802. begin
  803. had_info:=(status.verbosity and V_Info)<>0;
  804. { this message should allways appear !! }
  805. status.verbosity:=status.verbosity or V_Info;
  806. Message(scan_i_press_enter);
  807. readln;
  808. If not(had_info) then
  809. status.verbosity:=status.verbosity and (not V_Info);
  810. end;
  811. procedure dir_warning;
  812. begin
  813. do_message(scan_w_user_defined);
  814. end;
  815. procedure dir_warnings;
  816. begin
  817. do_setverbose('W');
  818. end;
  819. procedure dir_writeableconst;
  820. begin
  821. do_delphiswitch('J');
  822. end;
  823. procedure dir_z1;
  824. begin
  825. aktpackenum:=1;
  826. end;
  827. procedure dir_z2;
  828. begin
  829. aktpackenum:=2;
  830. end;
  831. procedure dir_z4;
  832. begin
  833. aktpackenum:=4;
  834. end;
  835. procedure dir_externalsym;
  836. begin
  837. end;
  838. procedure dir_codepage;
  839. var
  840. s : string;
  841. begin
  842. if not current_module.in_global then
  843. Message(scan_w_switch_is_global)
  844. else
  845. begin
  846. current_scanner.skipspace;
  847. s:=current_scanner.readcomment;
  848. if not(cpavailable(s)) then
  849. Message1(option_code_page_not_available,s)
  850. else
  851. aktsourcecodepage:=s;
  852. end;
  853. end;
  854. {****************************************************************************
  855. Initialize Directives
  856. ****************************************************************************}
  857. procedure InitScannerDirectives;
  858. begin
  859. AddDirective('ALIGN',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_align);
  860. {$ifdef m68k}
  861. AddDirective('APPID',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_appid);
  862. AddDirective('APPNAME',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_appname);
  863. {$endif m68k}
  864. AddDirective('APPTYPE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_apptype);
  865. AddDirective('ASMMODE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
  866. AddDirective('ASSERTIONS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_assertions);
  867. AddDirective('BOOLEVAL',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_booleval);
  868. AddDirective('CALLING',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_calling);
  869. AddDirective('CODEPAGE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_codepage);
  870. AddDirective('COPYRIGHT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_copyright);
  871. AddDirective('D',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_description);
  872. AddDirective('DEBUGINFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
  873. AddDirective('DESCRIPTION',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_description);
  874. AddDirective('ERROR',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_error);
  875. AddDirective('EXTENDEDSYNTAX',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_extendedsyntax);
  876. AddDirective('EXTERNALSYM',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_externalsym);
  877. AddDirective('FATAL',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_fatal);
  878. AddDirective('FPUTYPE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_fputype);
  879. AddDirective('GOTO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_goto);
  880. AddDirective('HINT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_hint);
  881. AddDirective('HINTS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_hints);
  882. AddDirective('IOCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_iochecks);
  883. AddDirective('IMPLICITEXCEPTIONS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_implicitexceptions);
  884. AddDirective('INCLUDEPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_includepath);
  885. AddDirective('INFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_info);
  886. AddDirective('INLINE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_inline);
  887. AddDirective('INTERFACES',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_interfaces);
  888. AddDirective('L',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_link);
  889. AddDirective('LIBRARYPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_librarypath);
  890. AddDirective('LINK',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_link);
  891. AddDirective('LINKLIB',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_linklib);
  892. AddDirective('LOCALSYMBOLS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_localsymbols);
  893. AddDirective('LONGSTRINGS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_longstrings);
  894. AddDirective('M',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_memory);
  895. AddDirective('MACRO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_macro);
  896. AddDirective('MAXFPUREGISTERS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_maxfpuregisters);
  897. AddDirective('MEMORY',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_memory);
  898. AddDirective('MESSAGE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_message);
  899. AddDirective('MINENUMSIZE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packenum);
  900. AddDirective('MMX',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_mmx);
  901. AddDirective('MODE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_mode);
  902. AddDirective('NOTE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_note);
  903. AddDirective('NOTES',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_notes);
  904. AddDirective('OBJECTCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_objectchecks);
  905. AddDirective('OBJECTPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_objectpath);
  906. AddDirective('OPENSTRINGS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_openstrings);
  907. AddDirective('OUTPUT_FORMAT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_output_format);
  908. AddDirective('OVERFLOWCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_overflowchecks);
  909. AddDirective('PACKENUM',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packenum);
  910. AddDirective('PACKRECORDS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packrecords);
  911. {$IFDEF TestVarsets}
  912. AddDirective('PACKSET',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packset);
  913. {$ENDIF}
  914. AddDirective('PROFILE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_profile);
  915. AddDirective('R',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_resource);
  916. AddDirective('RANGECHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_rangechecks);
  917. AddDirective('REFERENCEINFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_referenceinfo);
  918. AddDirective('SATURATION',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_saturation);
  919. AddDirective('SCREENNAME',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_screenname);
  920. AddDirective('SMARTLINK',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_smartlink);
  921. AddDirective('STACKFRAMES',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_stackframes);
  922. AddDirective('STATIC',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_static);
  923. AddDirective('STOP',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_stop);
  924. AddDirective('THREADING',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_threading);
  925. AddDirective('THREADNAME',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_threadname);
  926. AddDirective('TYPEDADDRESS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_typedaddress);
  927. AddDirective('TYPEINFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_typeinfo);
  928. AddDirective('UNITPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_unitpath);
  929. AddDirective('VARSTRINGCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_varstringchecks);
  930. AddDirective('VERSION',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_version);
  931. AddDirective('WAIT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_wait);
  932. AddDirective('WARNING',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_warning);
  933. AddDirective('WARNINGS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_warnings);
  934. AddDirective('WRITEABLECONST',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_writeableconst);
  935. AddDirective('Z1',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_z1);
  936. AddDirective('Z2',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_z2);
  937. AddDirective('Z4',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_z4);
  938. end;
  939. end.
  940. {
  941. $Log$
  942. Revision 1.37 2004-06-20 08:55:30 florian
  943. * logs truncated
  944. Revision 1.36 2004/06/16 20:07:09 florian
  945. * dwarf branch merged
  946. Revision 1.35 2004/05/19 23:29:56 peter
  947. * $message directive compatible with delphi
  948. Revision 1.34 2004/05/11 22:51:34 olle
  949. * Performanceimprovement
  950. Revision 1.33 2004/05/11 18:30:50 olle
  951. + mode macpas: support for Apples align directives
  952. Revision 1.32.2.1 2004/05/03 14:59:57 peter
  953. * no dlltool needed for win32 linking executables
  954. }