scandir.pas 30 KB

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