scandir.pas 31 KB

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