scandir.pas 53 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678
  1. {
  2. Copyright (c) 1998-2002 by Peter Vreman
  3. This unit implements directive parsing for the scanner
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit scandir;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype;
  22. const
  23. switchesstatestackmax = 20;
  24. type
  25. tsavedswitchesstate = record
  26. localsw: tlocalswitches;
  27. verbosity: longint;
  28. pmessage : pmessagestaterecord;
  29. end;
  30. type
  31. tswitchesstatestack = array[0..switchesstatestackmax] of tsavedswitchesstate;
  32. var
  33. switchesstatestack:tswitchesstatestack;
  34. switchesstatestackpos: Integer;
  35. procedure InitScannerDirectives;
  36. implementation
  37. uses
  38. SysUtils,
  39. cutils,cfileutl,
  40. globals,systems,widestr,cpuinfo,
  41. verbose,comphook,ppu,
  42. scanner,switches,
  43. fmodule,
  44. defutil,
  45. dirparse,
  46. symconst,symtable,symbase,symtype,symsym,
  47. rabase;
  48. {*****************************************************************************
  49. Helpers
  50. *****************************************************************************}
  51. procedure do_delphiswitch(sw:char);
  52. var
  53. state : char;
  54. begin
  55. { c contains the next char, a + or - would be fine }
  56. state:=current_scanner.readstate;
  57. if state in ['-','+'] then
  58. HandleSwitch(sw,state);
  59. end;
  60. procedure do_setverbose(flag:char);
  61. var
  62. state : char;
  63. begin
  64. { support ON/OFF }
  65. state:=current_scanner.ReadState;
  66. recordpendingverbosityswitch(flag,state);
  67. end;
  68. procedure do_moduleswitch(sw:tmoduleswitch);
  69. var
  70. state : char;
  71. begin
  72. state:=current_scanner.readstate;
  73. if (sw<>cs_modulenone) and (state in ['-','+']) then
  74. begin
  75. if state='-' then
  76. exclude(current_settings.moduleswitches,sw)
  77. else
  78. include(current_settings.moduleswitches,sw);
  79. end;
  80. end;
  81. procedure do_localswitch(sw:tlocalswitch);
  82. var
  83. state : char;
  84. begin
  85. state:=current_scanner.readstate;
  86. if (sw<>cs_localnone) and (state in ['-','+']) then
  87. recordpendinglocalswitch(sw,state);
  88. end;
  89. function do_localswitchdefault(sw:tlocalswitch): char;
  90. begin
  91. result:=current_scanner.readstatedefault;
  92. if (sw<>cs_localnone) and (result in ['-','+','*']) then
  93. recordpendinglocalswitch(sw,result);
  94. end;
  95. procedure do_message(w:integer);
  96. begin
  97. current_scanner.skipspace;
  98. Message1(w,current_scanner.readcomment);
  99. end;
  100. {*****************************************************************************
  101. Directive Callbacks
  102. *****************************************************************************}
  103. procedure dir_align;
  104. var
  105. hs : string;
  106. b : byte;
  107. begin
  108. current_scanner.skipspace;
  109. if not(c in ['0'..'9']) then
  110. begin
  111. { Support also the ON and OFF as switch }
  112. hs:=current_scanner.readid;
  113. if (hs='ON') then
  114. current_settings.packrecords:=4
  115. else if (hs='OFF') then
  116. current_settings.packrecords:=1
  117. else if m_mac in current_settings.modeswitches then
  118. begin
  119. { Support switches used in Apples Universal Interfaces}
  120. if (hs='MAC68K') then
  121. current_settings.packrecords:=mac68k_alignment
  122. { "power" alignment is the default C packrecords setting on
  123. Mac OS X }
  124. else if (hs='POWER') or (hs='POWERPC') then
  125. current_settings.packrecords:=C_alignment
  126. else if (hs='RESET') then
  127. current_settings.packrecords:=default_settings.packrecords
  128. else
  129. Message1(scan_e_illegal_pack_records,hs);
  130. end
  131. else
  132. Message1(scan_e_illegal_pack_records,hs);
  133. end
  134. else
  135. begin
  136. b:=current_scanner.readval;
  137. case b of
  138. 1 : current_settings.packrecords:=1;
  139. 2 : current_settings.packrecords:=2;
  140. 4 : current_settings.packrecords:=4;
  141. 8 : current_settings.packrecords:=8;
  142. 16 : current_settings.packrecords:=16;
  143. 32 : current_settings.packrecords:=32;
  144. else
  145. Message1(scan_e_illegal_pack_records,tostr(b));
  146. end;
  147. end;
  148. end;
  149. procedure dir_a1;
  150. begin
  151. current_settings.packrecords:=1;
  152. end;
  153. procedure dir_a2;
  154. begin
  155. current_settings.packrecords:=2;
  156. end;
  157. procedure dir_a4;
  158. begin
  159. current_settings.packrecords:=4;
  160. end;
  161. procedure dir_a8;
  162. begin
  163. current_settings.packrecords:=8;
  164. end;
  165. procedure dir_asmmode;
  166. var
  167. s : string;
  168. begin
  169. current_scanner.skipspace;
  170. s:=current_scanner.readid;
  171. If Inside_asm_statement then
  172. Message1(scan_w_no_asm_reader_switch_inside_asm,s);
  173. if s='DEFAULT' then
  174. current_settings.asmmode:=init_settings.asmmode
  175. else
  176. if not SetAsmReadMode(s,current_settings.asmmode) then
  177. Message1(scan_e_illegal_asmmode_specifier,s);
  178. end;
  179. {$if defined(m68k) or defined(arm)}
  180. procedure dir_appid;
  181. begin
  182. if target_info.system<>system_m68k_palmos then
  183. Message(scan_w_appid_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_applicationid:=current_scanner.readcomment;
  188. end;
  189. procedure dir_appname;
  190. begin
  191. if target_info.system<>system_m68k_palmos then
  192. Message(scan_w_appname_not_support);
  193. { change description global var in all cases }
  194. { it not used but in win32 and os2 }
  195. current_scanner.skipspace;
  196. palmos_applicationname:=current_scanner.readcomment;
  197. end;
  198. {$endif defined(m68k) or defined(arm)}
  199. procedure dir_apptype;
  200. var
  201. hs : string;
  202. begin
  203. if not (target_info.system in systems_all_windows + [system_i386_os2,
  204. system_i386_emx, system_powerpc_macos,
  205. system_arm_nds, system_i8086_msdos] +
  206. systems_nativent) then
  207. begin
  208. if m_delphi in current_settings.modeswitches then
  209. Message(scan_n_app_type_not_support)
  210. else
  211. Message(scan_w_app_type_not_support);
  212. end
  213. else
  214. begin
  215. if not current_module.in_global then
  216. Message(scan_w_switch_is_global)
  217. else
  218. begin
  219. current_scanner.skipspace;
  220. hs:=current_scanner.readid;
  221. if (hs='GUI') and not (target_info.system in [system_i8086_msdos]) then
  222. SetApptype(app_gui)
  223. else if (hs='CONSOLE') and not (target_info.system in [system_i8086_msdos]) then
  224. SetApptype(app_cui)
  225. else if (hs='NATIVE') and (target_info.system in systems_windows + systems_nativent) then
  226. SetApptype(app_native)
  227. else if (hs='FS') and (target_info.system in [system_i386_os2,
  228. system_i386_emx]) then
  229. SetApptype(app_fs)
  230. else if (hs='TOOL') and (target_info.system in [system_powerpc_macos]) then
  231. SetApptype(app_tool)
  232. else if (hs='ARM9') and (target_info.system in [system_arm_nds]) then
  233. SetApptype(app_arm9)
  234. else if (hs='ARM7') and (target_info.system in [system_arm_nds]) then
  235. SetApptype(app_arm7)
  236. else if (hs='COM') and (target_info.system in [system_i8086_msdos]) then
  237. SetApptype(app_com)
  238. else if (hs='EXE') and (target_info.system in [system_i8086_msdos]) then
  239. SetApptype(app_cui)
  240. else
  241. Message1(scan_w_unsupported_app_type,hs);
  242. end;
  243. end;
  244. end;
  245. procedure dir_calling;
  246. var
  247. hs : string;
  248. begin
  249. current_scanner.skipspace;
  250. hs:=current_scanner.readid;
  251. if (hs='') then
  252. Message(parser_e_proc_directive_expected)
  253. else
  254. recordpendingcallingswitch(hs);
  255. end;
  256. procedure dir_checklowaddrloads;
  257. begin
  258. do_localswitchdefault(cs_check_low_addr_load);
  259. end;
  260. procedure dir_checkpointer;
  261. var
  262. switch: char;
  263. begin
  264. switch:=do_localswitchdefault(cs_checkpointer);
  265. if (switch='+') and
  266. not(target_info.system in systems_support_checkpointer) then
  267. Message1(scan_e_unsupported_switch,'CHECKPOINTER+');
  268. end;
  269. procedure dir_objectchecks;
  270. begin
  271. do_localswitch(cs_check_object);
  272. end;
  273. procedure dir_ieeeerrors;
  274. begin
  275. do_localswitch(cs_ieee_errors);
  276. end;
  277. procedure dir_assertions;
  278. begin
  279. do_delphiswitch('C');
  280. end;
  281. procedure dir_booleval;
  282. begin
  283. do_delphiswitch('B');
  284. end;
  285. procedure dir_debuginfo;
  286. begin
  287. do_delphiswitch('D');
  288. end;
  289. procedure dir_description;
  290. begin
  291. if not (target_info.system in systems_all_windows+[system_i386_os2,system_i386_emx,
  292. system_i386_netware,system_i386_wdosx,system_i386_netwlibc]) then
  293. Message(scan_w_description_not_support);
  294. { change description global var in all cases }
  295. { it not used but in win32, os2 and netware }
  296. current_scanner.skipspace;
  297. description:=current_scanner.readcomment;
  298. DescriptionSetExplicity:=true;
  299. end;
  300. procedure dir_screenname; {ad}
  301. begin
  302. if not (target_info.system in [system_i386_netware,system_i386_netwlibc]) then
  303. {Message(scan_w_decription_not_support);}
  304. comment (V_Warning,'Screenname only supported for target netware');
  305. current_scanner.skipspace;
  306. nwscreenname:=current_scanner.readcomment;
  307. end;
  308. procedure dir_threadname; {ad}
  309. begin
  310. if not (target_info.system in [system_i386_netware,system_i386_netwlibc]) then
  311. {Message(scan_w_decription_not_support);}
  312. comment (V_Warning,'Threadname only supported for target netware');
  313. current_scanner.skipspace;
  314. nwthreadname:=current_scanner.readcomment;
  315. end;
  316. procedure dir_copyright; {ad}
  317. begin
  318. if not (target_info.system in [system_i386_netware,system_i386_netwlibc]) then
  319. {Message(scan_w_decription_not_support);}
  320. comment (V_Warning,'Copyright only supported for target netware');
  321. current_scanner.skipspace;
  322. nwcopyright:=current_scanner.readcomment;
  323. end;
  324. procedure dir_error;
  325. begin
  326. do_message(scan_e_user_defined);
  327. end;
  328. procedure dir_extendedsyntax;
  329. begin
  330. do_delphiswitch('X');
  331. end;
  332. procedure dir_fatal;
  333. begin
  334. do_message(scan_f_user_defined);
  335. end;
  336. procedure dir_fputype;
  337. begin
  338. current_scanner.skipspace;
  339. undef_system_macro('FPU'+fputypestr[current_settings.fputype]);
  340. if not(SetFPUType(upper(current_scanner.readcomment),current_settings.fputype)) then
  341. comment(V_Error,'Illegal FPU type');
  342. def_system_macro('FPU'+fputypestr[current_settings.fputype]);
  343. end;
  344. procedure dir_frameworkpath;
  345. begin
  346. if not current_module.in_global then
  347. Message(scan_w_switch_is_global)
  348. else if not(target_info.system in systems_darwin) then
  349. begin
  350. Message(scan_w_frameworks_darwin_only);
  351. current_scanner.skipspace;
  352. current_scanner.readcomment
  353. end
  354. else
  355. begin
  356. current_scanner.skipspace;
  357. current_module.localframeworksearchpath.AddPath(current_scanner.readcomment,false);
  358. end;
  359. end;
  360. procedure dir_goto;
  361. begin
  362. do_moduleswitch(cs_support_goto);
  363. end;
  364. procedure dir_hint;
  365. begin
  366. do_message(scan_h_user_defined);
  367. end;
  368. procedure dir_hints;
  369. begin
  370. do_setverbose('H');
  371. end;
  372. procedure dir_imagebase;
  373. begin
  374. if not (target_info.system in (systems_windows+systems_wince)) then
  375. Message(scan_w_imagebase_not_support);
  376. current_scanner.skipspace;
  377. imagebase:=current_scanner.readval;
  378. ImageBaseSetExplicity:=true
  379. end;
  380. procedure dir_implicitexceptions;
  381. begin
  382. do_moduleswitch(cs_implicit_exceptions);
  383. end;
  384. procedure dir_includepath;
  385. begin
  386. if not current_module.in_global then
  387. Message(scan_w_switch_is_global)
  388. else
  389. begin
  390. current_scanner.skipspace;
  391. current_module.localincludesearchpath.AddPath(current_scanner.readcomment,false);
  392. end;
  393. end;
  394. procedure dir_info;
  395. begin
  396. do_message(scan_i_user_defined);
  397. end;
  398. procedure dir_inline;
  399. begin
  400. do_localswitch(cs_do_inline);
  401. end;
  402. procedure dir_interfaces;
  403. var
  404. hs : string;
  405. begin
  406. {corba/com/default}
  407. current_scanner.skipspace;
  408. hs:=current_scanner.readid;
  409. {$ifndef jvm}
  410. if (hs='CORBA') then
  411. current_settings.interfacetype:=it_interfacecorba
  412. else if (hs='COM') then
  413. current_settings.interfacetype:=it_interfacecom
  414. else
  415. {$endif jvm}
  416. if (hs='DEFAULT') then
  417. current_settings.interfacetype:=init_settings.interfacetype
  418. else
  419. Message(scan_e_invalid_interface_type);
  420. end;
  421. procedure dir_iochecks;
  422. begin
  423. do_delphiswitch('I');
  424. end;
  425. procedure dir_libexport;
  426. begin
  427. {not implemented}
  428. end;
  429. procedure dir_librarypath;
  430. begin
  431. if not current_module.in_global then
  432. Message(scan_w_switch_is_global)
  433. else
  434. begin
  435. current_scanner.skipspace;
  436. current_module.locallibrarysearchpath.AddPath(current_scanner.readcomment,false);
  437. end;
  438. end;
  439. procedure dir_link;
  440. var
  441. s : string;
  442. begin
  443. current_scanner.skipspace;
  444. if scanner.c = '''' then
  445. begin
  446. s:= current_scanner.readquotedstring;
  447. current_scanner.readcomment
  448. end
  449. else
  450. s:= trimspace(current_scanner.readcomment);
  451. s:=FixFileName(s);
  452. if ExtractFileExt(s)='' then
  453. s:=ChangeFileExt(s,target_info.objext);
  454. current_module.linkotherofiles.add(s,link_always);
  455. end;
  456. procedure dir_linkframework;
  457. var
  458. s : string;
  459. begin
  460. current_scanner.skipspace;
  461. if scanner.c = '''' then
  462. begin
  463. s:= current_scanner.readquotedstring;
  464. current_scanner.readcomment
  465. end
  466. else
  467. s:= trimspace(current_scanner.readcomment);
  468. s:=FixFileName(s);
  469. if (target_info.system in systems_darwin) then
  470. current_module.linkotherframeworks.add(s,link_always)
  471. else
  472. Message(scan_w_frameworks_darwin_only);
  473. end;
  474. procedure dir_linklib;
  475. type
  476. tLinkMode=(lm_shared,lm_static);
  477. var
  478. s : string;
  479. quote : char;
  480. libext,
  481. libname,
  482. linkmodestr : string;
  483. p : longint;
  484. linkMode : tLinkMode;
  485. begin
  486. current_scanner.skipspace;
  487. if scanner.c = '''' then
  488. begin
  489. libname:= current_scanner.readquotedstring;
  490. s:= current_scanner.readcomment;
  491. p:=pos(',',s);
  492. end
  493. else
  494. begin
  495. s:= current_scanner.readcomment;
  496. p:=pos(',',s);
  497. if p=0 then
  498. libname:=TrimSpace(s)
  499. else
  500. libname:=TrimSpace(copy(s,1,p-1));
  501. end;
  502. if p=0 then
  503. linkmodeStr:=''
  504. else
  505. linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
  506. if (libname='') or (libname='''''') or (libname='""') then
  507. exit;
  508. { create library name }
  509. if libname[1] in ['''','"'] then
  510. begin
  511. quote:=libname[1];
  512. Delete(libname,1,1);
  513. p:=pos(quote,libname);
  514. if p>0 then
  515. Delete(libname,p,1);
  516. end;
  517. libname:=FixFileName(libname);
  518. { get linkmode, default is to check the extension for
  519. the static library, otherwise shared linking is assumed }
  520. linkmode:=lm_shared;
  521. if linkModeStr='' then
  522. begin
  523. libext:=ExtractFileExt(libname);
  524. if libext=target_info.staticClibext then
  525. linkMode:=lm_static;
  526. end
  527. else if linkModeStr='STATIC' then
  528. linkmode:=lm_static
  529. else if (LinkModeStr='SHARED') or (LinkModeStr='') then
  530. linkmode:=lm_shared
  531. else
  532. Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
  533. { add to the list of other libraries }
  534. if linkMode=lm_static then
  535. current_module.linkOtherStaticLibs.add(libname,link_always)
  536. else
  537. current_module.linkOtherSharedLibs.add(libname,link_always);
  538. end;
  539. procedure dir_localsymbols;
  540. begin
  541. do_delphiswitch('L');
  542. end;
  543. procedure dir_longstrings;
  544. begin
  545. do_delphiswitch('H');
  546. end;
  547. procedure dir_macro;
  548. begin
  549. do_moduleswitch(cs_support_macro);
  550. end;
  551. procedure dir_pascalmainname;
  552. var
  553. s: string;
  554. begin
  555. current_scanner.skipspace;
  556. s:=trimspace(current_scanner.readcomment);
  557. if assigned(current_module.mainname) and
  558. (s<>current_module.mainname^) then
  559. begin
  560. Message1(scan_w_multiple_main_name_overrides,current_module.mainname^);
  561. stringdispose(current_module.mainname)
  562. end
  563. else if (mainaliasname<>defaultmainaliasname) and
  564. (mainaliasname<>s) then
  565. Message1(scan_w_multiple_main_name_overrides,mainaliasname);
  566. mainaliasname:=s;
  567. if (mainaliasname<>defaultmainaliasname) then
  568. current_module.mainname:=stringdup(mainaliasname);
  569. end;
  570. procedure dir_maxfpuregisters;
  571. var
  572. l : integer;
  573. hs : string;
  574. begin
  575. current_scanner.skipspace;
  576. if not(c in ['0'..'9']) then
  577. begin
  578. hs:=current_scanner.readid;
  579. if (hs='NORMAL') or (hs='DEFAULT') then
  580. current_settings.maxfpuregisters:=-1
  581. else
  582. Message(scan_e_invalid_maxfpureg_value);
  583. end
  584. else
  585. begin
  586. l:=current_scanner.readval;
  587. case l of
  588. 0..8:
  589. current_settings.maxfpuregisters:=l;
  590. else
  591. Message(scan_e_invalid_maxfpureg_value);
  592. end;
  593. end;
  594. end;
  595. procedure dir_maxstacksize;
  596. begin
  597. if not (target_info.system in (systems_windows+systems_wince)) then
  598. Message(scan_w_maxstacksize_not_support);
  599. current_scanner.skipspace;
  600. maxstacksize:=current_scanner.readval;
  601. MaxStackSizeSetExplicity:=true;
  602. end;
  603. procedure dir_memory;
  604. var
  605. l : longint;
  606. begin
  607. current_scanner.skipspace;
  608. l:=current_scanner.readval;
  609. if l>1024 then
  610. stacksize:=l;
  611. if c=',' then
  612. begin
  613. current_scanner.readchar;
  614. current_scanner.skipspace;
  615. l:=current_scanner.readval;
  616. if l>1024 then
  617. heapsize:=l;
  618. end;
  619. end;
  620. procedure dir_message;
  621. var
  622. hs : string;
  623. w : longint;
  624. begin
  625. w:=0;
  626. current_scanner.skipspace;
  627. { Message level specified? }
  628. if c='''' then
  629. w:=scan_n_user_defined
  630. else
  631. begin
  632. hs:=current_scanner.readid;
  633. if (hs='WARN') or (hs='WARNING') then
  634. w:=scan_w_user_defined
  635. else
  636. if (hs='ERROR') then
  637. w:=scan_e_user_defined
  638. else
  639. if (hs='FATAL') then
  640. w:=scan_f_user_defined
  641. else
  642. if (hs='HINT') then
  643. w:=scan_h_user_defined
  644. else
  645. if (hs='NOTE') then
  646. w:=scan_n_user_defined
  647. else
  648. Message1(scan_w_illegal_directive,hs);
  649. end;
  650. { Only print message when there was no error }
  651. if w<>0 then
  652. begin
  653. current_scanner.skipspace;
  654. if c='''' then
  655. hs:=current_scanner.readquotedstring
  656. else
  657. hs:=current_scanner.readcomment;
  658. Message1(w,hs);
  659. end
  660. else
  661. current_scanner.readcomment;
  662. end;
  663. procedure dir_minstacksize;
  664. begin
  665. if not (target_info.system in (systems_windows+systems_wince)) then
  666. Message(scan_w_minstacksize_not_support);
  667. current_scanner.skipspace;
  668. minstacksize:=current_scanner.readval;
  669. MinStackSizeSetExplicity:=true;
  670. end;
  671. procedure dir_mode;
  672. begin
  673. if not current_module.in_global then
  674. Message(scan_w_switch_is_global)
  675. else
  676. begin
  677. current_scanner.skipspace;
  678. current_scanner.readstring;
  679. if not current_module.mode_switch_allowed and
  680. not ((m_mac in current_settings.modeswitches) and (pattern='MACPAS')) then
  681. Message1(scan_e_mode_switch_not_allowed,pattern)
  682. else if not SetCompileMode(pattern,false) then
  683. Message1(scan_w_illegal_switch,pattern)
  684. end;
  685. current_module.mode_switch_allowed:= false;
  686. end;
  687. procedure dir_modeswitch;
  688. var
  689. s : string;
  690. begin
  691. if not current_module.in_global then
  692. Message(scan_w_switch_is_global)
  693. else
  694. begin
  695. current_scanner.skipspace;
  696. current_scanner.readstring;
  697. s:=pattern;
  698. if c in ['+','-'] then
  699. s:=s+current_scanner.readstate;
  700. if not SetCompileModeSwitch(s,false) then
  701. Message1(scan_w_illegal_switch,s)
  702. end;
  703. end;
  704. procedure dir_namespace;
  705. var
  706. s : string;
  707. begin
  708. { used to define Java package names for all types declared in the
  709. current unit }
  710. if not current_module.in_global then
  711. Message(scan_w_switch_is_global)
  712. else
  713. begin
  714. current_scanner.skipspace;
  715. current_scanner.readstring;
  716. s:=orgpattern;
  717. while c='.' do
  718. begin
  719. current_scanner.readchar;
  720. current_scanner.readstring;
  721. s:=s+'.'+orgpattern;
  722. end;
  723. disposestr(current_module.namespace);
  724. current_module.namespace:=stringdup(s);
  725. end;
  726. end;
  727. procedure dir_mmx;
  728. begin
  729. do_localswitch(cs_mmx);
  730. end;
  731. procedure dir_note;
  732. begin
  733. do_message(scan_n_user_defined);
  734. end;
  735. procedure dir_notes;
  736. begin
  737. do_setverbose('N');
  738. end;
  739. procedure dir_objectpath;
  740. begin
  741. if not current_module.in_global then
  742. Message(scan_w_switch_is_global)
  743. else
  744. begin
  745. current_scanner.skipspace;
  746. current_module.localobjectsearchpath.AddPath(current_scanner.readcomment,false);
  747. end;
  748. end;
  749. procedure dir_openstrings;
  750. begin
  751. do_delphiswitch('P');
  752. end;
  753. procedure dir_optimization;
  754. var
  755. hs : string;
  756. begin
  757. current_scanner.skipspace;
  758. { Support also the ON and OFF as switch }
  759. hs:=current_scanner.readid;
  760. if (hs='ON') then
  761. current_settings.optimizerswitches:=level2optimizerswitches
  762. else if (hs='OFF') then
  763. current_settings.optimizerswitches:=[]
  764. else if (hs='DEFAULT') then
  765. current_settings.optimizerswitches:=init_settings.optimizerswitches
  766. else
  767. begin
  768. if not UpdateOptimizerStr(hs,current_settings.optimizerswitches) then
  769. Message1(scan_e_illegal_optimization_specifier,hs);
  770. end;
  771. end;
  772. procedure dir_overflowchecks;
  773. begin
  774. do_delphiswitch('Q');
  775. end;
  776. procedure dir_packenum;
  777. var
  778. hs : string;
  779. begin
  780. current_scanner.skipspace;
  781. if not(c in ['0'..'9']) then
  782. begin
  783. hs:=current_scanner.readid;
  784. if (hs='NORMAL') or (hs='DEFAULT') then
  785. current_settings.packenum:=4
  786. else
  787. Message1(scan_e_illegal_pack_enum, hs);
  788. end
  789. else
  790. begin
  791. case current_scanner.readval of
  792. 1 : current_settings.packenum:=1;
  793. 2 : current_settings.packenum:=2;
  794. 4 : current_settings.packenum:=4;
  795. else
  796. Message1(scan_e_illegal_pack_enum, pattern);
  797. end;
  798. end;
  799. end;
  800. procedure dir_minfpconstprec;
  801. begin
  802. current_scanner.skipspace;
  803. if not SetMinFPConstPrec(current_scanner.readid,current_settings.minfpconstprec) then
  804. Message1(scan_e_illegal_minfpconstprec, pattern);
  805. end;
  806. procedure dir_packrecords;
  807. var
  808. hs : string;
  809. begin
  810. { can't change packrecords setting on managed vm targets }
  811. if target_info.system in systems_managed_vm then
  812. Message1(scanner_w_directive_ignored_on_target, 'PACKRECORDS');
  813. current_scanner.skipspace;
  814. if not(c in ['0'..'9']) then
  815. begin
  816. hs:=current_scanner.readid;
  817. { C has the special recordalignmax of C_alignment }
  818. if (hs='C') then
  819. current_settings.packrecords:=C_alignment
  820. else
  821. if (hs='NORMAL') or (hs='DEFAULT') then
  822. current_settings.packrecords:=default_settings.packrecords
  823. else
  824. Message1(scan_e_illegal_pack_records,hs);
  825. end
  826. else
  827. begin
  828. case current_scanner.readval of
  829. 1 : current_settings.packrecords:=1;
  830. 2 : current_settings.packrecords:=2;
  831. 4 : current_settings.packrecords:=4;
  832. 8 : current_settings.packrecords:=8;
  833. 16 : current_settings.packrecords:=16;
  834. 32 : current_settings.packrecords:=32;
  835. else
  836. Message1(scan_e_illegal_pack_records,pattern);
  837. end;
  838. end;
  839. end;
  840. procedure dir_packset;
  841. var
  842. hs : string;
  843. begin
  844. current_scanner.skipspace;
  845. if not(c in ['1','2','4','8']) then
  846. begin
  847. hs:=current_scanner.readid;
  848. if (hs='FIXED') or (hs='DEFAULT') OR (hs='NORMAL') then
  849. current_settings.setalloc:=0 {Fixed mode, sets are 4 or 32 bytes}
  850. else
  851. Message(scan_e_only_packset);
  852. end
  853. else
  854. begin
  855. case current_scanner.readval of
  856. 1 : current_settings.setalloc:=1;
  857. 2 : current_settings.setalloc:=2;
  858. 4 : current_settings.setalloc:=4;
  859. 8 : current_settings.setalloc:=8;
  860. else
  861. Message(scan_e_only_packset);
  862. end;
  863. end;
  864. end;
  865. procedure dir_pic;
  866. begin
  867. { windows doesn't need/support pic }
  868. if tf_no_pic_supported in target_info.flags then
  869. message(scan_w_pic_ignored)
  870. else
  871. do_moduleswitch(cs_create_pic);
  872. end;
  873. procedure dir_pop;
  874. begin
  875. if switchesstatestackpos < 1 then
  876. Message(scan_e_too_many_pop);
  877. Dec(switchesstatestackpos);
  878. recordpendinglocalfullswitch(switchesstatestack[switchesstatestackpos].localsw);
  879. recordpendingverbosityfullswitch(switchesstatestack[switchesstatestackpos].verbosity);
  880. pendingstate.nextmessagerecord:=switchesstatestack[switchesstatestackpos].pmessage;
  881. { Reset verbosity and forget previous pmeesage }
  882. RestoreLocalVerbosity(nil);
  883. current_settings.pmessage:=nil;
  884. { Do not yet activate these changes, as otherwise
  885. you get problem idf you put a $pop just right after
  886. a addition for instance fro which you explicitly truned the overflow check
  887. out by using $Q- after a $push PM 2012-08-29 }
  888. // flushpendingswitchesstate;
  889. end;
  890. procedure dir_pointermath;
  891. begin
  892. do_localswitch(cs_pointermath);
  893. end;
  894. procedure dir_profile;
  895. begin
  896. do_moduleswitch(cs_profile);
  897. { defined/undefine FPC_PROFILE }
  898. if cs_profile in current_settings.moduleswitches then
  899. def_system_macro('FPC_PROFILE')
  900. else
  901. undef_system_macro('FPC_PROFILE');
  902. end;
  903. procedure dir_push;
  904. begin
  905. if switchesstatestackpos > switchesstatestackmax then
  906. Message(scan_e_too_many_push);
  907. flushpendingswitchesstate;
  908. switchesstatestack[switchesstatestackpos].localsw:= current_settings.localswitches;
  909. switchesstatestack[switchesstatestackpos].pmessage:= current_settings.pmessage;
  910. switchesstatestack[switchesstatestackpos].verbosity:=status.verbosity;
  911. Inc(switchesstatestackpos);
  912. end;
  913. procedure dir_rangechecks;
  914. begin
  915. do_delphiswitch('R');
  916. end;
  917. procedure dir_referenceinfo;
  918. begin
  919. do_delphiswitch('Y');
  920. end;
  921. procedure dir_resource;
  922. var
  923. s : string;
  924. begin
  925. current_scanner.skipspace;
  926. if scanner.c = '''' then
  927. begin
  928. s:= current_scanner.readquotedstring;
  929. current_scanner.readcomment
  930. end
  931. else
  932. s:= trimspace(current_scanner.readcomment);
  933. { replace * with the name of the main source.
  934. This should always be defined. }
  935. if s[1]='*' then
  936. if Assigned(Current_Module) then
  937. begin
  938. delete(S,1,1);
  939. insert(ChangeFileExt(ExtractFileName(current_module.mainsource),''),S,1 );
  940. end;
  941. s:=FixFileName(s);
  942. if ExtractFileExt(s)='' then
  943. s:=ChangeFileExt(s,target_info.resext);
  944. if target_info.res<>res_none then
  945. begin
  946. current_module.flags:=current_module.flags or uf_has_resourcefiles;
  947. if (res_single_file in target_res.resflags) and
  948. not (Current_module.ResourceFiles.Empty) then
  949. Message(scan_w_only_one_resourcefile_supported)
  950. else
  951. current_module.resourcefiles.insert(FixFileName(s));
  952. end
  953. else
  954. Message(scan_e_resourcefiles_not_supported);
  955. end;
  956. procedure dir_saturation;
  957. begin
  958. do_localswitch(cs_mmx_saturation);
  959. end;
  960. procedure dir_safefpuexceptions;
  961. begin
  962. do_localswitch(cs_fpu_fwait);
  963. end;
  964. procedure dir_scopedenums;
  965. begin
  966. do_localswitch(cs_scopedenums);
  967. end;
  968. function get_peflag_const(const ident:string;error:longint):longint;
  969. var
  970. srsym : tsym;
  971. srsymtable : tsymtable;
  972. begin
  973. result:=0;
  974. if searchsym(ident,srsym,srsymtable) then
  975. if (srsym.typ=constsym) and
  976. (tconstsym(srsym).consttyp=constord) and
  977. is_integer(tconstsym(srsym).constdef) then
  978. with tconstsym(srsym).value.valueord do
  979. if signed then
  980. result:=tconstsym(srsym).value.valueord.svalue
  981. else
  982. result:=tconstsym(srsym).value.valueord.uvalue
  983. else
  984. message(error)
  985. else
  986. message1(sym_e_id_not_found,ident);
  987. end;
  988. procedure dir_setpeflags;
  989. var
  990. ident : string;
  991. begin
  992. if not (target_info.system in (systems_all_windows)) then
  993. Message(scan_w_setpeflags_not_support);
  994. current_scanner.skipspace;
  995. ident:=current_scanner.readid;
  996. if ident<>'' then
  997. peflags:=peflags or get_peflag_const(ident,scan_e_illegal_peflag)
  998. else
  999. peflags:=peflags or current_scanner.readval;
  1000. SetPEFlagsSetExplicity:=true;
  1001. end;
  1002. procedure dir_setpeoptflags;
  1003. var
  1004. ident : string;
  1005. begin
  1006. if not (target_info.system in (systems_all_windows)) then
  1007. Message(scan_w_setpeoptflags_not_support);
  1008. current_scanner.skipspace;
  1009. ident:=current_scanner.readid;
  1010. if ident<>'' then
  1011. peoptflags:=peoptflags or get_peflag_const(ident,scan_e_illegal_peoptflag)
  1012. else
  1013. peoptflags:=peoptflags or current_scanner.readval;
  1014. SetPEOptFlagsSetExplicity:=true;
  1015. end;
  1016. procedure dir_smartlink;
  1017. begin
  1018. do_moduleswitch(cs_create_smart);
  1019. if (paratargetdbg in [dbg_dwarf2,dbg_dwarf3]) and
  1020. not(target_info.system in (systems_darwin+[system_i8086_msdos])) and
  1021. { smart linking does not yet work with DWARF debug info on most targets }
  1022. (cs_create_smart in current_settings.moduleswitches) and
  1023. not (af_outputbinary in target_asm.flags) then
  1024. begin
  1025. Message(option_dwarf_smart_linking);
  1026. Exclude(current_settings.moduleswitches,cs_create_smart);
  1027. end;
  1028. end;
  1029. procedure dir_stackframes;
  1030. begin
  1031. do_delphiswitch('W');
  1032. end;
  1033. procedure dir_stop;
  1034. begin
  1035. do_message(scan_f_user_defined);
  1036. end;
  1037. procedure dir_stringchecks;
  1038. begin
  1039. // Delphi adds checks that ansistring and unicodestring are correct in
  1040. // different places. Skip it for now.
  1041. end;
  1042. {$ifdef powerpc}
  1043. procedure dir_syscall;
  1044. var
  1045. sctype : string;
  1046. begin
  1047. { not needed on amiga/m68k for now, because there's only one }
  1048. { syscall convention (legacy) (KB) }
  1049. { not needed on amiga/powerpc because there's only one }
  1050. { syscall convention (sysv) (KB) }
  1051. if not (target_info.system in [system_powerpc_morphos]) then
  1052. comment (V_Warning,'Syscall directive is useless on this target.');
  1053. current_scanner.skipspace;
  1054. sctype:=current_scanner.readid;
  1055. if (sctype='LEGACY') or (sctype='SYSV') or (sctype='SYSVBASE') or
  1056. (sctype='BASESYSV') or (sctype='R12BASE') then
  1057. syscall_convention:=sctype
  1058. else
  1059. comment (V_Warning,'Invalid Syscall directive ignored.');
  1060. end;
  1061. {$endif}
  1062. procedure dir_targetswitch;
  1063. var
  1064. name, value: string;
  1065. begin
  1066. { note: *not* recorded in the tokenstream, so not replayed for generics }
  1067. current_scanner.skipspace;
  1068. name:=current_scanner.readid;
  1069. if c='=' then
  1070. begin
  1071. current_scanner.readchar;
  1072. current_scanner.readid;
  1073. value:=orgpattern;
  1074. UpdateTargetSwitchStr(name+'='+value,current_settings.targetswitches,current_module.in_global);
  1075. end
  1076. else
  1077. UpdateTargetSwitchStr(name,current_settings.targetswitches,current_module.in_global);
  1078. end;
  1079. procedure dir_typedaddress;
  1080. begin
  1081. do_delphiswitch('T');
  1082. end;
  1083. procedure dir_typeinfo;
  1084. begin
  1085. do_delphiswitch('M');
  1086. end;
  1087. procedure dir_unitpath;
  1088. begin
  1089. if not current_module.in_global then
  1090. Message(scan_w_switch_is_global)
  1091. else
  1092. with current_scanner,current_module,localunitsearchpath do
  1093. begin
  1094. skipspace;
  1095. AddPath(path,readcomment,false);
  1096. end;
  1097. end;
  1098. procedure dir_varparacopyoutcheck;
  1099. begin
  1100. if not(target_info.system in systems_jvm) then
  1101. begin
  1102. Message1(scan_w_illegal_switch,pattern);
  1103. exit;
  1104. end;
  1105. do_localswitch(cs_check_var_copyout);
  1106. end;
  1107. procedure dir_varpropsetter;
  1108. begin
  1109. do_localswitch(cs_varpropsetter);
  1110. end;
  1111. procedure dir_varstringchecks;
  1112. begin
  1113. do_delphiswitch('V');
  1114. end;
  1115. procedure dir_version;
  1116. var
  1117. major, minor, revision : longint;
  1118. error : integer;
  1119. begin
  1120. if not (target_info.system in systems_all_windows+[system_i386_os2,system_i386_emx,
  1121. system_i386_netware,system_i386_wdosx,
  1122. system_i386_netwlibc]) then
  1123. begin
  1124. Message(scan_n_version_not_support);
  1125. exit;
  1126. end;
  1127. if (compile_level<>1) then
  1128. Message(scan_n_only_exe_version)
  1129. else
  1130. begin
  1131. { change description global var in all cases }
  1132. { it not used but in win32, os2 and netware }
  1133. current_scanner.skipspace;
  1134. { we should only accept Major.Minor format for win32 and os2 }
  1135. current_scanner.readnumber;
  1136. major:=0;
  1137. minor:=0;
  1138. revision:=0;
  1139. val(pattern,major,error);
  1140. if (error<>0) or (major > high(word)) or (major < 0) then
  1141. begin
  1142. Message1(scan_w_wrong_version_ignored,pattern);
  1143. exit;
  1144. end;
  1145. if c='.' then
  1146. begin
  1147. current_scanner.readchar;
  1148. current_scanner.readnumber;
  1149. val(pattern,minor,error);
  1150. if (error<>0) or (minor > high(word)) or (minor < 0) then
  1151. begin
  1152. Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
  1153. exit;
  1154. end;
  1155. if (c='.') and
  1156. (target_info.system in [system_i386_netware,system_i386_netwlibc]) then
  1157. begin
  1158. current_scanner.readchar;
  1159. current_scanner.readnumber;
  1160. val(pattern,revision,error);
  1161. if (error<>0) or (revision > high(word)) or (revision < 0) then
  1162. begin
  1163. Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
  1164. exit;
  1165. end;
  1166. dllmajor:=word(major);
  1167. dllminor:=word(minor);
  1168. dllrevision:=word(revision);
  1169. dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
  1170. end
  1171. else
  1172. begin
  1173. dllmajor:=word(major);
  1174. dllminor:=word(minor);
  1175. dllversion:=tostr(major)+'.'+tostr(minor);
  1176. end;
  1177. end
  1178. else
  1179. dllversion:=tostr(major);
  1180. end;
  1181. end;
  1182. procedure dir_wait;
  1183. var
  1184. had_info : boolean;
  1185. begin
  1186. had_info:=(status.verbosity and V_Info)<>0;
  1187. { this message should allways appear !! }
  1188. status.verbosity:=status.verbosity or V_Info;
  1189. Message(scan_i_press_enter);
  1190. readln;
  1191. If not(had_info) then
  1192. status.verbosity:=status.verbosity and (not V_Info);
  1193. end;
  1194. { delphi compatible warn directive:
  1195. $warn <identifier> on
  1196. $warn <identifier> off
  1197. $warn <identifier> error
  1198. }
  1199. procedure dir_warn;
  1200. var
  1201. ident : string;
  1202. state : string;
  1203. msgstate : tmsgstate;
  1204. i : integer;
  1205. begin
  1206. current_scanner.skipspace;
  1207. ident:=current_scanner.readid;
  1208. current_scanner.skipspace;
  1209. state:=current_scanner.readid;
  1210. { support both delphi and fpc switches }
  1211. { use local ms_on/off/error tmsgstate values }
  1212. if (state='ON') or (state='+') then
  1213. msgstate:=ms_on
  1214. else
  1215. if (state='OFF') or (state='-') then
  1216. msgstate:=ms_off
  1217. else
  1218. if (state='ERROR') then
  1219. msgstate:=ms_error
  1220. else
  1221. begin
  1222. Message1(scanner_e_illegal_warn_state,state);
  1223. exit;
  1224. end;
  1225. if ident='CONSTRUCTING_ABSTRACT' then
  1226. recordpendingmessagestate(type_w_instance_with_abstract, msgstate)
  1227. else
  1228. if ident='IMPLICIT_VARIANTS' then
  1229. recordpendingmessagestate(parser_w_implicit_uses_of_variants_unit, msgstate)
  1230. else
  1231. if ident='NO_RETVAL' then
  1232. recordpendingmessagestate(sym_w_function_result_not_set, msgstate)
  1233. else
  1234. if ident='SYMBOL_DEPRECATED' then
  1235. begin
  1236. recordpendingmessagestate(sym_w_deprecated_symbol, msgstate);
  1237. recordpendingmessagestate(sym_w_deprecated_symbol_with_msg, msgstate);
  1238. end
  1239. else
  1240. if ident='SYMBOL_EXPERIMENTAL' then
  1241. recordpendingmessagestate(sym_w_experimental_symbol, msgstate)
  1242. else
  1243. if ident='SYMBOL_LIBRARY' then
  1244. recordpendingmessagestate(sym_w_library_symbol, msgstate)
  1245. else
  1246. if ident='SYMBOL_PLATFORM' then
  1247. recordpendingmessagestate(sym_w_non_portable_symbol, msgstate)
  1248. else
  1249. if ident='SYMBOL_UNIMPLEMENTED' then
  1250. recordpendingmessagestate(sym_w_non_implemented_symbol, msgstate)
  1251. else
  1252. if ident='UNIT_DEPRECATED' then
  1253. begin
  1254. recordpendingmessagestate(sym_w_deprecated_unit, msgstate);
  1255. recordpendingmessagestate(sym_w_deprecated_unit_with_msg, msgstate);
  1256. end
  1257. else
  1258. if ident='UNIT_EXPERIMENTAL' then
  1259. recordpendingmessagestate(sym_w_experimental_unit, msgstate)
  1260. else
  1261. if ident='UNIT_LIBRARY' then
  1262. recordpendingmessagestate(sym_w_library_unit, msgstate)
  1263. else
  1264. if ident='UNIT_PLATFORM' then
  1265. recordpendingmessagestate(sym_w_non_portable_unit, msgstate)
  1266. else
  1267. if ident='UNIT_UNIMPLEMENTED' then
  1268. recordpendingmessagestate(sym_w_non_implemented_unit, msgstate)
  1269. else
  1270. if ident='ZERO_NIL_COMPAT' then
  1271. recordpendingmessagestate(type_w_zero_to_nil, msgstate)
  1272. else
  1273. if ident='IMPLICIT_STRING_CAST' then
  1274. recordpendingmessagestate(type_w_implicit_string_cast, msgstate)
  1275. else
  1276. if ident='IMPLICIT_STRING_CAST_LOSS' then
  1277. recordpendingmessagestate(type_w_implicit_string_cast_loss, msgstate)
  1278. else
  1279. if ident='EXPLICIT_STRING_CAST' then
  1280. recordpendingmessagestate(type_w_explicit_string_cast, msgstate)
  1281. else
  1282. if ident='EXPLICIT_STRING_CAST_LOSS' then
  1283. recordpendingmessagestate(type_w_explicit_string_cast_loss, msgstate)
  1284. else
  1285. if ident='CVT_NARROWING_STRING_LOST' then
  1286. recordpendingmessagestate(type_w_unicode_data_loss, msgstate)
  1287. else
  1288. if ident='INTF_RAISE_VISIBILITY' then
  1289. recordpendingmessagestate(type_w_interface_lower_visibility, msgstate)
  1290. else
  1291. begin
  1292. i:=0;
  1293. if not ChangeMessageVerbosity(ident,i,msgstate) then
  1294. Message1(scanner_w_illegal_warn_identifier,ident);
  1295. end;
  1296. end;
  1297. procedure dir_warning;
  1298. begin
  1299. do_message(scan_w_user_defined);
  1300. end;
  1301. procedure dir_warnings;
  1302. begin
  1303. do_setverbose('W');
  1304. end;
  1305. procedure dir_writeableconst;
  1306. begin
  1307. do_delphiswitch('J');
  1308. end;
  1309. procedure dir_z1;
  1310. begin
  1311. current_settings.packenum:=1;
  1312. end;
  1313. procedure dir_z2;
  1314. begin
  1315. current_settings.packenum:=2;
  1316. end;
  1317. procedure dir_z4;
  1318. begin
  1319. current_settings.packenum:=4;
  1320. end;
  1321. procedure dir_externalsym;
  1322. begin
  1323. end;
  1324. procedure dir_nodefine;
  1325. begin
  1326. end;
  1327. procedure dir_hppemit;
  1328. begin
  1329. end;
  1330. procedure dir_weakpackageunit;
  1331. begin
  1332. end;
  1333. procedure dir_codealign;
  1334. var
  1335. s : string;
  1336. begin
  1337. current_scanner.skipspace;
  1338. s:=current_scanner.readcomment;
  1339. if not(UpdateAlignmentStr(s,current_settings.alignment)) then
  1340. message(scanner_e_illegal_alignment_directive);
  1341. end;
  1342. procedure dir_codepage;
  1343. var
  1344. s : string;
  1345. begin
  1346. if not current_module.in_global then
  1347. Message(scan_w_switch_is_global)
  1348. else
  1349. begin
  1350. current_scanner.skipspace;
  1351. s:=current_scanner.readcomment;
  1352. if (upper(s)='UTF8') or (upper(s)='UTF-8') then
  1353. current_settings.sourcecodepage:=CP_UTF8
  1354. else if not cpavailable(s) then
  1355. Message1(option_code_page_not_available,s)
  1356. else
  1357. current_settings.sourcecodepage:=codepagebyname(s);
  1358. include(current_settings.moduleswitches,cs_explicit_codepage);
  1359. end;
  1360. end;
  1361. procedure dir_coperators;
  1362. begin
  1363. do_moduleswitch(cs_support_c_operators);
  1364. end;
  1365. procedure dir_bitpacking;
  1366. begin
  1367. do_localswitch(cs_bitpacking);
  1368. end;
  1369. procedure dir_region;
  1370. begin
  1371. end;
  1372. procedure dir_endregion;
  1373. begin
  1374. end;
  1375. procedure dir_zerobasesstrings;
  1376. begin
  1377. do_localswitch(cs_zerobasedstrings);
  1378. end;
  1379. {****************************************************************************
  1380. Initialize Directives
  1381. ****************************************************************************}
  1382. procedure InitScannerDirectives;
  1383. begin
  1384. AddDirective('A1',directive_all, @dir_a1);
  1385. AddDirective('A2',directive_all, @dir_a2);
  1386. AddDirective('A4',directive_all, @dir_a4);
  1387. AddDirective('A8',directive_all, @dir_a8);
  1388. AddDirective('ALIGN',directive_all, @dir_align);
  1389. {$ifdef m68k}
  1390. AddDirective('APPID',directive_all, @dir_appid);
  1391. AddDirective('APPNAME',directive_all, @dir_appname);
  1392. {$endif m68k}
  1393. AddDirective('APPTYPE',directive_all, @dir_apptype);
  1394. AddDirective('ASMMODE',directive_all, @dir_asmmode);
  1395. AddDirective('ASSERTIONS',directive_all, @dir_assertions);
  1396. AddDirective('BOOLEVAL',directive_all, @dir_booleval);
  1397. AddDirective('BITPACKING',directive_all, @dir_bitpacking);
  1398. AddDirective('CALLING',directive_all, @dir_calling);
  1399. AddDirective('CHECKLOWADDRLOADS',directive_all, @dir_checklowaddrloads);
  1400. AddDirective('CHECKPOINTER',directive_all, @dir_checkpointer);
  1401. AddDirective('CODEALIGN',directive_all, @dir_codealign);
  1402. AddDirective('CODEPAGE',directive_all, @dir_codepage);
  1403. AddDirective('COPERATORS',directive_all, @dir_coperators);
  1404. AddDirective('COPYRIGHT',directive_all, @dir_copyright);
  1405. AddDirective('D',directive_all, @dir_description);
  1406. AddDirective('DEBUGINFO',directive_all, @dir_debuginfo);
  1407. AddDirective('DESCRIPTION',directive_all, @dir_description);
  1408. AddDirective('ENDREGION',directive_all, @dir_endregion);
  1409. AddDirective('ERROR',directive_all, @dir_error);
  1410. AddDirective('ERRORC',directive_mac, @dir_error);
  1411. AddDirective('EXTENDEDSYNTAX',directive_all, @dir_extendedsyntax);
  1412. AddDirective('EXTERNALSYM',directive_all, @dir_externalsym);
  1413. AddDirective('FATAL',directive_all, @dir_fatal);
  1414. AddDirective('FPUTYPE',directive_all, @dir_fputype);
  1415. AddDirective('FRAMEWORKPATH',directive_all, @dir_frameworkpath);
  1416. AddDirective('GOTO',directive_all, @dir_goto);
  1417. AddDirective('HINT',directive_all, @dir_hint);
  1418. AddDirective('HINTS',directive_all, @dir_hints);
  1419. AddDirective('HPPEMIT',directive_all, @dir_hppemit);
  1420. AddDirective('IEEEERRORS',directive_all,@dir_ieeeerrors);
  1421. AddDirective('IOCHECKS',directive_all, @dir_iochecks);
  1422. AddDirective('IMAGEBASE',directive_all, @dir_imagebase);
  1423. AddDirective('IMPLICITEXCEPTIONS',directive_all, @dir_implicitexceptions);
  1424. AddDirective('INCLUDEPATH',directive_all, @dir_includepath);
  1425. AddDirective('INFO',directive_all, @dir_info);
  1426. AddDirective('INLINE',directive_all, @dir_inline);
  1427. AddDirective('INTERFACES',directive_all, @dir_interfaces);
  1428. AddDirective('L',directive_all, @dir_link);
  1429. AddDirective('LIBEXPORT',directive_mac, @dir_libexport);
  1430. AddDirective('LIBRARYPATH',directive_all, @dir_librarypath);
  1431. AddDirective('LINK',directive_all, @dir_link);
  1432. AddDirective('LINKFRAMEWORK',directive_all, @dir_linkframework);
  1433. AddDirective('LINKLIB',directive_all, @dir_linklib);
  1434. AddDirective('LOCALSYMBOLS',directive_all, @dir_localsymbols);
  1435. AddDirective('LONGSTRINGS',directive_all, @dir_longstrings);
  1436. AddDirective('M',directive_all, @dir_memory);
  1437. AddDirective('MACRO',directive_all, @dir_macro);
  1438. AddDirective('MAXFPUREGISTERS',directive_all, @dir_maxfpuregisters);
  1439. AddDirective('MAXSTACKSIZE',directive_all, @dir_maxstacksize);
  1440. AddDirective('MEMORY',directive_all, @dir_memory);
  1441. AddDirective('MESSAGE',directive_all, @dir_message);
  1442. AddDirective('MINENUMSIZE',directive_all, @dir_packenum);
  1443. AddDirective('MINFPCONSTPREC',directive_all, @dir_minfpconstprec);
  1444. AddDirective('MINSTACKSIZE',directive_all, @dir_minstacksize);
  1445. AddDirective('MMX',directive_all, @dir_mmx);
  1446. AddDirective('MODE',directive_all, @dir_mode);
  1447. AddDirective('MODESWITCH',directive_all, @dir_modeswitch);
  1448. AddDirective('NAMESPACE',directive_all, @dir_namespace);
  1449. AddDirective('NODEFINE',directive_all, @dir_nodefine);
  1450. AddDirective('NOTE',directive_all, @dir_note);
  1451. AddDirective('NOTES',directive_all, @dir_notes);
  1452. AddDirective('OBJECTCHECKS',directive_all, @dir_objectchecks);
  1453. AddDirective('OBJECTPATH',directive_all, @dir_objectpath);
  1454. AddDirective('OPENSTRINGS',directive_all, @dir_openstrings);
  1455. AddDirective('OPTIMIZATION',directive_all, @dir_optimization);
  1456. AddDirective('OV',directive_mac, @dir_overflowchecks);
  1457. AddDirective('OVERFLOWCHECKS',directive_all, @dir_overflowchecks);
  1458. AddDirective('PACKENUM',directive_all, @dir_packenum);
  1459. AddDirective('PACKRECORDS',directive_all, @dir_packrecords);
  1460. AddDirective('PACKSET',directive_all, @dir_packset);
  1461. AddDirective('PASCALMAINNAME',directive_all, @dir_pascalmainname);
  1462. AddDirective('PIC',directive_all, @dir_pic);
  1463. AddDirective('POINTERMATH',directive_all, @dir_pointermath);
  1464. AddDirective('POP',directive_all, @dir_pop);
  1465. AddDirective('PROFILE',directive_all, @dir_profile);
  1466. AddDirective('PUSH',directive_all, @dir_push);
  1467. AddDirective('R',directive_all, @dir_resource);
  1468. AddDirective('RANGECHECKS',directive_all, @dir_rangechecks);
  1469. AddDirective('REFERENCEINFO',directive_all, @dir_referenceinfo);
  1470. AddDirective('REGION',directive_all, @dir_region);
  1471. AddDirective('RESOURCE',directive_all, @dir_resource);
  1472. AddDirective('SATURATION',directive_all, @dir_saturation);
  1473. AddDirective('SAFEFPUEXCEPTIONS',directive_all, @dir_safefpuexceptions);
  1474. AddDirective('SCOPEDENUMS',directive_all, @dir_scopedenums);
  1475. AddDirective('SETPEFLAGS', directive_all, @dir_setpeflags);
  1476. AddDirective('SETPEOPTFLAGS', directive_all, @dir_setpeoptflags);
  1477. AddDirective('SCREENNAME',directive_all, @dir_screenname);
  1478. AddDirective('SMARTLINK',directive_all, @dir_smartlink);
  1479. AddDirective('STACKFRAMES',directive_all, @dir_stackframes);
  1480. AddDirective('STOP',directive_all, @dir_stop);
  1481. AddDirective('STRINGCHECKS', directive_all, @dir_stringchecks);
  1482. {$ifdef powerpc}
  1483. AddDirective('SYSCALL',directive_all, @dir_syscall);
  1484. {$endif powerpc}
  1485. AddDirective('TARGETSWITCH',directive_all, @dir_targetswitch);
  1486. AddDirective('THREADNAME',directive_all, @dir_threadname);
  1487. AddDirective('TYPEDADDRESS',directive_all, @dir_typedaddress);
  1488. AddDirective('TYPEINFO',directive_all, @dir_typeinfo);
  1489. AddDirective('UNITPATH',directive_all, @dir_unitpath);
  1490. AddDirective('VARPARACOPYOUTCHECK',directive_all, @dir_varparacopyoutcheck);
  1491. AddDirective('VARPROPSETTER',directive_all, @dir_varpropsetter);
  1492. AddDirective('VARSTRINGCHECKS',directive_all, @dir_varstringchecks);
  1493. AddDirective('VERSION',directive_all, @dir_version);
  1494. AddDirective('WAIT',directive_all, @dir_wait);
  1495. AddDirective('WARN',directive_all, @dir_warn);
  1496. AddDirective('WARNING',directive_all, @dir_warning);
  1497. AddDirective('WARNINGS',directive_all, @dir_warnings);
  1498. AddDirective('WEAKPACKAGEUNIT',directive_all, @dir_weakpackageunit);
  1499. AddDirective('WRITEABLECONST',directive_all, @dir_writeableconst);
  1500. AddDirective('Z1',directive_all, @dir_z1);
  1501. AddDirective('Z2',directive_all, @dir_z2);
  1502. AddDirective('Z4',directive_all, @dir_z4);
  1503. AddDirective('ZEROBASEDSTRINGS',directive_all, @dir_zerobasesstrings);
  1504. end;
  1505. end.