scanner.pas 60 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087
  1. {
  2. $Id$
  3. Copyright (c) 1993,97 by Florian Klaempfl
  4. This unit implements the scanner part and handling of the switches
  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. {$ifdef tp}
  19. {$F+,N+,E+,R-}
  20. {$endif}
  21. unit scanner;
  22. interface
  23. uses
  24. {$ifdef Delphi}
  25. dmisc,
  26. {$endif Delphi}
  27. globtype,version,tokens,
  28. cobjects,globals,verbose,comphook,files;
  29. const
  30. {$ifdef TP}
  31. maxmacrolen=1024;
  32. {$else}
  33. maxmacrolen=16*1024;
  34. {$endif}
  35. Newline = #10;
  36. type
  37. tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
  38. pmacrobuffer = ^tmacrobuffer;
  39. tmacrobuffer = array[0..maxmacrolen-1] of char;
  40. preproctyp = (pp_ifdef,pp_ifndef,pp_if,pp_ifopt,pp_else);
  41. ppreprocstack = ^tpreprocstack;
  42. tpreprocstack = object
  43. typ : preproctyp;
  44. accept : boolean;
  45. next : ppreprocstack;
  46. name : stringid;
  47. line_nb : longint;
  48. constructor init(atyp:preproctyp;a:boolean;n:ppreprocstack);
  49. destructor done;
  50. end;
  51. pscannerfile = ^tscannerfile;
  52. tscannerfile = object
  53. inputfile : pinputfile; { current inputfile list }
  54. inputbuffer, { input buffer }
  55. inputpointer : pchar;
  56. inputstart : longint;
  57. line_no, { line }
  58. lastlinepos : longint;
  59. lasttokenpos : longint; { token }
  60. lasttoken,
  61. nexttoken : ttoken;
  62. comment_level,
  63. yylexcount : longint;
  64. lastasmgetchar : char;
  65. preprocstack : ppreprocstack;
  66. invalid : boolean; { flag if sourcefiles have been destroyed ! }
  67. constructor init(const fn:string);
  68. destructor done;
  69. { File buffer things }
  70. function openinputfile:boolean;
  71. procedure closeinputfile;
  72. function tempopeninputfile:boolean;
  73. procedure tempcloseinputfile;
  74. procedure saveinputfile;
  75. procedure restoreinputfile;
  76. procedure nextfile;
  77. procedure addfile(hp:pinputfile);
  78. procedure reload;
  79. procedure insertmacro(p:pchar;len:longint);
  80. { Scanner things }
  81. procedure gettokenpos;
  82. procedure inc_comment_level;
  83. procedure dec_comment_level;
  84. procedure end_of_file;
  85. procedure checkpreprocstack;
  86. procedure poppreprocstack;
  87. procedure addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:tmsgconst);
  88. procedure elsepreprocstack;
  89. procedure linebreak;
  90. procedure readchar;
  91. procedure readstring;
  92. procedure readnumber;
  93. function readid:string;
  94. function readval:longint;
  95. function readcomment:string;
  96. function readstate:char;
  97. procedure skipspace;
  98. procedure skipuntildirective;
  99. procedure skipcomment;
  100. procedure skipdelphicomment;
  101. procedure skipoldtpcomment;
  102. procedure skipccomment;
  103. procedure readtoken;
  104. function readpreproc:ttoken;
  105. function asmgetchar:char;
  106. end;
  107. var
  108. c : char;
  109. orgpattern,
  110. pattern : string;
  111. current_scanner : pscannerfile;
  112. aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
  113. implementation
  114. uses
  115. {$ifndef delphi}
  116. dos,
  117. {$endif delphi}
  118. systems,symtable,switches;
  119. {*****************************************************************************
  120. Helper routines
  121. *****************************************************************************}
  122. type
  123. tokenidxrec=record
  124. first,last : ttoken;
  125. end;
  126. var
  127. tokenidx:array[2..tokenidlen,'A'..'Z'] of tokenidxrec;
  128. const
  129. { use any special name that is an invalid file name to avoid problems }
  130. macro_special_name = '____Macro____';
  131. preprocstring : array [preproctyp] of string[7]
  132. = ('$IFDEF','$IFNDEF','$IF','$IFOPT','$ELSE');
  133. procedure create_tokenidx;
  134. { create an index with the first and last token for every possible token
  135. length, so a search only will be done in that small part }
  136. var
  137. t : ttoken;
  138. begin
  139. fillchar(tokenidx,sizeof(tokenidx),0);
  140. for t:=low(ttoken) to high(ttoken) do
  141. begin
  142. if not tokeninfo[t].special then
  143. begin
  144. if ord(tokenidx[length(tokeninfo[t].str),tokeninfo[t].str[1]].first)=0 then
  145. tokenidx[length(tokeninfo[t].str),tokeninfo[t].str[1]].first:=t;
  146. tokenidx[length(tokeninfo[t].str),tokeninfo[t].str[1]].last:=t;
  147. end;
  148. end;
  149. end;
  150. function is_keyword(const s:string):boolean;
  151. var
  152. low,high,mid : longint;
  153. begin
  154. if not (length(s) in [2..tokenidlen]) then
  155. begin
  156. is_keyword:=false;
  157. exit;
  158. end;
  159. low:=ord(tokenidx[length(s),s[1]].first);
  160. high:=ord(tokenidx[length(s),s[1]].last);
  161. while low<high do
  162. begin
  163. mid:=(high+low+1) shr 1;
  164. if pattern<tokeninfo[ttoken(mid)].str then
  165. high:=mid-1
  166. else
  167. low:=mid;
  168. end;
  169. is_keyword:=(pattern=tokeninfo[ttoken(high)].str) and
  170. (tokeninfo[ttoken(high)].keyword in aktmodeswitches);
  171. end;
  172. {*****************************************************************************
  173. TPreProcStack
  174. *****************************************************************************}
  175. constructor tpreprocstack.init(atyp : preproctyp;a:boolean;n:ppreprocstack);
  176. begin
  177. accept:=a;
  178. typ:=atyp;
  179. next:=n;
  180. end;
  181. destructor tpreprocstack.done;
  182. begin
  183. end;
  184. {****************************************************************************
  185. TSCANNERFILE
  186. ****************************************************************************}
  187. constructor tscannerfile.init(const fn:string);
  188. begin
  189. inputfile:=new(pinputfile,init(fn));
  190. current_module^.sourcefiles^.register_file(inputfile);
  191. { reset localinput }
  192. inputbuffer:=nil;
  193. inputpointer:=nil;
  194. inputstart:=0;
  195. { reset scanner }
  196. preprocstack:=nil;
  197. comment_level:=0;
  198. yylexcount:=0;
  199. block_type:=bt_general;
  200. line_no:=0;
  201. lastlinepos:=0;
  202. lasttokenpos:=0;
  203. lasttoken:=NOTOKEN;
  204. nexttoken:=NOTOKEN;
  205. lastasmgetchar:=#0;
  206. invalid:=false;
  207. { load block }
  208. if not openinputfile then
  209. Message1(scan_f_cannot_open_input,fn);
  210. reload;
  211. end;
  212. destructor tscannerfile.done;
  213. begin
  214. if not invalid then
  215. begin
  216. if status.errorcount=0 then
  217. checkpreprocstack;
  218. { close file, but only if we are the first compile }
  219. { probably not necessary anymore with invalid flag PM }
  220. if not current_module^.in_second_compile then
  221. begin
  222. if not inputfile^.closed then
  223. closeinputfile;
  224. end;
  225. end;
  226. end;
  227. function tscannerfile.openinputfile:boolean;
  228. begin
  229. openinputfile:=inputfile^.open;
  230. { load buffer }
  231. inputbuffer:=inputfile^.buf;
  232. inputpointer:=inputfile^.buf;
  233. inputstart:=inputfile^.bufstart;
  234. { line }
  235. line_no:=0;
  236. lastlinepos:=0;
  237. lasttokenpos:=0;
  238. end;
  239. procedure tscannerfile.closeinputfile;
  240. begin
  241. inputfile^.close;
  242. { reset buffer }
  243. inputbuffer:=nil;
  244. inputpointer:=nil;
  245. inputstart:=0;
  246. { reset line }
  247. line_no:=0;
  248. lastlinepos:=0;
  249. lasttokenpos:=0;
  250. end;
  251. function tscannerfile.tempopeninputfile:boolean;
  252. begin
  253. tempopeninputfile:=inputfile^.tempopen;
  254. { reload buffer }
  255. inputbuffer:=inputfile^.buf;
  256. inputpointer:=inputfile^.buf;
  257. inputstart:=inputfile^.bufstart;
  258. end;
  259. procedure tscannerfile.tempcloseinputfile;
  260. begin
  261. inputfile^.setpos(inputstart+(inputpointer-inputbuffer));
  262. inputfile^.tempclose;
  263. { reset buffer }
  264. inputbuffer:=nil;
  265. inputpointer:=nil;
  266. inputstart:=0;
  267. end;
  268. procedure tscannerfile.saveinputfile;
  269. begin
  270. inputfile^.saveinputpointer:=inputpointer;
  271. inputfile^.savelastlinepos:=lastlinepos;
  272. inputfile^.saveline_no:=line_no;
  273. end;
  274. procedure tscannerfile.restoreinputfile;
  275. begin
  276. inputpointer:=inputfile^.saveinputpointer;
  277. lastlinepos:=inputfile^.savelastlinepos;
  278. line_no:=inputfile^.saveline_no;
  279. if not inputfile^.is_macro then
  280. parser_current_file:=inputfile^.name^;
  281. end;
  282. procedure tscannerfile.nextfile;
  283. var
  284. to_dispose : pinputfile;
  285. begin
  286. if assigned(inputfile^.next) then
  287. begin
  288. if inputfile^.is_macro then
  289. to_dispose:=inputfile
  290. else
  291. to_dispose:=nil;
  292. { we can allways close the file, no ? }
  293. inputfile^.close;
  294. inputfile:=inputfile^.next;
  295. if assigned(to_dispose) then
  296. dispose(to_dispose,done);
  297. restoreinputfile;
  298. end;
  299. end;
  300. procedure tscannerfile.addfile(hp:pinputfile);
  301. begin
  302. saveinputfile;
  303. { add to list }
  304. hp^.next:=inputfile;
  305. inputfile:=hp;
  306. { load new inputfile }
  307. restoreinputfile;
  308. end;
  309. procedure tscannerfile.reload;
  310. begin
  311. with inputfile^ do
  312. begin
  313. repeat
  314. { still more to read?, then change the #0 to a space so its seen
  315. as a seperator }
  316. if (c=#0) and (bufsize>0) and (inputpointer-inputbuffer<bufsize) then
  317. begin
  318. c:=' ';
  319. inc(longint(inputpointer));
  320. exit;
  321. end;
  322. { can we read more from this file ? }
  323. if (c<>#26) and (not endoffile) then
  324. begin
  325. readbuf;
  326. inputpointer:=buf;
  327. inputbuffer:=buf;
  328. inputstart:=bufstart;
  329. { first line? }
  330. if line_no=0 then
  331. begin
  332. line_no:=1;
  333. if cs_asm_source in aktglobalswitches then
  334. inputfile^.setline(line_no,bufstart);
  335. end;
  336. end
  337. else
  338. begin
  339. { load eof position in tokenpos/aktfilepos }
  340. gettokenpos;
  341. { close file }
  342. closeinputfile;
  343. { no next module, than EOF }
  344. if not assigned(inputfile^.next) then
  345. begin
  346. c:=#26;
  347. exit;
  348. end;
  349. { load next file and reopen it }
  350. nextfile;
  351. tempopeninputfile;
  352. { status }
  353. Message1(scan_t_back_in,inputfile^.name^);
  354. end;
  355. { load next char }
  356. c:=inputpointer^;
  357. inc(longint(inputpointer));
  358. until c<>#0; { if also end, then reload again }
  359. end;
  360. end;
  361. procedure tscannerfile.insertmacro(p:pchar;len:longint);
  362. var
  363. hp : pinputfile;
  364. begin
  365. { save old postion and decrease linebreak }
  366. if c=newline then
  367. dec(line_no);
  368. dec(longint(inputpointer));
  369. tempcloseinputfile;
  370. { create macro 'file' }
  371. { use special name to dispose after !! }
  372. hp:=new(pinputfile,init(macro_special_name));
  373. addfile(hp);
  374. with inputfile^ do
  375. begin
  376. setmacro(p,len);
  377. { local buffer }
  378. inputbuffer:=buf;
  379. inputpointer:=buf;
  380. inputstart:=bufstart;
  381. end;
  382. { reset line }
  383. line_no:=0;
  384. lastlinepos:=0;
  385. lasttokenpos:=0;
  386. { load new c }
  387. c:=inputpointer^;
  388. inc(longint(inputpointer));
  389. end;
  390. procedure tscannerfile.gettokenpos;
  391. { load the values of tokenpos and lasttokenpos }
  392. begin
  393. lasttokenpos:=inputstart+(inputpointer-inputbuffer);
  394. tokenpos.line:=line_no;
  395. tokenpos.column:=lasttokenpos-lastlinepos;
  396. tokenpos.fileindex:=inputfile^.ref_index;
  397. aktfilepos:=tokenpos;
  398. end;
  399. procedure tscannerfile.inc_comment_level;
  400. var
  401. oldaktfilepos : tfileposinfo;
  402. begin
  403. if (m_nested_comment in aktmodeswitches) then
  404. inc(comment_level)
  405. else
  406. comment_level:=1;
  407. if (comment_level>1) then
  408. begin
  409. oldaktfilepos:=aktfilepos;
  410. gettokenpos; { update for warning }
  411. Message1(scan_w_comment_level,tostr(comment_level));
  412. aktfilepos:=oldaktfilepos;
  413. end;
  414. end;
  415. procedure tscannerfile.dec_comment_level;
  416. begin
  417. if (m_nested_comment in aktmodeswitches) then
  418. dec(comment_level)
  419. else
  420. comment_level:=0;
  421. end;
  422. procedure tscannerfile.linebreak;
  423. var
  424. cur : char;
  425. oldtokenpos,
  426. oldaktfilepos : tfileposinfo;
  427. begin
  428. with inputfile^ do
  429. begin
  430. if (byte(inputpointer^)=0) and not(endoffile) then
  431. begin
  432. cur:=c;
  433. reload;
  434. if byte(cur)+byte(c)<>23 then
  435. dec(longint(inputpointer));
  436. end
  437. else
  438. begin
  439. { Fix linebreak to be only newline (=#10) for all types of linebreaks }
  440. if (byte(inputpointer^)+byte(c)=23) then
  441. inc(longint(inputpointer));
  442. end;
  443. c:=newline;
  444. { increase line counters }
  445. lastlinepos:=bufstart+(inputpointer-inputbuffer);
  446. inc(line_no);
  447. { update linebuffer }
  448. if cs_asm_source in aktglobalswitches then
  449. inputfile^.setline(line_no,lastlinepos);
  450. { update for status and call the show status routine,
  451. but don't touch aktfilepos ! }
  452. oldaktfilepos:=aktfilepos;
  453. oldtokenpos:=tokenpos;
  454. gettokenpos; { update for v_status }
  455. inc(status.compiledlines);
  456. ShowStatus;
  457. aktfilepos:=oldaktfilepos;
  458. tokenpos:=oldtokenpos;
  459. end;
  460. end;
  461. procedure tscannerfile.end_of_file;
  462. begin
  463. checkpreprocstack;
  464. Message(scan_f_end_of_file);
  465. end;
  466. procedure tscannerfile.checkpreprocstack;
  467. begin
  468. { check for missing ifdefs }
  469. while assigned(preprocstack) do
  470. begin
  471. Message3(scan_e_endif_expected,preprocstring[preprocstack^.typ],preprocstack^.name,tostr(preprocstack^.line_nb));
  472. poppreprocstack;
  473. end;
  474. end;
  475. procedure tscannerfile.poppreprocstack;
  476. var
  477. hp : ppreprocstack;
  478. begin
  479. if assigned(preprocstack) then
  480. begin
  481. Message1(scan_c_endif_found,preprocstack^.name);
  482. hp:=preprocstack^.next;
  483. dispose(preprocstack,done);
  484. preprocstack:=hp;
  485. end
  486. else
  487. Message(scan_e_endif_without_if);
  488. end;
  489. procedure tscannerfile.addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:tmsgconst);
  490. begin
  491. preprocstack:=new(ppreprocstack,init(atyp,((preprocstack=nil) or preprocstack^.accept) and a,preprocstack));
  492. preprocstack^.name:=s;
  493. preprocstack^.line_nb:=line_no;
  494. if preprocstack^.accept then
  495. Message2(w,preprocstack^.name,'accepted')
  496. else
  497. Message2(w,preprocstack^.name,'rejected');
  498. end;
  499. procedure tscannerfile.elsepreprocstack;
  500. begin
  501. if assigned(preprocstack) then
  502. begin
  503. preprocstack^.typ:=pp_else;
  504. preprocstack^.line_nb:=line_no;
  505. if not(assigned(preprocstack^.next)) or (preprocstack^.next^.accept) then
  506. preprocstack^.accept:=not preprocstack^.accept;
  507. if preprocstack^.accept then
  508. Message2(scan_c_else_found,preprocstack^.name,'accepted')
  509. else
  510. Message2(scan_c_else_found,preprocstack^.name,'rejected');
  511. end
  512. else
  513. Message(scan_e_endif_without_if);
  514. end;
  515. procedure tscannerfile.readchar;
  516. begin
  517. c:=inputpointer^;
  518. if c=#0 then
  519. reload
  520. else
  521. inc(longint(inputpointer));
  522. case c of
  523. #26 : reload;
  524. #10,
  525. #13 : linebreak;
  526. end;
  527. end;
  528. procedure tscannerfile.readstring;
  529. var
  530. i : longint;
  531. begin
  532. i:=0;
  533. repeat
  534. case c of
  535. '_',
  536. '0'..'9',
  537. 'A'..'Z' : begin
  538. if i<255 then
  539. begin
  540. inc(i);
  541. orgpattern[i]:=c;
  542. pattern[i]:=c;
  543. end;
  544. c:=inputpointer^;
  545. inc(longint(inputpointer));
  546. end;
  547. 'a'..'z' : begin
  548. if i<255 then
  549. begin
  550. inc(i);
  551. orgpattern[i]:=c;
  552. pattern[i]:=chr(ord(c)-32)
  553. end;
  554. c:=inputpointer^;
  555. inc(longint(inputpointer));
  556. end;
  557. #0 : reload;
  558. #26 : begin
  559. reload;
  560. if c=#26 then
  561. break;
  562. end;
  563. #13,#10 : begin
  564. linebreak;
  565. break;
  566. end;
  567. else
  568. break;
  569. end;
  570. until false;
  571. {$ifndef TP}
  572. {$ifopt H+}
  573. setlength(orgpattern,i);
  574. setlength(pattern,i);
  575. {$else}
  576. orgpattern[0]:=chr(i);
  577. pattern[0]:=chr(i);
  578. {$endif}
  579. {$else}
  580. orgpattern[0]:=chr(i);
  581. pattern[0]:=chr(i);
  582. {$endif}
  583. end;
  584. procedure tscannerfile.readnumber;
  585. var
  586. base,
  587. i : longint;
  588. begin
  589. case c of
  590. '%' : begin
  591. readchar;
  592. base:=2;
  593. pattern[1]:='%';
  594. i:=1;
  595. end;
  596. '$' : begin
  597. readchar;
  598. base:=16;
  599. pattern[1]:='$';
  600. i:=1;
  601. end;
  602. else
  603. begin
  604. base:=10;
  605. i:=0;
  606. end;
  607. end;
  608. while ((base>=10) and (c in ['0'..'9'])) or
  609. ((base=16) and (c in ['A'..'F','a'..'f'])) or
  610. ((base=2) and (c in ['0'..'1'])) do
  611. begin
  612. if i<255 then
  613. begin
  614. inc(i);
  615. pattern[i]:=c;
  616. end;
  617. { get next char }
  618. c:=inputpointer^;
  619. if c=#0 then
  620. reload
  621. else
  622. inc(longint(inputpointer));
  623. end;
  624. { was the next char a linebreak ? }
  625. case c of
  626. #26 : reload;
  627. #10,
  628. #13 : linebreak;
  629. end;
  630. {$ifndef TP}
  631. {$ifopt H+}
  632. setlength(pattern,i);
  633. {$else}
  634. pattern[0]:=chr(i);
  635. {$endif}
  636. {$else}
  637. pattern[0]:=chr(i);
  638. {$endif}
  639. end;
  640. function tscannerfile.readid:string;
  641. begin
  642. readstring;
  643. readid:=pattern;
  644. end;
  645. function tscannerfile.readval:longint;
  646. var
  647. l : longint;
  648. w : integer;
  649. begin
  650. readnumber;
  651. valint(pattern,l,w);
  652. readval:=l;
  653. end;
  654. function tscannerfile.readcomment:string;
  655. var
  656. i : longint;
  657. begin
  658. i:=0;
  659. repeat
  660. case c of
  661. '}' :
  662. if aktcommentstyle=comment_tp then
  663. begin
  664. readchar;
  665. dec_comment_level;
  666. break;
  667. end;
  668. '*' :
  669. if aktcommentstyle=comment_oldtp then
  670. begin
  671. readchar;
  672. if c=')' then
  673. begin
  674. readchar;
  675. dec_comment_level;
  676. break;
  677. end;
  678. end;
  679. #26 :
  680. end_of_file;
  681. else
  682. begin
  683. if (i<255) then
  684. begin
  685. inc(i);
  686. readcomment[i]:=c;
  687. end;
  688. end;
  689. end;
  690. c:=inputpointer^;
  691. if c=#0 then
  692. reload
  693. else
  694. inc(longint(inputpointer));
  695. if c in [#10,#13] then
  696. linebreak;
  697. until false;
  698. {$ifndef TP}
  699. {$ifopt H+}
  700. setlength(readcomment,i);
  701. {$else}
  702. readcomment[0]:=chr(i);
  703. {$endif}
  704. {$else}
  705. readcomment[0]:=chr(i);
  706. {$endif}
  707. end;
  708. function tscannerfile.readstate:char;
  709. var
  710. state : char;
  711. begin
  712. state:=' ';
  713. if c=' ' then
  714. begin
  715. current_scanner^.skipspace;
  716. current_scanner^.readid;
  717. if pattern='ON' then
  718. state:='+'
  719. else
  720. if pattern='OFF' then
  721. state:='-';
  722. end
  723. else
  724. state:=c;
  725. if not (state in ['+','-']) then
  726. Message(scan_e_wrong_switch_toggle);
  727. readstate:=state;
  728. end;
  729. procedure tscannerfile.skipspace;
  730. begin
  731. while c in [' ',#9..#13] do
  732. begin
  733. c:=inputpointer^;
  734. if c=#0 then
  735. reload
  736. else
  737. inc(longint(inputpointer));
  738. case c of
  739. #26 : reload;
  740. #10,
  741. #13 : linebreak;
  742. end;
  743. end;
  744. end;
  745. procedure tscannerfile.skipuntildirective;
  746. var
  747. found : longint;
  748. next_char_loaded : boolean;
  749. oldcommentstyle : tcommentstyle;
  750. begin
  751. found:=0;
  752. next_char_loaded:=false;
  753. oldcommentstyle:=aktcommentstyle;
  754. repeat
  755. case c of
  756. #26 :
  757. end_of_file;
  758. '{' :
  759. begin
  760. if not(m_nested_comment in aktmodeswitches) or
  761. (comment_level=0) then
  762. begin
  763. found:=1;
  764. aktcommentstyle:=comment_tp;
  765. end;
  766. inc_comment_level;
  767. end;
  768. '}' :
  769. begin
  770. dec_comment_level;
  771. found:=0;
  772. end;
  773. '$' :
  774. begin
  775. if found=1 then
  776. found:=2;
  777. end;
  778. '''' :
  779. if (m_tp in aktmodeswitches) or
  780. (m_delphi in aktmodeswitches) then
  781. begin
  782. repeat
  783. readchar;
  784. case c of
  785. #26 :
  786. end_of_file;
  787. newline :
  788. break;
  789. '''' :
  790. begin
  791. readchar;
  792. if c<>'''' then
  793. break;
  794. end;
  795. end;
  796. until false;
  797. end;
  798. '(' :
  799. begin
  800. readchar;
  801. if c='*' then
  802. begin
  803. readchar;
  804. if c='$' then
  805. begin
  806. found:=2;
  807. inc_comment_level;
  808. aktcommentstyle:=comment_oldtp;
  809. end
  810. else
  811. begin
  812. skipoldtpcomment;
  813. aktcommentstyle:=oldcommentstyle;
  814. end;
  815. end
  816. else
  817. next_char_loaded:=true;
  818. end;
  819. else
  820. found:=0;
  821. end;
  822. if next_char_loaded then
  823. next_char_loaded:=false
  824. else
  825. begin
  826. c:=inputpointer^;
  827. if c=#0 then
  828. reload
  829. else
  830. inc(longint(inputpointer));
  831. case c of
  832. #26 : reload;
  833. #10,
  834. #13 : linebreak;
  835. end;
  836. end;
  837. until (found=2);
  838. end;
  839. {****************************************************************************
  840. Include directive scanning/parsing
  841. ****************************************************************************}
  842. {$i scandir.inc}
  843. {****************************************************************************
  844. Comment Handling
  845. ****************************************************************************}
  846. procedure tscannerfile.skipcomment;
  847. begin
  848. aktcommentstyle:=comment_tp;
  849. readchar;
  850. inc_comment_level;
  851. { handle compiler switches }
  852. if (c='$') then
  853. handledirectives;
  854. { handle_switches can dec comment_level, }
  855. while (comment_level>0) do
  856. begin
  857. case c of
  858. '{' : inc_comment_level;
  859. '}' : dec_comment_level;
  860. #26 : end_of_file;
  861. end;
  862. c:=inputpointer^;
  863. if c=#0 then
  864. reload
  865. else
  866. inc(longint(inputpointer));
  867. case c of
  868. #26 : reload;
  869. #10,
  870. #13 : linebreak;
  871. end;
  872. end;
  873. aktcommentstyle:=comment_none;
  874. end;
  875. procedure tscannerfile.skipdelphicomment;
  876. begin
  877. aktcommentstyle:=comment_delphi;
  878. inc_comment_level;
  879. readchar;
  880. { this is currently not supported }
  881. if c='$' then
  882. Message(scan_e_wrong_styled_switch);
  883. { skip comment }
  884. while c<>newline do
  885. begin
  886. if c=#26 then
  887. end_of_file;
  888. readchar;
  889. end;
  890. dec_comment_level;
  891. aktcommentstyle:=comment_none;
  892. end;
  893. procedure tscannerfile.skipoldtpcomment;
  894. var
  895. found : longint;
  896. begin
  897. aktcommentstyle:=comment_oldtp;
  898. inc_comment_level;
  899. readchar;
  900. { this is currently not supported }
  901. if (c='$') then
  902. handledirectives;
  903. { skip comment }
  904. while (comment_level>0) do
  905. begin
  906. found:=0;
  907. repeat
  908. case c of
  909. #26 :
  910. end_of_file;
  911. '*' :
  912. begin
  913. if found=3 then
  914. begin
  915. inc_comment_level;
  916. found:=0;
  917. end
  918. else
  919. found:=1;
  920. end;
  921. ')' :
  922. begin
  923. if found=1 then
  924. begin
  925. dec_comment_level;
  926. if comment_level=0 then
  927. found:=2
  928. else
  929. found:=0;
  930. end;
  931. end;
  932. '(' :
  933. found:=3;
  934. else
  935. found:=0;
  936. end;
  937. c:=inputpointer^;
  938. if c=#0 then
  939. reload
  940. else
  941. inc(longint(inputpointer));
  942. case c of
  943. #26 : reload;
  944. #10,
  945. #13 : linebreak;
  946. end;
  947. until (found=2);
  948. end;
  949. aktcommentstyle:=comment_none;
  950. end;
  951. procedure tscannerfile.skipccomment;
  952. var
  953. found : longint;
  954. begin
  955. aktcommentstyle:=comment_c;
  956. inc_comment_level;
  957. readchar;
  958. { this is currently not supported }
  959. if c='$' then
  960. Message(scan_e_wrong_styled_switch);
  961. { skip comment }
  962. while (comment_level>0) do
  963. begin
  964. found:=0;
  965. repeat
  966. case c of
  967. #26 :
  968. end_of_file;
  969. '*' :
  970. begin
  971. if found=3 then
  972. begin
  973. inc_comment_level;
  974. found:=0;
  975. end
  976. else
  977. found:=1;
  978. end;
  979. '/' :
  980. begin
  981. if found=1 then
  982. begin
  983. dec_comment_level;
  984. if comment_level=0 then
  985. found:=2
  986. else
  987. found:=0;
  988. end
  989. else
  990. found:=3;
  991. end;
  992. else
  993. found:=0;
  994. end;
  995. c:=inputpointer^;
  996. if c=#0 then
  997. reload
  998. else
  999. inc(longint(inputpointer));
  1000. case c of
  1001. #26 : reload;
  1002. #10,
  1003. #13 : linebreak;
  1004. end;
  1005. until (found=2);
  1006. end;
  1007. aktcommentstyle:=comment_none;
  1008. end;
  1009. {****************************************************************************
  1010. Token Scanner
  1011. ****************************************************************************}
  1012. procedure tscannerfile.readtoken;
  1013. var
  1014. code : integer;
  1015. low,high,mid : longint;
  1016. m : longint;
  1017. mac : pmacrosym;
  1018. asciinr : string[3];
  1019. label
  1020. exit_label;
  1021. begin
  1022. { was there already a token read, then return that token }
  1023. if nexttoken<>NOTOKEN then
  1024. begin
  1025. token:=nexttoken;
  1026. nexttoken:=NOTOKEN;
  1027. goto exit_label;
  1028. end;
  1029. { Skip all spaces and comments }
  1030. repeat
  1031. case c of
  1032. '{' :
  1033. skipcomment;
  1034. ' ',#9..#13 :
  1035. skipspace;
  1036. else
  1037. break;
  1038. end;
  1039. until false;
  1040. { Save current token position, for EOF its already loaded }
  1041. if c<>#26 then
  1042. gettokenpos;
  1043. { Check first for a identifier/keyword, this is 20+% faster (PFV) }
  1044. if c in ['A'..'Z','a'..'z','_'] then
  1045. begin
  1046. readstring;
  1047. token:=_ID;
  1048. idtoken:=_ID;
  1049. { keyword or any other known token,
  1050. pattern is always uppercased }
  1051. if (pattern[1]<>'_') and (length(pattern) in [2..tokenidlen]) then
  1052. begin
  1053. low:=ord(tokenidx[length(pattern),pattern[1]].first);
  1054. high:=ord(tokenidx[length(pattern),pattern[1]].last);
  1055. while low<high do
  1056. begin
  1057. mid:=(high+low+1) shr 1;
  1058. if pattern<tokeninfo[ttoken(mid)].str then
  1059. high:=mid-1
  1060. else
  1061. low:=mid;
  1062. end;
  1063. if pattern=tokeninfo[ttoken(high)].str then
  1064. begin
  1065. if tokeninfo[ttoken(high)].keyword in aktmodeswitches then
  1066. token:=ttoken(high);
  1067. idtoken:=ttoken(high);
  1068. end;
  1069. end;
  1070. { Only process identifiers and not keywords }
  1071. if token=_ID then
  1072. begin
  1073. { this takes some time ... }
  1074. if (cs_support_macro in aktmoduleswitches) then
  1075. begin
  1076. mac:=pmacrosym(macros^.search(pattern));
  1077. if assigned(mac) and (assigned(mac^.buftext)) then
  1078. begin
  1079. insertmacro(mac^.buftext,mac^.buflen);
  1080. { handle empty macros }
  1081. if c=#0 then
  1082. reload;
  1083. { play it again ... }
  1084. inc(yylexcount);
  1085. if yylexcount>16 then
  1086. Message(scan_w_macro_deep_ten);
  1087. readtoken;
  1088. { that's all folks }
  1089. dec(yylexcount);
  1090. exit;
  1091. end;
  1092. end;
  1093. end;
  1094. { return token }
  1095. goto exit_label;
  1096. end
  1097. else
  1098. begin
  1099. idtoken:=_NOID;
  1100. case c of
  1101. '$' :
  1102. begin
  1103. readnumber;
  1104. token:=_INTCONST;
  1105. goto exit_label;
  1106. end;
  1107. '%' :
  1108. begin
  1109. readnumber;
  1110. token:=_INTCONST;
  1111. goto exit_label;
  1112. end;
  1113. '0'..'9' :
  1114. begin
  1115. readnumber;
  1116. if (c in ['.','e','E']) then
  1117. begin
  1118. { first check for a . }
  1119. if c='.' then
  1120. begin
  1121. readchar;
  1122. { is it a .. from a range? }
  1123. case c of
  1124. '.' :
  1125. begin
  1126. readchar;
  1127. token:=_INTCONST;
  1128. nexttoken:=_POINTPOINT;
  1129. goto exit_label;
  1130. end;
  1131. ')' :
  1132. begin
  1133. readchar;
  1134. token:=_INTCONST;
  1135. nexttoken:=_RECKKLAMMER;
  1136. goto exit_label;
  1137. end;
  1138. end;
  1139. { insert the number after the . }
  1140. pattern:=pattern+'.';
  1141. while c in ['0'..'9'] do
  1142. begin
  1143. pattern:=pattern+c;
  1144. readchar;
  1145. end;
  1146. end;
  1147. { E can also follow after a point is scanned }
  1148. if c in ['e','E'] then
  1149. begin
  1150. pattern:=pattern+'E';
  1151. readchar;
  1152. if c in ['-','+'] then
  1153. begin
  1154. pattern:=pattern+c;
  1155. readchar;
  1156. end;
  1157. if not(c in ['0'..'9']) then
  1158. Message(scan_f_illegal_char);
  1159. while c in ['0'..'9'] do
  1160. begin
  1161. pattern:=pattern+c;
  1162. readchar;
  1163. end;
  1164. end;
  1165. token:=_REALNUMBER;
  1166. goto exit_label;
  1167. end;
  1168. token:=_INTCONST;
  1169. goto exit_label;
  1170. end;
  1171. ';' :
  1172. begin
  1173. readchar;
  1174. token:=_SEMICOLON;
  1175. goto exit_label;
  1176. end;
  1177. '[' :
  1178. begin
  1179. readchar;
  1180. token:=_LECKKLAMMER;
  1181. goto exit_label;
  1182. end;
  1183. ']' :
  1184. begin
  1185. readchar;
  1186. token:=_RECKKLAMMER;
  1187. goto exit_label;
  1188. end;
  1189. '(' :
  1190. begin
  1191. readchar;
  1192. case c of
  1193. '*' :
  1194. begin
  1195. skipoldtpcomment;
  1196. readtoken;
  1197. exit;
  1198. end;
  1199. '.' :
  1200. begin
  1201. readchar;
  1202. token:=_LECKKLAMMER;
  1203. goto exit_label;
  1204. end;
  1205. end;
  1206. token:=_LKLAMMER;
  1207. goto exit_label;
  1208. end;
  1209. ')' :
  1210. begin
  1211. readchar;
  1212. token:=_RKLAMMER;
  1213. goto exit_label;
  1214. end;
  1215. '+' :
  1216. begin
  1217. readchar;
  1218. if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
  1219. begin
  1220. readchar;
  1221. token:=_PLUSASN;
  1222. goto exit_label;
  1223. end;
  1224. token:=_PLUS;
  1225. goto exit_label;
  1226. end;
  1227. '-' :
  1228. begin
  1229. readchar;
  1230. if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
  1231. begin
  1232. readchar;
  1233. token:=_MINUSASN;
  1234. goto exit_label;
  1235. end;
  1236. token:=_MINUS;
  1237. goto exit_label;
  1238. end;
  1239. ':' :
  1240. begin
  1241. readchar;
  1242. if c='=' then
  1243. begin
  1244. readchar;
  1245. token:=_ASSIGNMENT;
  1246. goto exit_label;
  1247. end;
  1248. token:=_COLON;
  1249. goto exit_label;
  1250. end;
  1251. '*' :
  1252. begin
  1253. readchar;
  1254. if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
  1255. begin
  1256. readchar;
  1257. token:=_STARASN;
  1258. end
  1259. else
  1260. if c='*' then
  1261. begin
  1262. readchar;
  1263. token:=_STARSTAR;
  1264. end
  1265. else
  1266. token:=_STAR;
  1267. goto exit_label;
  1268. end;
  1269. '/' :
  1270. begin
  1271. readchar;
  1272. case c of
  1273. '=' :
  1274. begin
  1275. if (cs_support_c_operators in aktmoduleswitches) then
  1276. begin
  1277. readchar;
  1278. token:=_SLASHASN;
  1279. goto exit_label;
  1280. end;
  1281. end;
  1282. '/' :
  1283. begin
  1284. skipdelphicomment;
  1285. readtoken;
  1286. exit;
  1287. end;
  1288. '*' :
  1289. begin
  1290. skipccomment;
  1291. readtoken;
  1292. exit;
  1293. end;
  1294. end;
  1295. token:=_SLASH;
  1296. goto exit_label;
  1297. end;
  1298. '=' :
  1299. begin
  1300. readchar;
  1301. token:=_EQUAL;
  1302. goto exit_label;
  1303. end;
  1304. '.' :
  1305. begin
  1306. readchar;
  1307. case c of
  1308. '.' :
  1309. begin
  1310. readchar;
  1311. token:=_POINTPOINT;
  1312. goto exit_label;
  1313. end;
  1314. ')' :
  1315. begin
  1316. readchar;
  1317. token:=_RECKKLAMMER;
  1318. goto exit_label;
  1319. end;
  1320. end;
  1321. token:=_POINT;
  1322. goto exit_label;
  1323. end;
  1324. '@' :
  1325. begin
  1326. readchar;
  1327. if c='@' then
  1328. begin
  1329. readchar;
  1330. token:=_DOUBLEADDR;
  1331. end
  1332. else
  1333. token:=_KLAMMERAFFE;
  1334. goto exit_label;
  1335. end;
  1336. ',' :
  1337. begin
  1338. readchar;
  1339. token:=_COMMA;
  1340. goto exit_label;
  1341. end;
  1342. '''','#','^' :
  1343. begin
  1344. if c='^' then
  1345. begin
  1346. readchar;
  1347. c:=upcase(c);
  1348. if (block_type=bt_type) or
  1349. (lasttoken=_ID) or
  1350. (lasttoken=_RKLAMMER) or (lasttoken=_RECKKLAMMER) or (lasttoken=_CARET) then
  1351. begin
  1352. token:=_CARET;
  1353. goto exit_label;
  1354. end
  1355. else
  1356. begin
  1357. if c<#64 then
  1358. pattern:=chr(ord(c)+64)
  1359. else
  1360. pattern:=chr(ord(c)-64);
  1361. readchar;
  1362. end;
  1363. end
  1364. else
  1365. pattern:='';
  1366. repeat
  1367. case c of
  1368. '#' :
  1369. begin
  1370. readchar; { read # }
  1371. if c='$' then
  1372. begin
  1373. readchar; { read leading $ }
  1374. asciinr:='$';
  1375. while (upcase(c) in ['A'..'F','0'..'9']) and (length(asciinr)<3) do
  1376. begin
  1377. asciinr:=asciinr+c;
  1378. readchar;
  1379. end;
  1380. end
  1381. else
  1382. begin
  1383. asciinr:='';
  1384. while (c in ['0'..'9']) and (length(asciinr)<3) do
  1385. begin
  1386. asciinr:=asciinr+c;
  1387. readchar;
  1388. end;
  1389. end;
  1390. valint(asciinr,m,code);
  1391. if (asciinr='') or (code<>0) or
  1392. (m<0) or (m>255) then
  1393. Message(scan_e_illegal_char_const);
  1394. pattern:=pattern+chr(m);
  1395. end;
  1396. '''' :
  1397. begin
  1398. repeat
  1399. readchar;
  1400. case c of
  1401. #26 :
  1402. end_of_file;
  1403. newline :
  1404. Message(scan_f_string_exceeds_line);
  1405. '''' :
  1406. begin
  1407. readchar;
  1408. if c<>'''' then
  1409. break;
  1410. end;
  1411. end;
  1412. pattern:=pattern+c;
  1413. until false;
  1414. end;
  1415. '^' :
  1416. begin
  1417. readchar;
  1418. if c<#64 then
  1419. c:=chr(ord(c)+64)
  1420. else
  1421. c:=chr(ord(c)-64);
  1422. pattern:=pattern+c;
  1423. readchar;
  1424. end;
  1425. else
  1426. break;
  1427. end;
  1428. until false;
  1429. { strings with length 1 become const chars }
  1430. if length(pattern)=1 then
  1431. token:=_CCHAR
  1432. else
  1433. token:=_CSTRING;
  1434. goto exit_label;
  1435. end;
  1436. '>' :
  1437. begin
  1438. readchar;
  1439. case c of
  1440. '=' :
  1441. begin
  1442. readchar;
  1443. token:=_GTE;
  1444. goto exit_label;
  1445. end;
  1446. '>' :
  1447. begin
  1448. readchar;
  1449. token:=_SHR;
  1450. goto exit_label;
  1451. end;
  1452. '<' :
  1453. begin { >< is for a symetric diff for sets }
  1454. readchar;
  1455. token:=_SYMDIF;
  1456. goto exit_label;
  1457. end;
  1458. end;
  1459. token:=_GT;
  1460. goto exit_label;
  1461. end;
  1462. '<' :
  1463. begin
  1464. readchar;
  1465. case c of
  1466. '>' :
  1467. begin
  1468. readchar;
  1469. token:=_UNEQUAL;
  1470. goto exit_label;
  1471. end;
  1472. '=' :
  1473. begin
  1474. readchar;
  1475. token:=_LTE;
  1476. goto exit_label;
  1477. end;
  1478. '<' :
  1479. begin
  1480. readchar;
  1481. token:=_SHL;
  1482. goto exit_label;
  1483. end;
  1484. end;
  1485. token:=_LT;
  1486. goto exit_label;
  1487. end;
  1488. #26 :
  1489. begin
  1490. token:=_EOF;
  1491. checkpreprocstack;
  1492. goto exit_label;
  1493. end;
  1494. else
  1495. begin
  1496. Message(scan_f_illegal_char);
  1497. end;
  1498. end;
  1499. end;
  1500. exit_label:
  1501. lasttoken:=token;
  1502. end;
  1503. function tscannerfile.readpreproc:ttoken;
  1504. begin
  1505. skipspace;
  1506. case c of
  1507. 'A'..'Z',
  1508. 'a'..'z',
  1509. '_','0'..'9' : begin
  1510. preprocpat:=readid;
  1511. readpreproc:=_ID;
  1512. end;
  1513. '(' : begin
  1514. readchar;
  1515. readpreproc:=_LKLAMMER;
  1516. end;
  1517. ')' : begin
  1518. readchar;
  1519. readpreproc:=_RKLAMMER;
  1520. end;
  1521. '+' : begin
  1522. readchar;
  1523. readpreproc:=_PLUS;
  1524. end;
  1525. '-' : begin
  1526. readchar;
  1527. readpreproc:=_MINUS;
  1528. end;
  1529. '*' : begin
  1530. readchar;
  1531. readpreproc:=_STAR;
  1532. end;
  1533. '/' : begin
  1534. readchar;
  1535. readpreproc:=_SLASH;
  1536. end;
  1537. '=' : begin
  1538. readchar;
  1539. readpreproc:=_EQUAL;
  1540. end;
  1541. '>' : begin
  1542. readchar;
  1543. if c='=' then
  1544. begin
  1545. readchar;
  1546. readpreproc:=_GTE;
  1547. end
  1548. else
  1549. readpreproc:=_GT;
  1550. end;
  1551. '<' : begin
  1552. readchar;
  1553. case c of
  1554. '>' : begin
  1555. readchar;
  1556. readpreproc:=_UNEQUAL;
  1557. end;
  1558. '=' : begin
  1559. readchar;
  1560. readpreproc:=_LTE;
  1561. end;
  1562. else readpreproc:=_LT;
  1563. end;
  1564. end;
  1565. #26 :
  1566. end_of_file;
  1567. else
  1568. begin
  1569. readpreproc:=_EOF;
  1570. checkpreprocstack;
  1571. end;
  1572. end;
  1573. end;
  1574. function tscannerfile.asmgetchar : char;
  1575. begin
  1576. if lastasmgetchar<>#0 then
  1577. begin
  1578. c:=lastasmgetchar;
  1579. lastasmgetchar:=#0;
  1580. end
  1581. else
  1582. readchar;
  1583. case c of
  1584. '{' : begin
  1585. skipcomment;
  1586. asmgetchar:=c;
  1587. exit;
  1588. end;
  1589. '/' : begin
  1590. readchar;
  1591. if c='/' then
  1592. begin
  1593. skipdelphicomment;
  1594. asmgetchar:=c;
  1595. end
  1596. else
  1597. begin
  1598. asmgetchar:='/';
  1599. lastasmgetchar:=c;
  1600. end;
  1601. exit;
  1602. end;
  1603. '(' : begin
  1604. readchar;
  1605. if c='*' then
  1606. begin
  1607. skipoldtpcomment;
  1608. asmgetchar:=c;
  1609. end
  1610. else
  1611. begin
  1612. asmgetchar:='(';
  1613. lastasmgetchar:=c;
  1614. end;
  1615. exit;
  1616. end;
  1617. else
  1618. begin
  1619. asmgetchar:=c;
  1620. end;
  1621. end;
  1622. end;
  1623. begin
  1624. create_tokenidx;
  1625. end.
  1626. {
  1627. $Log$
  1628. Revision 1.91 1999-08-05 16:53:11 peter
  1629. * V_Fatal=1, all other V_ are also increased
  1630. * Check for local procedure when assigning procvar
  1631. * fixed comment parsing because directives
  1632. * oldtp mode directives better supported
  1633. * added some messages to errore.msg
  1634. Revision 1.90 1999/08/04 13:03:05 jonas
  1635. * all tokens now start with an underscore
  1636. * PowerPC compiles!!
  1637. Revision 1.89 1999/07/29 11:43:22 peter
  1638. * always output preprocstack when unexpected eof is found
  1639. * fixed tp7/delphi skipuntildirective parsing
  1640. Revision 1.88 1999/07/24 11:20:59 peter
  1641. * directives are allowed in (* *)
  1642. * fixed parsing of (* between conditional code
  1643. Revision 1.87 1999/07/18 10:20:02 florian
  1644. * made it compilable with Dlephi 4 again
  1645. + fixed problem with large stack allocations on win32
  1646. Revision 1.86 1999/06/02 22:44:19 pierre
  1647. * previous wrong log corrected
  1648. Revision 1.85 1999/06/02 22:25:49 pierre
  1649. * changed $ifdef FPC @ into $ifndef TP
  1650. Revision 1.84 1999/05/31 23:28:42 pierre
  1651. * problem with main file end without newline
  1652. Revision 1.83 1999/05/20 14:57:29 peter
  1653. * fixed line counting with macro's
  1654. Revision 1.82 1999/05/04 21:45:04 florian
  1655. * changes to compile it with Delphi 4.0
  1656. Revision 1.81 1999/04/07 14:36:44 pierre
  1657. + better preproc stack checking and report
  1658. Revision 1.80 1999/04/06 11:20:59 peter
  1659. * more hashing for keyword table
  1660. Revision 1.79 1999/04/01 22:05:59 peter
  1661. * '1.' is now parsed as a real
  1662. Revision 1.78 1999/03/26 19:10:06 peter
  1663. * support also ^^
  1664. Revision 1.77 1999/03/26 00:05:45 peter
  1665. * released valintern
  1666. + deffile is now removed when compiling is finished
  1667. * ^( compiles now correct
  1668. + static directive
  1669. * shrd fixed
  1670. Revision 1.76 1999/03/24 23:17:24 peter
  1671. * fixed bugs 212,222,225,227,229,231,233
  1672. Revision 1.75 1999/03/16 21:00:27 peter
  1673. * fixed old tp comment behaviour within directives
  1674. Revision 1.74 1999/03/11 10:46:29 daniel
  1675. * Reverted C styled comments
  1676. Revision 1.73 1999/03/02 22:49:35 peter
  1677. * fixed nested comments for old style tp and c
  1678. Revision 1.72 1999/02/02 00:15:10 florian
  1679. + c styled comments
  1680. Revision 1.71 1999/01/27 13:05:45 pierre
  1681. * give include file name on error
  1682. Revision 1.70 1999/01/19 12:14:38 peter
  1683. * fixed eof bug with includefiles
  1684. Revision 1.69 1998/12/11 00:03:46 peter
  1685. + globtype,tokens,version unit splitted from globals
  1686. Revision 1.68 1998/11/16 15:41:44 peter
  1687. * tp7 didn't like my ifopt H+ :(
  1688. Revision 1.67 1998/11/16 12:18:06 peter
  1689. * H+ fixes
  1690. Revision 1.66 1998/11/05 23:48:29 peter
  1691. * recordtype.field support in constant expressions
  1692. * fixed imul for oa_imm8 which was not allowed
  1693. * fixed reading of local typed constants
  1694. * fixed comment reading which is not any longer a separator
  1695. Revision 1.65 1998/11/03 11:35:02 peter
  1696. * don't check for endif if error
  1697. Revision 1.64 1998/10/21 20:16:05 peter
  1698. * beter line info for conditionals
  1699. Revision 1.63 1998/10/16 14:20:57 daniel
  1700. * Faster keyword scanning.
  1701. * Import library and smartlink library in one file.
  1702. Revision 1.62 1998/10/15 12:22:23 pierre
  1703. * close include files immediately after end reading
  1704. instead of waiting until unit compilation ended !
  1705. Revision 1.61 1998/10/09 11:08:15 peter
  1706. * fixed inputfile^.name^ bug
  1707. Revision 1.60 1998/10/09 08:56:31 pierre
  1708. * several memory leaks fixed
  1709. Revision 1.59 1998/10/08 23:29:05 peter
  1710. * -vu shows unit info, -vt shows tried/used files
  1711. Revision 1.58 1998/10/08 17:17:30 pierre
  1712. * current_module old scanner tagged as invalid if unit is recompiled
  1713. + added ppheap for better info on tracegetmem of heaptrc
  1714. (adds line column and file index)
  1715. * several memory leaks removed ith help of heaptrc !!
  1716. Revision 1.57 1998/10/08 13:45:25 peter
  1717. * EOF position is now correctly saved in aktfilepos
  1718. Revision 1.56 1998/09/30 16:43:38 peter
  1719. * fixed unit interdependency with circular uses
  1720. Revision 1.55 1998/09/28 16:57:26 pierre
  1721. * changed all length(p^.value_str^) into str_length(p)
  1722. to get it work with and without ansistrings
  1723. * changed sourcefiles field of tmodule to a pointer
  1724. Revision 1.54 1998/09/26 17:45:41 peter
  1725. + idtoken and only one token table
  1726. Revision 1.53 1998/09/24 23:49:20 peter
  1727. + aktmodeswitches
  1728. Revision 1.52 1998/09/18 16:03:45 florian
  1729. * some changes to compile with Delphi
  1730. Revision 1.51 1998/09/16 16:41:49 peter
  1731. * merged fixes
  1732. Revision 1.50.2.1 1998/09/16 16:09:49 peter
  1733. * on/off support also for the local/module switches
  1734. Revision 1.50 1998/09/04 08:36:06 peter
  1735. + (. and .) which are equal to [ and ]
  1736. Revision 1.49 1998/09/03 11:24:03 peter
  1737. * moved more inputfile things from tscannerfile to tinputfile
  1738. * changed ifdef Sourceline to cs_asm_source
  1739. Revision 1.48 1998/09/01 12:51:02 peter
  1740. * close also resets lastlinepos
  1741. Revision 1.47 1998/09/01 09:01:52 peter
  1742. * initialize all object variables in .init
  1743. Revision 1.46 1998/08/29 13:49:00 peter
  1744. * fixed freemem calls which had the wrong size sometimes
  1745. Revision 1.45 1998/08/26 15:35:35 peter
  1746. * fixed scannerfiles for macros
  1747. + $I %<environment>%
  1748. Revision 1.44 1998/08/20 16:09:55 pierre
  1749. * tokenpos has to be restored also after
  1750. printstatus
  1751. Revision 1.43 1998/08/20 09:26:45 pierre
  1752. + funcret setting in underproc testing
  1753. compile with _dTEST_FUNCRET
  1754. Revision 1.42 1998/08/19 14:57:51 peter
  1755. * small fix for aktfilepos
  1756. Revision 1.41 1998/08/18 14:17:10 pierre
  1757. * bug about assigning the return value of a function to
  1758. a procvar fixed : warning
  1759. assigning a proc to a procvar need @ in FPC mode !!
  1760. * missing file/line info restored
  1761. Revision 1.40 1998/08/11 14:04:33 peter
  1762. * auto close an open file and better error msg
  1763. Revision 1.39 1998/08/10 14:50:26 peter
  1764. + localswitches, moduleswitches, globalswitches splitting
  1765. Revision 1.38 1998/08/10 10:18:34 peter
  1766. + Compiler,Comphook unit which are the new interface units to the
  1767. compiler
  1768. Revision 1.37 1998/07/23 12:40:41 michael
  1769. No nested comments in Delphi mode.
  1770. Revision 1.36 1998/07/20 22:17:17 florian
  1771. * hex constants in numeric char (#$54#$43 ...) are now allowed
  1772. * there was a bug in record_var_dec which prevents the used
  1773. of nested variant records (for example drivers.tevent of tv)
  1774. Revision 1.35 1998/07/14 21:38:13 peter
  1775. + support for with p^do constructs
  1776. Revision 1.34 1998/07/14 14:47:04 peter
  1777. * released NEWINPUT
  1778. Revision 1.33 1998/07/10 10:48:40 peter
  1779. * fixed realnumber scanning
  1780. * [] after asmblock was not uppercased anymore
  1781. Revision 1.31 1998/07/07 17:39:38 peter
  1782. * fixed $I with following eof
  1783. Revision 1.30 1998/07/07 12:32:55 peter
  1784. * status.currentsource is now calculated in verbose (more accurated)
  1785. Revision 1.29 1998/07/07 11:20:11 peter
  1786. + NEWINPUT for a better inputfile and scanner object
  1787. Revision 1.28 1998/07/01 15:26:57 peter
  1788. * better bufferfile.reset error handling
  1789. Revision 1.27 1998/06/25 08:48:19 florian
  1790. * first version of rtti support
  1791. Revision 1.26 1998/06/16 08:56:30 peter
  1792. + targetcpu
  1793. * cleaner pmodules for newppu
  1794. Revision 1.25 1998/06/13 00:10:15 peter
  1795. * working browser and newppu
  1796. * some small fixes against crashes which occured in bp7 (but not in
  1797. fpc?!)
  1798. Revision 1.24 1998/06/12 10:32:36 pierre
  1799. * column problem hopefully solved
  1800. + C vars declaration changed
  1801. Revision 1.23 1998/06/03 22:49:02 peter
  1802. + wordbool,longbool
  1803. * rename bis,von -> high,low
  1804. * moved some systemunit loading/creating to psystem.pas
  1805. Revision 1.21 1998/05/27 00:20:32 peter
  1806. * some scanner optimizes
  1807. * automaticly aout2exe for go32v1
  1808. * fixed dynamiclinker option which was added at the wrong place
  1809. Revision 1.20 1998/05/23 01:21:30 peter
  1810. + aktasmmode, aktoptprocessor, aktoutputformat
  1811. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  1812. + $LIBNAME to set the library name where the unit will be put in
  1813. * splitted cgi386 a bit (codeseg to large for bp7)
  1814. * nasm, tasm works again. nasm moved to ag386nsm.pas
  1815. Revision 1.19 1998/05/20 09:42:37 pierre
  1816. + UseTokenInfo now default
  1817. * unit in interface uses and implementation uses gives error now
  1818. * only one error for unknown symbol (uses lastsymknown boolean)
  1819. the problem came from the label code !
  1820. + first inlined procedures and function work
  1821. (warning there might be allowed cases were the result is still wrong !!)
  1822. * UseBrower updated gives a global list of all position of all used symbols
  1823. with switch -gb
  1824. Revision 1.18 1998/05/12 10:47:00 peter
  1825. * moved printstatus to verb_def
  1826. + V_Normal which is between V_Error and V_Warning and doesn't have a
  1827. prefix like error: warning: and is included in V_Default
  1828. * fixed some messages
  1829. * first time parameter scan is only for -v and -T
  1830. - removed old style messages
  1831. Revision 1.17 1998/05/06 08:38:47 pierre
  1832. * better position info with UseTokenInfo
  1833. UseTokenInfo greatly simplified
  1834. + added check for changed tree after first time firstpass
  1835. (if we could remove all the cases were it happen
  1836. we could skip all firstpass if firstpasscount > 1)
  1837. Only with ExtDebug
  1838. Revision 1.16 1998/05/04 17:54:28 peter
  1839. + smartlinking works (only case jumptable left todo)
  1840. * redesign of systems.pas to support assemblers and linkers
  1841. + Unitname is now also in the PPU-file, increased version to 14
  1842. Revision 1.15 1998/05/01 16:38:46 florian
  1843. * handling of private and protected fixed
  1844. + change_keywords_to_tp implemented to remove
  1845. keywords which aren't supported by tp
  1846. * break and continue are now symbols of the system unit
  1847. + widestring, longstring and ansistring type released
  1848. Revision 1.14 1998/04/30 15:59:42 pierre
  1849. * GDB works again better :
  1850. correct type info in one pass
  1851. + UseTokenInfo for better source position
  1852. * fixed one remaining bug in scanner for line counts
  1853. * several little fixes
  1854. Revision 1.13 1998/04/29 13:42:27 peter
  1855. + $IOCHECKS and $ALIGN to test already, other will follow soon
  1856. * fixed the wrong linecounting with comments
  1857. Revision 1.12 1998/04/29 10:34:04 pierre
  1858. + added some code for ansistring (not complete nor working yet)
  1859. * corrected operator overloading
  1860. * corrected nasm output
  1861. + started inline procedures
  1862. + added starstarn : use ** for exponentiation (^ gave problems)
  1863. + started UseTokenInfo cond to get accurate positions
  1864. Revision 1.11 1998/04/27 23:10:29 peter
  1865. + new scanner
  1866. * $makelib -> if smartlink
  1867. * small filename fixes pmodule.setfilename
  1868. * moved import from files.pas -> import.pas
  1869. }