scandir.pas 33 KB

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