scandir.inc 28 KB

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