1 (* ==================================================================== *)
2 (* *)
3 (* Scanner Module for the Gardens Point Component Pascal Compiler. *)
4 (* Copyright (c) John Gough 1999, 2000. *)
5 (* This module was extensively modified from the scanner *)
6 (* automatically produced by the M2 version of COCO/R, using *)
7 (* the CPascal.atg grammar used for the JVM version of GPCP. *)
8 (* *)
9 (* ==================================================================== *)
13 (* This is a modified version for Mburg --- it computes column positions *)
14 (* Scanner generated by Coco/R *)
16 IMPORT
17 GPCPcopyright,
18 RTS,
19 ASCII,
20 Console,
22 GPBinFiles,
23 GPTextFiles;
25 CONST
27 (* not only for errors but also for not finished states of scanner analysis *)
36 CONST
41 TYPE
46 (* ======================== EXPORTS ========================= *)
47 TYPE
63 (* ====================== END EXPORTS ======================= *)
65 VAR
86 (* ======================== EXPORTS ========================= *)
87 VAR
98 (* ====================== END EXPORTS ======================= *)
100 (* ======================== EXPORTS ========================= *)
118 BEGIN
120 ELSE
130 BEGIN
139 BEGIN
147 BEGIN
151 (* ====================== END EXPORTS ======================= *)
154 (* Gets next symbol from source file *)
157 (* Retrieves exact string of max length len from position pos in source file *)
160 (* Returns exact character at position pos in source file *)
163 (* Reads and stores source file internally *)
171 (* ==================================================================== *)
175 BEGIN
184 BEGIN
195 BEGIN
216 (*
217 * This code requires special care.
218 * For the CLR it would be simplest to catch overflows
219 * in the per-character loop, and put in a rescue clause
220 * that reported the Error-233. Unfortunately this does
221 * not work on the JVM, so we have to catch the overflow
222 * manually by detecting the sum wrapping to negative.
223 *)
237 ELSE
241 ELSE
255 BEGIN
260 ELSE
271 BEGIN
278 (* RANGE CHECK HERE *)
282 (* ====================== END EXPORTS ======================= *)
285 (* Return global variable ch *)
286 BEGIN
290 ELSE
296 (* ==================================================================== *)
299 VAR
303 BEGIN
307 NextCh;
309 NextCh;
310 LOOP
312 NextCh;
318 NextCh;
323 ELSE
331 (* ==================================================================== *)
334 VAR
339 VAR
342 BEGIN
343 (* Assert: only called with literals ==> LEN(s$) = LEN(s)-1 *)
350 RETURN TRUE
354 BEGIN
358 END
361 END
365 END
369 END
378 END
380 END
386 END
389 END
392 END
395 END
399 END
402 END
408 END
410 END
414 END
416 END
419 END
422 END
423 ELSE
424 END
429 BEGIN
448 LOOP
451 (* ---------------------------------- *)
464 (* ---------------------------------- *)
473 ELSE
477 (* throw away the escape char *)
480 (* ---------------------------------- *)
490 (* ---------------------------------- *)
496 ELSE
500 (* ---------------------------------- *)
506 ELSE
510 (* ---------------------------------- *)
514 END;
516 state := 49;
517 | 51: RETURN mkToken(Tok.bangStrSym);
518 (* ---------------------------------- *)
519 | 2: RETURN mkToken(Tok.integerSym);
520 | 3: DEC(bp, apx+1); DEC(nextLen, apx);
521 NextCh; RETURN mkToken(Tok.integerSym);
524 ELSE RETURN mkToken(Tok.realSym);
525 END;
529 ELSE RETURN mkToken(noSym);
530 END;
532 ELSE RETURN mkToken(noSym);
533 END;
535 ELSE RETURN mkToken(Tok.realSym);
536 END;
537 | 8: RETURN mkToken(Tok.CharConstantSym);
538 | 9: IF (ch <= CHR(9)) OR
539 (ch >= CHR(11)) & (ch <= CHR(12)) OR
576 ELSE RETURN mkToken(Tok.bangSym);
577 END;
579 ELSE RETURN mkToken(Tok.pointSym);
580 END;
581 | 19: RETURN mkToken(Tok.equalSym);
582 | 20: RETURN mkToken(Tok.commaSym);
583 | 21: RETURN mkToken(Tok.lparenSym);
584 | 22: RETURN mkToken(Tok.plusSym);
585 | 23: RETURN mkToken(Tok.rparenSym);
586 | 24: RETURN mkToken(Tok.semicolonSym);
588 ELSE RETURN mkToken(Tok.colonSym);
589 END;
590 | 26: RETURN mkToken(Tok.lbrackSym);
591 | 27: RETURN mkToken(Tok.rbrackSym);
592 | 28: RETURN mkToken(Tok.uparrowSym);
593 | 29: RETURN mkToken(Tok.dollarSym);
594 | 30: RETURN mkToken(Tok.hashSym);
596 ELSE RETURN mkToken(Tok.lessSym);
597 END;
598 | 32: RETURN mkToken(Tok.lessequalSym);
600 ELSE RETURN mkToken(Tok.greaterSym);
601 END;
602 | 34: RETURN mkToken(Tok.greaterequalSym);
603 | 35: RETURN mkToken(Tok.slashSym);
604 | 36: RETURN mkToken(Tok.andSym);
605 | 37: RETURN mkToken(Tok.tildeSym);
606 | 38: RETURN mkToken(Tok.lbraceSym);
607 | 39: RETURN mkToken(Tok.rbraceSym);
608 | 40: RETURN mkToken(Tok.pointpointSym);
609 | 41: RETURN mkToken(Tok.colonequalSym);
610 | 42: RETURN mkToken(Tok.barSym);
611 | 43: ch := 0X; DEC(bp); RETURN mkToken(Tok.EOFSYM);
612 ELSE RETURN mkToken(noSym); (*NextCh already done*)
613 END
614 END
615 END get;
617 (* ==================================================================== *)
619 PROCEDURE SkipAndGetLine(i : INTEGER; (* indent to skip *)
620 e : INTEGER; (* end file-pos *)
621 VAR p : INTEGER; (* crnt file-pos *)
622 OUT l : INTEGER; (* fetched length *)
623 VAR s : ARRAY OF CHAR); (* output string *)
624 VAR
625 ch : CHAR;
626 ix : INTEGER;
627 sp : INTEGER;
628 BEGIN
629 sp := 0;
630 ch := charAt(p); INC(p);
631 (* skip i positions if possible *)
633 IF ch = asciiHT THEN INC(sp,8); DEC(sp,sp MOD 8) ELSE INC(sp) END;
634 ch := charAt(p); INC(p);
635 END;
636 ix := 0;
637 WHILE sp > i DO
639 END;
640 WHILE (p <= e) & (ch # asciiLF) DO
641 s[ix] := ch; INC(ix);
642 ch := charAt(p); INC(p);
643 END;
644 s[ix] := 0X; l := ix;
645 END SkipAndGetLine;
647 (* ==================================================================== *)
649 PROCEDURE GetString (pos: INTEGER; len: INTEGER; OUT name: ARRAY OF CHAR);
650 VAR
651 i: INTEGER;
652 p: INTEGER;
653 BEGIN
654 IF len >= LEN(name) THEN len := LEN(name)-1 END;
655 p := pos; i := 0;
656 WHILE i < len DO
657 name[i] := charAt(p); INC(i); INC(p)
658 END;
659 name[len] := 0X;
660 END GetString;
662 (* ==================================================================== *)
664 PROCEDURE charAt (pos: INTEGER): CHAR;
665 VAR
666 ch : CHAR;
667 BEGIN
668 IF pos >= inputLen THEN RETURN eof END;
669 ch := buf[pos DIV LBlkSize][pos MOD LBlkSize];
670 IF ch # eof THEN RETURN ch ELSE RETURN eof END
671 END charAt;
673 (* ==================================================================== *)
675 PROCEDURE Reset;
676 VAR
677 len: INTEGER;
678 i, read: INTEGER;
679 BEGIN (*assert: src has been opened*)
680 FOR i := 0 TO BlkNmbr - 1 DO savedBuf[i] := NIL END; bufSaved := FALSE;
681 i := -1;
682 inputLen := 0;
683 REPEAT
684 INC(i);
685 (*
686 * Conserve memory by not deallocating the buffer.
687 * Reuse for later compilation, expanding if necessary.
688 *)
689 IF buf[i] = NIL THEN NEW(buf[i]) END;
690 read := GPBinFiles.readNBytes(src, buf[i]^, BlkSize);
691 INC(inputLen, read);
692 UNTIL read < BlkSize;
693 GPBinFiles.CloseFile(src);
694 buf[i][read] := eofByt;
695 curLine := 1; lineStart := -2; bp := -1;
696 oldEols := 0; apx := 0; errors := 0; warnings := 0;
697 spaces := 0; (* # new # *)
698 NextCh;
699 END Reset;
701 PROCEDURE NewReadBuffer*(source : ARRAY OF POINTER TO ARRAY OF CHAR);
702 VAR count, linIx, chrIx, index : INTEGER;
703 lineP : POINTER TO ARRAY OF CHAR;
704 theCh : CHAR;
705 BEGIN
706 IF ~bufSaved THEN
707 count := 0;
708 WHILE (count < BlkNmbr) & (buf[count] # NIL) DO
709 savedBuf[count] := buf[count]; INC(count);
710 END;
711 END;
712 bufSaved := TRUE;
713 NEW(buf[0]);
714 index := 0;
715 FOR linIx := 0 TO LEN(source) - 1 DO
716 lineP := source[linIx];
717 chrIx := 0;
718 IF lineP = NIL THEN theCh := 0X ELSE theCh := lineP[0] END;
719 WHILE theCh # 0X DO
720 buf[0][index] := USHORT(ORD(theCh)); INC(index); INC(chrIx);
721 theCh := lineP[chrIx];
722 END;
723 buf[0][index] := ORD(ASCII.LF); INC(index);
724 END;
725 buf[0][index] := eofByt;
726 (*
727 * Initialize the scanner state.
728 *)
729 curLine := 1; lineStart := -2; bp := -1;
730 oldEols := 0; apx := 0;
731 spaces := 0; (* # new # *)
732 NextCh;
733 END NewReadBuffer;
735 PROCEDURE RestoreFileBuffer*();
736 VAR count : INTEGER;
737 BEGIN
738 count := 0;
739 WHILE (count < BlkNmbr) & (savedBuf[count] # NIL) DO
740 buf[count] := savedBuf[count]; INC(count);
741 END;
742 END RestoreFileBuffer;
744 (* ==================================================================== *)
746 BEGIN
747 start[ 0] := 43; start[ 1] := 48; start[ 2] := 48; start[ 3] := 48;
748 start[ 4] := 48; start[ 5] := 48; start[ 6] := 48; start[ 7] := 48;
749 start[ 8] := 48; start[ 9] := 48; start[ 10] := 48; start[ 11] := 48;
750 start[ 12] := 48; start[ 13] := 48; start[ 14] := 48; start[ 15] := 48;
751 start[ 16] := 48; start[ 17] := 48; start[ 18] := 48; start[ 19] := 48;
752 start[ 20] := 48; start[ 21] := 48; start[ 22] := 48; start[ 23] := 48;
753 start[ 24] := 48; start[ 25] := 48; start[ 26] := 48; start[ 27] := 48;
754 start[ 28] := 48; start[ 29] := 48; start[ 30] := 48; start[ 31] := 48;
755 start[ 32] := 48; start[ 33] := 17; start[ 34] := 9; start[ 35] := 30; (* '!' = 33 => state 17 *)
756 start[ 36] := 29; start[ 37] := 48; start[ 38] := 36; start[ 39] := 11; (* '%' = 37 => state 48 *)
757 start[ 40] := 21; start[ 41] := 23; start[ 42] := 15; start[ 43] := 22;
758 start[ 44] := 20; start[ 45] := 16; start[ 46] := 18; start[ 47] := 35;
759 start[ 48] := 12; start[ 49] := 12; start[ 50] := 12; start[ 51] := 12;
760 start[ 52] := 12; start[ 53] := 12; start[ 54] := 12; start[ 55] := 12;
761 start[ 56] := 12; start[ 57] := 12; start[ 58] := 25; start[ 59] := 24;
762 start[ 60] := 31; start[ 61] := 19; start[ 62] := 33; start[ 63] := 48;
763 start[ 64] := 48; start[ 65] := 1; start[ 66] := 1; start[ 67] := 1;
764 start[ 68] := 1; start[ 69] := 1; start[ 70] := 1; start[ 71] := 1;
765 start[ 72] := 1; start[ 73] := 1; start[ 74] := 1; start[ 75] := 1;
766 start[ 76] := 1; start[ 77] := 1; start[ 78] := 1; start[ 79] := 1;
767 start[ 80] := 1; start[ 81] := 1; start[ 82] := 1; start[ 83] := 1;
768 start[ 84] := 1; start[ 85] := 1; start[ 86] := 1; start[ 87] := 1;
769 start[ 88] := 1; start[ 89] := 1; start[ 90] := 1; start[ 91] := 26;
770 start[ 92] := 48; start[ 93] := 27; start[ 94] := 28;
771 (* ------------------------------------------- *)
773 (* ------------------------------------------- *)
774 start[ 95] := 1; start[ 96] := 44;
775 (* ------------------------------------------- *)
776 start[ 97] := 1; start[ 98] := 1; start[ 99] := 1;
777 start[100] := 1; start[101] := 1; start[102] := 1; start[103] := 1;
778 start[104] := 1; start[105] := 1; start[106] := 1; start[107] := 1;
779 start[108] := 1; start[109] := 1; start[110] := 1; start[111] := 1;
780 start[112] := 1; start[113] := 1; start[114] := 1; start[115] := 1;
781 start[116] := 1; start[117] := 1; start[118] := 1; start[119] := 1;
782 start[120] := 1; start[121] := 1; start[122] := 1; start[123] := 38;
783 start[124] := 42; start[125] := 39; start[126] := 37; start[127] := 48;
784 start[128] := 48; start[129] := 48; start[130] := 48; start[131] := 48;
785 start[132] := 48; start[133] := 48; start[134] := 48; start[135] := 48;
786 start[136] := 48; start[137] := 48; start[138] := 48; start[139] := 48;
787 start[140] := 48; start[141] := 48; start[142] := 48; start[143] := 48;
788 start[144] := 48; start[145] := 48; start[148] := 48; start[147] := 48;
789 start[148] := 48; start[149] := 48; start[150] := 48; start[151] := 48;
790 start[152] := 48; start[153] := 48; start[154] := 48; start[155] := 48;
791 start[156] := 48; start[157] := 48; start[158] := 48; start[159] := 48;
792 start[160] := 48; start[161] := 48; start[162] := 48; start[163] := 48;
793 start[164] := 48; start[165] := 48; start[166] := 48; start[167] := 48;
794 start[168] := 48; start[169] := 48; start[170] := 48; start[171] := 48;
795 start[172] := 48; start[173] := 48; start[174] := 48; start[175] := 48;
796 start[176] := 48; start[177] := 48; start[178] := 48; start[179] := 48;
797 start[180] := 48; start[181] := 48; start[182] := 48; start[183] := 48;
798 start[184] := 48; start[185] := 48; start[186] := 48; start[187] := 48;
799 start[188] := 48; start[189] := 48; start[190] := 48; start[191] := 48;
800 (* ------------------------------------------- *)
801 (* Latin-8 alphabetics start here ... *)
802 (* ------------------------------------------- *)
803 start[192] := 1; start[193] := 1; start[194] := 1; start[195] := 1;
804 start[196] := 1; start[197] := 1; start[198] := 1; start[199] := 1;
805 start[200] := 1; start[201] := 1; start[202] := 1; start[203] := 1;
806 start[204] := 1; start[205] := 1; start[206] := 1; start[207] := 1;
807 start[208] := 1; start[209] := 1; start[210] := 1; start[211] := 1;
808 start[212] := 1; start[213] := 1; start[214] := 1;
810 (* odd character out *)
811 start[215] := 48;
813 start[216] := 1; start[217] := 1; start[218] := 1; start[219] := 1;
814 start[220] := 1; start[221] := 1; start[222] := 1; start[223] := 1;
815 start[224] := 1; start[225] := 1; start[226] := 1; start[227] := 1;
816 start[228] := 1; start[229] := 1; start[230] := 1; start[231] := 1;
817 start[232] := 1; start[233] := 1; start[234] := 1; start[235] := 1;
818 start[236] := 1; start[237] := 1; start[238] := 1; start[239] := 1;
819 start[240] := 1; start[241] := 1; start[242] := 1; start[243] := 1;
820 start[244] := 1; start[245] := 1; start[246] := 1;
822 (* odd character out *)
823 start[247] := 48;
825 start[248] := 1; start[249] := 1; start[250] := 1; start[251] := 1;
826 start[252] := 1; start[253] := 1; start[254] := 1; start[255] := 1;
827 LBlkSize := BlkSize;
828 END CPascalS.