scandir.pas 33 KB

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