scandir.pas 36 KB

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