scandir.pas 54 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707
  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,link,
  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_forcefarcalls;
  333. begin
  334. if (target_info.system<>system_i8086_msdos)
  335. {$ifdef i8086}
  336. or (current_settings.x86memorymodel in x86_near_code_models)
  337. {$endif i8086}
  338. then
  339. begin
  340. Message1(scan_n_ignored_switch,pattern);
  341. exit;
  342. end;
  343. do_localswitch(cs_force_far_calls);
  344. end;
  345. procedure dir_fatal;
  346. begin
  347. do_message(scan_f_user_defined);
  348. end;
  349. procedure dir_fputype;
  350. begin
  351. current_scanner.skipspace;
  352. undef_system_macro('FPU'+fputypestr[current_settings.fputype]);
  353. if not(SetFPUType(upper(current_scanner.readcomment),current_settings.fputype)) then
  354. comment(V_Error,'Illegal FPU type');
  355. def_system_macro('FPU'+fputypestr[current_settings.fputype]);
  356. end;
  357. procedure dir_frameworkpath;
  358. begin
  359. if not current_module.in_global then
  360. Message(scan_w_switch_is_global)
  361. else if not(target_info.system in systems_darwin) then
  362. begin
  363. Message(scan_w_frameworks_darwin_only);
  364. current_scanner.skipspace;
  365. current_scanner.readcomment
  366. end
  367. else
  368. begin
  369. current_scanner.skipspace;
  370. current_module.localframeworksearchpath.AddPath(current_scanner.readcomment,false);
  371. end;
  372. end;
  373. procedure dir_goto;
  374. begin
  375. do_moduleswitch(cs_support_goto);
  376. end;
  377. procedure dir_hint;
  378. begin
  379. do_message(scan_h_user_defined);
  380. end;
  381. procedure dir_hints;
  382. begin
  383. do_setverbose('H');
  384. end;
  385. procedure dir_imagebase;
  386. begin
  387. if not (target_info.system in (systems_windows+systems_wince)) then
  388. Message(scan_w_imagebase_not_support);
  389. current_scanner.skipspace;
  390. imagebase:=current_scanner.readval;
  391. ImageBaseSetExplicity:=true
  392. end;
  393. procedure dir_implicitexceptions;
  394. begin
  395. do_moduleswitch(cs_implicit_exceptions);
  396. end;
  397. procedure dir_includepath;
  398. begin
  399. if not current_module.in_global then
  400. Message(scan_w_switch_is_global)
  401. else
  402. begin
  403. current_scanner.skipspace;
  404. current_module.localincludesearchpath.AddPath(current_scanner.readcomment,false);
  405. end;
  406. end;
  407. procedure dir_info;
  408. begin
  409. do_message(scan_i_user_defined);
  410. end;
  411. procedure dir_inline;
  412. begin
  413. do_localswitch(cs_do_inline);
  414. end;
  415. procedure dir_interfaces;
  416. var
  417. hs : string;
  418. begin
  419. {corba/com/default}
  420. current_scanner.skipspace;
  421. hs:=current_scanner.readid;
  422. {$ifndef jvm}
  423. if (hs='CORBA') then
  424. current_settings.interfacetype:=it_interfacecorba
  425. else if (hs='COM') then
  426. current_settings.interfacetype:=it_interfacecom
  427. else
  428. {$endif jvm}
  429. if (hs='DEFAULT') then
  430. current_settings.interfacetype:=init_settings.interfacetype
  431. else
  432. Message(scan_e_invalid_interface_type);
  433. end;
  434. procedure dir_iochecks;
  435. begin
  436. do_delphiswitch('I');
  437. end;
  438. procedure dir_libexport;
  439. begin
  440. {not implemented}
  441. end;
  442. procedure dir_librarypath;
  443. begin
  444. if not current_module.in_global then
  445. Message(scan_w_switch_is_global)
  446. else
  447. begin
  448. current_scanner.skipspace;
  449. current_module.locallibrarysearchpath.AddPath(current_scanner.readcomment,false);
  450. end;
  451. end;
  452. procedure dir_link;
  453. var
  454. s : string;
  455. begin
  456. current_scanner.skipspace;
  457. if scanner.c = '''' then
  458. begin
  459. s:= current_scanner.readquotedstring;
  460. current_scanner.readcomment
  461. end
  462. else
  463. s:= trimspace(current_scanner.readcomment);
  464. s:=FixFileName(s);
  465. if ExtractFileExt(s)='' then
  466. s:=ChangeFileExt(s,target_info.objext);
  467. current_module.linkotherofiles.add(s,link_always);
  468. end;
  469. procedure dir_linkframework;
  470. var
  471. s : string;
  472. begin
  473. current_scanner.skipspace;
  474. if scanner.c = '''' then
  475. begin
  476. s:= current_scanner.readquotedstring;
  477. current_scanner.readcomment
  478. end
  479. else
  480. s:= trimspace(current_scanner.readcomment);
  481. s:=FixFileName(s);
  482. if (target_info.system in systems_darwin) then
  483. current_module.linkotherframeworks.add(s,link_always)
  484. else
  485. Message(scan_w_frameworks_darwin_only);
  486. end;
  487. procedure dir_linklib;
  488. type
  489. tLinkMode=(lm_shared,lm_static);
  490. var
  491. s : string;
  492. quote : char;
  493. libext,
  494. libname,
  495. linkmodestr : string;
  496. p : longint;
  497. linkMode : tLinkMode;
  498. begin
  499. current_scanner.skipspace;
  500. if scanner.c = '''' then
  501. begin
  502. libname:= current_scanner.readquotedstring;
  503. s:= current_scanner.readcomment;
  504. p:=pos(',',s);
  505. end
  506. else
  507. begin
  508. s:= current_scanner.readcomment;
  509. p:=pos(',',s);
  510. if p=0 then
  511. libname:=TrimSpace(s)
  512. else
  513. libname:=TrimSpace(copy(s,1,p-1));
  514. end;
  515. if p=0 then
  516. linkmodeStr:=''
  517. else
  518. linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
  519. if (libname='') or (libname='''''') or (libname='""') then
  520. exit;
  521. { create library name }
  522. if libname[1] in ['''','"'] then
  523. begin
  524. quote:=libname[1];
  525. Delete(libname,1,1);
  526. p:=pos(quote,libname);
  527. if p>0 then
  528. Delete(libname,p,1);
  529. end;
  530. libname:=FixFileName(libname);
  531. { get linkmode, default is to check the extension for
  532. the static library, otherwise shared linking is assumed }
  533. linkmode:=lm_shared;
  534. if linkModeStr='' then
  535. begin
  536. libext:=ExtractFileExt(libname);
  537. if libext=target_info.staticClibext then
  538. linkMode:=lm_static;
  539. end
  540. else if linkModeStr='STATIC' then
  541. linkmode:=lm_static
  542. else if (LinkModeStr='SHARED') or (LinkModeStr='') then
  543. linkmode:=lm_shared
  544. else
  545. Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
  546. { add to the list of other libraries }
  547. if linkMode=lm_static then
  548. current_module.linkOtherStaticLibs.add(libname,link_always)
  549. else
  550. current_module.linkOtherSharedLibs.add(libname,link_always);
  551. end;
  552. procedure dir_localsymbols;
  553. begin
  554. do_delphiswitch('L');
  555. end;
  556. procedure dir_longstrings;
  557. begin
  558. do_delphiswitch('H');
  559. end;
  560. procedure dir_macro;
  561. begin
  562. do_moduleswitch(cs_support_macro);
  563. end;
  564. procedure dir_pascalmainname;
  565. var
  566. s: string;
  567. begin
  568. current_scanner.skipspace;
  569. s:=trimspace(current_scanner.readcomment);
  570. if assigned(current_module.mainname) and
  571. (s<>current_module.mainname^) then
  572. begin
  573. Message1(scan_w_multiple_main_name_overrides,current_module.mainname^);
  574. stringdispose(current_module.mainname)
  575. end
  576. else if (mainaliasname<>defaultmainaliasname) and
  577. (mainaliasname<>s) then
  578. Message1(scan_w_multiple_main_name_overrides,mainaliasname);
  579. mainaliasname:=s;
  580. if (mainaliasname<>defaultmainaliasname) then
  581. current_module.mainname:=stringdup(mainaliasname);
  582. end;
  583. procedure dir_maxfpuregisters;
  584. var
  585. l : integer;
  586. hs : string;
  587. begin
  588. current_scanner.skipspace;
  589. if not(c in ['0'..'9']) then
  590. begin
  591. hs:=current_scanner.readid;
  592. if (hs='NORMAL') or (hs='DEFAULT') then
  593. current_settings.maxfpuregisters:=-1
  594. else
  595. Message(scan_e_invalid_maxfpureg_value);
  596. end
  597. else
  598. begin
  599. l:=current_scanner.readval;
  600. case l of
  601. 0..8:
  602. current_settings.maxfpuregisters:=l;
  603. else
  604. Message(scan_e_invalid_maxfpureg_value);
  605. end;
  606. end;
  607. end;
  608. procedure dir_maxstacksize;
  609. begin
  610. if not (target_info.system in (systems_windows+systems_wince)) then
  611. Message(scan_w_maxstacksize_not_support);
  612. current_scanner.skipspace;
  613. maxstacksize:=current_scanner.readval;
  614. MaxStackSizeSetExplicity:=true;
  615. end;
  616. procedure dir_memory;
  617. var
  618. l : longint;
  619. begin
  620. current_scanner.skipspace;
  621. l:=current_scanner.readval;
  622. if l>1024 then
  623. stacksize:=l;
  624. if c=',' then
  625. begin
  626. current_scanner.readchar;
  627. current_scanner.skipspace;
  628. l:=current_scanner.readval;
  629. if l>1024 then
  630. heapsize:=l;
  631. end;
  632. end;
  633. procedure dir_message;
  634. var
  635. hs : string;
  636. w : longint;
  637. begin
  638. w:=0;
  639. current_scanner.skipspace;
  640. { Message level specified? }
  641. if c='''' then
  642. w:=scan_n_user_defined
  643. else
  644. begin
  645. hs:=current_scanner.readid;
  646. if (hs='WARN') or (hs='WARNING') then
  647. w:=scan_w_user_defined
  648. else
  649. if (hs='ERROR') then
  650. w:=scan_e_user_defined
  651. else
  652. if (hs='FATAL') then
  653. w:=scan_f_user_defined
  654. else
  655. if (hs='HINT') then
  656. w:=scan_h_user_defined
  657. else
  658. if (hs='NOTE') then
  659. w:=scan_n_user_defined
  660. else
  661. Message1(scan_w_illegal_directive,hs);
  662. end;
  663. { Only print message when there was no error }
  664. if w<>0 then
  665. begin
  666. current_scanner.skipspace;
  667. if c='''' then
  668. hs:=current_scanner.readquotedstring
  669. else
  670. hs:=current_scanner.readcomment;
  671. Message1(w,hs);
  672. end
  673. else
  674. current_scanner.readcomment;
  675. end;
  676. procedure dir_minstacksize;
  677. begin
  678. if not (target_info.system in (systems_windows+systems_wince)) then
  679. Message(scan_w_minstacksize_not_support);
  680. current_scanner.skipspace;
  681. minstacksize:=current_scanner.readval;
  682. MinStackSizeSetExplicity:=true;
  683. end;
  684. procedure dir_mode;
  685. begin
  686. if not current_module.in_global then
  687. Message(scan_w_switch_is_global)
  688. else
  689. begin
  690. current_scanner.skipspace;
  691. current_scanner.readstring;
  692. if not current_module.mode_switch_allowed and
  693. not ((m_mac in current_settings.modeswitches) and (pattern='MACPAS')) then
  694. Message1(scan_e_mode_switch_not_allowed,pattern)
  695. else if not SetCompileMode(pattern,false) then
  696. Message1(scan_w_illegal_switch,pattern)
  697. end;
  698. current_module.mode_switch_allowed:= false;
  699. end;
  700. procedure dir_modeswitch;
  701. var
  702. s : string;
  703. begin
  704. if not current_module.in_global then
  705. Message(scan_w_switch_is_global)
  706. else
  707. begin
  708. current_scanner.skipspace;
  709. current_scanner.readstring;
  710. s:=pattern;
  711. if c in ['+','-'] then
  712. s:=s+current_scanner.readstate;
  713. if not SetCompileModeSwitch(s,false) then
  714. Message1(scan_w_illegal_switch,s)
  715. end;
  716. end;
  717. procedure dir_namespace;
  718. var
  719. s : string;
  720. begin
  721. { used to define Java package names for all types declared in the
  722. current unit }
  723. if not current_module.in_global then
  724. Message(scan_w_switch_is_global)
  725. else
  726. begin
  727. current_scanner.skipspace;
  728. current_scanner.readstring;
  729. s:=orgpattern;
  730. while c='.' do
  731. begin
  732. current_scanner.readchar;
  733. current_scanner.readstring;
  734. s:=s+'.'+orgpattern;
  735. end;
  736. disposestr(current_module.namespace);
  737. current_module.namespace:=stringdup(s);
  738. end;
  739. end;
  740. procedure dir_mmx;
  741. begin
  742. do_localswitch(cs_mmx);
  743. end;
  744. procedure dir_note;
  745. begin
  746. do_message(scan_n_user_defined);
  747. end;
  748. procedure dir_notes;
  749. begin
  750. do_setverbose('N');
  751. end;
  752. procedure dir_objectpath;
  753. begin
  754. if not current_module.in_global then
  755. Message(scan_w_switch_is_global)
  756. else
  757. begin
  758. current_scanner.skipspace;
  759. current_module.localobjectsearchpath.AddPath(current_scanner.readcomment,false);
  760. end;
  761. end;
  762. procedure dir_openstrings;
  763. begin
  764. do_delphiswitch('P');
  765. end;
  766. procedure dir_optimization;
  767. var
  768. hs : string;
  769. begin
  770. current_scanner.skipspace;
  771. { Support also the ON and OFF as switch }
  772. hs:=current_scanner.readid;
  773. if (hs='ON') then
  774. current_settings.optimizerswitches:=level2optimizerswitches
  775. else if (hs='OFF') then
  776. current_settings.optimizerswitches:=[]
  777. else if (hs='DEFAULT') then
  778. current_settings.optimizerswitches:=init_settings.optimizerswitches
  779. else
  780. begin
  781. if not UpdateOptimizerStr(hs,current_settings.optimizerswitches) then
  782. Message1(scan_e_illegal_optimization_specifier,hs);
  783. end;
  784. end;
  785. procedure dir_overflowchecks;
  786. begin
  787. do_delphiswitch('Q');
  788. end;
  789. procedure dir_packenum;
  790. var
  791. hs : string;
  792. begin
  793. current_scanner.skipspace;
  794. if not(c in ['0'..'9']) then
  795. begin
  796. hs:=current_scanner.readid;
  797. if (hs='NORMAL') or (hs='DEFAULT') then
  798. current_settings.packenum:=4
  799. else
  800. Message1(scan_e_illegal_pack_enum, hs);
  801. end
  802. else
  803. begin
  804. case current_scanner.readval of
  805. 1 : current_settings.packenum:=1;
  806. 2 : current_settings.packenum:=2;
  807. 4 : current_settings.packenum:=4;
  808. else
  809. Message1(scan_e_illegal_pack_enum, pattern);
  810. end;
  811. end;
  812. end;
  813. procedure dir_minfpconstprec;
  814. begin
  815. current_scanner.skipspace;
  816. if not SetMinFPConstPrec(current_scanner.readid,current_settings.minfpconstprec) then
  817. Message1(scan_e_illegal_minfpconstprec, pattern);
  818. end;
  819. procedure dir_packrecords;
  820. var
  821. hs : string;
  822. begin
  823. { can't change packrecords setting on managed vm targets }
  824. if target_info.system in systems_managed_vm then
  825. Message1(scanner_w_directive_ignored_on_target, 'PACKRECORDS');
  826. current_scanner.skipspace;
  827. if not(c in ['0'..'9']) then
  828. begin
  829. hs:=current_scanner.readid;
  830. { C has the special recordalignmax of C_alignment }
  831. if (hs='C') then
  832. current_settings.packrecords:=C_alignment
  833. else
  834. if (hs='NORMAL') or (hs='DEFAULT') then
  835. current_settings.packrecords:=default_settings.packrecords
  836. else
  837. Message1(scan_e_illegal_pack_records,hs);
  838. end
  839. else
  840. begin
  841. case current_scanner.readval of
  842. 1 : current_settings.packrecords:=1;
  843. 2 : current_settings.packrecords:=2;
  844. 4 : current_settings.packrecords:=4;
  845. 8 : current_settings.packrecords:=8;
  846. 16 : current_settings.packrecords:=16;
  847. 32 : current_settings.packrecords:=32;
  848. else
  849. Message1(scan_e_illegal_pack_records,pattern);
  850. end;
  851. end;
  852. end;
  853. procedure dir_packset;
  854. var
  855. hs : string;
  856. begin
  857. current_scanner.skipspace;
  858. if not(c in ['1','2','4','8']) then
  859. begin
  860. hs:=current_scanner.readid;
  861. if (hs='FIXED') or (hs='DEFAULT') OR (hs='NORMAL') then
  862. current_settings.setalloc:=0 {Fixed mode, sets are 4 or 32 bytes}
  863. else
  864. Message(scan_e_only_packset);
  865. end
  866. else
  867. begin
  868. case current_scanner.readval of
  869. 1 : current_settings.setalloc:=1;
  870. 2 : current_settings.setalloc:=2;
  871. 4 : current_settings.setalloc:=4;
  872. 8 : current_settings.setalloc:=8;
  873. else
  874. Message(scan_e_only_packset);
  875. end;
  876. end;
  877. end;
  878. procedure dir_pic;
  879. begin
  880. { windows doesn't need/support pic }
  881. if tf_no_pic_supported in target_info.flags then
  882. message(scan_w_pic_ignored)
  883. else
  884. do_moduleswitch(cs_create_pic);
  885. end;
  886. procedure dir_pop;
  887. begin
  888. if switchesstatestackpos < 1 then
  889. Message(scan_e_too_many_pop);
  890. Dec(switchesstatestackpos);
  891. recordpendinglocalfullswitch(switchesstatestack[switchesstatestackpos].localsw);
  892. recordpendingverbosityfullswitch(switchesstatestack[switchesstatestackpos].verbosity);
  893. pendingstate.nextmessagerecord:=switchesstatestack[switchesstatestackpos].pmessage;
  894. { Reset verbosity and forget previous pmeesage }
  895. RestoreLocalVerbosity(nil);
  896. current_settings.pmessage:=nil;
  897. { Do not yet activate these changes, as otherwise
  898. you get problem idf you put a $pop just right after
  899. a addition for instance fro which you explicitly truned the overflow check
  900. out by using $Q- after a $push PM 2012-08-29 }
  901. // flushpendingswitchesstate;
  902. end;
  903. procedure dir_pointermath;
  904. begin
  905. do_localswitch(cs_pointermath);
  906. end;
  907. procedure dir_profile;
  908. begin
  909. do_moduleswitch(cs_profile);
  910. { defined/undefine FPC_PROFILE }
  911. if cs_profile in current_settings.moduleswitches then
  912. def_system_macro('FPC_PROFILE')
  913. else
  914. undef_system_macro('FPC_PROFILE');
  915. end;
  916. procedure dir_push;
  917. begin
  918. if switchesstatestackpos > switchesstatestackmax then
  919. Message(scan_e_too_many_push);
  920. flushpendingswitchesstate;
  921. switchesstatestack[switchesstatestackpos].localsw:= current_settings.localswitches;
  922. switchesstatestack[switchesstatestackpos].pmessage:= current_settings.pmessage;
  923. switchesstatestack[switchesstatestackpos].verbosity:=status.verbosity;
  924. Inc(switchesstatestackpos);
  925. end;
  926. procedure dir_rangechecks;
  927. begin
  928. do_delphiswitch('R');
  929. end;
  930. procedure dir_referenceinfo;
  931. begin
  932. do_delphiswitch('Y');
  933. end;
  934. procedure dir_resource;
  935. var
  936. s : string;
  937. begin
  938. current_scanner.skipspace;
  939. if scanner.c = '''' then
  940. begin
  941. s:= current_scanner.readquotedstring;
  942. current_scanner.readcomment
  943. end
  944. else
  945. s:= trimspace(current_scanner.readcomment);
  946. { replace * with the name of the main source.
  947. This should always be defined. }
  948. if s[1]='*' then
  949. if Assigned(Current_Module) then
  950. begin
  951. delete(S,1,1);
  952. insert(ChangeFileExt(ExtractFileName(current_module.mainsource),''),S,1 );
  953. end;
  954. s:=FixFileName(s);
  955. if ExtractFileExt(s)='' then
  956. s:=ChangeFileExt(s,target_info.resext);
  957. if target_info.res<>res_none then
  958. begin
  959. current_module.flags:=current_module.flags or uf_has_resourcefiles;
  960. if (res_single_file in target_res.resflags) and
  961. not (Current_module.ResourceFiles.Empty) then
  962. Message(scan_w_only_one_resourcefile_supported)
  963. else
  964. current_module.resourcefiles.insert(FixFileName(s));
  965. end
  966. else
  967. Message(scan_e_resourcefiles_not_supported);
  968. end;
  969. procedure dir_saturation;
  970. begin
  971. do_localswitch(cs_mmx_saturation);
  972. end;
  973. procedure dir_safefpuexceptions;
  974. begin
  975. do_localswitch(cs_fpu_fwait);
  976. end;
  977. procedure dir_scopedenums;
  978. begin
  979. do_localswitch(cs_scopedenums);
  980. end;
  981. function get_peflag_const(const ident:string;error:longint):longint;
  982. var
  983. srsym : tsym;
  984. srsymtable : tsymtable;
  985. begin
  986. result:=0;
  987. if searchsym(ident,srsym,srsymtable) then
  988. if (srsym.typ=constsym) and
  989. (tconstsym(srsym).consttyp=constord) and
  990. is_integer(tconstsym(srsym).constdef) then
  991. with tconstsym(srsym).value.valueord do
  992. if signed then
  993. result:=tconstsym(srsym).value.valueord.svalue
  994. else
  995. result:=tconstsym(srsym).value.valueord.uvalue
  996. else
  997. message(error)
  998. else
  999. message1(sym_e_id_not_found,ident);
  1000. end;
  1001. procedure dir_setpeflags;
  1002. var
  1003. ident : string;
  1004. begin
  1005. if not (target_info.system in (systems_all_windows)) then
  1006. Message(scan_w_setpeflags_not_support);
  1007. current_scanner.skipspace;
  1008. ident:=current_scanner.readid;
  1009. if ident<>'' then
  1010. peflags:=peflags or get_peflag_const(ident,scan_e_illegal_peflag)
  1011. else
  1012. peflags:=peflags or current_scanner.readval;
  1013. SetPEFlagsSetExplicity:=true;
  1014. end;
  1015. procedure dir_setpeoptflags;
  1016. var
  1017. ident : string;
  1018. begin
  1019. if not (target_info.system in (systems_all_windows)) then
  1020. Message(scan_w_setpeoptflags_not_support);
  1021. current_scanner.skipspace;
  1022. ident:=current_scanner.readid;
  1023. if ident<>'' then
  1024. peoptflags:=peoptflags or get_peflag_const(ident,scan_e_illegal_peoptflag)
  1025. else
  1026. peoptflags:=peoptflags or current_scanner.readval;
  1027. SetPEOptFlagsSetExplicity:=true;
  1028. end;
  1029. procedure dir_smartlink;
  1030. begin
  1031. do_moduleswitch(cs_create_smart);
  1032. if (paratargetdbg in [dbg_dwarf2,dbg_dwarf3]) and
  1033. not(target_info.system in (systems_darwin+[system_i8086_msdos])) and
  1034. { smart linking does not yet work with DWARF debug info on most targets }
  1035. (cs_create_smart in current_settings.moduleswitches) and
  1036. not (af_outputbinary in target_asm.flags) then
  1037. begin
  1038. Message(option_dwarf_smart_linking);
  1039. Exclude(current_settings.moduleswitches,cs_create_smart);
  1040. end;
  1041. { Also create a smartlinked version, on an assembler that
  1042. does not support smartlink sections like nasm?
  1043. This is not compatible with using internal linker. }
  1044. if ((cs_link_smart in current_settings.globalswitches) or
  1045. (cs_create_smart in current_settings.moduleswitches)) and
  1046. (af_needar in target_asm.flags) and
  1047. not (af_smartlink_sections in target_asm.flags) and
  1048. not (cs_link_extern in current_settings.globalswitches) then
  1049. begin
  1050. DoneLinker;
  1051. Message(option_smart_link_requires_external_linker);
  1052. include(current_settings.globalswitches,cs_link_extern);
  1053. InitLinker;
  1054. end
  1055. end;
  1056. procedure dir_stackframes;
  1057. begin
  1058. do_delphiswitch('W');
  1059. end;
  1060. procedure dir_stop;
  1061. begin
  1062. do_message(scan_f_user_defined);
  1063. end;
  1064. procedure dir_stringchecks;
  1065. begin
  1066. // Delphi adds checks that ansistring and unicodestring are correct in
  1067. // different places. Skip it for now.
  1068. end;
  1069. {$ifdef powerpc}
  1070. procedure dir_syscall;
  1071. var
  1072. sctype : string;
  1073. begin
  1074. { not needed on amiga/m68k for now, because there's only one }
  1075. { syscall convention (legacy) (KB) }
  1076. { not needed on amiga/powerpc because there's only one }
  1077. { syscall convention (sysv) (KB) }
  1078. if not (target_info.system in [system_powerpc_morphos]) then
  1079. comment (V_Warning,'Syscall directive is useless on this target.');
  1080. current_scanner.skipspace;
  1081. sctype:=current_scanner.readid;
  1082. if (sctype='LEGACY') or (sctype='SYSV') or (sctype='SYSVBASE') or
  1083. (sctype='BASESYSV') or (sctype='R12BASE') then
  1084. syscall_convention:=sctype
  1085. else
  1086. comment (V_Warning,'Invalid Syscall directive ignored.');
  1087. end;
  1088. {$endif}
  1089. procedure dir_targetswitch;
  1090. var
  1091. name, value: string;
  1092. begin
  1093. { note: *not* recorded in the tokenstream, so not replayed for generics }
  1094. current_scanner.skipspace;
  1095. name:=current_scanner.readid;
  1096. if c='=' then
  1097. begin
  1098. current_scanner.readchar;
  1099. current_scanner.readid;
  1100. value:=orgpattern;
  1101. UpdateTargetSwitchStr(name+'='+value,current_settings.targetswitches,current_module.in_global);
  1102. end
  1103. else
  1104. UpdateTargetSwitchStr(name,current_settings.targetswitches,current_module.in_global);
  1105. end;
  1106. procedure dir_typedaddress;
  1107. begin
  1108. do_delphiswitch('T');
  1109. end;
  1110. procedure dir_typeinfo;
  1111. begin
  1112. do_delphiswitch('M');
  1113. end;
  1114. procedure dir_unitpath;
  1115. begin
  1116. if not current_module.in_global then
  1117. Message(scan_w_switch_is_global)
  1118. else
  1119. with current_scanner,current_module,localunitsearchpath do
  1120. begin
  1121. skipspace;
  1122. AddPath(path,readcomment,false);
  1123. end;
  1124. end;
  1125. procedure dir_varparacopyoutcheck;
  1126. begin
  1127. if not(target_info.system in systems_jvm) then
  1128. begin
  1129. Message1(scan_w_illegal_switch,pattern);
  1130. exit;
  1131. end;
  1132. do_localswitch(cs_check_var_copyout);
  1133. end;
  1134. procedure dir_varpropsetter;
  1135. begin
  1136. do_localswitch(cs_varpropsetter);
  1137. end;
  1138. procedure dir_varstringchecks;
  1139. begin
  1140. do_delphiswitch('V');
  1141. end;
  1142. procedure dir_version;
  1143. var
  1144. major, minor, revision : longint;
  1145. error : integer;
  1146. begin
  1147. if not (target_info.system in systems_all_windows+[system_i386_os2,system_i386_emx,
  1148. system_i386_netware,system_i386_wdosx,
  1149. system_i386_netwlibc]) then
  1150. begin
  1151. Message(scan_n_version_not_support);
  1152. exit;
  1153. end;
  1154. if (compile_level<>1) then
  1155. Message(scan_n_only_exe_version)
  1156. else
  1157. begin
  1158. { change description global var in all cases }
  1159. { it not used but in win32, os2 and netware }
  1160. current_scanner.skipspace;
  1161. { we should only accept Major.Minor format for win32 and os2 }
  1162. current_scanner.readnumber;
  1163. major:=0;
  1164. minor:=0;
  1165. revision:=0;
  1166. val(pattern,major,error);
  1167. if (error<>0) or (major > high(word)) or (major < 0) then
  1168. begin
  1169. Message1(scan_w_wrong_version_ignored,pattern);
  1170. exit;
  1171. end;
  1172. if c='.' then
  1173. begin
  1174. current_scanner.readchar;
  1175. current_scanner.readnumber;
  1176. val(pattern,minor,error);
  1177. if (error<>0) or (minor > high(word)) or (minor < 0) then
  1178. begin
  1179. Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
  1180. exit;
  1181. end;
  1182. if (c='.') and
  1183. (target_info.system in [system_i386_netware,system_i386_netwlibc]) then
  1184. begin
  1185. current_scanner.readchar;
  1186. current_scanner.readnumber;
  1187. val(pattern,revision,error);
  1188. if (error<>0) or (revision > high(word)) or (revision < 0) then
  1189. begin
  1190. Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
  1191. exit;
  1192. end;
  1193. dllmajor:=word(major);
  1194. dllminor:=word(minor);
  1195. dllrevision:=word(revision);
  1196. dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
  1197. end
  1198. else
  1199. begin
  1200. dllmajor:=word(major);
  1201. dllminor:=word(minor);
  1202. dllversion:=tostr(major)+'.'+tostr(minor);
  1203. end;
  1204. end
  1205. else
  1206. dllversion:=tostr(major);
  1207. end;
  1208. end;
  1209. procedure dir_wait;
  1210. var
  1211. had_info : boolean;
  1212. begin
  1213. had_info:=(status.verbosity and V_Info)<>0;
  1214. { this message should allways appear !! }
  1215. status.verbosity:=status.verbosity or V_Info;
  1216. Message(scan_i_press_enter);
  1217. readln;
  1218. If not(had_info) then
  1219. status.verbosity:=status.verbosity and (not V_Info);
  1220. end;
  1221. { delphi compatible warn directive:
  1222. $warn <identifier> on
  1223. $warn <identifier> off
  1224. $warn <identifier> error
  1225. }
  1226. procedure dir_warn;
  1227. var
  1228. ident : string;
  1229. state : string;
  1230. msgstate : tmsgstate;
  1231. i : integer;
  1232. begin
  1233. current_scanner.skipspace;
  1234. ident:=current_scanner.readid;
  1235. current_scanner.skipspace;
  1236. state:=current_scanner.readid;
  1237. { support both delphi and fpc switches }
  1238. { use local ms_on/off/error tmsgstate values }
  1239. if (state='ON') or (state='+') then
  1240. msgstate:=ms_on
  1241. else
  1242. if (state='OFF') or (state='-') then
  1243. msgstate:=ms_off
  1244. else
  1245. if (state='ERROR') then
  1246. msgstate:=ms_error
  1247. else
  1248. begin
  1249. Message1(scanner_e_illegal_warn_state,state);
  1250. exit;
  1251. end;
  1252. if ident='CONSTRUCTING_ABSTRACT' then
  1253. recordpendingmessagestate(type_w_instance_with_abstract, msgstate)
  1254. else
  1255. if ident='IMPLICIT_VARIANTS' then
  1256. recordpendingmessagestate(parser_w_implicit_uses_of_variants_unit, msgstate)
  1257. else
  1258. if ident='NO_RETVAL' then
  1259. recordpendingmessagestate(sym_w_function_result_not_set, msgstate)
  1260. else
  1261. if ident='SYMBOL_DEPRECATED' then
  1262. begin
  1263. recordpendingmessagestate(sym_w_deprecated_symbol, msgstate);
  1264. recordpendingmessagestate(sym_w_deprecated_symbol_with_msg, msgstate);
  1265. end
  1266. else
  1267. if ident='SYMBOL_EXPERIMENTAL' then
  1268. recordpendingmessagestate(sym_w_experimental_symbol, msgstate)
  1269. else
  1270. if ident='SYMBOL_LIBRARY' then
  1271. recordpendingmessagestate(sym_w_library_symbol, msgstate)
  1272. else
  1273. if ident='SYMBOL_PLATFORM' then
  1274. recordpendingmessagestate(sym_w_non_portable_symbol, msgstate)
  1275. else
  1276. if ident='SYMBOL_UNIMPLEMENTED' then
  1277. recordpendingmessagestate(sym_w_non_implemented_symbol, msgstate)
  1278. else
  1279. if ident='UNIT_DEPRECATED' then
  1280. begin
  1281. recordpendingmessagestate(sym_w_deprecated_unit, msgstate);
  1282. recordpendingmessagestate(sym_w_deprecated_unit_with_msg, msgstate);
  1283. end
  1284. else
  1285. if ident='UNIT_EXPERIMENTAL' then
  1286. recordpendingmessagestate(sym_w_experimental_unit, msgstate)
  1287. else
  1288. if ident='UNIT_LIBRARY' then
  1289. recordpendingmessagestate(sym_w_library_unit, msgstate)
  1290. else
  1291. if ident='UNIT_PLATFORM' then
  1292. recordpendingmessagestate(sym_w_non_portable_unit, msgstate)
  1293. else
  1294. if ident='UNIT_UNIMPLEMENTED' then
  1295. recordpendingmessagestate(sym_w_non_implemented_unit, msgstate)
  1296. else
  1297. if ident='ZERO_NIL_COMPAT' then
  1298. recordpendingmessagestate(type_w_zero_to_nil, msgstate)
  1299. else
  1300. if ident='IMPLICIT_STRING_CAST' then
  1301. recordpendingmessagestate(type_w_implicit_string_cast, msgstate)
  1302. else
  1303. if ident='IMPLICIT_STRING_CAST_LOSS' then
  1304. recordpendingmessagestate(type_w_implicit_string_cast_loss, msgstate)
  1305. else
  1306. if ident='EXPLICIT_STRING_CAST' then
  1307. recordpendingmessagestate(type_w_explicit_string_cast, msgstate)
  1308. else
  1309. if ident='EXPLICIT_STRING_CAST_LOSS' then
  1310. recordpendingmessagestate(type_w_explicit_string_cast_loss, msgstate)
  1311. else
  1312. if ident='CVT_NARROWING_STRING_LOST' then
  1313. recordpendingmessagestate(type_w_unicode_data_loss, msgstate)
  1314. else
  1315. if ident='INTF_RAISE_VISIBILITY' then
  1316. recordpendingmessagestate(type_w_interface_lower_visibility, msgstate)
  1317. else
  1318. begin
  1319. i:=0;
  1320. if not ChangeMessageVerbosity(ident,i,msgstate) then
  1321. Message1(scanner_w_illegal_warn_identifier,ident);
  1322. end;
  1323. end;
  1324. procedure dir_warning;
  1325. begin
  1326. do_message(scan_w_user_defined);
  1327. end;
  1328. procedure dir_warnings;
  1329. begin
  1330. do_setverbose('W');
  1331. end;
  1332. procedure dir_writeableconst;
  1333. begin
  1334. do_delphiswitch('J');
  1335. end;
  1336. procedure dir_z1;
  1337. begin
  1338. current_settings.packenum:=1;
  1339. end;
  1340. procedure dir_z2;
  1341. begin
  1342. current_settings.packenum:=2;
  1343. end;
  1344. procedure dir_z4;
  1345. begin
  1346. current_settings.packenum:=4;
  1347. end;
  1348. procedure dir_externalsym;
  1349. begin
  1350. end;
  1351. procedure dir_nodefine;
  1352. begin
  1353. end;
  1354. procedure dir_hppemit;
  1355. begin
  1356. end;
  1357. procedure dir_weakpackageunit;
  1358. begin
  1359. end;
  1360. procedure dir_codealign;
  1361. var
  1362. s : string;
  1363. begin
  1364. current_scanner.skipspace;
  1365. s:=current_scanner.readcomment;
  1366. if not(UpdateAlignmentStr(s,current_settings.alignment)) then
  1367. message(scanner_e_illegal_alignment_directive);
  1368. end;
  1369. procedure dir_codepage;
  1370. var
  1371. s : string;
  1372. begin
  1373. if not current_module.in_global then
  1374. Message(scan_w_switch_is_global)
  1375. else
  1376. begin
  1377. current_scanner.skipspace;
  1378. s:=current_scanner.readcomment;
  1379. if (upper(s)='UTF8') or (upper(s)='UTF-8') then
  1380. current_settings.sourcecodepage:=CP_UTF8
  1381. else if not cpavailable(s) then
  1382. Message1(option_code_page_not_available,s)
  1383. else
  1384. current_settings.sourcecodepage:=codepagebyname(s);
  1385. include(current_settings.moduleswitches,cs_explicit_codepage);
  1386. end;
  1387. end;
  1388. procedure dir_coperators;
  1389. begin
  1390. do_moduleswitch(cs_support_c_operators);
  1391. end;
  1392. procedure dir_bitpacking;
  1393. begin
  1394. do_localswitch(cs_bitpacking);
  1395. end;
  1396. procedure dir_region;
  1397. begin
  1398. end;
  1399. procedure dir_endregion;
  1400. begin
  1401. end;
  1402. procedure dir_zerobasesstrings;
  1403. begin
  1404. do_localswitch(cs_zerobasedstrings);
  1405. end;
  1406. {****************************************************************************
  1407. Initialize Directives
  1408. ****************************************************************************}
  1409. procedure InitScannerDirectives;
  1410. begin
  1411. AddDirective('A1',directive_all, @dir_a1);
  1412. AddDirective('A2',directive_all, @dir_a2);
  1413. AddDirective('A4',directive_all, @dir_a4);
  1414. AddDirective('A8',directive_all, @dir_a8);
  1415. AddDirective('ALIGN',directive_all, @dir_align);
  1416. {$ifdef m68k}
  1417. AddDirective('APPID',directive_all, @dir_appid);
  1418. AddDirective('APPNAME',directive_all, @dir_appname);
  1419. {$endif m68k}
  1420. AddDirective('APPTYPE',directive_all, @dir_apptype);
  1421. AddDirective('ASMMODE',directive_all, @dir_asmmode);
  1422. AddDirective('ASSERTIONS',directive_all, @dir_assertions);
  1423. AddDirective('BOOLEVAL',directive_all, @dir_booleval);
  1424. AddDirective('BITPACKING',directive_all, @dir_bitpacking);
  1425. AddDirective('CALLING',directive_all, @dir_calling);
  1426. AddDirective('CHECKLOWADDRLOADS',directive_all, @dir_checklowaddrloads);
  1427. AddDirective('CHECKPOINTER',directive_all, @dir_checkpointer);
  1428. AddDirective('CODEALIGN',directive_all, @dir_codealign);
  1429. AddDirective('CODEPAGE',directive_all, @dir_codepage);
  1430. AddDirective('COPERATORS',directive_all, @dir_coperators);
  1431. AddDirective('COPYRIGHT',directive_all, @dir_copyright);
  1432. AddDirective('D',directive_all, @dir_description);
  1433. AddDirective('DEBUGINFO',directive_all, @dir_debuginfo);
  1434. AddDirective('DESCRIPTION',directive_all, @dir_description);
  1435. AddDirective('ENDREGION',directive_all, @dir_endregion);
  1436. AddDirective('ERROR',directive_all, @dir_error);
  1437. AddDirective('ERRORC',directive_mac, @dir_error);
  1438. AddDirective('EXTENDEDSYNTAX',directive_all, @dir_extendedsyntax);
  1439. AddDirective('EXTERNALSYM',directive_all, @dir_externalsym);
  1440. AddDirective('F',directive_all, @dir_forcefarcalls);
  1441. AddDirective('FATAL',directive_all, @dir_fatal);
  1442. AddDirective('FPUTYPE',directive_all, @dir_fputype);
  1443. AddDirective('FRAMEWORKPATH',directive_all, @dir_frameworkpath);
  1444. AddDirective('GOTO',directive_all, @dir_goto);
  1445. AddDirective('HINT',directive_all, @dir_hint);
  1446. AddDirective('HINTS',directive_all, @dir_hints);
  1447. AddDirective('HPPEMIT',directive_all, @dir_hppemit);
  1448. AddDirective('IEEEERRORS',directive_all,@dir_ieeeerrors);
  1449. AddDirective('IOCHECKS',directive_all, @dir_iochecks);
  1450. AddDirective('IMAGEBASE',directive_all, @dir_imagebase);
  1451. AddDirective('IMPLICITEXCEPTIONS',directive_all, @dir_implicitexceptions);
  1452. AddDirective('INCLUDEPATH',directive_all, @dir_includepath);
  1453. AddDirective('INFO',directive_all, @dir_info);
  1454. AddDirective('INLINE',directive_all, @dir_inline);
  1455. AddDirective('INTERFACES',directive_all, @dir_interfaces);
  1456. AddDirective('L',directive_all, @dir_link);
  1457. AddDirective('LIBEXPORT',directive_mac, @dir_libexport);
  1458. AddDirective('LIBRARYPATH',directive_all, @dir_librarypath);
  1459. AddDirective('LINK',directive_all, @dir_link);
  1460. AddDirective('LINKFRAMEWORK',directive_all, @dir_linkframework);
  1461. AddDirective('LINKLIB',directive_all, @dir_linklib);
  1462. AddDirective('LOCALSYMBOLS',directive_all, @dir_localsymbols);
  1463. AddDirective('LONGSTRINGS',directive_all, @dir_longstrings);
  1464. AddDirective('M',directive_all, @dir_memory);
  1465. AddDirective('MACRO',directive_all, @dir_macro);
  1466. AddDirective('MAXFPUREGISTERS',directive_all, @dir_maxfpuregisters);
  1467. AddDirective('MAXSTACKSIZE',directive_all, @dir_maxstacksize);
  1468. AddDirective('MEMORY',directive_all, @dir_memory);
  1469. AddDirective('MESSAGE',directive_all, @dir_message);
  1470. AddDirective('MINENUMSIZE',directive_all, @dir_packenum);
  1471. AddDirective('MINFPCONSTPREC',directive_all, @dir_minfpconstprec);
  1472. AddDirective('MINSTACKSIZE',directive_all, @dir_minstacksize);
  1473. AddDirective('MMX',directive_all, @dir_mmx);
  1474. AddDirective('MODE',directive_all, @dir_mode);
  1475. AddDirective('MODESWITCH',directive_all, @dir_modeswitch);
  1476. AddDirective('NAMESPACE',directive_all, @dir_namespace);
  1477. AddDirective('NODEFINE',directive_all, @dir_nodefine);
  1478. AddDirective('NOTE',directive_all, @dir_note);
  1479. AddDirective('NOTES',directive_all, @dir_notes);
  1480. AddDirective('OBJECTCHECKS',directive_all, @dir_objectchecks);
  1481. AddDirective('OBJECTPATH',directive_all, @dir_objectpath);
  1482. AddDirective('OPENSTRINGS',directive_all, @dir_openstrings);
  1483. AddDirective('OPTIMIZATION',directive_all, @dir_optimization);
  1484. AddDirective('OV',directive_mac, @dir_overflowchecks);
  1485. AddDirective('OVERFLOWCHECKS',directive_all, @dir_overflowchecks);
  1486. AddDirective('PACKENUM',directive_all, @dir_packenum);
  1487. AddDirective('PACKRECORDS',directive_all, @dir_packrecords);
  1488. AddDirective('PACKSET',directive_all, @dir_packset);
  1489. AddDirective('PASCALMAINNAME',directive_all, @dir_pascalmainname);
  1490. AddDirective('PIC',directive_all, @dir_pic);
  1491. AddDirective('POINTERMATH',directive_all, @dir_pointermath);
  1492. AddDirective('POP',directive_all, @dir_pop);
  1493. AddDirective('PROFILE',directive_all, @dir_profile);
  1494. AddDirective('PUSH',directive_all, @dir_push);
  1495. AddDirective('R',directive_all, @dir_resource);
  1496. AddDirective('RANGECHECKS',directive_all, @dir_rangechecks);
  1497. AddDirective('REFERENCEINFO',directive_all, @dir_referenceinfo);
  1498. AddDirective('REGION',directive_all, @dir_region);
  1499. AddDirective('RESOURCE',directive_all, @dir_resource);
  1500. AddDirective('SATURATION',directive_all, @dir_saturation);
  1501. AddDirective('SAFEFPUEXCEPTIONS',directive_all, @dir_safefpuexceptions);
  1502. AddDirective('SCOPEDENUMS',directive_all, @dir_scopedenums);
  1503. AddDirective('SETPEFLAGS', directive_all, @dir_setpeflags);
  1504. AddDirective('SETPEOPTFLAGS', directive_all, @dir_setpeoptflags);
  1505. AddDirective('SCREENNAME',directive_all, @dir_screenname);
  1506. AddDirective('SMARTLINK',directive_all, @dir_smartlink);
  1507. AddDirective('STACKFRAMES',directive_all, @dir_stackframes);
  1508. AddDirective('STOP',directive_all, @dir_stop);
  1509. AddDirective('STRINGCHECKS', directive_all, @dir_stringchecks);
  1510. {$ifdef powerpc}
  1511. AddDirective('SYSCALL',directive_all, @dir_syscall);
  1512. {$endif powerpc}
  1513. AddDirective('TARGETSWITCH',directive_all, @dir_targetswitch);
  1514. AddDirective('THREADNAME',directive_all, @dir_threadname);
  1515. AddDirective('TYPEDADDRESS',directive_all, @dir_typedaddress);
  1516. AddDirective('TYPEINFO',directive_all, @dir_typeinfo);
  1517. AddDirective('UNITPATH',directive_all, @dir_unitpath);
  1518. AddDirective('VARPARACOPYOUTCHECK',directive_all, @dir_varparacopyoutcheck);
  1519. AddDirective('VARPROPSETTER',directive_all, @dir_varpropsetter);
  1520. AddDirective('VARSTRINGCHECKS',directive_all, @dir_varstringchecks);
  1521. AddDirective('VERSION',directive_all, @dir_version);
  1522. AddDirective('WAIT',directive_all, @dir_wait);
  1523. AddDirective('WARN',directive_all, @dir_warn);
  1524. AddDirective('WARNING',directive_all, @dir_warning);
  1525. AddDirective('WARNINGS',directive_all, @dir_warnings);
  1526. AddDirective('WEAKPACKAGEUNIT',directive_all, @dir_weakpackageunit);
  1527. AddDirective('WRITEABLECONST',directive_all, @dir_writeableconst);
  1528. AddDirective('Z1',directive_all, @dir_z1);
  1529. AddDirective('Z2',directive_all, @dir_z2);
  1530. AddDirective('Z4',directive_all, @dir_z4);
  1531. AddDirective('ZEROBASEDSTRINGS',directive_all, @dir_zerobasesstrings);
  1532. end;
  1533. end.