scandir.inc 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860
  1. {
  2. $Id$
  3. Copyright (c) 1998 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. const
  19. directivelen=16;
  20. type
  21. directivestr=string[directivelen];
  22. tdirectivetoken=(
  23. _DIR_NONE,
  24. _DIR_ALIGN,_DIR_ASMMODE,
  25. _DIR_D,_DIR_DEFINE,_DIR_DESCRIPTION,
  26. _DIR_ELSE,_DIR_ENDIF,_DIR_ERROR,
  27. _DIR_FATAL,
  28. _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
  29. _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INFO,
  30. _DIR_L,_DIR_LINKLIB,
  31. _DIR_MESSAGE,_DIR_MMX,
  32. _DIR_NOTE,
  33. _DIR_OUTPUT_FORMAT,
  34. _DIR_PACKRECORDS,
  35. _DIR_SATURATION,_DIR_SMARTLINK,_DIR_STOP,
  36. _DIR_UNDEF,
  37. _DIR_WAIT,_DIR_WARNING
  38. );
  39. const
  40. firstdirective=_DIR_NONE;
  41. lastdirective=_DIR_WARNING;
  42. directive:array[tdirectivetoken] of directivestr=(
  43. '',
  44. 'ALIGN','ASMMODE',
  45. 'D','DEFINE','DESCRIPTION',
  46. 'ELSE','ENDIF','ERROR',
  47. 'FATAL',
  48. 'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
  49. 'IF','IFDEF','IFNDEF','IFOPT','INFO',
  50. 'L','LINKLIB',
  51. 'MESSAGE','MMX',
  52. 'NOTE',
  53. 'OUTPUT_FORMAT',
  54. 'PACKRECORDS',
  55. 'SATURATION','SMARTLINK','STOP',
  56. 'UNDEF',
  57. 'WAIT','WARNING'
  58. );
  59. function Get_Directive(const hs:string):tdirectivetoken;
  60. var
  61. i : tdirectivetoken;
  62. begin
  63. for i:=firstdirective to lastdirective do
  64. if directive[i]=hs then
  65. begin
  66. Get_Directive:=i;
  67. exit;
  68. end;
  69. Get_Directive:=_DIR_NONE;
  70. end;
  71. {-------------------------------------------
  72. IF Conditional Handling
  73. -------------------------------------------}
  74. var
  75. preprocpat : string;
  76. preproc_token : ttoken;
  77. procedure preproc_consume(t : ttoken);
  78. begin
  79. if t<>preproc_token then
  80. Message(scan_e_preproc_syntax_error);
  81. preproc_token:=current_scanner^.readpreproc;
  82. end;
  83. function read_expr : string;forward;
  84. function read_factor : string;
  85. var
  86. hs : string;
  87. mac : pmacrosym;
  88. len : byte;
  89. begin
  90. if preproc_token=ID then
  91. begin
  92. if preprocpat='NOT' then
  93. begin
  94. preproc_consume(ID);
  95. hs:=read_expr;
  96. if hs='0' then
  97. read_factor:='1'
  98. else
  99. read_factor:='0';
  100. end
  101. else
  102. begin
  103. mac:=pmacrosym(macros^.search(hs));
  104. hs:=preprocpat;
  105. preproc_consume(ID);
  106. if assigned(mac) then
  107. begin
  108. if mac^.defined and assigned(mac^.buftext) then
  109. begin
  110. if mac^.buflen>255 then
  111. begin
  112. len:=255;
  113. Message(scan_w_marco_cut_after_255_chars);
  114. end
  115. else
  116. len:=mac^.buflen;
  117. hs[0]:=char(len);
  118. move(mac^.buftext^,hs[1],len);
  119. end
  120. else
  121. read_factor:='';
  122. end
  123. else
  124. read_factor:=hs;
  125. end
  126. end
  127. else if preproc_token=LKLAMMER then
  128. begin
  129. preproc_consume(LKLAMMER);
  130. read_factor:=read_expr;
  131. preproc_consume(RKLAMMER);
  132. end
  133. else
  134. Message(scan_e_error_in_preproc_expr);
  135. end;
  136. function read_term : string;
  137. var
  138. hs1,hs2 : string;
  139. begin
  140. hs1:=read_factor;
  141. while true do
  142. begin
  143. if (preproc_token=ID) then
  144. begin
  145. if preprocpat='AND' then
  146. begin
  147. preproc_consume(ID);
  148. hs2:=read_factor;
  149. if (hs1<>'0') and (hs2<>'0') then
  150. hs1:='1';
  151. end
  152. else
  153. break;
  154. end
  155. else
  156. break;
  157. end;
  158. read_term:=hs1;
  159. end;
  160. function read_simple_expr : string;
  161. var
  162. hs1,hs2 : string;
  163. begin
  164. hs1:=read_term;
  165. while true do
  166. begin
  167. if (preproc_token=ID) then
  168. begin
  169. if preprocpat='OR' then
  170. begin
  171. preproc_consume(ID);
  172. hs2:=read_term;
  173. if (hs1<>'0') or (hs2<>'0') then
  174. hs1:='1';
  175. end
  176. else
  177. break;
  178. end
  179. else
  180. break;
  181. end;
  182. read_simple_expr:=hs1;
  183. end;
  184. function read_expr : string;
  185. var
  186. hs1,hs2 : string;
  187. b : boolean;
  188. t : ttoken;
  189. w : word;
  190. l1,l2 : longint;
  191. begin
  192. hs1:=read_simple_expr;
  193. t:=preproc_token;
  194. if not(t in [EQUAL,UNEQUAL,LT,GT,LTE,GTE]) then
  195. begin
  196. read_expr:=hs1;
  197. exit;
  198. end;
  199. preproc_consume(t);
  200. hs2:=read_simple_expr;
  201. if is_number(hs1) and is_number(hs2) then
  202. begin
  203. valint(hs1,l1,w);
  204. valint(hs2,l2,w);
  205. case t of
  206. EQUAL:
  207. b:=l1=l2;
  208. UNEQUAL:
  209. b:=l1<>l2;
  210. LT:
  211. b:=l1<l2;
  212. GT:
  213. b:=l1>l2;
  214. GTE:
  215. b:=l1>=l2;
  216. LTE:
  217. b:=l1<=l2;
  218. end;
  219. end
  220. else
  221. begin
  222. case t of
  223. EQUAL:
  224. b:=hs1=hs2;
  225. UNEQUAL:
  226. b:=hs1<>hs2;
  227. LT:
  228. b:=hs1<hs2;
  229. GT:
  230. b:=hs1>hs2;
  231. GTE:
  232. b:=hs1>=hs2;
  233. LTE:
  234. b:=hs1<=hs2;
  235. end;
  236. end;
  237. if b then
  238. read_expr:='1'
  239. else
  240. read_expr:='0';
  241. end;
  242. {-------------------------------------------
  243. Directives
  244. -------------------------------------------}
  245. function is_conditional(t:tdirectivetoken):boolean;
  246. begin
  247. is_conditional:=(t in [_DIR_ENDIF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_IF,_DIR_ELSE]);
  248. end;
  249. procedure dir_conditional(t:tdirectivetoken);
  250. var
  251. hs : string;
  252. mac : pmacrosym;
  253. found : boolean;
  254. begin
  255. while true do
  256. begin
  257. case t of
  258. _DIR_ENDIF : begin
  259. current_scanner^.poppreprocstack;
  260. end;
  261. _DIR_ELSE : begin
  262. current_scanner^.elsepreprocstack;
  263. end;
  264. _DIR_IFDEF : begin
  265. current_scanner^.skipspace;
  266. hs:=current_scanner^.readid;
  267. mac:=pmacrosym(macros^.search(hs));
  268. current_scanner^.addpreprocstack(assigned(mac) and mac^.defined,hs,scan_c_ifdef_found);
  269. end;
  270. _DIR_IFOPT : begin
  271. current_scanner^.skipspace;
  272. hs:=current_scanner^.readid;
  273. if (length(hs)=1) and (c in ['-','+']) then
  274. begin
  275. found:=CheckSwitch(hs[1],c);
  276. current_scanner^.readchar; {read + or -}
  277. end
  278. else
  279. Message(scan_w_illegal_switch);
  280. current_scanner^.addpreprocstack(found,hs,scan_c_ifopt_found);
  281. end;
  282. _DIR_IF : begin
  283. current_scanner^.skipspace;
  284. { start preproc expression scanner }
  285. preproc_token:=current_scanner^.readpreproc;
  286. hs:=read_expr;
  287. current_scanner^.addpreprocstack(hs<>'0',hs,scan_c_if_found);
  288. end;
  289. _DIR_IFNDEF : begin
  290. current_scanner^.skipspace;
  291. hs:=current_scanner^.readid;
  292. mac:=pmacrosym(macros^.search(hs));
  293. current_scanner^.addpreprocstack(not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found);
  294. end;
  295. end;
  296. { accept the text ? }
  297. if (current_scanner^.preprocstack=nil) or current_scanner^.preprocstack^.accept then
  298. break
  299. else
  300. begin
  301. Message(scan_c_skipping_until);
  302. repeat
  303. current_scanner^.skipuntildirective;
  304. t:=Get_Directive(current_scanner^.readid);
  305. until is_conditional(t);
  306. Message1(scan_d_handling_switch,'$'+directive[t]);
  307. end;
  308. end;
  309. end;
  310. procedure dir_define(t:tdirectivetoken);
  311. var
  312. ht : ttoken;
  313. hs2,
  314. hs : string;
  315. mac : pmacrosym;
  316. macropos : longint;
  317. macrobuffer : pmacrobuffer;
  318. begin
  319. current_scanner^.skipspace;
  320. hs:=current_scanner^.readid;
  321. mac:=pmacrosym(macros^.search(hs));
  322. if not assigned(mac) then
  323. begin
  324. mac:=new(pmacrosym,init(hs));
  325. mac^.defined:=true;
  326. Message1(parser_m_macro_defined,mac^.name);
  327. macros^.insert(mac);
  328. end
  329. else
  330. begin
  331. Message1(parser_m_macro_defined,mac^.name);
  332. mac^.defined:=true;
  333. { delete old definition }
  334. if assigned(mac^.buftext) then
  335. begin
  336. freemem(mac^.buftext,mac^.buflen);
  337. mac^.buftext:=nil;
  338. end;
  339. end;
  340. if (cs_support_macro in aktmoduleswitches) then
  341. begin
  342. { key words are never substituted }
  343. hs2:=pattern;
  344. pattern:=hs;
  345. if is_keyword(ht) then
  346. Message(scan_e_keyword_cant_be_a_macro);
  347. pattern:=hs2;
  348. { !!!!!! handle macro params, need we this? }
  349. current_scanner^.skipspace;
  350. { may be a macro? }
  351. if c=':' then
  352. begin
  353. current_scanner^.readchar;
  354. if c='=' then
  355. begin
  356. new(macrobuffer);
  357. macropos:=0;
  358. { first char }
  359. current_scanner^.readchar;
  360. while (c<>'}') do
  361. begin
  362. macrobuffer^[macropos]:=c;
  363. current_scanner^.readchar;
  364. if c=#26 then Message(scan_f_end_of_file);
  365. inc(macropos);
  366. if macropos>maxmacrolen then
  367. Message(scan_f_macro_buffer_overflow);
  368. end;
  369. { free buffer of macro ?}
  370. if assigned(mac^.buftext) then
  371. freemem(mac^.buftext,mac^.buflen);
  372. { get new mem }
  373. getmem(mac^.buftext,macropos);
  374. mac^.buflen:=macropos;
  375. { copy the text }
  376. move(macrobuffer^,mac^.buftext^,macropos);
  377. dispose(macrobuffer);
  378. end;
  379. end;
  380. end;
  381. end;
  382. procedure dir_undef(t:tdirectivetoken);
  383. var
  384. hs : string;
  385. mac : pmacrosym;
  386. begin
  387. current_scanner^.skipspace;
  388. hs:=current_scanner^.readid;
  389. mac:=pmacrosym(macros^.search(hs));
  390. if not assigned(mac) then
  391. begin
  392. mac:=new(pmacrosym,init(hs));
  393. Message1(parser_m_macro_undefined,mac^.name);
  394. mac^.defined:=false;
  395. macros^.insert(mac);
  396. end
  397. else
  398. begin
  399. Message1(parser_m_macro_undefined,mac^.name);
  400. mac^.defined:=false;
  401. { delete old definition }
  402. if assigned(mac^.buftext) then
  403. begin
  404. freemem(mac^.buftext,mac^.buflen);
  405. mac^.buftext:=nil;
  406. end;
  407. end;
  408. end;
  409. procedure dir_message(t:tdirectivetoken);
  410. var
  411. w : tmsgconst;
  412. begin
  413. case t of
  414. _DIR_STOP,
  415. _DIR_FATAL : w:=scan_f_user_defined;
  416. _DIR_ERROR : w:=scan_e_user_defined;
  417. _DIR_WARNING : w:=scan_w_user_defined;
  418. _DIR_NOTE : w:=scan_n_user_defined;
  419. _DIR_MESSAGE,
  420. _DIR_INFO : w:=scan_i_user_defined;
  421. end;
  422. current_scanner^.skipspace;
  423. Message1(w,current_scanner^.readcomment);
  424. end;
  425. procedure dir_moduleswitch(t:tdirectivetoken);
  426. var
  427. sw : tmoduleswitch;
  428. begin
  429. case t of
  430. _DIR_SMARTLINK : sw:=cs_smartlink;
  431. end;
  432. current_scanner^.skipspace;
  433. if c='-' then
  434. aktmoduleswitches:=aktmoduleswitches-[sw]
  435. else
  436. aktmoduleswitches:=aktmoduleswitches+[sw];
  437. end;
  438. procedure dir_localswitch(t:tdirectivetoken);
  439. var
  440. sw : tlocalswitch;
  441. begin
  442. {$ifdef SUPPORT_MMX}
  443. case t of
  444. _DIR_MMX : sw:=cs_mmx;
  445. _DIR_SATURATION : sw:=cs_mmx_saturation;
  446. end;
  447. {$endif}
  448. current_scanner^.skipspace;
  449. if c='-' then
  450. aktlocalswitches:=aktlocalswitches-[sw]
  451. else
  452. aktlocalswitches:=aktlocalswitches+[sw];
  453. end;
  454. procedure dir_include(t:tdirectivetoken);
  455. var
  456. hs : string;
  457. path : dirstr;
  458. name : namestr;
  459. ext : extstr;
  460. hp : pinputfile;
  461. found : boolean;
  462. begin
  463. current_scanner^.skipspace;
  464. hs:=current_scanner^.readcomment;
  465. while (hs<>'') and (hs[length(hs)]=' ') do
  466. dec(byte(hs[0]));
  467. if hs='' then
  468. exit;
  469. if (hs[1]='%') then
  470. begin
  471. { save old }
  472. path:=hs;
  473. { remove %'s }
  474. Delete(hs,1,1);
  475. if hs[length(hs)]='%' then
  476. Delete(hs,length(hs),1);
  477. { first check for internal macros }
  478. if hs='TIME' then
  479. hs:=gettimestr
  480. else
  481. if hs='DATE' then
  482. hs:=getdatestr
  483. else
  484. if hs='FPCVERSION' then
  485. hs:=version_string
  486. else
  487. if hs='FPCTARGET' then
  488. hs:=target_string
  489. else
  490. hs:=getenv(hs);
  491. if hs='' then
  492. Comment(V_Warning,'Include environment '+path+' not found in environment')
  493. else
  494. begin
  495. { make it a stringconst }
  496. hs:=''''+hs+'''';
  497. current_scanner^.insertmacro(@hs[1],length(hs));
  498. end;
  499. end
  500. else
  501. begin
  502. hs:=FixFileName(hs);
  503. fsplit(hs,path,name,ext);
  504. { first look in the path of _d then currentmodule }
  505. path:=search(name+ext,path+';'+current_scanner^.inputfile^.path^+';'+includesearchpath,found);
  506. { shutdown current file }
  507. current_scanner^.tempclose;
  508. { load new file }
  509. hp:=new(pinputfile,init(path+name+ext));
  510. current_scanner^.addfile(hp);
  511. if not current_scanner^.open then
  512. Message1(scan_f_cannot_open_includefile,hs);
  513. Message1(scan_u_start_include_file,current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^);
  514. current_scanner^.reload;
  515. { register for refs }
  516. current_module^.sourcefiles.register_file(hp);
  517. current_module^.current_index:=hp^.ref_index;
  518. end;
  519. end;
  520. procedure dir_description(t:tdirectivetoken);
  521. begin
  522. end;
  523. procedure dir_linkobject(t:tdirectivetoken);
  524. begin
  525. current_scanner^.skipspace;
  526. current_scanner^.readstring;
  527. current_module^.linkofiles.insert(FixFileName(orgpattern));
  528. end;
  529. procedure dir_linklib(t:tdirectivetoken);
  530. begin
  531. current_scanner^.skipspace;
  532. current_scanner^.readstring;
  533. current_module^.linkSharedLibs.insert(orgpattern);
  534. end;
  535. procedure dir_outputformat(t:tdirectivetoken);
  536. begin
  537. if not current_module^.in_global then
  538. Message(scan_w_switch_is_global)
  539. else
  540. begin
  541. current_scanner^.skipspace;
  542. if set_string_asm(current_scanner^.readid) then
  543. aktoutputformat:=target_asm.id
  544. else
  545. Message(scan_w_illegal_switch);
  546. end;
  547. end;
  548. procedure dir_packrecords(t:tdirectivetoken);
  549. var
  550. hs : string;
  551. begin
  552. current_scanner^.skipspace;
  553. if upcase(c)='N' then
  554. begin
  555. hs:=current_scanner^.readid;
  556. if (hs='NORMAL') or (hs='DEFAULT') then
  557. aktpackrecords:=2
  558. else
  559. Message(scan_w_only_pack_records);
  560. end
  561. else
  562. begin
  563. case current_scanner^.readval of
  564. 1 : aktpackrecords:=1;
  565. 2 : aktpackrecords:=2;
  566. 4 : aktpackrecords:=4;
  567. 16 : aktpackrecords:=16;
  568. else
  569. Message(scan_w_only_pack_records);
  570. end;
  571. end;
  572. end;
  573. procedure dir_wait(t:tdirectivetoken);
  574. begin
  575. Message(scan_i_press_enter);
  576. readln;
  577. end;
  578. procedure dir_asmmode(t:tdirectivetoken);
  579. var
  580. s : string;
  581. begin
  582. current_scanner^.skipspace;
  583. s:=current_scanner^.readid;
  584. if s='DEFAULT' then
  585. aktasmmode:=initasmmode
  586. else
  587. if not set_string_asmmode(s,aktasmmode) then
  588. Message1(scan_w_unsupported_asmmode_specifier,s);
  589. end;
  590. procedure dir_oldasmmode(t:tdirectivetoken);
  591. begin
  592. {$ifdef i386}
  593. case t of
  594. _DIR_I386_ATT : aktasmmode:=I386_ATT;
  595. _DIR_I386_DIRECT : aktasmmode:=I386_DIRECT;
  596. _DIR_I386_INTEL : aktasmmode:=I386_INTEL;
  597. end;
  598. {$endif}
  599. end;
  600. procedure dir_delphiswitch(t:tdirectivetoken);
  601. var
  602. sw : char;
  603. begin
  604. case t of
  605. _DIR_ALIGN : sw:='A';
  606. _DIR_IOCHECKS : sw:='I';
  607. else
  608. exit;
  609. end;
  610. { c contains the next char, a + or - would be fine }
  611. HandleSwitch(sw,c);
  612. end;
  613. type
  614. tdirectiveproc=procedure(t:tdirectivetoken);
  615. const
  616. directiveproc:array[tdirectivetoken] of tdirectiveproc=(
  617. {_DIR_NONE} nil,
  618. {_DIR_ALIGN} dir_delphiswitch,
  619. {_DIR_ASMMODE} dir_asmmode,
  620. {_DIR_D} dir_description,
  621. {_DIR_DEFINE} dir_define,
  622. {_DIR_DESCRIPTION} dir_description,
  623. {_DIR_ELSE} dir_conditional,
  624. {_DIR_ENDIF} dir_conditional,
  625. {_DIR_ERROR} dir_message,
  626. {_DIR_FATAL} dir_message,
  627. {_DIR_I} dir_include,
  628. {_DIR_I386_ATT} dir_oldasmmode,
  629. {_DIR_I386_DIRECT} dir_oldasmmode,
  630. {_DIR_I386_INTEL} dir_oldasmmode,
  631. {_DIR_IOCHECKS} dir_delphiswitch,
  632. {_DIR_IF} dir_conditional,
  633. {_DIR_IFDEF} dir_conditional,
  634. {_DIR_IFNDEF} dir_conditional,
  635. {_DIR_IFOPT} dir_conditional,
  636. {_DIR_INFO} dir_message,
  637. {_DIR_L} dir_linkobject,
  638. {_DIR_LINKLIB} dir_linklib,
  639. {_DIR_MESSAGE} dir_message,
  640. {_DIR_MMX} dir_localswitch,
  641. {_DIR_NOTE} dir_message,
  642. {_DIR_OUTPUT_FORMAT} dir_outputformat,
  643. {_DIR_PACKRECORDS} dir_packrecords,
  644. {_DIR_SATURATION} dir_localswitch,
  645. {_DIR_SMARTLINK} dir_moduleswitch,
  646. {_DIR_STOP} dir_message,
  647. {_DIR_UNDEF} dir_undef,
  648. {_DIR_WAIT} dir_wait,
  649. {_DIR_WARNING} dir_message
  650. );
  651. {-------------------------------------------
  652. Main switches handling
  653. -------------------------------------------}
  654. procedure handledirectives;
  655. var
  656. t : tdirectivetoken;
  657. p : tdirectiveproc;
  658. hs : string;
  659. begin
  660. current_scanner^.gettokenpos;
  661. current_scanner^.readchar; {Remove the $}
  662. hs:=current_scanner^.readid;
  663. Message1(scan_d_handling_switch,'$'+hs);
  664. if hs='' then
  665. Message1(scan_w_illegal_switch,'$'+hs);
  666. { Check for compiler switches }
  667. while (length(hs)=1) and (c in ['-','+']) do
  668. begin
  669. HandleSwitch(hs[1],c);
  670. current_scanner^.readchar; {Remove + or -}
  671. if c=',' then
  672. begin
  673. current_scanner^.readchar; {Remove , }
  674. { read next switch, support $v+,$+}
  675. hs:=current_scanner^.readid;
  676. if (hs='') then
  677. begin
  678. if (c='$') and not(cs_tp_compatible in aktmoduleswitches) then
  679. begin
  680. current_scanner^.readchar; { skip $ }
  681. hs:=current_scanner^.readid;
  682. end;
  683. if (hs='') then
  684. Message1(scan_w_illegal_directive,'$'+c);
  685. end
  686. else
  687. Message1(scan_d_handling_switch,'$'+hs);
  688. end
  689. else
  690. hs:='';
  691. end;
  692. { directives may follow switches after a , }
  693. if hs<>'' then
  694. begin
  695. t:=Get_Directive(hs);
  696. if t<>_DIR_NONE then
  697. begin
  698. p:=directiveproc[t];
  699. {$ifdef FPC}
  700. if assigned(p) then
  701. {$else}
  702. if @p<>nil then
  703. {$endif}
  704. p(t);
  705. end
  706. else
  707. Message1(scan_w_illegal_directive,'$'+hs);
  708. { conditionals already read the comment }
  709. if (current_scanner^.comment_level>0) then
  710. current_scanner^.readcomment;
  711. end;
  712. end;
  713. {
  714. $Log$
  715. Revision 1.23 1998-08-26 15:35:34 peter
  716. * fixed scannerfiles for macros
  717. + $I %<environment>%
  718. Revision 1.22 1998/08/19 14:57:50 peter
  719. * small fix for aktfilepos
  720. Revision 1.20 1998/08/18 15:11:52 peter
  721. * recompiles again
  722. Revision 1.19 1998/08/18 09:24:44 pierre
  723. * small warning position bug fixed
  724. * support_mmx switches splitting was missing
  725. * rhide error and warning output corrected
  726. Revision 1.18 1998/08/10 14:50:25 peter
  727. + localswitches, moduleswitches, globalswitches splitting
  728. Revision 1.17 1998/08/10 09:56:04 peter
  729. * path to the include file is also written to the debug output
  730. Revision 1.16 1998/08/04 22:03:44 michael
  731. + fixed dir_include search() call
  732. Revision 1.15 1998/07/14 21:46:55 peter
  733. * updated messages file
  734. Revision 1.14 1998/07/14 14:47:03 peter
  735. * released NEWINPUT
  736. Revision 1.13 1998/07/07 12:32:54 peter
  737. * status.currentsource is now calculated in verbose (more accurated)
  738. Revision 1.12 1998/07/07 11:20:10 peter
  739. + NEWINPUT for a better inputfile and scanner object
  740. Revision 1.11 1998/06/04 23:51:59 peter
  741. * m68k compiles
  742. + .def file creation moved to gendef.pas so it could also be used
  743. for win32
  744. Revision 1.10 1998/05/30 14:31:10 peter
  745. + $ASMMODE
  746. Revision 1.9 1998/05/23 01:21:28 peter
  747. + aktasmmode, aktoptprocessor, aktoutputformat
  748. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  749. + $LIBNAME to set the library name where the unit will be put in
  750. * splitted cgi386 a bit (codeseg to large for bp7)
  751. * nasm, tasm works again. nasm moved to ag386nsm.pas
  752. Revision 1.8 1998/05/11 13:07:57 peter
  753. + $ifdef NEWPPU for the new ppuformat
  754. + $define GDB not longer required
  755. * removed all warnings and stripped some log comments
  756. * no findfirst/findnext anymore to remove smartlink *.o files
  757. Revision 1.7 1998/05/08 09:21:20 michael
  758. * Added missing -Fl message to messages file.
  759. * Corrected mangling of file names when doing Linklib
  760. * -Fl now actually WORKS.
  761. * Librarysearchpath is now a field in linker object.
  762. Revision 1.6 1998/05/04 17:54:28 peter
  763. + smartlinking works (only case jumptable left todo)
  764. * redesign of systems.pas to support assemblers and linkers
  765. + Unitname is now also in the PPU-file, increased version to 14
  766. Revision 1.5 1998/04/30 15:59:42 pierre
  767. * GDB works again better :
  768. correct type info in one pass
  769. + UseTokenInfo for better source position
  770. * fixed one remaining bug in scanner for line counts
  771. * several little fixes
  772. Revision 1.4 1998/04/29 13:42:27 peter
  773. + $IOCHECKS and $ALIGN to test already, other will follow soon
  774. * fixed the wrong linecounting with comments
  775. Revision 1.3 1998/04/28 11:45:53 florian
  776. * make it compilable with TP
  777. + small COM problems solved to compile classes.pp
  778. Revision 1.2 1998/04/28 10:09:54 pierre
  779. * typo error in asm style reading corrected
  780. Revision 1.1 1998/04/27 23:13:53 peter
  781. + the new files for the scanner
  782. }