]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* mcLexBuf.mod provides a buffer for the all the tokens created by m2.lex. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2015-2023 Free Software Foundation, Inc. |
1eee94d3 GM |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | You should have received a copy of the GNU General Public License | |
19 | along with GNU Modula-2; see the file COPYING3. If not see | |
20 | <http://www.gnu.org/licenses/>. *) | |
21 | ||
22 | IMPLEMENTATION MODULE mcLexBuf ; | |
23 | ||
24 | IMPORT mcflex ; | |
25 | ||
26 | FROM libc IMPORT strlen ; | |
27 | FROM SYSTEM IMPORT ADDRESS ; | |
28 | FROM Storage IMPORT ALLOCATE, DEALLOCATE ; | |
29 | FROM DynamicStrings IMPORT string, InitString, InitStringCharStar, Equal, Mark, KillString ; | |
30 | FROM FormatStrings IMPORT Sprintf1 ; | |
31 | FROM nameKey IMPORT NulName, Name, makekey, keyToCharStar ; | |
32 | FROM mcReserved IMPORT toktype ; | |
33 | FROM mcComment IMPORT isProcedureComment, isBodyComment, isAfterComment, getContent ; | |
34 | FROM mcPrintf IMPORT printf0, printf1, printf2, printf3 ; | |
35 | FROM mcDebug IMPORT assert ; | |
36 | ||
37 | ||
38 | CONST | |
39 | MaxBucketSize = 100 ; | |
40 | Debugging = FALSE ; | |
41 | ||
42 | TYPE | |
43 | sourceList = POINTER TO RECORD | |
44 | left, | |
45 | right: sourceList ; | |
46 | name : String ; | |
47 | line : CARDINAL ; | |
48 | col : CARDINAL ; | |
49 | END ; | |
50 | ||
51 | tokenDesc = RECORD | |
52 | token: toktype ; | |
53 | str : Name ; | |
54 | int : INTEGER ; | |
55 | com : commentDesc ; | |
56 | line : CARDINAL ; | |
57 | col : CARDINAL ; | |
58 | file : sourceList ; | |
59 | END ; | |
60 | ||
61 | tokenBucket = POINTER TO RECORD | |
62 | buf : ARRAY [0..MaxBucketSize] OF tokenDesc ; | |
63 | len : CARDINAL ; | |
64 | next: tokenBucket ; | |
65 | END ; | |
66 | ||
67 | listDesc = RECORD | |
68 | head, | |
69 | tail : tokenBucket ; | |
70 | lastBucketOffset: CARDINAL ; | |
71 | END ; | |
72 | ||
73 | VAR | |
74 | procedureComment, | |
75 | bodyComment, | |
76 | afterComment : commentDesc ; | |
77 | currentSource : sourceList ; | |
78 | useBufferedTokens, | |
79 | currentUsed : BOOLEAN ; | |
80 | listOfTokens : listDesc ; | |
81 | nextTokNo : CARDINAL ; | |
82 | ||
83 | ||
84 | (* | |
85 | debugLex - display the last, n, tokens. | |
86 | *) | |
87 | ||
88 | PROCEDURE debugLex (n: CARDINAL) ; | |
89 | VAR | |
90 | c, | |
91 | i, o, t: CARDINAL ; | |
92 | b : tokenBucket ; | |
93 | BEGIN | |
94 | IF nextTokNo > n | |
95 | THEN | |
96 | o := nextTokNo - n | |
97 | ELSE | |
98 | o := 0 | |
99 | END ; | |
100 | i := 0 ; | |
101 | REPEAT | |
102 | t := o + i ; | |
103 | IF nextTokNo = t | |
104 | THEN | |
105 | printf0 ("nextTokNo ") | |
106 | END ; | |
107 | b := findtokenBucket (t) ; | |
108 | IF b = NIL | |
109 | THEN | |
110 | t := o + i ; | |
111 | printf1 ("end of buf (%d is further ahead than the buffer contents)\n", t) | |
112 | ELSE | |
113 | c := o + i ; | |
114 | printf2 ("entry %d %d ", c, t) ; | |
115 | displayToken (b^.buf[t].token) ; | |
116 | printf0 ("\n") ; | |
117 | INC (i) | |
118 | END | |
119 | UNTIL b = NIL | |
120 | END debugLex ; | |
121 | ||
122 | ||
123 | (* | |
124 | getProcedureComment - returns the procedure comment if it exists, | |
125 | or NIL otherwise. | |
126 | *) | |
127 | ||
128 | PROCEDURE getProcedureComment () : commentDesc ; | |
129 | BEGIN | |
130 | RETURN procedureComment | |
131 | END getProcedureComment ; | |
132 | ||
133 | ||
134 | (* | |
135 | getBodyComment - returns the body comment if it exists, | |
136 | or NIL otherwise. The body comment is | |
137 | removed if found. | |
138 | *) | |
139 | ||
140 | PROCEDURE getBodyComment () : commentDesc ; | |
141 | VAR | |
142 | b: commentDesc ; | |
143 | BEGIN | |
144 | b := bodyComment ; | |
145 | bodyComment := NIL ; | |
146 | RETURN b | |
147 | END getBodyComment ; | |
148 | ||
149 | ||
150 | (* | |
151 | seekTo - | |
152 | *) | |
153 | ||
154 | PROCEDURE seekTo (t: CARDINAL) ; | |
155 | VAR | |
156 | b: tokenBucket ; | |
157 | BEGIN | |
158 | nextTokNo := t ; | |
159 | IF t > 0 | |
160 | THEN | |
161 | DEC (t) ; | |
162 | b := findtokenBucket (t) ; | |
163 | IF b = NIL | |
164 | THEN | |
165 | updateFromBucket (b, t) | |
166 | END | |
167 | END | |
168 | END seekTo ; | |
169 | ||
170 | ||
171 | (* | |
172 | peeptokenBucket - | |
173 | *) | |
174 | ||
175 | PROCEDURE peeptokenBucket (VAR t: CARDINAL) : tokenBucket ; | |
176 | VAR | |
177 | ct : toktype ; | |
178 | old, | |
179 | n : CARDINAL ; | |
180 | b, c: tokenBucket ; | |
181 | BEGIN | |
182 | ct := currenttoken ; | |
183 | IF Debugging | |
184 | THEN | |
185 | debugLex (5) | |
186 | END ; | |
187 | old := getTokenNo () ; | |
188 | REPEAT | |
189 | n := t ; | |
190 | b := findtokenBucket (n) ; | |
191 | IF b = NIL | |
192 | THEN | |
193 | doGetToken ; | |
194 | n := t ; | |
195 | b := findtokenBucket (n) ; | |
196 | IF (b = NIL) OR (currenttoken = eoftok) | |
197 | THEN | |
198 | (* bailing out. *) | |
199 | nextTokNo := old + 1 ; | |
200 | b := findtokenBucket (old) ; | |
201 | updateFromBucket (b, old) ; | |
202 | RETURN NIL | |
203 | END | |
204 | END ; | |
205 | UNTIL (b # NIL) OR (currenttoken = eoftok) ; | |
206 | t := n ; | |
207 | nextTokNo := old + 1 ; | |
208 | IF Debugging | |
209 | THEN | |
210 | printf2 ("nextTokNo = %d, old = %d\n", nextTokNo, old) | |
211 | END ; | |
212 | b := findtokenBucket (old) ; | |
213 | IF Debugging | |
214 | THEN | |
215 | printf1 (" adjusted old = %d\n", old) | |
216 | END ; | |
217 | IF b # NIL | |
218 | THEN | |
219 | updateFromBucket (b, old) | |
220 | END ; | |
221 | IF Debugging | |
222 | THEN | |
223 | debugLex (5) | |
224 | END ; | |
225 | assert (ct = currenttoken) ; | |
226 | RETURN b | |
227 | END peeptokenBucket ; | |
228 | ||
229 | ||
230 | (* | |
231 | peepAfterComment - peeps ahead looking for an after statement comment. It stops at an END token | |
232 | or if the line number changes. | |
233 | *) | |
234 | ||
235 | PROCEDURE peepAfterComment ; | |
236 | VAR | |
237 | oldTokNo, | |
238 | t, | |
239 | peep, | |
240 | cno, | |
241 | nextline, | |
242 | curline : CARDINAL ; | |
243 | b : tokenBucket ; | |
244 | finished: BOOLEAN ; | |
245 | BEGIN | |
246 | oldTokNo := nextTokNo ; | |
247 | cno := getTokenNo () ; | |
248 | curline := tokenToLineNo (cno, 0) ; | |
249 | nextline := curline ; | |
250 | peep := 0 ; | |
251 | finished := FALSE ; | |
252 | REPEAT | |
253 | t := cno + peep ; | |
254 | b := peeptokenBucket (t) ; | |
255 | IF (b = NIL) OR (currenttoken = eoftok) | |
256 | THEN | |
257 | finished := TRUE | |
258 | ELSE | |
259 | nextline := b^.buf[t].line ; | |
260 | IF nextline = curline | |
261 | THEN | |
262 | CASE b^.buf[t].token OF | |
263 | ||
264 | eoftok, | |
265 | endtok : finished := TRUE | | |
266 | commenttok: IF isAfterComment (b^.buf[t].com) | |
267 | THEN | |
268 | afterComment := b^.buf[t].com | |
269 | END | |
270 | ELSE | |
271 | END | |
272 | ELSE | |
273 | finished := TRUE | |
274 | END | |
275 | END ; | |
276 | INC (peep) | |
277 | UNTIL finished ; | |
278 | seekTo (oldTokNo) | |
279 | END peepAfterComment ; | |
280 | ||
281 | ||
282 | (* | |
283 | getAfterComment - returns the after comment if it exists, | |
284 | or NIL otherwise. The after comment is | |
285 | removed if found. | |
286 | *) | |
287 | ||
288 | PROCEDURE getAfterComment () : commentDesc ; | |
289 | VAR | |
290 | a: commentDesc ; | |
291 | BEGIN | |
292 | peepAfterComment ; | |
293 | a := afterComment ; | |
294 | afterComment := NIL ; | |
295 | RETURN a | |
296 | END getAfterComment ; | |
297 | ||
298 | ||
299 | (* | |
300 | init - initializes the token list and source list. | |
301 | *) | |
302 | ||
303 | PROCEDURE init ; | |
304 | BEGIN | |
305 | currenttoken := eoftok ; | |
306 | nextTokNo := 0 ; | |
307 | currentSource := NIL ; | |
308 | listOfTokens.head := NIL ; | |
309 | listOfTokens.tail := NIL ; | |
310 | useBufferedTokens := FALSE ; | |
311 | procedureComment := NIL ; | |
312 | bodyComment := NIL ; | |
313 | afterComment := NIL ; | |
314 | lastcomment := NIL | |
315 | END init ; | |
316 | ||
317 | ||
318 | (* | |
319 | addTo - adds a new element to the end of sourceList, currentSource. | |
320 | *) | |
321 | ||
322 | PROCEDURE addTo (l: sourceList) ; | |
323 | BEGIN | |
324 | l^.right := currentSource ; | |
325 | l^.left := currentSource^.left ; | |
326 | currentSource^.left^.right := l ; | |
327 | currentSource^.left := l ; | |
328 | WITH l^.left^ DO | |
329 | line := mcflex.getLineNo() ; | |
330 | col := mcflex.getColumnNo() | |
331 | END | |
332 | END addTo ; | |
333 | ||
334 | ||
335 | (* | |
336 | subFrom - subtracts, l, from the source list. | |
337 | *) | |
338 | ||
339 | PROCEDURE subFrom (l: sourceList) ; | |
340 | BEGIN | |
341 | l^.left^.right := l^.right ; | |
342 | l^.right^.left := l^.left | |
343 | END subFrom ; | |
344 | ||
345 | ||
346 | (* | |
347 | newElement - returns a new sourceList | |
348 | *) | |
349 | ||
350 | PROCEDURE newElement (s: ADDRESS) : sourceList ; | |
351 | VAR | |
352 | l: sourceList ; | |
353 | BEGIN | |
354 | NEW (l) ; | |
355 | IF l=NIL | |
356 | THEN | |
357 | HALT | |
358 | ELSE | |
359 | WITH l^ DO | |
360 | name := InitStringCharStar (s) ; | |
361 | left := NIL ; | |
362 | right := NIL | |
363 | END | |
364 | END ; | |
365 | RETURN l | |
366 | END newElement ; | |
367 | ||
368 | ||
369 | (* | |
370 | newList - initializes an empty list with the classic dummy header element. | |
371 | *) | |
372 | ||
373 | PROCEDURE newList () : sourceList ; | |
374 | VAR | |
375 | l: sourceList ; | |
376 | BEGIN | |
377 | NEW (l) ; | |
378 | WITH l^ DO | |
379 | left := l ; | |
380 | right := l ; | |
381 | name := NIL | |
382 | END ; | |
383 | RETURN l | |
384 | END newList ; | |
385 | ||
386 | ||
387 | (* | |
388 | checkIfNeedToDuplicate - checks to see whether the currentSource has | |
389 | been used, if it has then duplicate the list. | |
390 | *) | |
391 | ||
392 | PROCEDURE checkIfNeedToDuplicate ; | |
393 | VAR | |
394 | l, h: sourceList ; | |
395 | BEGIN | |
396 | IF currentUsed | |
397 | THEN | |
398 | l := currentSource^.right ; | |
399 | h := currentSource ; | |
400 | currentSource := newList() ; | |
401 | WHILE l#h DO | |
402 | addTo (newElement (l^.name)) ; | |
403 | l := l^.right | |
404 | END | |
405 | END | |
406 | END checkIfNeedToDuplicate ; | |
407 | ||
408 | ||
409 | (* | |
410 | pushFile - indicates that, filename, has just been included. | |
411 | *) | |
412 | ||
413 | PROCEDURE pushFile (filename: ADDRESS) ; | |
414 | VAR | |
415 | l: sourceList ; | |
416 | BEGIN | |
417 | checkIfNeedToDuplicate ; | |
418 | addTo (newElement (filename)) ; | |
419 | IF Debugging | |
420 | THEN | |
421 | IF currentSource^.right#currentSource | |
422 | THEN | |
423 | l := currentSource ; | |
424 | REPEAT | |
425 | printf3 ('name = %s, line = %d, col = %d\n', l^.name, l^.line, l^.col) ; | |
426 | l := l^.right | |
427 | UNTIL l=currentSource | |
428 | END | |
429 | END | |
430 | END pushFile ; | |
431 | ||
432 | ||
433 | (* | |
434 | popFile - indicates that we are returning to, filename, having finished | |
435 | an include. | |
436 | *) | |
437 | ||
438 | PROCEDURE popFile (filename: ADDRESS) ; | |
439 | VAR | |
440 | l: sourceList ; | |
441 | BEGIN | |
442 | checkIfNeedToDuplicate ; | |
443 | IF (currentSource#NIL) AND (currentSource^.left#currentSource) | |
444 | THEN | |
445 | l := currentSource^.left ; (* last element *) | |
446 | subFrom (l) ; | |
447 | DISPOSE (l) ; | |
448 | IF (currentSource^.left#currentSource) AND | |
449 | (NOT Equal(currentSource^.name, Mark (InitStringCharStar (filename)))) | |
450 | THEN | |
451 | (* mismatch in source file names after preprocessing files *) | |
452 | END | |
453 | ELSE | |
454 | (* source file list is empty, cannot pop an include.. *) | |
455 | END | |
456 | END popFile ; | |
457 | ||
458 | ||
459 | (* | |
460 | killList - kills the sourceList providing that it has not been used. | |
461 | *) | |
462 | ||
463 | PROCEDURE killList ; | |
464 | VAR | |
465 | l, k: sourceList ; | |
466 | BEGIN | |
467 | IF (NOT currentUsed) AND (currentSource#NIL) | |
468 | THEN | |
469 | l := currentSource ; | |
470 | REPEAT | |
471 | k := l ; | |
472 | l := l^.right ; | |
473 | DISPOSE (k) | |
474 | UNTIL l=currentSource | |
475 | END | |
476 | END killList ; | |
477 | ||
478 | ||
479 | (* | |
480 | reInitialize - re-initialize the all the data structures. | |
481 | *) | |
482 | ||
483 | PROCEDURE reInitialize ; | |
484 | VAR | |
485 | s, t: tokenBucket ; | |
486 | BEGIN | |
487 | IF listOfTokens.head#NIL | |
488 | THEN | |
489 | t := listOfTokens.head ; | |
490 | REPEAT | |
491 | s := t ; | |
492 | t := t^.next ; | |
493 | DISPOSE (s) ; | |
494 | UNTIL t=NIL ; | |
495 | currentUsed := FALSE ; | |
496 | killList | |
497 | END ; | |
498 | init | |
499 | END reInitialize ; | |
500 | ||
501 | ||
502 | (* | |
503 | setFile - sets the current filename to, filename. | |
504 | *) | |
505 | ||
506 | PROCEDURE setFile (filename: ADDRESS) ; | |
507 | BEGIN | |
508 | killList ; | |
509 | currentUsed := FALSE ; | |
510 | currentSource := newList() ; | |
511 | addTo (newElement (filename)) | |
512 | END setFile ; | |
513 | ||
514 | ||
515 | (* | |
516 | openSource - attempts to open the source file, s. | |
517 | The success of the operation is returned. | |
518 | *) | |
519 | ||
520 | PROCEDURE openSource (s: String) : BOOLEAN ; | |
521 | BEGIN | |
522 | IF useBufferedTokens | |
523 | THEN | |
524 | getToken ; | |
525 | RETURN TRUE | |
526 | ELSE | |
527 | IF mcflex.openSource (string (s)) | |
528 | THEN | |
529 | setFile (string (s)) ; | |
530 | syncOpenWithBuffer ; | |
531 | getToken ; | |
532 | RETURN TRUE | |
533 | ELSE | |
534 | RETURN FALSE | |
535 | END | |
536 | END | |
537 | END openSource ; | |
538 | ||
539 | ||
540 | (* | |
541 | closeSource - closes the current open file. | |
542 | *) | |
543 | ||
544 | PROCEDURE closeSource ; | |
545 | BEGIN | |
546 | IF useBufferedTokens | |
547 | THEN | |
548 | WHILE currenttoken#eoftok DO | |
549 | getToken | |
550 | END | |
551 | ELSE | |
552 | (* a subsequent call to mcflex.OpenSource will really close the file *) | |
553 | END | |
554 | END closeSource ; | |
555 | ||
556 | ||
557 | (* | |
558 | resetForNewPass - reset the buffer pointers to the beginning ready for | |
559 | a new pass | |
560 | *) | |
561 | ||
562 | PROCEDURE resetForNewPass ; | |
563 | BEGIN | |
564 | nextTokNo := 0 ; | |
565 | useBufferedTokens := TRUE | |
566 | END resetForNewPass ; | |
567 | ||
568 | ||
569 | (* | |
570 | displayToken - | |
571 | *) | |
572 | ||
573 | PROCEDURE displayToken (t: toktype) ; | |
574 | BEGIN | |
575 | CASE t OF | |
576 | ||
577 | eoftok: printf0('eoftok\n') | | |
578 | plustok: printf0('plustok\n') | | |
579 | minustok: printf0('minustok\n') | | |
580 | timestok: printf0('timestok\n') | | |
581 | dividetok: printf0('dividetok\n') | | |
582 | becomestok: printf0('becomestok\n') | | |
583 | ambersandtok: printf0('ambersandtok\n') | | |
584 | periodtok: printf0('periodtok\n') | | |
585 | commatok: printf0('commatok\n') | | |
586 | commenttok: printf0('commenttok\n') | | |
587 | semicolontok: printf0('semicolontok\n') | | |
588 | lparatok: printf0('lparatok\n') | | |
589 | rparatok: printf0('rparatok\n') | | |
590 | lsbratok: printf0('lsbratok\n') | | |
591 | rsbratok: printf0('rsbratok\n') | | |
592 | lcbratok: printf0('lcbratok\n') | | |
593 | rcbratok: printf0('rcbratok\n') | | |
594 | uparrowtok: printf0('uparrowtok\n') | | |
595 | singlequotetok: printf0('singlequotetok\n') | | |
596 | equaltok: printf0('equaltok\n') | | |
597 | hashtok: printf0('hashtok\n') | | |
598 | lesstok: printf0('lesstok\n') | | |
599 | greatertok: printf0('greatertok\n') | | |
600 | lessgreatertok: printf0('lessgreatertok\n') | | |
601 | lessequaltok: printf0('lessequaltok\n') | | |
602 | greaterequaltok: printf0('greaterequaltok\n') | | |
603 | periodperiodtok: printf0('periodperiodtok\n') | | |
604 | colontok: printf0('colontok\n') | | |
605 | doublequotestok: printf0('doublequotestok\n') | | |
606 | bartok: printf0('bartok\n') | | |
607 | andtok: printf0('andtok\n') | | |
608 | arraytok: printf0('arraytok\n') | | |
609 | begintok: printf0('begintok\n') | | |
610 | bytok: printf0('bytok\n') | | |
611 | casetok: printf0('casetok\n') | | |
612 | consttok: printf0('consttok\n') | | |
613 | definitiontok: printf0('definitiontok\n') | | |
614 | divtok: printf0('divtok\n') | | |
615 | dotok: printf0('dotok\n') | | |
616 | elsetok: printf0('elsetok\n') | | |
617 | elsiftok: printf0('elsiftok\n') | | |
618 | endtok: printf0('endtok\n') | | |
619 | exittok: printf0('exittok\n') | | |
620 | exporttok: printf0('exporttok\n') | | |
621 | fortok: printf0('fortok\n') | | |
622 | fromtok: printf0('fromtok\n') | | |
623 | iftok: printf0('iftok\n') | | |
624 | implementationtok: printf0('implementationtok\n') | | |
625 | importtok: printf0('importtok\n') | | |
626 | intok: printf0('intok\n') | | |
627 | looptok: printf0('looptok\n') | | |
628 | modtok: printf0('modtok\n') | | |
629 | moduletok: printf0('moduletok\n') | | |
630 | nottok: printf0('nottok\n') | | |
631 | oftok: printf0('oftok\n') | | |
632 | ortok: printf0('ortok\n') | | |
633 | pointertok: printf0('pointertok\n') | | |
634 | proceduretok: printf0('proceduretok\n') | | |
635 | qualifiedtok: printf0('qualifiedtok\n') | | |
636 | unqualifiedtok: printf0('unqualifiedtok\n') | | |
637 | recordtok: printf0('recordtok\n') | | |
638 | repeattok: printf0('repeattok\n') | | |
639 | returntok: printf0('returntok\n') | | |
640 | settok: printf0('settok\n') | | |
641 | thentok: printf0('thentok\n') | | |
642 | totok: printf0('totok\n') | | |
643 | typetok: printf0('typetok\n') | | |
644 | untiltok: printf0('untiltok\n') | | |
645 | vartok: printf0('vartok\n') | | |
646 | whiletok: printf0('whiletok\n') | | |
647 | withtok: printf0('withtok\n') | | |
648 | asmtok: printf0('asmtok\n') | | |
649 | volatiletok: printf0('volatiletok\n') | | |
650 | periodperiodperiodtok: printf0('periodperiodperiodtok\n') | | |
651 | datetok: printf0('datetok\n') | | |
652 | linetok: printf0('linetok\n') | | |
653 | filetok: printf0('filetok\n') | | |
654 | integertok: printf0('integertok\n') | | |
655 | identtok: printf0('identtok\n') | | |
656 | realtok: printf0('realtok\n') | | |
657 | stringtok: printf0('stringtok\n') | |
658 | ||
659 | ELSE | |
660 | printf0 ('unknown tok (--fixme--)\n') | |
661 | END | |
662 | END displayToken ; | |
663 | ||
664 | ||
665 | (* | |
666 | updateFromBucket - updates the global variables: currenttoken, | |
667 | currentstring, currentcolumn and currentinteger | |
668 | from tokenBucket, b, and, offset. | |
669 | *) | |
670 | ||
671 | PROCEDURE updateFromBucket (b: tokenBucket; offset: CARDINAL) ; | |
672 | BEGIN | |
673 | WITH b^.buf[offset] DO | |
674 | currenttoken := token ; | |
675 | currentstring := keyToCharStar (str) ; | |
676 | currentcolumn := col ; | |
677 | currentinteger := int ; | |
678 | currentcomment := com ; | |
679 | IF currentcomment # NIL | |
680 | THEN | |
681 | lastcomment := currentcomment | |
682 | END ; | |
683 | IF Debugging | |
684 | THEN | |
685 | printf3 ('line %d (# %d %d) ', line, offset, nextTokNo) | |
686 | END | |
687 | END | |
688 | END updateFromBucket ; | |
689 | ||
690 | ||
691 | (* | |
692 | getToken - gets the next token into currenttoken. | |
693 | *) | |
694 | ||
695 | PROCEDURE getToken ; | |
696 | BEGIN | |
697 | REPEAT | |
698 | doGetToken ; | |
699 | IF currenttoken = commenttok | |
700 | THEN | |
701 | IF isProcedureComment (currentcomment) | |
702 | THEN | |
703 | procedureComment := currentcomment ; | |
704 | bodyComment := NIL ; | |
705 | afterComment := NIL ; | |
706 | ELSIF isBodyComment (currentcomment) | |
707 | THEN | |
708 | bodyComment := currentcomment ; | |
709 | afterComment := NIL | |
710 | ELSIF isAfterComment (currentcomment) | |
711 | THEN | |
712 | procedureComment := NIL ; | |
713 | bodyComment := NIL ; | |
714 | afterComment := currentcomment | |
715 | END | |
716 | END | |
717 | UNTIL currenttoken # commenttok | |
718 | END getToken ; | |
719 | ||
720 | ||
721 | (* | |
722 | doGetToken - fetch the next token into currenttoken. | |
723 | *) | |
724 | ||
725 | PROCEDURE doGetToken ; | |
726 | VAR | |
727 | a: ADDRESS ; | |
728 | t: CARDINAL ; | |
729 | b: tokenBucket ; | |
730 | BEGIN | |
731 | IF useBufferedTokens | |
732 | THEN | |
733 | t := nextTokNo ; | |
734 | b := findtokenBucket (t) ; | |
735 | updateFromBucket (b, t) | |
736 | ELSE | |
737 | IF listOfTokens.tail=NIL | |
738 | THEN | |
739 | a := mcflex.getToken () ; | |
740 | IF listOfTokens.tail=NIL | |
741 | THEN | |
742 | HALT | |
743 | END | |
744 | END ; | |
745 | IF nextTokNo>=listOfTokens.lastBucketOffset | |
746 | THEN | |
747 | (* nextTokNo is in the last bucket or needs to be read. *) | |
748 | IF nextTokNo-listOfTokens.lastBucketOffset<listOfTokens.tail^.len | |
749 | THEN | |
750 | IF Debugging | |
751 | THEN | |
752 | printf0 ('fetching token from buffer (updateFromBucket)\n') | |
753 | END ; | |
754 | updateFromBucket (listOfTokens.tail, | |
755 | nextTokNo-listOfTokens.lastBucketOffset) | |
756 | ELSE | |
757 | IF Debugging | |
758 | THEN | |
759 | printf0 ('calling flex to place token into buffer\n') | |
760 | END ; | |
761 | (* call the lexical phase to place a new token into the last bucket. *) | |
762 | a := mcflex.getToken () ; | |
763 | getToken ; (* and call ourselves again to collect the token from bucket. *) | |
764 | RETURN | |
765 | END | |
766 | ELSE | |
767 | IF Debugging | |
768 | THEN | |
769 | printf0 ('fetching token from buffer\n') | |
770 | END ; | |
771 | t := nextTokNo ; | |
772 | b := findtokenBucket (t) ; | |
773 | updateFromBucket (b, t) | |
774 | END | |
775 | END ; | |
776 | IF Debugging | |
777 | THEN | |
778 | displayToken (currenttoken) | |
779 | END ; | |
780 | INC (nextTokNo) | |
781 | END doGetToken ; | |
782 | ||
783 | ||
784 | (* | |
785 | syncOpenWithBuffer - synchronise the buffer with the start of a file. | |
786 | Skips all the tokens to do with the previous file. | |
787 | *) | |
788 | ||
789 | PROCEDURE syncOpenWithBuffer ; | |
790 | BEGIN | |
791 | IF listOfTokens.tail#NIL | |
792 | THEN | |
793 | WITH listOfTokens.tail^ DO | |
794 | nextTokNo := listOfTokens.lastBucketOffset+len | |
795 | END | |
796 | END | |
797 | END syncOpenWithBuffer ; | |
798 | ||
799 | ||
800 | (* | |
801 | insertToken - inserts a symbol, token, infront of the current token | |
802 | ready for the next pass. | |
803 | *) | |
804 | ||
805 | PROCEDURE insertToken (token: toktype) ; | |
806 | BEGIN | |
807 | IF listOfTokens.tail#NIL | |
808 | THEN | |
809 | WITH listOfTokens.tail^ DO | |
810 | IF len>0 | |
811 | THEN | |
812 | buf[len-1].token := token | |
813 | END | |
814 | END ; | |
815 | addTokToList (currenttoken, NulName, 0, NIL, | |
816 | getLineNo (), getColumnNo (), currentSource) ; | |
817 | getToken | |
818 | END | |
819 | END insertToken ; | |
820 | ||
821 | ||
822 | (* | |
823 | insertTokenAndRewind - inserts a symbol, token, infront of the current token | |
824 | and then moves the token stream back onto the inserted token. | |
825 | *) | |
826 | ||
827 | PROCEDURE insertTokenAndRewind (token: toktype) ; | |
828 | BEGIN | |
829 | IF listOfTokens.tail#NIL | |
830 | THEN | |
831 | WITH listOfTokens.tail^ DO | |
832 | IF len>0 | |
833 | THEN | |
834 | buf[len-1].token := token | |
835 | END | |
836 | END ; | |
837 | addTokToList (currenttoken, NulName, 0, NIL, | |
838 | getLineNo(), getColumnNo(), currentSource) ; | |
839 | currenttoken := token | |
840 | END | |
841 | END insertTokenAndRewind ; | |
842 | ||
843 | ||
844 | (* | |
845 | getPreviousTokenLineNo - returns the line number of the previous token. | |
846 | *) | |
847 | ||
848 | PROCEDURE getPreviousTokenLineNo () : CARDINAL ; | |
849 | BEGIN | |
850 | RETURN getLineNo() | |
851 | END getPreviousTokenLineNo ; | |
852 | ||
853 | ||
854 | (* | |
855 | getLineNo - returns the current line number where the symbol occurs in | |
856 | the source file. | |
857 | *) | |
858 | ||
859 | PROCEDURE getLineNo () : CARDINAL ; | |
860 | BEGIN | |
861 | IF nextTokNo=0 | |
862 | THEN | |
863 | RETURN 0 | |
864 | ELSE | |
865 | RETURN tokenToLineNo (getTokenNo (), 0) | |
866 | END | |
867 | END getLineNo ; | |
868 | ||
869 | ||
870 | (* | |
871 | getColumnNo - returns the current column where the symbol occurs in | |
872 | the source file. | |
873 | *) | |
874 | ||
875 | PROCEDURE getColumnNo () : CARDINAL ; | |
876 | BEGIN | |
877 | IF nextTokNo=0 | |
878 | THEN | |
879 | RETURN 0 | |
880 | ELSE | |
881 | RETURN tokenToColumnNo (getTokenNo (), 0) | |
882 | END | |
883 | END getColumnNo ; | |
884 | ||
885 | ||
886 | (* | |
887 | getTokenNo - returns the current token number. | |
888 | *) | |
889 | ||
890 | PROCEDURE getTokenNo () : CARDINAL ; | |
891 | BEGIN | |
892 | IF nextTokNo=0 | |
893 | THEN | |
894 | RETURN 0 | |
895 | ELSE | |
896 | RETURN nextTokNo-1 | |
897 | END | |
898 | END getTokenNo ; | |
899 | ||
900 | ||
901 | (* | |
902 | findtokenBucket - returns the tokenBucket corresponding to the tokenNo. | |
903 | *) | |
904 | ||
905 | PROCEDURE findtokenBucket (VAR tokenNo: CARDINAL) : tokenBucket ; | |
906 | VAR | |
907 | b: tokenBucket ; | |
908 | BEGIN | |
909 | b := listOfTokens.head ; | |
910 | WHILE b#NIL DO | |
911 | WITH b^ DO | |
912 | IF tokenNo<len | |
913 | THEN | |
914 | RETURN b | |
915 | ELSE | |
916 | DEC (tokenNo, len) | |
917 | END | |
918 | END ; | |
919 | b := b^.next | |
920 | END ; | |
921 | RETURN NIL | |
922 | END findtokenBucket ; | |
923 | ||
924 | ||
925 | (* | |
926 | tokenToLineNo - returns the line number of the current file for the | |
927 | tokenNo. The depth refers to the include depth. | |
928 | A depth of 0 is the current file, depth of 1 is the file | |
929 | which included the current file. Zero is returned if the | |
930 | depth exceeds the file nesting level. | |
931 | *) | |
932 | ||
933 | PROCEDURE tokenToLineNo (tokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ; | |
934 | VAR | |
935 | b: tokenBucket ; | |
936 | l: sourceList ; | |
937 | BEGIN | |
938 | b := findtokenBucket (tokenNo) ; | |
939 | IF b=NIL | |
940 | THEN | |
941 | RETURN 0 | |
942 | ELSE | |
943 | IF depth=0 | |
944 | THEN | |
945 | RETURN b^.buf[tokenNo].line | |
946 | ELSE | |
947 | l := b^.buf[tokenNo].file^.left ; | |
948 | WHILE depth>0 DO | |
949 | l := l^.left ; | |
950 | IF l=b^.buf[tokenNo].file^.left | |
951 | THEN | |
952 | RETURN 0 | |
953 | END ; | |
954 | DEC (depth) | |
955 | END ; | |
956 | RETURN l^.line | |
957 | END | |
958 | END | |
959 | END tokenToLineNo ; | |
960 | ||
961 | ||
962 | (* | |
963 | tokenToColumnNo - returns the column number of the current file for the | |
964 | tokenNo. The depth refers to the include depth. | |
965 | A depth of 0 is the current file, depth of 1 is the file | |
966 | which included the current file. Zero is returned if the | |
967 | depth exceeds the file nesting level. | |
968 | *) | |
969 | ||
970 | PROCEDURE tokenToColumnNo (tokenNo: CARDINAL; depth: CARDINAL) : CARDINAL ; | |
971 | VAR | |
972 | b: tokenBucket ; | |
973 | l: sourceList ; | |
974 | BEGIN | |
975 | b := findtokenBucket (tokenNo) ; | |
976 | IF b=NIL | |
977 | THEN | |
978 | RETURN 0 | |
979 | ELSE | |
980 | IF depth=0 | |
981 | THEN | |
982 | RETURN b^.buf[tokenNo].col | |
983 | ELSE | |
984 | l := b^.buf[tokenNo].file^.left ; | |
985 | WHILE depth>0 DO | |
986 | l := l^.left ; | |
987 | IF l=b^.buf[tokenNo].file^.left | |
988 | THEN | |
989 | RETURN 0 | |
990 | END ; | |
991 | DEC (depth) | |
992 | END ; | |
993 | RETURN l^.col | |
994 | END | |
995 | END | |
996 | END tokenToColumnNo ; | |
997 | ||
998 | ||
999 | (* | |
1000 | findFileNameFromToken - returns the complete FileName for the appropriate | |
1001 | source file yields the token number, tokenNo. | |
1002 | The, Depth, indicates the include level: 0..n | |
1003 | Level 0 is the current. NIL is returned if n+1 | |
1004 | is requested. | |
1005 | *) | |
1006 | ||
1007 | PROCEDURE findFileNameFromToken (tokenNo: CARDINAL; depth: CARDINAL) : String ; | |
1008 | VAR | |
1009 | b: tokenBucket ; | |
1010 | l: sourceList ; | |
1011 | BEGIN | |
1012 | b := findtokenBucket (tokenNo) ; | |
1013 | IF b=NIL | |
1014 | THEN | |
1015 | RETURN NIL | |
1016 | ELSE | |
1017 | l := b^.buf[tokenNo].file^.left ; | |
1018 | WHILE depth>0 DO | |
1019 | l := l^.left ; | |
1020 | IF l=b^.buf[tokenNo].file^.left | |
1021 | THEN | |
1022 | RETURN NIL | |
1023 | END ; | |
1024 | DEC (depth) | |
1025 | END ; | |
1026 | RETURN l^.name | |
1027 | END | |
1028 | END findFileNameFromToken ; | |
1029 | ||
1030 | ||
1031 | (* | |
1032 | getFileName - returns a String defining the current file. | |
1033 | *) | |
1034 | ||
1035 | PROCEDURE getFileName () : String ; | |
1036 | BEGIN | |
1037 | RETURN findFileNameFromToken (getTokenNo (), 0) | |
1038 | END getFileName ; | |
1039 | ||
1040 | ||
1041 | PROCEDURE stop ; BEGIN END stop ; | |
1042 | ||
1043 | ||
1044 | (* | |
1045 | addTokToList - adds a token to a dynamic list. | |
1046 | *) | |
1047 | ||
1048 | PROCEDURE addTokToList (t: toktype; n: Name; | |
1049 | i: INTEGER; comment: commentDesc; | |
1050 | l: CARDINAL; c: CARDINAL; f: sourceList) ; | |
1051 | VAR | |
1052 | b: tokenBucket ; | |
1053 | BEGIN | |
1054 | IF listOfTokens.head=NIL | |
1055 | THEN | |
1056 | NEW (listOfTokens.head) ; | |
1057 | IF listOfTokens.head=NIL | |
1058 | THEN | |
1059 | (* list error *) | |
1060 | END ; | |
1061 | listOfTokens.tail := listOfTokens.head ; | |
1062 | listOfTokens.tail^.len := 0 | |
1063 | ELSIF listOfTokens.tail^.len=MaxBucketSize | |
1064 | THEN | |
1065 | assert (listOfTokens.tail^.next=NIL) ; | |
1066 | NEW (listOfTokens.tail^.next) ; | |
1067 | IF listOfTokens.tail^.next=NIL | |
1068 | THEN | |
1069 | (* list error *) | |
1070 | ELSE | |
1071 | listOfTokens.tail := listOfTokens.tail^.next ; | |
1072 | listOfTokens.tail^.len := 0 | |
1073 | END ; | |
1074 | INC (listOfTokens.lastBucketOffset, MaxBucketSize) | |
1075 | END ; | |
1076 | WITH listOfTokens.tail^ DO | |
1077 | next := NIL ; | |
1078 | assert (len # MaxBucketSize) ; | |
1079 | WITH buf[len] DO | |
1080 | token := t ; | |
1081 | str := n ; | |
1082 | int := i ; | |
1083 | com := comment ; | |
1084 | line := l ; | |
1085 | col := c ; | |
1086 | file := f | |
1087 | END ; | |
1088 | INC (len) | |
1089 | END | |
1090 | END addTokToList ; | |
1091 | ||
1092 | ||
1093 | (* | |
1094 | isLastTokenEof - returns TRUE if the last token was an eoftok | |
1095 | *) | |
1096 | ||
1097 | PROCEDURE isLastTokenEof () : BOOLEAN ; | |
1098 | VAR | |
1099 | t: CARDINAL ; | |
1100 | b: tokenBucket ; | |
1101 | BEGIN | |
1102 | IF listOfTokens.tail#NIL | |
1103 | THEN | |
1104 | IF listOfTokens.tail^.len=0 | |
1105 | THEN | |
1106 | b := listOfTokens.head ; | |
1107 | IF b=listOfTokens.tail | |
1108 | THEN | |
1109 | RETURN FALSE | |
1110 | END ; | |
1111 | WHILE b^.next#listOfTokens.tail DO | |
1112 | b := b^.next | |
1113 | END ; | |
1114 | ELSE | |
1115 | b := listOfTokens.tail | |
1116 | END ; | |
1117 | WITH b^ DO | |
1118 | assert (len>0) ; (* len should always be >0 *) | |
1119 | RETURN buf[len-1].token=eoftok | |
1120 | END | |
1121 | END ; | |
1122 | RETURN FALSE | |
1123 | END isLastTokenEof ; | |
1124 | ||
1125 | ||
1126 | (* *********************************************************************** | |
1127 | * | |
1128 | * These functions allow m2.flex to deliver tokens into the buffer | |
1129 | * | |
1130 | ************************************************************************* *) | |
1131 | ||
1132 | (* | |
1133 | addTok - adds a token to the buffer. | |
1134 | *) | |
1135 | ||
1136 | PROCEDURE addTok (t: toktype) ; | |
1137 | BEGIN | |
1138 | IF NOT ((t=eoftok) AND isLastTokenEof()) | |
1139 | THEN | |
1140 | addTokToList (t, NulName, 0, NIL, | |
1141 | mcflex.getLineNo (), mcflex.getColumnNo (), currentSource) ; | |
1142 | currentUsed := TRUE | |
1143 | END | |
1144 | END addTok ; | |
1145 | ||
1146 | ||
1147 | (* | |
1148 | addTokCharStar - adds a token to the buffer and an additional string, s. | |
1149 | A copy of string, s, is made. | |
1150 | *) | |
1151 | ||
1152 | PROCEDURE addTokCharStar (t: toktype; s: ADDRESS) ; | |
1153 | BEGIN | |
1154 | IF strlen(s)>80 | |
1155 | THEN | |
1156 | stop | |
1157 | END ; | |
1158 | addTokToList (t, makekey (s), 0, NIL, | |
1159 | mcflex.getLineNo (), mcflex.getColumnNo (), currentSource) ; | |
1160 | currentUsed := TRUE | |
1161 | END addTokCharStar ; | |
1162 | ||
1163 | ||
1164 | (* | |
1165 | addTokInteger - adds a token and an integer to the buffer. | |
1166 | *) | |
1167 | ||
1168 | PROCEDURE addTokInteger (t: toktype; i: INTEGER) ; | |
1169 | VAR | |
1170 | s: String ; | |
1171 | c, | |
1172 | l: CARDINAL ; | |
1173 | BEGIN | |
1174 | l := mcflex.getLineNo () ; | |
1175 | c := mcflex.getColumnNo () ; | |
1176 | s := Sprintf1 (Mark (InitString ('%d')), i) ; | |
1177 | addTokToList (t, makekey(string(s)), i, NIL, l, c, currentSource) ; | |
1178 | s := KillString (s) ; | |
1179 | currentUsed := TRUE | |
1180 | END addTokInteger ; | |
1181 | ||
1182 | ||
1183 | (* | |
1184 | addTokComment - adds a token to the buffer and a comment descriptor, com. | |
1185 | *) | |
1186 | ||
1187 | PROCEDURE addTokComment (t: toktype; com: commentDesc) ; | |
1188 | BEGIN | |
1189 | addTokToList (t, NulName, 0, com, | |
1190 | mcflex.getLineNo (), mcflex.getColumnNo (), currentSource) ; | |
1191 | currentUsed := TRUE | |
1192 | END addTokComment ; | |
1193 | ||
1194 | ||
1195 | BEGIN | |
1196 | init | |
1197 | END mcLexBuf. |