scanner.pas 59 KB

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