scandir.pas 31 KB

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