scandir.pas 36 KB

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