scandir.pas 34 KB

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