scandir.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 defines.inc}
  20. interface
  21. procedure InitScannerDirectives;
  22. implementation
  23. uses
  24. {$ifdef delphi}
  25. dmisc,
  26. {$else}
  27. dos,
  28. {$endif}
  29. cutils,
  30. version,globtype,globals,systems,
  31. verbose,comphook,
  32. scanner,switches,
  33. finput,fmodule;
  34. {*****************************************************************************
  35. Helpers
  36. *****************************************************************************}
  37. procedure do_delphiswitch(sw:char);
  38. var
  39. state : char;
  40. begin
  41. { c contains the next char, a + or - would be fine }
  42. state:=current_scanner.readstate;
  43. if state in ['-','+'] then
  44. HandleSwitch(sw,state);
  45. end;
  46. procedure do_setverbose(flag:char);
  47. var
  48. state : char;
  49. begin
  50. { support ON/OFF }
  51. state:=current_scanner.ReadState;
  52. SetVerbosity(flag+state);
  53. end;
  54. procedure do_moduleswitch(sw:tmoduleswitch);
  55. var
  56. state : char;
  57. begin
  58. state:=current_scanner.readstate;
  59. if (sw<>cs_modulenone) and (state in ['-','+']) then
  60. begin
  61. if state='-' then
  62. exclude(aktmoduleswitches,sw)
  63. else
  64. include(aktmoduleswitches,sw);
  65. end;
  66. end;
  67. procedure do_localswitch(sw:tlocalswitch);
  68. var
  69. state : char;
  70. begin
  71. state:=current_scanner.readstate;
  72. if (sw<>cs_localnone) and (state in ['-','+']) then
  73. begin
  74. if not localswitcheschanged then
  75. nextaktlocalswitches:=aktlocalswitches;
  76. if state='-' then
  77. exclude(nextaktlocalswitches,sw)
  78. else
  79. include(nextaktlocalswitches,sw);
  80. localswitcheschanged:=true;
  81. end;
  82. end;
  83. procedure do_message(w:integer);
  84. begin
  85. current_scanner.skipspace;
  86. Message1(w,current_scanner.readcomment);
  87. end;
  88. {*****************************************************************************
  89. Directive Callbacks
  90. *****************************************************************************}
  91. procedure dir_align;
  92. var
  93. hs : string;
  94. begin
  95. current_scanner.skipspace;
  96. if not(c in ['0'..'9']) then
  97. begin
  98. { Support also the ON and OFF as switch }
  99. hs:=current_scanner.readid;
  100. if (hs='ON') then
  101. aktalignment.recordalignmax:=4
  102. else
  103. if (hs='OFF') then
  104. aktalignment.recordalignmax:=1
  105. else
  106. Message(scan_w_only_pack_records);
  107. end
  108. else
  109. begin
  110. case current_scanner.readval of
  111. 1 : aktalignment.recordalignmax:=1;
  112. 2 : aktalignment.recordalignmax:=2;
  113. 4 : aktalignment.recordalignmax:=4;
  114. 8 : aktalignment.recordalignmax:=8;
  115. 16 : aktalignment.recordalignmax:=16;
  116. 32 : aktalignment.recordalignmax:=32;
  117. else
  118. Message(scan_w_only_pack_records);
  119. end;
  120. end;
  121. end;
  122. procedure dir_asmmode;
  123. var
  124. s : string;
  125. begin
  126. current_scanner.skipspace;
  127. s:=current_scanner.readid;
  128. If Inside_asm_statement then
  129. Message1(scan_w_no_asm_reader_switch_inside_asm,s);
  130. if s='DEFAULT' then
  131. aktasmmode:=initasmmode
  132. else
  133. if not set_asmmode_by_string(s,aktasmmode) then
  134. Message1(scan_w_unsupported_asmmode_specifier,s);
  135. end;
  136. {$ifdef m68k}
  137. procedure dir_appid;
  138. begin
  139. if target_info.target<>target_m68k_palmos then
  140. Message(scan_w_appid_not_support);
  141. { change description global var in all cases }
  142. { it not used but in win32 and os2 }
  143. current_scanner^.skipspace;
  144. palmos_applicationid:=current_scanner^.readcomment;
  145. end;
  146. procedure dir_appname;
  147. begin
  148. if target_info.target<>target_m68k_palmos then
  149. Message(scan_w_appname_not_support);
  150. { change description global var in all cases }
  151. { it not used but in win32 and os2 }
  152. current_scanner^.skipspace;
  153. palmos_applicationname:=current_scanner^.readcomment;
  154. end;
  155. {$endif m68k}
  156. procedure dir_apptype;
  157. var
  158. hs : string;
  159. begin
  160. if (target_info.target<>target_i386_win32)
  161. and (target_info.target<>target_i386_os2) then
  162. Message(scan_w_app_type_not_support);
  163. if not current_module.in_global then
  164. Message(scan_w_switch_is_global)
  165. else
  166. begin
  167. current_scanner.skipspace;
  168. hs:=current_scanner.readid;
  169. if hs='GUI' then
  170. apptype:=app_gui
  171. else if hs='CONSOLE' then
  172. apptype:=app_cui
  173. else if (hs='FS') and (target_info.target=target_i386_os2) then
  174. apptype:=app_fs
  175. else
  176. Message1(scan_w_unsupported_app_type,hs);
  177. end;
  178. end;
  179. procedure dir_calling;
  180. var
  181. hs : string;
  182. begin
  183. current_scanner.skipspace;
  184. hs:=current_scanner.readid;
  185. if not SetAktProcCall(hs,false) then
  186. Message1(parser_w_unknown_proc_directive_ignored,hs);
  187. end;
  188. procedure dir_assertions;
  189. begin
  190. do_delphiswitch('C');
  191. end;
  192. procedure dir_booleval;
  193. begin
  194. do_delphiswitch('B');
  195. end;
  196. procedure dir_debuginfo;
  197. begin
  198. do_delphiswitch('D');
  199. end;
  200. procedure dir_description;
  201. begin
  202. if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware]) then
  203. Message(scan_w_description_not_support);
  204. { change description global var in all cases }
  205. { it not used but in win32, os2 and netware }
  206. current_scanner.skipspace;
  207. description:=current_scanner.readcomment;
  208. end;
  209. procedure dir_screenname; {ad}
  210. begin
  211. if target_info.target <> target_i386_netware then
  212. {Message(scan_w_decription_not_support);}
  213. comment (V_Warning,'Screenname only supported for target netware');
  214. current_scanner.skipspace;
  215. nwscreenname:=current_scanner.readcomment;
  216. end;
  217. procedure dir_threadname; {ad}
  218. begin
  219. if target_info.target <> target_i386_netware then
  220. {Message(scan_w_decription_not_support);}
  221. comment (V_Warning,'Threadname only supported for target netware');
  222. current_scanner.skipspace;
  223. nwthreadname:=current_scanner.readcomment;
  224. end;
  225. procedure dir_copyright; {ad}
  226. begin
  227. if target_info.target <> target_i386_netware then
  228. {Message(scan_w_decription_not_support);}
  229. comment (V_Warning,'Copyright only supported for target netware');
  230. current_scanner.skipspace;
  231. nwcopyright:=current_scanner.readcomment;
  232. end;
  233. procedure dir_error;
  234. begin
  235. do_message(scan_e_user_defined);
  236. end;
  237. procedure dir_extendedsyntax;
  238. begin
  239. do_delphiswitch('X');
  240. end;
  241. procedure dir_fatal;
  242. begin
  243. do_message(scan_f_user_defined);
  244. end;
  245. procedure dir_goto;
  246. begin
  247. do_moduleswitch(cs_support_goto);
  248. end;
  249. procedure dir_hint;
  250. begin
  251. do_message(scan_h_user_defined);
  252. end;
  253. procedure dir_hints;
  254. begin
  255. do_setverbose('H');
  256. end;
  257. procedure dir_includepath;
  258. begin
  259. if not current_module.in_global then
  260. Message(scan_w_switch_is_global)
  261. else
  262. begin
  263. current_scanner.skipspace;
  264. current_module.localincludesearchpath.AddPath(current_scanner.readcomment,false);
  265. end;
  266. end;
  267. procedure dir_info;
  268. begin
  269. do_message(scan_i_user_defined);
  270. end;
  271. procedure dir_inline;
  272. begin
  273. do_moduleswitch(cs_support_inline);
  274. end;
  275. procedure dir_interfaces;
  276. var
  277. hs : string;
  278. begin
  279. {corba/com/default}
  280. current_scanner.skipspace;
  281. hs:=current_scanner.readid;
  282. if (hs='CORBA') then
  283. aktinterfacetype:=it_interfacecorba
  284. else if (hs='COM') then
  285. aktinterfacetype:=it_interfacecom
  286. else if (hs='DEFAULT') then
  287. aktinterfacetype:=initinterfacetype
  288. else
  289. Message(scan_e_invalid_interface_type);
  290. end;
  291. procedure dir_iochecks;
  292. begin
  293. do_delphiswitch('I');
  294. end;
  295. procedure dir_librarypath;
  296. begin
  297. if not current_module.in_global then
  298. Message(scan_w_switch_is_global)
  299. else
  300. begin
  301. current_scanner.skipspace;
  302. current_module.locallibrarysearchpath.AddPath(current_scanner.readcomment,false);
  303. end;
  304. end;
  305. procedure dir_link;
  306. var
  307. s : string;
  308. begin
  309. current_scanner.skipspace;
  310. s:=AddExtension(FixFileName(current_scanner.readcomment),target_info.objext);
  311. current_module.linkotherofiles.add(s,link_allways);
  312. end;
  313. procedure dir_linklib;
  314. type
  315. tLinkMode=(lm_shared,lm_static);
  316. var
  317. s : string;
  318. quote : char;
  319. libname,
  320. linkmodestr : string;
  321. p : longint;
  322. linkMode : tLinkMode;
  323. begin
  324. current_scanner.skipspace;
  325. s:=current_scanner.readcomment;
  326. p:=pos(',',s);
  327. if p=0 then
  328. begin
  329. libname:=TrimSpace(s);
  330. linkmodeStr:='';
  331. end
  332. else
  333. begin
  334. libname:=TrimSpace(copy(s,1,p-1));
  335. linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
  336. end;
  337. if (libname='') or (libname='''''') or (libname='""') then
  338. exit;
  339. { get linkmode, default is shared linking }
  340. if linkModeStr='STATIC' then
  341. linkmode:=lm_static
  342. else if (LinkModeStr='SHARED') or (LinkModeStr='') then
  343. linkmode:=lm_shared
  344. else
  345. begin
  346. Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
  347. exit;
  348. end;
  349. { create library name }
  350. if libname[1] in ['''','"'] then
  351. begin
  352. quote:=libname[1];
  353. Delete(libname,1,1);
  354. p:=pos(quote,libname);
  355. if p>0 then
  356. Delete(libname,p,1);
  357. end;
  358. { add to the list of libraries to link }
  359. if linkMode=lm_static then
  360. current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
  361. else
  362. current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
  363. end;
  364. procedure dir_localsymbols;
  365. begin
  366. do_delphiswitch('L');
  367. end;
  368. procedure dir_longstrings;
  369. begin
  370. do_delphiswitch('H');
  371. end;
  372. procedure dir_macro;
  373. begin
  374. do_moduleswitch(cs_support_macro);
  375. end;
  376. procedure dir_maxfpuregisters;
  377. var
  378. l : integer;
  379. hs : string;
  380. begin
  381. current_scanner.skipspace;
  382. if not(c in ['0'..'9']) then
  383. begin
  384. hs:=current_scanner.readid;
  385. if (hs='NORMAL') or (hs='DEFAULT') then
  386. aktmaxfpuregisters:=-1
  387. else
  388. Message(scan_e_invalid_maxfpureg_value);
  389. end
  390. else
  391. begin
  392. l:=current_scanner.readval;
  393. case l of
  394. 0..8:
  395. aktmaxfpuregisters:=l;
  396. else
  397. Message(scan_e_invalid_maxfpureg_value);
  398. end;
  399. end;
  400. end;
  401. procedure dir_memory;
  402. var
  403. l : longint;
  404. begin
  405. current_scanner.skipspace;
  406. l:=current_scanner.readval;
  407. if l>1024 then
  408. stacksize:=l;
  409. current_scanner.skipspace;
  410. if c=',' then
  411. begin
  412. current_scanner.readchar;
  413. current_scanner.skipspace;
  414. l:=current_scanner.readval;
  415. if l>1024 then
  416. heapsize:=l;
  417. end;
  418. if c=',' then
  419. begin
  420. current_scanner.readchar;
  421. current_scanner.skipspace;
  422. l:=current_scanner.readval;
  423. { Ignore this value, because the limit is set by the OS
  424. info and shouldn't be changed by the user (PFV) }
  425. end;
  426. end;
  427. procedure dir_message;
  428. begin
  429. do_message(scan_i_user_defined);
  430. end;
  431. procedure dir_mode;
  432. begin
  433. if not current_module.in_global then
  434. Message(scan_w_switch_is_global)
  435. else
  436. begin
  437. current_scanner.skipspace;
  438. current_scanner.readstring;
  439. if not SetCompileMode(pattern,false) then
  440. Message1(scan_w_illegal_switch,pattern);
  441. end;
  442. end;
  443. procedure dir_mmx;
  444. begin
  445. do_localswitch(cs_mmx);
  446. end;
  447. procedure dir_note;
  448. begin
  449. do_message(scan_n_user_defined);
  450. end;
  451. procedure dir_notes;
  452. begin
  453. do_setverbose('N');
  454. end;
  455. procedure dir_objectpath;
  456. begin
  457. if not current_module.in_global then
  458. Message(scan_w_switch_is_global)
  459. else
  460. begin
  461. current_scanner.skipspace;
  462. current_module.localobjectsearchpath.AddPath(current_scanner.readcomment,false);
  463. end;
  464. end;
  465. procedure dir_openstrings;
  466. begin
  467. do_delphiswitch('P');
  468. end;
  469. procedure dir_output_format;
  470. begin
  471. if not current_module.in_global then
  472. Message(scan_w_switch_is_global)
  473. else
  474. begin
  475. current_scanner.skipspace;
  476. if set_target_asm_by_string(current_scanner.readid) then
  477. aktoutputformat:=target_asm.id
  478. else
  479. Message1(scan_w_illegal_switch,pattern);
  480. end;
  481. end;
  482. procedure dir_overflowchecks;
  483. begin
  484. do_delphiswitch('Q');
  485. end;
  486. procedure dir_packenum;
  487. var
  488. hs : string;
  489. begin
  490. current_scanner.skipspace;
  491. if not(c in ['0'..'9']) then
  492. begin
  493. hs:=current_scanner.readid;
  494. if (hs='NORMAL') or (hs='DEFAULT') then
  495. aktpackenum:=4
  496. else
  497. Message(scan_w_only_pack_enum);
  498. end
  499. else
  500. begin
  501. case current_scanner.readval of
  502. 1 : aktpackenum:=1;
  503. 2 : aktpackenum:=2;
  504. 4 : aktpackenum:=4;
  505. else
  506. Message(scan_w_only_pack_enum);
  507. end;
  508. end;
  509. end;
  510. procedure dir_packrecords;
  511. var
  512. hs : string;
  513. begin
  514. current_scanner.skipspace;
  515. if not(c in ['0'..'9']) then
  516. begin
  517. hs:=current_scanner.readid;
  518. { C has the special recordalignmax of -1 }
  519. if (hs='C') then
  520. aktalignment.recordalignmax:=-1
  521. else
  522. if (hs='NORMAL') or (hs='DEFAULT') then
  523. aktalignment.recordalignmax:=2
  524. else
  525. Message(scan_w_only_pack_records);
  526. end
  527. else
  528. begin
  529. case current_scanner.readval of
  530. 1 : aktalignment.recordalignmax:=1;
  531. 2 : aktalignment.recordalignmax:=2;
  532. 4 : aktalignment.recordalignmax:=4;
  533. 8 : aktalignment.recordalignmax:=8;
  534. 16 : aktalignment.recordalignmax:=16;
  535. 32 : aktalignment.recordalignmax:=32;
  536. else
  537. Message(scan_w_only_pack_records);
  538. end;
  539. end;
  540. end;
  541. {$ifdef testvarsets}
  542. procedure dir_packset;
  543. var
  544. hs : string;
  545. begin
  546. current_scanner.skipspace;
  547. if not(c in ['1','2','4']) then
  548. begin
  549. hs:=current_scanner.readid;
  550. if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then
  551. aktsetalloc:=0 {Fixed mode, sets are 4 or 32 bytes}
  552. else
  553. Message(scan_w_only_packset);
  554. end
  555. else
  556. begin
  557. case current_scanner.readval of
  558. 1 : aktsetalloc:=1;
  559. 2 : aktsetalloc:=2;
  560. 4 : aktsetalloc:=4;
  561. else
  562. Message(scan_w_only_packset);
  563. end;
  564. end;
  565. end;
  566. {$ENDIF}
  567. procedure dir_profile;
  568. var
  569. mac : tmacro;
  570. begin
  571. do_moduleswitch(cs_profile);
  572. { defined/undefine FPC_PROFILE }
  573. mac:=tmacro(current_scanner.macros.search('FPC_PROFILE'));
  574. if not assigned(mac) then
  575. begin
  576. mac:=tmacro.create('FPC_PROFILE');
  577. current_scanner.macros.insert(mac);
  578. end;
  579. mac.defined:=(cs_profile in aktmoduleswitches);
  580. end;
  581. procedure dir_rangechecks;
  582. begin
  583. do_delphiswitch('R');
  584. end;
  585. procedure dir_referenceinfo;
  586. begin
  587. do_delphiswitch('Y');
  588. end;
  589. procedure dir_resource;
  590. var
  591. s : string;
  592. begin
  593. current_scanner.skipspace;
  594. s:=current_scanner.readcomment;
  595. { replace * with current module name.
  596. This should always be defined. }
  597. if s[1]='*' then
  598. if Assigned(Current_Module) then
  599. begin
  600. delete(S,1,1);
  601. insert(lower(current_module.modulename^),S,1);
  602. end;
  603. s:=AddExtension(FixFileName(s),target_info.resext);
  604. if target_info.res<>res_none then
  605. if (target_info.res = res_emxbind) and
  606. not (Current_module.ResourceFiles.Empty) then
  607. Message(scan_w_only_one_resourcefile_supported)
  608. else
  609. current_module.resourcefiles.insert(FixFileName(s))
  610. else
  611. Message(scan_e_resourcefiles_not_supported);
  612. end;
  613. procedure dir_saturation;
  614. begin
  615. do_localswitch(cs_mmx_saturation);
  616. end;
  617. procedure dir_smartlink;
  618. begin
  619. do_moduleswitch(cs_create_smart);
  620. end;
  621. procedure dir_stackframes;
  622. begin
  623. do_delphiswitch('W');
  624. end;
  625. procedure dir_static;
  626. begin
  627. do_moduleswitch(cs_static_keyword);
  628. end;
  629. procedure dir_stop;
  630. begin
  631. do_message(scan_f_user_defined);
  632. end;
  633. procedure dir_typedaddress;
  634. begin
  635. do_delphiswitch('T');
  636. end;
  637. procedure dir_typeinfo;
  638. begin
  639. do_delphiswitch('M');
  640. end;
  641. procedure dir_unitpath;
  642. begin
  643. if not current_module.in_global then
  644. Message(scan_w_switch_is_global)
  645. else
  646. begin
  647. current_scanner.skipspace;
  648. current_module.localunitsearchpath.AddPath(current_scanner.readcomment,false);
  649. end;
  650. end;
  651. procedure dir_varstringchecks;
  652. begin
  653. do_delphiswitch('V');
  654. end;
  655. procedure dir_version;
  656. var
  657. major, minor, revision : longint;
  658. error : integer;
  659. begin
  660. if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware]) then
  661. begin
  662. Message(scan_n_version_not_support);
  663. exit;
  664. end;
  665. if (compile_level<>1) then
  666. Message(scan_n_only_exe_version)
  667. else
  668. begin
  669. { change description global var in all cases }
  670. { it not used but in win32, os2 and netware }
  671. current_scanner.skipspace;
  672. { we should only accept Major.Minor format for win32 and os2 }
  673. current_scanner.readnumber;
  674. major:=0;
  675. minor:=0;
  676. revision:=0;
  677. valint(pattern,major,error);
  678. if error<>0 then
  679. begin
  680. Message1(scan_w_wrong_version_ignored,pattern);
  681. exit;
  682. end;
  683. if c='.' then
  684. begin
  685. current_scanner.readchar;
  686. current_scanner.readnumber;
  687. valint(pattern,minor,error);
  688. if error<>0 then
  689. begin
  690. Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
  691. exit;
  692. end;
  693. if (c='.') and
  694. (target_info.target = target_i386_netware) then
  695. begin
  696. current_scanner.readchar;
  697. current_scanner.readnumber;
  698. valint(pattern,revision,error);
  699. if error<>0 then
  700. begin
  701. Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
  702. exit;
  703. end;
  704. dllmajor:=major;
  705. dllminor:=minor;
  706. dllrevision:=revision;
  707. dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
  708. end
  709. else
  710. begin
  711. dllmajor:=major;
  712. dllminor:=minor;
  713. dllversion:=tostr(major)+'.'+tostr(minor);
  714. end;
  715. end
  716. else
  717. dllversion:=tostr(major);
  718. end;
  719. end;
  720. procedure dir_wait;
  721. var
  722. had_info : boolean;
  723. begin
  724. had_info:=(status.verbosity and V_Info)<>0;
  725. { this message should allways appear !! }
  726. status.verbosity:=status.verbosity or V_Info;
  727. Message(scan_i_press_enter);
  728. readln;
  729. If not(had_info) then
  730. status.verbosity:=status.verbosity and (not V_Info);
  731. end;
  732. procedure dir_warning;
  733. begin
  734. do_message(scan_w_user_defined);
  735. end;
  736. procedure dir_warnings;
  737. begin
  738. do_setverbose('W');
  739. end;
  740. procedure dir_z1;
  741. begin
  742. aktpackenum:=1;
  743. end;
  744. procedure dir_z2;
  745. begin
  746. aktpackenum:=2;
  747. end;
  748. procedure dir_z4;
  749. begin
  750. aktpackenum:=4;
  751. end;
  752. {****************************************************************************
  753. Initialize Directives
  754. ****************************************************************************}
  755. procedure InitScannerDirectives;
  756. begin
  757. AddDirective('ALIGN',{$ifdef FPCPROCVAR}@{$endif}dir_align);
  758. {$ifdef m68k}
  759. AddDirective('APPID',{$ifdef FPCPROCVAR}@{$endif}dir_appid);
  760. AddDirective('APPNAME',{$ifdef FPCPROCVAR}@{$endif}dir_appname);
  761. {$endif m68k}
  762. AddDirective('APPTYPE',{$ifdef FPCPROCVAR}@{$endif}dir_apptype);
  763. AddDirective('ASMMODE',{$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
  764. AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions);
  765. AddDirective('BOOLEVAL',{$ifdef FPCPROCVAR}@{$endif}dir_booleval);
  766. AddDirective('CALLING',{$ifdef FPCPROCVAR}@{$endif}dir_calling);
  767. AddDirective('COPYRIGHT',{$ifdef FPCPROCVAR}@{$endif}dir_copyright);
  768. AddDirective('D',{$ifdef FPCPROCVAR}@{$endif}dir_description);
  769. AddDirective('DEBUGINFO',{$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
  770. AddDirective('DESCRIPTION',{$ifdef FPCPROCVAR}@{$endif}dir_description);
  771. AddDirective('ERROR',{$ifdef FPCPROCVAR}@{$endif}dir_error);
  772. AddDirective('EXTENDEDSYNTAX',{$ifdef FPCPROCVAR}@{$endif}dir_extendedsyntax);
  773. AddDirective('FATAL',{$ifdef FPCPROCVAR}@{$endif}dir_fatal);
  774. AddDirective('GOTO',{$ifdef FPCPROCVAR}@{$endif}dir_goto);
  775. AddDirective('HINT',{$ifdef FPCPROCVAR}@{$endif}dir_hint);
  776. AddDirective('HINTS',{$ifdef FPCPROCVAR}@{$endif}dir_hints);
  777. AddDirective('IOCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_iochecks);
  778. AddDirective('INCLUDEPATH',{$ifdef FPCPROCVAR}@{$endif}dir_includepath);
  779. AddDirective('INFO',{$ifdef FPCPROCVAR}@{$endif}dir_info);
  780. AddDirective('INLINE',{$ifdef FPCPROCVAR}@{$endif}dir_inline);
  781. AddDirective('INTERFACES',{$ifdef FPCPROCVAR}@{$endif}dir_interfaces);
  782. AddDirective('L',{$ifdef FPCPROCVAR}@{$endif}dir_link);
  783. AddDirective('LIBRARYPATH',{$ifdef FPCPROCVAR}@{$endif}dir_librarypath);
  784. AddDirective('LINK',{$ifdef FPCPROCVAR}@{$endif}dir_link);
  785. AddDirective('LINKLIB',{$ifdef FPCPROCVAR}@{$endif}dir_linklib);
  786. AddDirective('LOCALSYMBOLS',{$ifdef FPCPROCVAR}@{$endif}dir_localsymbols);
  787. AddDirective('LONGSTRINGS',{$ifdef FPCPROCVAR}@{$endif}dir_longstrings);
  788. AddDirective('M',{$ifdef FPCPROCVAR}@{$endif}dir_memory);
  789. AddDirective('MACRO',{$ifdef FPCPROCVAR}@{$endif}dir_macro);
  790. AddDirective('MAXFPUREGISTERS',{$ifdef FPCPROCVAR}@{$endif}dir_maxfpuregisters);
  791. AddDirective('MEMORY',{$ifdef FPCPROCVAR}@{$endif}dir_memory);
  792. AddDirective('MESSAGE',{$ifdef FPCPROCVAR}@{$endif}dir_message);
  793. AddDirective('MINENUMSIZE',{$ifdef FPCPROCVAR}@{$endif}dir_packenum);
  794. AddDirective('MMX',{$ifdef FPCPROCVAR}@{$endif}dir_mmx);
  795. AddDirective('MODE',{$ifdef FPCPROCVAR}@{$endif}dir_mode);
  796. AddDirective('NOTE',{$ifdef FPCPROCVAR}@{$endif}dir_note);
  797. AddDirective('NOTES',{$ifdef FPCPROCVAR}@{$endif}dir_notes);
  798. AddDirective('OBJECTPATH',{$ifdef FPCPROCVAR}@{$endif}dir_objectpath);
  799. AddDirective('OPENSTRINGS',{$ifdef FPCPROCVAR}@{$endif}dir_openstrings);
  800. AddDirective('OUTPUT_FORMAT',{$ifdef FPCPROCVAR}@{$endif}dir_output_format);
  801. AddDirective('OVERFLOWCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_overflowchecks);
  802. AddDirective('PACKENUM',{$ifdef FPCPROCVAR}@{$endif}dir_packenum);
  803. AddDirective('PACKRECORDS',{$ifdef FPCPROCVAR}@{$endif}dir_packrecords);
  804. {$IFDEF TestVarsets}
  805. AddDirective('PACKSET',{$ifdef FPCPROCVAR}@{$endif}dir_packset);
  806. {$ENDIF}
  807. AddDirective('PROFILE',{$ifdef FPCPROCVAR}@{$endif}dir_profile);
  808. AddDirective('R',{$ifdef FPCPROCVAR}@{$endif}dir_resource);
  809. AddDirective('RANGECHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_rangechecks);
  810. AddDirective('REFERENCEINFO',{$ifdef FPCPROCVAR}@{$endif}dir_referenceinfo);
  811. AddDirective('SATURATION',{$ifdef FPCPROCVAR}@{$endif}dir_saturation);
  812. {ad 18.05.2001: Screen and Threadname for Netware}
  813. AddDirective('SCREENNAME',{$ifdef FPCPROCVAR}@{$endif}dir_screenname);
  814. AddDirective('SMARTLINK',{$ifdef FPCPROCVAR}@{$endif}dir_smartlink);
  815. AddDirective('STACKFRAMES',{$ifdef FPCPROCVAR}@{$endif}dir_stackframes);
  816. AddDirective('STATIC',{$ifdef FPCPROCVAR}@{$endif}dir_static);
  817. AddDirective('STOP',{$ifdef FPCPROCVAR}@{$endif}dir_stop);
  818. {ad 18.05.2001: Screen and Threadname for Netware}
  819. AddDirective('THREADNAME',{$ifdef FPCPROCVAR}@{$endif}dir_threadname);
  820. AddDirective('TYPEDADDRESS',{$ifdef FPCPROCVAR}@{$endif}dir_typedaddress);
  821. AddDirective('TYPEINFO',{$ifdef FPCPROCVAR}@{$endif}dir_typeinfo);
  822. AddDirective('UNITPATH',{$ifdef FPCPROCVAR}@{$endif}dir_unitpath);
  823. AddDirective('VARSTRINGCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_varstringchecks);
  824. AddDirective('VERSION',{$ifdef FPCPROCVAR}@{$endif}dir_version);
  825. AddDirective('WAIT',{$ifdef FPCPROCVAR}@{$endif}dir_wait);
  826. AddDirective('WARNING',{$ifdef FPCPROCVAR}@{$endif}dir_warning);
  827. AddDirective('WARNINGS',{$ifdef FPCPROCVAR}@{$endif}dir_warnings);
  828. AddDirective('Z1',{$ifdef FPCPROCVAR}@{$endif}dir_z1);
  829. AddDirective('Z2',{$ifdef FPCPROCVAR}@{$endif}dir_z2);
  830. AddDirective('Z4',{$ifdef FPCPROCVAR}@{$endif}dir_z4);
  831. end;
  832. end.
  833. {
  834. $Log$
  835. Revision 1.10 2001-11-02 23:16:52 peter
  836. * removed obsolete chainprocsym and test_procsym code
  837. Revision 1.9 2001/10/23 21:49:42 peter
  838. * $calling directive and -Cc commandline patch added
  839. from Pavel Ozerski
  840. Revision 1.8 2001/09/02 21:18:28 peter
  841. * split constsym.value in valueord,valueordptr,valueptr. The valueordptr
  842. is used for holding target platform pointer values. As those can be
  843. bigger than the source platform.
  844. Revision 1.7 2001/08/19 11:22:24 peter
  845. * palmos support from v10 merged
  846. Revision 1.6 2001/08/07 18:47:13 peter
  847. * merged netbsd start
  848. * profile for win32
  849. Revision 1.5 2001/07/01 20:16:16 peter
  850. * alignmentinfo record added
  851. * -Oa argument supports more alignment settings that can be specified
  852. per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
  853. RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
  854. required alignment and the maximum usefull alignment. The final
  855. alignment will be choosen per variable size dependent on these
  856. settings
  857. Revision 1.4 2001/06/03 20:20:27 peter
  858. * Align directive supports also values to be Kylix compatible. It's
  859. strange because the help of kylix still shows only On and Off as
  860. possible values, so still support those. On means 4 bytes and Off
  861. means 1 byte alignment.
  862. Revision 1.3 2001/05/30 21:35:49 peter
  863. * netware patches for copyright, screenname, threadname directives
  864. Revision 1.2 2001/04/18 22:01:58 peter
  865. * registration of targets and assemblers
  866. Revision 1.1 2001/04/13 18:00:36 peter
  867. * easier registration of directives
  868. Revision 1.20 2001/04/13 01:22:13 peter
  869. * symtable change to classes
  870. * range check generation and errors fixed, make cycle DEBUG=1 works
  871. * memory leaks fixed
  872. Revision 1.19 2001/03/13 18:45:07 peter
  873. * fixed some memory leaks
  874. Revision 1.18 2001/02/20 21:41:18 peter
  875. * new fixfilename, findfile for unix. Look first for lowercase, then
  876. NormalCase and last for UPPERCASE names.
  877. Revision 1.17 2001/01/20 18:32:52 hajny
  878. + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
  879. Revision 1.16 2001/01/13 00:09:21 peter
  880. * made Pavel O. happy ;)
  881. Revision 1.15 2000/12/25 00:07:28 peter
  882. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  883. tlinkedlist objects)
  884. Revision 1.14 2000/12/24 12:24:38 peter
  885. * moved preprocessfile into a conditional
  886. Revision 1.13 2000/12/12 19:48:52 peter
  887. * fixed lost char after $I directive (merged)
  888. Revision 1.12 2000/11/12 22:17:47 peter
  889. * some realname updates for messages
  890. Revision 1.11 2000/11/04 14:25:21 florian
  891. + merged Attila's changes for interfaces, not tested yet
  892. Revision 1.10 2000/10/31 22:02:51 peter
  893. * symtable splitted, no real code changes
  894. Revision 1.9 2000/09/26 10:50:41 jonas
  895. * initmodeswitches is changed is you change the compiler mode from the
  896. command line (the -S<x> switches didn't work anymore for changing the
  897. compiler mode) (merged from fixes branch)
  898. Revision 1.8 2000/09/24 21:33:47 peter
  899. * message updates merges
  900. Revision 1.7 2000/09/24 15:06:27 peter
  901. * use defines.inc
  902. Revision 1.6 2000/09/11 17:00:23 florian
  903. + first implementation of Netware Module support, thanks to
  904. Armin Diehl ([email protected]) for providing the patches
  905. Revision 1.5 2000/09/10 21:18:15 peter
  906. * macro warning (merged)
  907. Revision 1.4 2000/08/12 15:30:44 peter
  908. * IDE patch for stream reading (merged)
  909. Revision 1.3 2000/08/08 19:28:57 peter
  910. * memdebug/memory patches (merged)
  911. * only once illegal directive (merged)
  912. Revision 1.2 2000/07/13 11:32:49 michael
  913. + removed logs
  914. }