scandir.inc 36 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175
  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_APPTYPE,_DIR_ASMMODE,_DIR_ASSERTIONS,
  25. _DIR_BOOLEVAL,
  26. _DIR_D,_DIR_DEBUGINFO,_DIR_DEFINE,_DIR_DESCRIPTION,
  27. _DIR_ELSE,_DIR_ENDIF,_DIR_ERROR,_DIR_EXTENDEDSYNTAX,
  28. _DIR_FATAL,
  29. _DIR_HINT,_DIR_HINTS,
  30. _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
  31. _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INCLUDE,_DIR_INFO,
  32. _DIR_L,_DIR_LINK,_DIR_LINKLIB,_DIR_LOCALSYMBOLS,_DIR_LONGSTRINGS,
  33. _DIR_M,_DIR_MEMORY,_DIR_MESSAGE,_DIR_MINENUMSIZE,_DIR_MMX,_DIR_MODE,
  34. _DIR_NOTE,_DIR_NOTES,
  35. _DIR_OPENSTRINGS,_DIR_OUTPUT_FORMAT,_DIR_OVERFLOWCHECKS,
  36. _DIR_PACKENUM,_DIR_PACKRECORDS,
  37. _DIR_R,_DIR_RANGECHECKS,_DIR_REFERENCEINFO,
  38. _DIR_SATURATION,_DIR_SMARTLINK,_DIR_STACKFRAMES,_DIR_STOP,
  39. _DIR_TYPEDADDRESS,_DIR_TYPEINFO,
  40. _DIR_UNDEF,
  41. _DIR_VARSTRINGCHECKS,
  42. _DIR_WAIT,_DIR_WARNING,_DIR_WARNINGS,
  43. _DIR_Z1,_DIR_Z2,_DIR_Z4
  44. );
  45. const
  46. firstdirective=_DIR_NONE;
  47. lastdirective=_DIR_Z4;
  48. directive:array[tdirectivetoken] of directivestr=(
  49. '',
  50. 'ALIGN','APPTYPE','ASMMODE','ASSERTIONS',
  51. 'BOOLEVAL',
  52. 'D','DEBUGINFO','DEFINE','DESCRIPTION',
  53. 'ELSE','ENDIF','ERROR','EXTENDEDSYNTAX',
  54. 'FATAL',
  55. 'HINT','HINTS',
  56. 'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
  57. 'IF','IFDEF','IFNDEF','IFOPT','INCLUDE','INFO',
  58. 'L','LINK','LINKLIB','LOCALSYMBOLS','LONGSTRINGS',
  59. 'M','MEMORY','MESSAGE','MINENUMSIZE','MMX','MODE',
  60. 'NOTE','NOTES',
  61. 'OPENSTRINGS','OUTPUT_FORMAT','OVERFLOWCHECKS',
  62. 'PACKENUM','PACKRECORDS',
  63. 'R','RANGECHECKS','REFERENCEINFO',
  64. 'SATURATION','SMARTLINK','STACKFRAMES','STOP',
  65. 'TYPEDADDRESS','TYPEINFO',
  66. 'UNDEF',
  67. 'VARSTRINGCHECKS',
  68. 'WAIT','WARNING','WARNINGS',
  69. 'Z1','Z2','Z4'
  70. );
  71. function Get_Directive(const hs:string):tdirectivetoken;
  72. var
  73. i : tdirectivetoken;
  74. begin
  75. for i:=firstdirective to lastdirective do
  76. if directive[i]=hs then
  77. begin
  78. Get_Directive:=i;
  79. exit;
  80. end;
  81. Get_Directive:=_DIR_NONE;
  82. end;
  83. {-------------------------------------------
  84. IF Conditional Handling
  85. -------------------------------------------}
  86. var
  87. preprocpat : string;
  88. preproc_token : ttoken;
  89. procedure preproc_consume(t : ttoken);
  90. begin
  91. if t<>preproc_token then
  92. Message(scan_e_preproc_syntax_error);
  93. preproc_token:=current_scanner^.readpreproc;
  94. end;
  95. function read_expr : string;forward;
  96. function read_factor : string;
  97. var
  98. hs : string;
  99. mac : pmacrosym;
  100. len : byte;
  101. begin
  102. if preproc_token=ID then
  103. begin
  104. if preprocpat='NOT' then
  105. begin
  106. preproc_consume(ID);
  107. hs:=read_expr;
  108. if hs='0' then
  109. read_factor:='1'
  110. else
  111. read_factor:='0';
  112. end
  113. else
  114. begin
  115. mac:=pmacrosym(macros^.search(hs));
  116. hs:=preprocpat;
  117. preproc_consume(ID);
  118. if assigned(mac) then
  119. begin
  120. if mac^.defined and assigned(mac^.buftext) then
  121. begin
  122. if mac^.buflen>255 then
  123. begin
  124. len:=255;
  125. Message(scan_w_marco_cut_after_255_chars);
  126. end
  127. else
  128. len:=mac^.buflen;
  129. {$ifndef TP}
  130. {$ifopt H+}
  131. setlength(hs,len);
  132. {$else}
  133. hs[0]:=char(len);
  134. {$endif}
  135. {$else}
  136. hs[0]:=char(len);
  137. {$endif}
  138. move(mac^.buftext^,hs[1],len);
  139. end
  140. else
  141. read_factor:='';
  142. end
  143. else
  144. read_factor:=hs;
  145. end
  146. end
  147. else if preproc_token=LKLAMMER then
  148. begin
  149. preproc_consume(LKLAMMER);
  150. read_factor:=read_expr;
  151. preproc_consume(RKLAMMER);
  152. end
  153. else
  154. Message(scan_e_error_in_preproc_expr);
  155. end;
  156. function read_term : string;
  157. var
  158. hs1,hs2 : string;
  159. begin
  160. hs1:=read_factor;
  161. while true do
  162. begin
  163. if (preproc_token=ID) then
  164. begin
  165. if preprocpat='AND' then
  166. begin
  167. preproc_consume(ID);
  168. hs2:=read_factor;
  169. if (hs1<>'0') and (hs2<>'0') then
  170. hs1:='1';
  171. end
  172. else
  173. break;
  174. end
  175. else
  176. break;
  177. end;
  178. read_term:=hs1;
  179. end;
  180. function read_simple_expr : string;
  181. var
  182. hs1,hs2 : string;
  183. begin
  184. hs1:=read_term;
  185. while true do
  186. begin
  187. if (preproc_token=ID) then
  188. begin
  189. if preprocpat='OR' then
  190. begin
  191. preproc_consume(ID);
  192. hs2:=read_term;
  193. if (hs1<>'0') or (hs2<>'0') then
  194. hs1:='1';
  195. end
  196. else
  197. break;
  198. end
  199. else
  200. break;
  201. end;
  202. read_simple_expr:=hs1;
  203. end;
  204. function read_expr : string;
  205. var
  206. hs1,hs2 : string;
  207. b : boolean;
  208. t : ttoken;
  209. w : integer;
  210. l1,l2 : longint;
  211. begin
  212. hs1:=read_simple_expr;
  213. t:=preproc_token;
  214. if not(t in [EQUAL,UNEQUAL,LT,GT,LTE,GTE]) then
  215. begin
  216. read_expr:=hs1;
  217. exit;
  218. end;
  219. preproc_consume(t);
  220. hs2:=read_simple_expr;
  221. if is_number(hs1) and is_number(hs2) then
  222. begin
  223. valint(hs1,l1,w);
  224. valint(hs2,l2,w);
  225. case t of
  226. EQUAL : b:=l1=l2;
  227. UNEQUAL : b:=l1<>l2;
  228. LT : b:=l1<l2;
  229. GT : b:=l1>l2;
  230. GTE : b:=l1>=l2;
  231. LTE : b:=l1<=l2;
  232. end;
  233. end
  234. else
  235. begin
  236. case t of
  237. EQUAL : b:=hs1=hs2;
  238. UNEQUAL : b:=hs1<>hs2;
  239. LT : b:=hs1<hs2;
  240. GT : b:=hs1>hs2;
  241. GTE : b:=hs1>=hs2;
  242. LTE : b:=hs1<=hs2;
  243. end;
  244. end;
  245. if b then
  246. read_expr:='1'
  247. else
  248. read_expr:='0';
  249. end;
  250. {-------------------------------------------
  251. Directives
  252. -------------------------------------------}
  253. function is_conditional(t:tdirectivetoken):boolean;
  254. begin
  255. is_conditional:=(t in [_DIR_ENDIF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_IF,_DIR_ELSE]);
  256. end;
  257. procedure dir_conditional(t:tdirectivetoken);
  258. var
  259. hs : string;
  260. mac : pmacrosym;
  261. found : boolean;
  262. state : char;
  263. oldaktfilepos : tfileposinfo;
  264. begin
  265. oldaktfilepos:=aktfilepos;
  266. while true do
  267. begin
  268. current_scanner^.gettokenpos;
  269. case t of
  270. _DIR_ENDIF : begin
  271. current_scanner^.poppreprocstack;
  272. end;
  273. _DIR_ELSE : begin
  274. current_scanner^.elsepreprocstack;
  275. end;
  276. _DIR_IFDEF : begin
  277. current_scanner^.skipspace;
  278. hs:=current_scanner^.readid;
  279. mac:=pmacrosym(macros^.search(hs));
  280. current_scanner^.addpreprocstack(assigned(mac) and mac^.defined,hs,scan_c_ifdef_found);
  281. end;
  282. _DIR_IFOPT : begin
  283. current_scanner^.skipspace;
  284. hs:=current_scanner^.readid;
  285. if (length(hs)>1) then
  286. Message(scan_w_illegal_switch)
  287. else
  288. begin
  289. state:=current_scanner^.ReadState;
  290. if state in ['-','+'] then
  291. found:=CheckSwitch(hs[1],state);
  292. end;
  293. current_scanner^.addpreprocstack(found,hs,scan_c_ifopt_found);
  294. end;
  295. _DIR_IF : begin
  296. current_scanner^.skipspace;
  297. { start preproc expression scanner }
  298. preproc_token:=current_scanner^.readpreproc;
  299. hs:=read_expr;
  300. current_scanner^.addpreprocstack(hs<>'0',hs,scan_c_if_found);
  301. end;
  302. _DIR_IFNDEF : begin
  303. current_scanner^.skipspace;
  304. hs:=current_scanner^.readid;
  305. mac:=pmacrosym(macros^.search(hs));
  306. current_scanner^.addpreprocstack(not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found);
  307. end;
  308. end;
  309. { accept the text ? }
  310. if (current_scanner^.preprocstack=nil) or current_scanner^.preprocstack^.accept then
  311. break
  312. else
  313. begin
  314. current_scanner^.gettokenpos;
  315. Message(scan_c_skipping_until);
  316. repeat
  317. current_scanner^.skipuntildirective;
  318. t:=Get_Directive(current_scanner^.readid);
  319. until is_conditional(t);
  320. current_scanner^.gettokenpos;
  321. Message1(scan_d_handling_switch,'$'+directive[t]);
  322. end;
  323. end;
  324. oldaktfilepos:=aktfilepos;
  325. end;
  326. procedure dir_define(t:tdirectivetoken);
  327. var
  328. hs : string;
  329. mac : pmacrosym;
  330. macropos : longint;
  331. macrobuffer : pmacrobuffer;
  332. begin
  333. current_scanner^.skipspace;
  334. hs:=current_scanner^.readid;
  335. mac:=pmacrosym(macros^.search(hs));
  336. if not assigned(mac) then
  337. begin
  338. mac:=new(pmacrosym,init(hs));
  339. mac^.defined:=true;
  340. Message1(parser_m_macro_defined,mac^.name);
  341. macros^.insert(mac);
  342. end
  343. else
  344. begin
  345. Message1(parser_m_macro_defined,mac^.name);
  346. mac^.defined:=true;
  347. { delete old definition }
  348. if assigned(mac^.buftext) then
  349. begin
  350. freemem(mac^.buftext,mac^.buflen);
  351. mac^.buftext:=nil;
  352. end;
  353. end;
  354. if (cs_support_macro in aktmoduleswitches) then
  355. begin
  356. { key words are never substituted }
  357. if is_keyword(hs) then
  358. Message(scan_e_keyword_cant_be_a_macro);
  359. { !!!!!! handle macro params, need we this? }
  360. current_scanner^.skipspace;
  361. { may be a macro? }
  362. if c=':' then
  363. begin
  364. current_scanner^.readchar;
  365. if c='=' then
  366. begin
  367. new(macrobuffer);
  368. macropos:=0;
  369. { first char }
  370. current_scanner^.readchar;
  371. while (c<>'}') do
  372. begin
  373. macrobuffer^[macropos]:=c;
  374. current_scanner^.readchar;
  375. if c=#26 then Message(scan_f_end_of_file);
  376. inc(macropos);
  377. if macropos>maxmacrolen then
  378. Message(scan_f_macro_buffer_overflow);
  379. end;
  380. { free buffer of macro ?}
  381. if assigned(mac^.buftext) then
  382. freemem(mac^.buftext,mac^.buflen);
  383. { get new mem }
  384. getmem(mac^.buftext,macropos);
  385. mac^.buflen:=macropos;
  386. { copy the text }
  387. move(macrobuffer^,mac^.buftext^,macropos);
  388. dispose(macrobuffer);
  389. end;
  390. end;
  391. end;
  392. end;
  393. procedure dir_undef(t:tdirectivetoken);
  394. var
  395. hs : string;
  396. mac : pmacrosym;
  397. begin
  398. current_scanner^.skipspace;
  399. hs:=current_scanner^.readid;
  400. mac:=pmacrosym(macros^.search(hs));
  401. if not assigned(mac) then
  402. begin
  403. mac:=new(pmacrosym,init(hs));
  404. Message1(parser_m_macro_undefined,mac^.name);
  405. mac^.defined:=false;
  406. macros^.insert(mac);
  407. end
  408. else
  409. begin
  410. Message1(parser_m_macro_undefined,mac^.name);
  411. mac^.defined:=false;
  412. { delete old definition }
  413. if assigned(mac^.buftext) then
  414. begin
  415. freemem(mac^.buftext,mac^.buflen);
  416. mac^.buftext:=nil;
  417. end;
  418. end;
  419. end;
  420. procedure dir_message(t:tdirectivetoken);
  421. var
  422. w : tmsgconst;
  423. begin
  424. case t of
  425. _DIR_STOP,
  426. _DIR_FATAL : w:=scan_f_user_defined;
  427. _DIR_ERROR : w:=scan_e_user_defined;
  428. _DIR_WARNING : w:=scan_w_user_defined;
  429. _DIR_HINT : w:=scan_h_user_defined;
  430. _DIR_NOTE : w:=scan_n_user_defined;
  431. _DIR_MESSAGE,
  432. _DIR_INFO : w:=scan_i_user_defined;
  433. end;
  434. current_scanner^.skipspace;
  435. Message1(w,current_scanner^.readcomment);
  436. end;
  437. procedure dir_moduleswitch(t:tdirectivetoken);
  438. var
  439. sw : tmoduleswitch;
  440. state : char;
  441. begin
  442. sw:=cs_modulenone;
  443. case t of
  444. _DIR_SMARTLINK : sw:=cs_smartlink;
  445. end;
  446. state:=current_scanner^.readstate;
  447. if (sw<>cs_modulenone) and (state in ['-','+']) then
  448. begin
  449. if state='-' then
  450. aktmoduleswitches:=aktmoduleswitches-[sw]
  451. else
  452. aktmoduleswitches:=aktmoduleswitches+[sw];
  453. end;
  454. end;
  455. procedure dir_localswitch(t:tdirectivetoken);
  456. var
  457. sw : tlocalswitch;
  458. state : char;
  459. begin
  460. sw:=cs_localnone;
  461. {$ifdef SUPPORT_MMX}
  462. case t of
  463. _DIR_MMX : sw:=cs_mmx;
  464. _DIR_SATURATION : sw:=cs_mmx_saturation;
  465. end;
  466. {$endif}
  467. state:=current_scanner^.readstate;
  468. if (sw<>cs_localnone) and (state in ['-','+']) then
  469. begin
  470. if state='-' then
  471. aktlocalswitches:=aktlocalswitches-[sw]
  472. else
  473. aktlocalswitches:=aktlocalswitches+[sw];
  474. end;
  475. end;
  476. procedure dir_include(t:tdirectivetoken);
  477. var
  478. hs : string;
  479. path : dirstr;
  480. name : namestr;
  481. ext : extstr;
  482. hp : pinputfile;
  483. i : longint;
  484. found : boolean;
  485. begin
  486. current_scanner^.skipspace;
  487. hs:=current_scanner^.readcomment;
  488. i:=length(hs);
  489. while (i>0) and (hs[i]=' ') do
  490. dec(i);
  491. Delete(hs,i+1,length(hs)-i);
  492. if hs='' then
  493. exit;
  494. if (hs[1]='%') then
  495. begin
  496. { case insensitive }
  497. hs:=upper(hs);
  498. { save old }
  499. path:=hs;
  500. { remove %'s }
  501. Delete(hs,1,1);
  502. if hs[length(hs)]='%' then
  503. Delete(hs,length(hs),1);
  504. { first check for internal macros }
  505. if hs='TIME' then
  506. hs:=gettimestr
  507. else
  508. if hs='DATE' then
  509. hs:=getdatestr
  510. else
  511. if hs='FILE' then
  512. hs:=current_module^.sourcefiles^.get_file_name(aktfilepos.fileindex)
  513. else
  514. if hs='LINE' then
  515. hs:=tostr(aktfilepos.line)
  516. else
  517. if hs='FPCVERSION' then
  518. hs:=version_string
  519. else
  520. if hs='FPCTARGET' then
  521. hs:=target_cpu_string
  522. else
  523. hs:=getenv(hs);
  524. if hs='' then
  525. Comment(V_Warning,'Include environment '+path+' not found in environment')
  526. else
  527. begin
  528. { make it a stringconst }
  529. hs:=''''+hs+'''';
  530. current_scanner^.insertmacro(@hs[1],length(hs));
  531. end;
  532. end
  533. else
  534. begin
  535. hs:=FixFileName(hs);
  536. fsplit(hs,path,name,ext);
  537. { first look in the path of _d then currentmodule }
  538. path:=search(name+ext,path+';'+current_scanner^.inputfile^.path^+';'+includesearchpath,found);
  539. { shutdown current file }
  540. current_scanner^.tempcloseinputfile;
  541. { load new file }
  542. hp:=new(pinputfile,init(path+name+ext));
  543. current_scanner^.addfile(hp);
  544. if not current_scanner^.openinputfile then
  545. Message1(scan_f_cannot_open_includefile,hs);
  546. Message1(scan_t_start_include_file,current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^);
  547. current_scanner^.reload;
  548. { register for refs }
  549. current_module^.sourcefiles^.register_file(hp);
  550. end;
  551. end;
  552. procedure dir_description(t:tdirectivetoken);
  553. begin
  554. end;
  555. procedure dir_linkobject(t:tdirectivetoken);
  556. var
  557. s : string;
  558. begin
  559. current_scanner^.skipspace;
  560. s:=AddExtension(FixFileName(current_scanner^.readcomment),target_info.resext);
  561. current_module^.linkofiles.insert(s);
  562. end;
  563. procedure dir_resource(t:tdirectivetoken);
  564. var
  565. s : string;
  566. begin
  567. current_scanner^.skipspace;
  568. s:=AddExtension(FixFileName(current_scanner^.readcomment),target_info.resext);
  569. if target_info.res<>res_none then
  570. current_module^.resourcefiles.insert(FixFileName(s))
  571. else
  572. Message(scan_e_resourcefiles_not_supported);
  573. end;
  574. procedure dir_linklib(t:tdirectivetoken);
  575. begin
  576. current_scanner^.skipspace;
  577. current_scanner^.readstring;
  578. current_module^.linkSharedLibs.insert(orgpattern);
  579. end;
  580. procedure dir_outputformat(t:tdirectivetoken);
  581. begin
  582. if not current_module^.in_global then
  583. Message(scan_w_switch_is_global)
  584. else
  585. begin
  586. current_scanner^.skipspace;
  587. if set_string_asm(current_scanner^.readid) then
  588. aktoutputformat:=target_asm.id
  589. else
  590. Message(scan_w_illegal_switch);
  591. end;
  592. end;
  593. procedure dir_mode(t:tdirectivetoken);
  594. begin
  595. if not current_module^.in_global then
  596. Message(scan_w_switch_is_global)
  597. else
  598. begin
  599. current_scanner^.skipspace;
  600. current_scanner^.readstring;
  601. if pattern='DEFAULT' then
  602. aktmodeswitches:=initmodeswitches
  603. else
  604. if pattern='DELPHI' then
  605. aktmodeswitches:=delphimodeswitches
  606. else
  607. if pattern='TP' then
  608. aktmodeswitches:=tpmodeswitches
  609. else
  610. if pattern='FPC' then
  611. aktmodeswitches:=fpcmodeswitches
  612. else
  613. if pattern='OBJFPC' then
  614. aktmodeswitches:=objfpcmodeswitches
  615. else
  616. if pattern='GPC' then
  617. aktmodeswitches:=gpcmodeswitches;
  618. end;
  619. end;
  620. procedure dir_packrecords(t:tdirectivetoken);
  621. var
  622. hs : string;
  623. begin
  624. current_scanner^.skipspace;
  625. if not(c in ['0'..'9']) then
  626. begin
  627. hs:=current_scanner^.readid;
  628. if (hs='NORMAL') or (hs='DEFAULT') then
  629. aktpackrecords:=2
  630. else
  631. Message(scan_w_only_pack_records);
  632. end
  633. else
  634. begin
  635. case current_scanner^.readval of
  636. 1 : aktpackrecords:=1;
  637. 2 : aktpackrecords:=2;
  638. 4 : aktpackrecords:=4;
  639. 8 : aktpackrecords:=8;
  640. 16 : aktpackrecords:=16;
  641. 32 : aktpackrecords:=32;
  642. else
  643. Message(scan_w_only_pack_records);
  644. end;
  645. end;
  646. end;
  647. procedure dir_packenum(t:tdirectivetoken);
  648. var
  649. hs : string;
  650. begin
  651. if t in [_DIR_Z1,_DIR_Z2,_DIR_Z4] then
  652. begin
  653. aktpackenum:=ord(pattern[2])-ord('0');
  654. exit;
  655. end;
  656. current_scanner^.skipspace;
  657. if not(c in ['0'..'9']) then
  658. begin
  659. hs:=current_scanner^.readid;
  660. if (hs='NORMAL') or (hs='DEFAULT') then
  661. aktpackenum:=4
  662. else
  663. Message(scan_w_only_pack_enum);
  664. end
  665. else
  666. begin
  667. case current_scanner^.readval of
  668. 1 : aktpackenum:=1;
  669. 2 : aktpackenum:=2;
  670. 4 : aktpackenum:=4;
  671. else
  672. Message(scan_w_only_pack_enum);
  673. end;
  674. end;
  675. end;
  676. procedure dir_apptype(t:tdirectivetoken);
  677. var
  678. hs : string;
  679. begin
  680. if target_info.target<>target_i386_win32 then
  681. Message(scan_w_app_type_not_support);
  682. if not current_module^.in_global then
  683. Message(scan_w_switch_is_global)
  684. else
  685. begin
  686. current_scanner^.skipspace;
  687. hs:=current_scanner^.readid;
  688. if hs='GUI' then
  689. apptype:=at_gui
  690. else if hs='CONSOLE' then
  691. apptype:=at_cui
  692. else
  693. Message1(scan_w_unsupported_app_type,hs);
  694. end;
  695. end;
  696. procedure dir_wait(t:tdirectivetoken);
  697. var had_info : boolean;
  698. begin
  699. had_info:=(status.verbosity and V_Info)<>0;
  700. { this message should allways appear !! }
  701. status.verbosity:=status.verbosity or V_Info;
  702. Message(scan_i_press_enter);
  703. readln;
  704. If not(had_info) then
  705. status.verbosity:=status.verbosity and (not V_Info);
  706. end;
  707. procedure dir_asmmode(t:tdirectivetoken);
  708. var
  709. s : string;
  710. begin
  711. current_scanner^.skipspace;
  712. s:=current_scanner^.readid;
  713. if s='DEFAULT' then
  714. aktasmmode:=initasmmode
  715. else
  716. if not set_string_asmmode(s,aktasmmode) then
  717. Message1(scan_w_unsupported_asmmode_specifier,s);
  718. end;
  719. procedure dir_oldasmmode(t:tdirectivetoken);
  720. begin
  721. {$ifdef i386}
  722. case t of
  723. _DIR_I386_ATT : aktasmmode:=asmmode_i386_att;
  724. _DIR_I386_DIRECT : aktasmmode:=asmmode_i386_direct;
  725. _DIR_I386_INTEL : aktasmmode:=asmmode_i386_intel;
  726. end;
  727. {$endif i386}
  728. end;
  729. procedure dir_delphiswitch(t:tdirectivetoken);
  730. var
  731. sw,state : char;
  732. begin
  733. case t of
  734. _DIR_ALIGN : sw:='A';
  735. _DIR_ASSERTIONS : sw:='C';
  736. _DIR_BOOLEVAL : sw:='B';
  737. _DIR_DEBUGINFO : sw:='D';
  738. _DIR_IOCHECKS : sw:='I';
  739. _DIR_LOCALSYMBOLS : sw:='L';
  740. _DIR_LONGSTRINGS : sw:='H';
  741. _DIR_OPENSTRINGS : sw:='P';
  742. _DIR_OVERFLOWCHECKS : sw:='Q';
  743. _DIR_RANGECHECKS : sw:='R';
  744. _DIR_REFERENCEINFO : sw:='Y';
  745. _DIR_STACKFRAMES : sw:='W';
  746. _DIR_TYPEDADDRESS : sw:='T';
  747. _DIR_TYPEINFO : sw:='M';
  748. _DIR_VARSTRINGCHECKS : sw:='V';
  749. else
  750. exit;
  751. end;
  752. { c contains the next char, a + or - would be fine }
  753. state:=current_scanner^.readstate;
  754. if state in ['-','+'] then
  755. HandleSwitch(sw,state);
  756. end;
  757. procedure dir_memory(t:tdirectivetoken);
  758. var
  759. l : longint;
  760. begin
  761. current_scanner^.skipspace;
  762. l:=current_scanner^.readval;
  763. if l>1024 then
  764. stacksize:=l;
  765. current_scanner^.skipspace;
  766. if c=',' then
  767. begin
  768. current_scanner^.readchar;
  769. current_scanner^.skipspace;
  770. l:=current_scanner^.readval;
  771. if l>1024 then
  772. heapsize:=l;
  773. end;
  774. if c=',' then
  775. begin
  776. current_scanner^.readchar;
  777. current_scanner^.skipspace;
  778. l:=current_scanner^.readval;
  779. if l>1024 then
  780. maxheapsize:=l;
  781. end;
  782. if heapsize>maxheapsize then
  783. message(scan_w_illegal_switch);
  784. end;
  785. procedure dir_setverbose(t:tdirectivetoken);
  786. var
  787. flag,
  788. state : char;
  789. begin
  790. case t of
  791. _DIR_HINTS : flag:='H';
  792. _DIR_WARNINGS : flag:='W';
  793. _DIR_NOTES : flag:='N';
  794. else
  795. exit;
  796. end;
  797. { support ON/OFF }
  798. state:=current_scanner^.ReadState;
  799. SetVerbosity(flag+state);
  800. end;
  801. type
  802. tdirectiveproc=procedure(t:tdirectivetoken);
  803. const
  804. directiveproc:array[tdirectivetoken] of tdirectiveproc=(
  805. {_DIR_NONE} nil,
  806. {_DIR_ALIGN} dir_delphiswitch,
  807. {_DIR_APPTYPE} dir_apptype,
  808. {_DIR_ASMMODE} dir_asmmode,
  809. {_DIR_ASSERTION} dir_delphiswitch,
  810. {_DIR_BOOLEVAL} dir_delphiswitch,
  811. {_DIR_D} dir_description,
  812. {_DIR_DEBUGINFO} dir_delphiswitch,
  813. {_DIR_DEFINE} dir_define,
  814. {_DIR_DESCRIPTION} dir_description,
  815. {_DIR_ELSE} dir_conditional,
  816. {_DIR_ENDIF} dir_conditional,
  817. {_DIR_ERROR} dir_message,
  818. {_DIR_EXTENDEDSYNTAX} dir_delphiswitch,
  819. {_DIR_FATAL} dir_message,
  820. {_DIR_HINT} dir_message,
  821. {_DIR_HINTS} dir_setverbose,
  822. {_DIR_I} dir_include,
  823. {_DIR_I386_ATT} dir_oldasmmode,
  824. {_DIR_I386_DIRECT} dir_oldasmmode,
  825. {_DIR_I386_INTEL} dir_oldasmmode,
  826. {_DIR_IOCHECKS} dir_delphiswitch,
  827. {_DIR_IF} dir_conditional,
  828. {_DIR_IFDEF} dir_conditional,
  829. {_DIR_IFNDEF} dir_conditional,
  830. {_DIR_IFOPT} dir_conditional,
  831. {_DIR_INCLUDE} dir_include,
  832. {_DIR_INFO} dir_message,
  833. {_DIR_L} dir_linkobject,
  834. {_DIR_LINK} dir_linkobject,
  835. {_DIR_LINKLIB} dir_linklib,
  836. {_DIR_LOCALSYMBOLS} dir_delphiswitch,
  837. {_DIR_LONGSTRINGS} dir_delphiswitch,
  838. {_DIR_M} dir_memory,
  839. {_DIR_MEMORY} dir_memory,
  840. {_DIR_MESSAGE} dir_message,
  841. {_DIR_MINENUMSIZE} dir_packenum,
  842. {_DIR_MMX} dir_localswitch,
  843. {_DIR_MODE} dir_mode,
  844. {_DIR_NOTE} dir_message,
  845. {_DIR_NOTES} dir_setverbose,
  846. {_DIR_OPENSTRINGS} dir_delphiswitch,
  847. {_DIR_OUTPUT_FORMAT} dir_outputformat,
  848. {_DIR_OVERFLOWCHECKS} dir_delphiswitch,
  849. {_DIR_PACKENUM} dir_packenum,
  850. {_DIR_PACKRECORDS} dir_packrecords,
  851. {_DIR_R} dir_resource,
  852. {_DIR_RANGECHECKS} dir_delphiswitch,
  853. {_DIR_REFERENCEINFO} dir_delphiswitch,
  854. {_DIR_SATURATION} dir_localswitch,
  855. {_DIR_SMARTLINK} dir_moduleswitch,
  856. {_DIR_STACKFRAMES} dir_delphiswitch,
  857. {_DIR_STOP} dir_message,
  858. {_DIR_TYPEDADDRESS} dir_delphiswitch,
  859. {_DIR_TYPEINFO} dir_delphiswitch,
  860. {_DIR_UNDEF} dir_undef,
  861. {_DIR_VARSTRINGCHECKS} dir_delphiswitch,
  862. {_DIR_WAIT} dir_wait,
  863. {_DIR_WARNING} dir_message,
  864. {_DIR_WARNINGS} dir_setverbose,
  865. {_DIR_Z1} dir_packenum,
  866. {_DIR_Z2} dir_packenum,
  867. {_DIR_Z4} dir_packenum
  868. );
  869. {-------------------------------------------
  870. Main switches handling
  871. -------------------------------------------}
  872. procedure handledirectives;
  873. var
  874. t : tdirectivetoken;
  875. p : tdirectiveproc;
  876. hs : string;
  877. begin
  878. current_scanner^.gettokenpos;
  879. current_scanner^.readchar; {Remove the $}
  880. hs:=current_scanner^.readid;
  881. Message1(scan_d_handling_switch,'$'+hs);
  882. if hs='' then
  883. Message1(scan_w_illegal_switch,'$'+hs);
  884. { Check for compiler switches }
  885. while (length(hs)=1) and (c in ['-','+']) do
  886. begin
  887. HandleSwitch(hs[1],c);
  888. current_scanner^.readchar; {Remove + or -}
  889. if c=',' then
  890. begin
  891. current_scanner^.readchar; {Remove , }
  892. { read next switch, support $v+,$+}
  893. hs:=current_scanner^.readid;
  894. if (hs='') then
  895. begin
  896. if (c='$') and (m_fpc in aktmodeswitches) then
  897. begin
  898. current_scanner^.readchar; { skip $ }
  899. hs:=current_scanner^.readid;
  900. end;
  901. if (hs='') then
  902. Message1(scan_w_illegal_directive,'$'+c);
  903. end
  904. else
  905. Message1(scan_d_handling_switch,'$'+hs);
  906. end
  907. else
  908. hs:='';
  909. end;
  910. { directives may follow switches after a , }
  911. if hs<>'' then
  912. begin
  913. t:=Get_Directive(hs);
  914. if t<>_DIR_NONE then
  915. begin
  916. p:=directiveproc[t];
  917. {$ifdef FPC}
  918. if assigned(p) then
  919. {$else}
  920. if @p<>nil then
  921. {$endif}
  922. p(t);
  923. end
  924. else
  925. Message1(scan_w_illegal_directive,'$'+hs);
  926. { conditionals already read the comment }
  927. if (current_scanner^.comment_level>0) then
  928. current_scanner^.readcomment;
  929. end;
  930. end;
  931. {
  932. $Log$
  933. Revision 1.45 1998-12-28 23:26:25 peter
  934. + resource file handling ($R directive) for Win32
  935. Revision 1.44 1998/12/15 10:23:29 peter
  936. + -iSO, -iSP, -iTO, -iTP
  937. Revision 1.43 1998/11/16 15:41:43 peter
  938. * tp7 didn't like my ifopt H+ :(
  939. Revision 1.42 1998/11/16 12:18:04 peter
  940. * H+ fixes
  941. Revision 1.41 1998/10/22 17:54:08 florian
  942. + switch $APPTYPE for win32 added
  943. Revision 1.40 1998/10/21 20:16:04 peter
  944. * beter line info for conditionals
  945. Revision 1.39 1998/10/13 16:50:21 pierre
  946. * undid some changes of Peter that made the compiler wrong
  947. for m68k (I had to reinsert some ifdefs)
  948. * removed several memory leaks under m68k
  949. * removed the meory leaks for assembler readers
  950. * cross compiling shoud work again better
  951. ( crosscompiling sysamiga works
  952. but as68k still complain about some code !)
  953. Revision 1.38 1998/10/13 13:10:28 peter
  954. * new style for m68k/i386 infos and enums
  955. Revision 1.37 1998/10/08 23:29:04 peter
  956. * -vu shows unit info, -vt shows tried/used files
  957. Revision 1.36 1998/10/08 17:17:29 pierre
  958. * current_module old scanner tagged as invalid if unit is recompiled
  959. + added ppheap for better info on tracegetmem of heaptrc
  960. (adds line column and file index)
  961. * several memory leaks removed ith help of heaptrc !!
  962. Revision 1.35 1998/10/08 13:44:39 peter
  963. * fixed $I %date% not in uppercase
  964. Revision 1.34 1998/09/28 16:57:24 pierre
  965. * changed all length(p^.value_str^) into str_length(p)
  966. to get it work with and without ansistrings
  967. * changed sourcefiles field of tmodule to a pointer
  968. Revision 1.33 1998/09/26 17:45:40 peter
  969. + idtoken and only one token table
  970. Revision 1.32 1998/09/24 23:49:19 peter
  971. + aktmodeswitches
  972. Revision 1.31 1998/09/18 16:03:44 florian
  973. * some changes to compile with Delphi
  974. Revision 1.30 1998/09/16 16:41:47 peter
  975. * merged fixes
  976. Revision 1.28.2.1 1998/09/16 16:09:51 peter
  977. * on/off support also for the local/module switches
  978. Revision 1.29 1998/09/11 09:19:53 daniel
  979. * Removed tabs.
  980. Revision 1.28 1998/09/10 15:25:36 daniel
  981. + Added maxheapsize.
  982. * Corrected semi-bug in calling the assembler and the linker
  983. Revision 1.27 1998/09/09 15:33:59 peter
  984. * removed warnings
  985. Revision 1.26 1998/09/03 11:24:02 peter
  986. * moved more inputfile things from tscannerfile to tinputfile
  987. * changed ifdef Sourceline to cs_asm_source
  988. Revision 1.25 1998/09/02 15:13:31 peter
  989. * fixed typo in directive table
  990. Revision 1.24 1998/09/01 12:52:06 peter
  991. + a lot of delphi switches
  992. Revision 1.23 1998/08/26 15:35:34 peter
  993. * fixed scannerfiles for macros
  994. + $I %<environment>%
  995. Revision 1.22 1998/08/19 14:57:50 peter
  996. * small fix for aktfilepos
  997. Revision 1.20 1998/08/18 15:11:52 peter
  998. * recompiles again
  999. Revision 1.19 1998/08/18 09:24:44 pierre
  1000. * small warning position bug fixed
  1001. * support_mmx switches splitting was missing
  1002. * rhide error and warning output corrected
  1003. Revision 1.18 1998/08/10 14:50:25 peter
  1004. + localswitches, moduleswitches, globalswitches splitting
  1005. Revision 1.17 1998/08/10 09:56:04 peter
  1006. * path to the include file is also written to the debug output
  1007. Revision 1.16 1998/08/04 22:03:44 michael
  1008. + fixed dir_include search() call
  1009. Revision 1.15 1998/07/14 21:46:55 peter
  1010. * updated messages file
  1011. Revision 1.14 1998/07/14 14:47:03 peter
  1012. * released NEWINPUT
  1013. Revision 1.13 1998/07/07 12:32:54 peter
  1014. * status.currentsource is now calculated in verbose (more accurated)
  1015. Revision 1.12 1998/07/07 11:20:10 peter
  1016. + NEWINPUT for a better inputfile and scanner object
  1017. Revision 1.11 1998/06/04 23:51:59 peter
  1018. * m68k compiles
  1019. + .def file creation moved to gendef.pas so it could also be used
  1020. for win32
  1021. Revision 1.10 1998/05/30 14:31:10 peter
  1022. + $ASMMODE
  1023. Revision 1.9 1998/05/23 01:21:28 peter
  1024. + aktasmmode, aktoptprocessor, aktoutputformat
  1025. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  1026. + $LIBNAME to set the library name where the unit will be put in
  1027. * splitted cgi386 a bit (codeseg to large for bp7)
  1028. * nasm, tasm works again. nasm moved to ag386nsm.pas
  1029. Revision 1.8 1998/05/11 13:07:57 peter
  1030. + $ifdef NEWPPU for the new ppuformat
  1031. + $define GDB not longer required
  1032. * removed all warnings and stripped some log comments
  1033. * no findfirst/findnext anymore to remove smartlink *.o files
  1034. Revision 1.7 1998/05/08 09:21:20 michael
  1035. * Added missing -Fl message to messages file.
  1036. * Corrected mangling of file names when doing Linklib
  1037. * -Fl now actually WORKS.
  1038. * Librarysearchpath is now a field in linker object.
  1039. Revision 1.6 1998/05/04 17:54:28 peter
  1040. + smartlinking works (only case jumptable left todo)
  1041. * redesign of systems.pas to support assemblers and linkers
  1042. + Unitname is now also in the PPU-file, increased version to 14
  1043. Revision 1.5 1998/04/30 15:59:42 pierre
  1044. * GDB works again better :
  1045. correct type info in one pass
  1046. + UseTokenInfo for better source position
  1047. * fixed one remaining bug in scanner for line counts
  1048. * several little fixes
  1049. Revision 1.4 1998/04/29 13:42:27 peter
  1050. + $IOCHECKS and $ALIGN to test already, other will follow soon
  1051. * fixed the wrong linecounting with comments
  1052. Revision 1.3 1998/04/28 11:45:53 florian
  1053. * make it compilable with TP
  1054. + small COM problems solved to compile classes.pp
  1055. Revision 1.2 1998/04/28 10:09:54 pierre
  1056. * typo error in asm style reading corrected
  1057. Revision 1.1 1998/04/27 23:13:53 peter
  1058. + the new files for the scanner
  1059. }