WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Source/SCAN.ob07

 (*
-    Copyright 2016 Anton Krotov
+    BSD 2-Clause License
-    This file is part of Compiler.
-    Compiler is free software: you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
+    Copyright (c) 2018, Anton Krotov
-    (at your option) any later version.
-    Compiler is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-    You should have received a copy of the GNU General Public License
-    along with Compiler. If not, see .
+    All rights reserved.
 *)
+MODULE SCAN;
 MODULE SCAN;
+IMPORT TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, C := COLLECTIONS;
-IMPORT UTILS, sys := SYSTEM;
+CONST
-CONST
+    LEXLEN = 1024;
+    lxUNDEF*   =   0;  lxIDENT*   =   1;  lxINTEGER*   =   2;  lxHEX*     =   3;
-  Tab = 8;
+    lxCHAR*    =   4;  lxFLOAT*   =   5;  lxSTRING*    =   6;  lxCOMMENT* =   7;
+    lxEOF*     =   8;
+    lxKW       = 101;
+    lxARRAY*   = 101;  lxBEGIN*   = 102;  lxBY*        = 103;  lxCASE*    = 104;
-  maxINT* = 7FFFFFFFH;
+    lxCONST*   = 105;  lxDIV*     = 106;  lxDO*        = 107;  lxELSE*    = 108;
+    lxELSIF*   = 109;  lxEND*     = 110;  lxFALSE*     = 111;  lxFOR*     = 112;
-  minINT* = 80000000H;
+    lxIF*      = 113;  lxIMPORT*  = 114;  lxIN*        = 115;  lxIS*      = 116;
-  maxREAL* = 3.39E38;
+    lxMOD*     = 117;  lxMODULE*  = 118;  lxNIL*       = 119;  lxOF*      = 120;
-  maxDBL* = 1.69D308;
+    lxOR*      = 121;  lxPOINTER* = 122;  lxPROCEDURE* = 123;  lxRECORD*  = 124;
-  minREAL* = 1.41E-45;
+    lxREPEAT*  = 125;  lxRETURN*  = 126;  lxTHEN*      = 127;  lxTO*      = 128;
+    lxTRUE*    = 129;  lxTYPE*    = 130;  lxUNTIL*     = 131;  lxVAR*     = 132;
-  IDLENGTH = 255;
+    lxWHILE*   = 133;
-  STRLENGTH* = 256;
+    lxPLUS*    = 201;  lxMINUS*   = 202;  lxMUL*       = 203;  lxSLASH*   = 204;
-  lxEOF = 0; lxINT = -1; lxREAL = -2; lxSTRING = -3; lxIDENT = -4; lxHEX = -5; lxCHX = -6; lxLONGREAL = -7;
+    lxNOT*     = 205;  lxAND*     = 206;  lxPOINT*     = 207;  lxCOMMA*   = 208;
-  lxARRAY = 1; lxBEGIN = 2; lxBY = 3; lxCASE = 4; lxCONST = 5; lxDIV = 6; lxDO = 7; lxELSE = 8;
+    lxSEMI*    = 209;  lxBAR*     = 210;  lxLROUND*    = 211;  lxLSQUARE* = 212;
-  lxELSIF = 9; lxEND = 10; lxFALSE = 11; lxFOR = 12; lxIF = 13; lxIMPORT = 14; lxIN = 15; lxIS = 16;
-  lxMOD = 17; lxMODULE = 18; lxNIL = 19; lxOF = 20; lxOR = 21; lxPOINTER = 22; lxPROCEDURE = 23;
+    lxLCURLY*  = 213;  lxCARET*   = 214;  lxEQ*        = 215;  lxNE*      = 216;
-  lxRECORD = 24; lxREPEAT = 25; lxRETURN = 26; lxTHEN = 27; lxTO = 28; lxTRUE = 29; lxTYPE = 30;
+    lxLT*      = 217;  lxGT*      = 218;  lxCOLON*     = 219;  lxRROUND*  = 220;
-  lxUNTIL = 31; lxVAR = 32; lxWHILE = 33;
+    lxRSQUARE* = 221;  lxRCURLY*  = 222;  lxLE*        = 223;  lxGE*      = 224;
-  lxPlus = 51; lxMinus = 52; lxMult = 53; lxSlash = 54; lxNot = 55; lxAnd = 56; lxComma = 57; lxSemi = 58;
-  lxStick = 59; lxLRound = 60; lxLSquare = 61; lxLCurly = 62; lxCaret = 63; lxRRound = 64; lxRSquare = 65;
+    lxASSIGN*  = 225;  lxRANGE*   = 226;
+    lxERROR01 =  -1;  lxERROR02 =  -2;  lxERROR03   =  -3;  lxERROR04 =  -4;
+    lxERROR05 =  -5;  lxERROR06 =  -6;  lxERROR07   =  -7;  lxERROR08 =  -8;
+    lxERROR09 =  -9;  lxERROR10 = -10;  lxERROR11   = -11;  lxERROR12 = -12;
-  lxRCurly = 66; lxDot = 67; lxDbl = 68; lxAssign = 69; lxColon = 70;
-  lxEQ = 71; lxNE = 72; lxLT = 73; lxGT = 74; lxLE = 75; lxGE = 76;
-  lxERR0 = 100; lxERR1 = 101; lxERR2 = 102; lxERR3 = 103; lxERR4 = 104; lxERR5 = 105; lxERR6 = 106;
-  lxERR7 = 107; lxERR8 = 108; lxERR9 = 109; lxERR10 = 110; lxERR11 = 111; lxERR20 = 120;
 TYPE
-TYPE
-  TCoord* = RECORD line*, col*: INTEGER END;
-  NODE* = POINTER TO RECORD
-    Left, Right: NODE;
-    tLex: INTEGER;
+    LEXSTR* = ARRAY LEXLEN OF CHAR;
-    Name*: UTILS.STRING
-  END;
+    IDENT* = POINTER TO RECORD (AVL.DATA)
+        s*: LEXSTR;
+        offset*, offsetW*: INTEGER
+    END;
+    POSITION* = RECORD
+        line*, col*: INTEGER
+    END;
+    LEX* = RECORD
+        s*:              LEXSTR;
+        length*:         INTEGER;
+        sym*:            INTEGER;
+        pos*:            POSITION;
+        ident*:          IDENT;
+        string*:         IDENT;
+        value*:          ARITH.VALUE;
+        error*:          INTEGER;
+        over:            BOOLEAN
+    END;
   SCANNER* = POINTER TO RECORD
-    File, ccol, cline, count, tLex, vINT: INTEGER;
-    coord: TCoord;
+    SCANNER* = POINTER TO RECORD (C.ITEM)
-    ch, vCHX: CHAR;
+        text:            TEXTDRV.TEXT;
+        range:           BOOLEAN
-    Lex: UTILS.STRING;
+    END;
-    vFLT: LONGREAL;
-    id: NODE;
+    KEYWORD = ARRAY 10 OF CHAR;
+VAR
+    vocabulary: RECORD
-    buf, bufpos: INTEGER;
+        KW:          ARRAY 33 OF KEYWORD;
+        delimiters:  ARRAY 256 OF BOOLEAN;
+        idents:      AVL.NODE;
+        ident:       IDENT
-    CR, UTF8: BOOLEAN
-  END;
     END;
-VAR
+    scanners: C.COLLECTION;
-  Lex*: UTILS.STRING; File, ccol, cline, count*, tLex*, vINT*: INTEGER;
-  coord*: TCoord;
+PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
+    RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)
-  vFLT*: LONGREAL; id*: NODE; ch, vCHX*: CHAR;
+END nodecmp;
-  buf, bufpos: INTEGER; CR, UTF8: BOOLEAN;
-  Nodes: ARRAY 256 OF NODE;
+PROCEDURE key (VAR lex: LEX);
-  _START*, _version*: NODE;
+VAR
     L, R, M: INTEGER;
-PROCEDURE AddNode*(Name: UTILS.STRING): NODE;
+BEGIN
+    L := 0;
-VAR cur, res: NODE;
+    R := LEN(vocabulary.KW) - 1;
+    M := (L + R) DIV 2;
-  PROCEDURE NewNode(Right: BOOLEAN);
-  BEGIN
-    NEW(res);
-    UTILS.MemErr(res = NIL);
-    res.Name := Name;
-    res.tLex := lxIDENT;
-    res.Left := NIL;
-    res.Right := NIL;
-    IF Right THEN
-      cur.Right := res
-    ELSE
+    WHILE L # M DO
-      cur.Left := res
-    END
+        IF lex.s > vocabulary.KW[M] THEN
-  END NewNode;
-BEGIN
-  res := NIL;
-  cur := Nodes[ORD(Name[0])];
-  REPEAT
-    IF Name > cur.Name THEN
-      IF cur.Right # NIL THEN
-        cur := cur.Right
-      ELSE
-        NewNode(TRUE)
-      END
-    ELSIF Name < cur.Name THEN
-      IF cur.Left # NIL THEN
-        cur := cur.Left
-      ELSE
-        NewNode(FALSE)
-      END
-    ELSE
-      res := cur
-    END
-  UNTIL res # NIL
-  RETURN res
-END AddNode;
-PROCEDURE Backup*(scanner: SCANNER);
-BEGIN
-  scanner.File := File;
-  scanner.ccol := ccol;
-  scanner.cline := cline;
-  scanner.ch := ch;
-  scanner.Lex := Lex;
-  scanner.count := count;
-  scanner.coord := coord;
-  scanner.tLex := tLex;
-  scanner.vINT := vINT;
-  scanner.vFLT := vFLT;
-  scanner.vCHX := vCHX;
-  scanner.buf := buf;
-  scanner.bufpos := bufpos;
-  scanner.CR := CR;
-  scanner.UTF8 := UTF8
-END Backup;
-PROCEDURE Recover*(scanner: SCANNER);
-BEGIN
-  File := scanner.File;
-  ccol := scanner.ccol;
-  cline := scanner.cline;
-  ch := scanner.ch;
-  Lex := scanner.Lex;
-  count := scanner.count;
-  coord := scanner.coord;
-  tLex := scanner.tLex;
-  vINT := scanner.vINT;
-  vFLT := scanner.vFLT;
-  vCHX := scanner.vCHX;
-  buf := scanner.buf;
-  bufpos := scanner.bufpos;
-  CR := scanner.CR;
-  UTF8 := scanner.UTF8
+            L := M;
-END Recover;
-PROCEDURE Next;
-VAR cr: BOOLEAN;
-BEGIN
-  cr := FALSE;
-  sys.GET(bufpos, ch);
-  INC(ccol);
-  CASE ch OF
-  |0AX: IF ~CR THEN INC(cline) END; ccol := 0
-  |0DX: INC(cline); ccol := 0; cr := TRUE
-  |09X: DEC(ccol); ccol := (ccol DIV Tab) * Tab + Tab
-  |80X..0BFX: IF UTF8 THEN DEC(ccol) END
-  ELSE
-  END;
-  CR := cr;
-  INC(bufpos)
-END Next;
-PROCEDURE Open*(FName: ARRAY OF CHAR; VAR FHandle: INTEGER): BOOLEAN;
-VAR n, size: INTEGER; c: CHAR;
-BEGIN
-  File := UTILS.OpenF(FName);
-  FHandle := File;
-  IF File # 0 THEN
-    CR := FALSE;
-    UTF8 := FALSE;
+            M := (L + R) DIV 2
-    ccol := 0;
-    cline := 1;
+        ELSIF lex.s < vocabulary.KW[M] THEN
-    ch := 0X;
+            R := M;
-    size := UTILS.FileSize(File);
+            M := (L + R) DIV 2
-    buf := UTILS.GetMem(size + 1024);
-    UTILS.MemErr(buf = 0);
-    sys.PUT(buf + size, 0X);
-    n := UTILS.Read(File, buf, size);
-    UTILS.CloseF(File);
-    bufpos := buf;
-    sys.GET(buf, c);
-    IF c = 0EFX THEN
+        ELSE
-      sys.GET(buf + 1, c);
-      IF c = 0BBX THEN
-        sys.GET(buf + 2, c);
-        IF c = 0BFX THEN
+            lex.sym := lxKW + M;
-          INC(bufpos, 3);
-          UTF8 := TRUE
-        END
+            L := M;
-      END
+            R := M
-    END;
-    Next
+        END
-  END
-  RETURN (File # 0) & (n = size)
+    END;
-END Open;
+    IF L # R THEN
+        IF lex.s = vocabulary.KW[L] THEN
+            lex.sym := lxKW + L
-PROCEDURE Space(ch: CHAR): BOOLEAN;
+        END;
+        IF lex.s = vocabulary.KW[R] THEN
-  RETURN (ch <= 20X) & (ch > 0X)
+            lex.sym := lxKW + R
-END Space;
+        END
+    END
+END key;
 PROCEDURE Letter(ch: CHAR): BOOLEAN;
+PROCEDURE enterid* (s: LEXSTR): IDENT;
+VAR
-  RETURN (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") OR (ch = "_")
+    newnode: BOOLEAN;
+    node:    AVL.NODE;
+BEGIN
-END Letter;
+    vocabulary.ident.s := s;
+    vocabulary.idents := AVL.insert(vocabulary.idents, vocabulary.ident, nodecmp, newnode, node);
+    IF newnode THEN
+        NEW(vocabulary.ident);
+        vocabulary.ident.offset  := -1;
+        vocabulary.ident.offsetW := -1
-PROCEDURE Digit*(ch: CHAR): BOOLEAN;
-  RETURN (ch >= "0") & (ch <= "9")
+    END
-END Digit;
+    RETURN node.data(IDENT)
+END enterid;
+PROCEDURE putchar (VAR lex: LEX; c: CHAR);
+BEGIN
+    IF lex.length < LEXLEN - 1 THEN
+        lex.s[lex.length] := c;
+        INC(lex.length);
+        lex.s[lex.length] := 0X
+    ELSE
+        lex.over := TRUE
-PROCEDURE HexDigit*(ch: CHAR): BOOLEAN;
+    END
-  RETURN (ch >= "A") & (ch <= "F") OR (ch >= "0") & (ch <= "9")
+END putchar;
-END HexDigit;
-PROCEDURE PutChar(ch: CHAR);
+PROCEDURE ident (text: TEXTDRV.TEXT; VAR lex: LEX);
-BEGIN
+VAR
-  Lex[count] := ch;
+    c: CHAR;
+BEGIN
+    c := text.peak(text);
+    ASSERT(S.letter(c));
-  IF ch # 0X THEN
+    WHILE S.letter(c) OR S.digit(c) DO
-    INC(count)
+        putchar(lex, c);
+        text.nextc(text);
-  END
+        c := text.peak(text)
+    END;
+    IF lex.over THEN
+        lex.sym := lxERROR06
+    ELSE
+        lex.sym := lxIDENT;
+        key(lex)
+    END;
-END PutChar;
+    IF lex.sym = lxIDENT THEN
+        lex.ident := enterid(lex.s)
+    END
+END ident;
+PROCEDURE number (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN);
+VAR
+    c: CHAR;
+    hex: BOOLEAN;
+    error: INTEGER;
+BEGIN
+    c := text.peak(text);
+    ASSERT(S.digit(c));
+    error := 0;
+    range := FALSE;
-PROCEDURE PutNext(ch: CHAR);
+    lex.sym := lxINTEGER;
+    hex := FALSE;
+    WHILE S.digit(c) DO
+        putchar(lex, c);
+        text.nextc(text);
-BEGIN
+        c := text.peak(text)
-  PutChar(ch);
+    END;
+    WHILE S.hexdigit(c) DO
+        putchar(lex, c);
+        text.nextc(text);
+        c := text.peak(text);
+        hex := TRUE
+    END;
+    IF c = "H" THEN
+        putchar(lex, c);
+        text.nextc(text);
+        lex.sym := lxHEX
+    ELSIF c = "X" THEN
+        putchar(lex, c);
+        text.nextc(text);
+        lex.sym := lxCHAR
+    ELSIF c = "." THEN
+        IF hex THEN
+            lex.sym := lxERROR01
+        ELSE
+            text.nextc(text);
+            c := text.peak(text);
+            IF c # "." THEN
+                putchar(lex, ".");
+                lex.sym := lxFLOAT
+            ELSE
+                lex.sym := lxINTEGER;
+                range := TRUE
+            END;
+            WHILE S.digit(c) DO
+                putchar(lex, c);
+                text.nextc(text);
+                c := text.peak(text)
-  Next
+            END;
-END PutNext;
+            IF c = "E" THEN
+                putchar(lex, c);
+                text.nextc(text);
+                c := text.peak(text);
+                IF (c = "+") OR (c = "-") THEN
+                    putchar(lex, c);
+                    text.nextc(text);
+                    c := text.peak(text)
+                END;
+                IF S.digit(c) THEN
+                    WHILE S.digit(c) DO
+                        putchar(lex, c);
+                        text.nextc(text);
+                        c := text.peak(text)
+                    END
+                ELSE
+                    lex.sym := lxERROR02
+                END
+            END
+        END
+    ELSE
+        IF hex THEN
+            lex.sym := lxERROR01
+        END
+    END;
-PROCEDURE Ident;
+    IF lex.over & (lex.sym >= 0) THEN
+        lex.sym := lxERROR07
+    END;
-BEGIN
+    IF lex.sym = lxINTEGER THEN
+        ARITH.iconv(lex.s, lex.value, error)
-  tLex := lxIDENT;
+    ELSIF (lex.sym = lxHEX) OR (lex.sym = lxCHAR) THEN
+        ARITH.hconv(lex.s, lex.value, error)
+    ELSIF lex.sym = lxFLOAT THEN
+        ARITH.fconv(lex.s, lex.value, error)
+    END;
-  WHILE Letter(ch) OR Digit(ch) DO
+    CASE error OF
-    PutNext(ch)
+    |0:
-  END;
+    |1: lex.sym := lxERROR08
+    |2: lex.sym := lxERROR09
+    |3: lex.sym := lxERROR10
-  PutChar(0X);
+    |4: lex.sym := lxERROR11
+    |5: lex.sym := lxERROR12
+    END
-  IF count > IDLENGTH THEN
-    tLex := lxERR10
+END number;
-  END
-END Ident;
+PROCEDURE string (text: TEXTDRV.TEXT; VAR lex: LEX);
-PROCEDURE hex*(ch: CHAR): INTEGER;
+VAR
-VAR Res: INTEGER;
+    c, c1: CHAR;
-BEGIN
-  Res := ORD(ch);
+    n:     INTEGER;
+    quot:  CHAR;
-  CASE ch OF
-  |"0".."9": DEC(Res, ORD("0"))
+BEGIN
+    quot := text.peak(text);
-  |"A".."F": DEC(Res, ORD("A") - 10)
+    ASSERT((quot = '"') OR (quot = "'"));
   ELSE
-  END
+    text.nextc(text);
+    c := text.peak(text);
-  RETURN Res
+    c1 := c;
-END hex;
+    n := 0;
-PROCEDURE StrToInt16(str: UTILS.STRING): INTEGER;
-VAR i, res, n: INTEGER; flag: BOOLEAN;
-BEGIN
+    WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
-  res := 0;
+        putchar(lex, c);
-  i := 0;
-  n := 0;
+        text.nextc(text);
-  WHILE str[i] = "0" DO
-    INC(i)
+        c := text.peak(text);
+        INC(n)
+    END;
-  END;
+    IF c = quot THEN
+        text.nextc(text);
-  flag := TRUE;
+        IF lex.over THEN
+            lex.sym := lxERROR05
-  WHILE flag & (str[i] # "X") & (str[i] # "H") DO
+        ELSE
-    INC(n);
+            IF n # 1 THEN
-    IF n > 8 THEN
+                lex.sym := lxSTRING
+            ELSE
-      tLex := lxERR5;
+                lex.sym := lxCHAR;
-      flag := FALSE
+                ARITH.setChar(lex.value, ORD(c1))
-    ELSE
+            END
-      res := LSL(res, 4) + hex(str[i]);
+        END
-      INC(i)
-    END
-  END
+    ELSE
-  RETURN res
+        lex.sym := lxERROR03
-END StrToInt16;
+    END;
-PROCEDURE StrToChx(str: UTILS.STRING): CHAR;
-VAR res: INTEGER;
+    IF lex.sym = lxSTRING THEN
-BEGIN
+        lex.string := enterid(lex.s);
-  res := StrToInt16(str);
-  IF (res < 0) OR (res > 0FFH) THEN
+        lex.value.typ := ARITH.tSTRING;
-    tLex := lxERR6;
-    res := 0
+        lex.value.string := lex.string
+    END
+END string;
+PROCEDURE comment (text: TEXTDRV.TEXT);
+VAR
+    c: CHAR;
+    cond, depth: INTEGER;
   END
-  RETURN CHR(res)
-END StrToChx;
+BEGIN
+    cond := 0;
-PROCEDURE StrToInt*(str: UTILS.STRING): INTEGER;
+    depth := 1;
-VAR i, res: INTEGER; flag: BOOLEAN;
-BEGIN
-  res := 0;
-  i := 0;
-  flag := TRUE;
-  WHILE flag & (str[i] # 0X) DO
-    IF res > maxINT DIV 10 THEN
+    REPEAT
+        c := text.peak(text);
-      tLex := lxERR5;
+        text.nextc(text);
+        IF c = "*" THEN
-      flag := FALSE;
+            IF cond = 1 THEN
-      res := 0
+                cond := 0;
-    ELSE
+                INC(depth)
-      res := res * 10;
-      IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN
-        tLex := lxERR5;
+            ELSE
-        flag := FALSE;
+               cond := 2
-        res := 0
+            END
-      ELSE
+        ELSIF c = ")" THEN
-        res := res + (ORD(str[i]) - ORD("0"));
+            IF cond = 2 THEN
-        INC(i)
-      END
+                DEC(depth)
-    END
-  END
-  RETURN res
-END StrToInt;
+            END;
-PROCEDURE StrToFloat(str: UTILS.STRING): LONGREAL;
+            cond := 0
-VAR i, scale: INTEGER; res, m, d: LONGREAL; minus, nez: BOOLEAN;
+        ELSIF c = "(" THEN
-  PROCEDURE Error(e: INTEGER; VAR cont: BOOLEAN);
+            cond := 1
-  BEGIN
-    tLex := e;
-    res := 0.0D0;
-    cont := FALSE
+        ELSE
-  END Error;
-  PROCEDURE Inf(VAR cont: BOOLEAN; VAR i: INTEGER);
-  BEGIN
+            cond := 0
-    IF UTILS.IsInf(res) THEN
-      Error(lxERR7, cont)
+        END
-    END;
-    INC(i)
+    UNTIL (depth = 0) OR text.eof
-  END Inf;
-  PROCEDURE part1(): BOOLEAN;
+END comment;
-  VAR cont: BOOLEAN;
-  BEGIN
-    res := 0.0D0;
-    i := 0;
-    d := 1.0D0;
-    nez := FALSE;
+PROCEDURE delimiter (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN);
-    cont := TRUE;
-    WHILE cont & Digit(str[i]) DO
+VAR
-      nez := nez OR (str[i] # "0");
+    c: CHAR;
-      res := res * 10.0D0 + LONG(FLT(ORD(str[i]) - ORD("0")));
-      Inf(cont, i)
-    END
-    RETURN cont
-  END part1;
-  PROCEDURE part2(): BOOLEAN;
+BEGIN
-  VAR cont: BOOLEAN;
-  BEGIN
+    c := text.peak(text);
-    INC(i);
-    cont := TRUE;
+    IF range THEN
-    WHILE cont & Digit(str[i]) DO
-      nez := nez OR (str[i] # "0");
-      d := d / 10.0D0;
-      res := res + LONG(FLT(ORD(str[i]) - ORD("0"))) * d;
-      Inf(cont, i)
-    END
+        ASSERT(c = ".")
+    END;
-    RETURN cont
-  END part2;
+    putchar(lex, c);
+    text.nextc(text);
-  PROCEDURE part3(): BOOLEAN;
-  VAR cont: BOOLEAN;
-  BEGIN
-    cont := TRUE;
+    CASE c OF
-    IF str[i] = 0X THEN
-      IF res > LONG(maxREAL) THEN
-        Error(lxERR7, cont)
+    |"+":
-      ELSIF nez & ((res = 0.0D0) OR (res < LONG(minREAL)) & (tLex = lxREAL)) THEN
-        Error(lxERR9, cont)
+        lex.sym := lxPLUS
-      END
+    |"-":
+        lex.sym := lxMINUS
-    END
+    |"*":
+        lex.sym := lxMUL
-    RETURN cont
+    |"/":
+        lex.sym := lxSLASH;
-  END part3;
+        IF text.peak(text) = "/" THEN
+            lex.sym := lxCOMMENT;
             REPEAT
+                text.nextc(text)
+            UNTIL text.eol OR text.eof
+        END
+    |"~":
+        lex.sym := lxNOT
+    |"&":
+        lex.sym := lxAND
+    |".":
+        IF range THEN
+            putchar(lex, ".");
+            lex.sym := lxRANGE;
+            range := FALSE;
+            DEC(lex.pos.col)
+        ELSE
   PROCEDURE part4(): BOOLEAN;
-  VAR cont: BOOLEAN;
-  BEGIN
-    IF str[i] = "D" THEN
-      tLex := lxLONGREAL
-    END;
-    INC(i);
-    m := 10.0D0;
-    minus := FALSE;
-    IF str[i] = "+" THEN
+            lex.sym := lxPOINT;
-      INC(i)
-    ELSIF str[i] = "-" THEN
-      minus := TRUE;
+            c := text.peak(text);
-      INC(i);
-      m := 0.1D0
-    END;
-    scale := 0;
-    cont := TRUE;
-    WHILE cont & Digit(str[i]) DO
-      IF scale > maxINT DIV 10 THEN
-        Error(lxERR8, cont)
-      ELSE
-        scale := scale * 10;
-        IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN
-          Error(lxERR8, cont)
-        ELSE
+            IF c = "." THEN
-          scale := scale + (ORD(str[i]) - ORD("0"));
+                lex.sym := lxRANGE;
-          INC(i)
+                putchar(lex, c);
-        END
-      END
-    END
-    RETURN cont
-  END part4;
-  PROCEDURE part5(): BOOLEAN;
+                text.nextc(text)
-  VAR cont: BOOLEAN; i: INTEGER;
-  BEGIN
-    cont := TRUE;
-    IF scale = maxINT THEN
+            END
-      Error(lxERR8, cont)
-    END;
-    i := 1;
-    WHILE cont & (i <= scale) DO
-      res := res * m;
-      Inf(cont, i)
-    END;
-    IF cont & (nez & (res = 0.0D0) OR (res > 0.0D0) & (res < LONG(minREAL)) & (tLex = lxREAL)) THEN
+        END
-      Error(lxERR9, cont)
-    ELSIF cont & (tLex = lxREAL) & (res > LONG(maxREAL)) THEN
-      Error(lxERR7, cont)
-    END
-    RETURN cont
-  END part5;
+    |",":
+        lex.sym := lxCOMMA
-BEGIN
+    |";":
-  IF part1() & part2() & part3() & part4() & part5() THEN END
+        lex.sym := lxSEMI
-  RETURN res
-END StrToFloat;
-PROCEDURE Number;
-VAR nextchr: CHAR;
-BEGIN
-  tLex := lxINT;
+    |"|":
-  WHILE Digit(ch) DO
+        lex.sym := lxBAR
-    PutNext(ch)
-  END;
-  IF ch = "H" THEN
-    tLex := lxHEX
-  ELSIF ch = "X" THEN
-    tLex := lxCHX
-  END;
+    |"(":
-  IF tLex # lxINT THEN
-    PutNext(ch)
+        lex.sym := lxLROUND;
-  ELSE
+        c := text.peak(text);
     WHILE HexDigit(ch) DO
+        IF c = "*" THEN
+            lex.sym := lxCOMMENT;
+            putchar(lex, c);
+            text.nextc(text);
+            comment(text)
+        END
+    |"[":
+        lex.sym := lxLSQUARE
       tLex := lxHEX;
+    |"{":
+        lex.sym := lxLCURLY
+    |"^":
+        lex.sym := lxCARET
+    |"=":
+        lex.sym := lxEQ
-      PutNext(ch)
+    |"#":
+        lex.sym := lxNE
+    |"<":
+        lex.sym := lxLT;
+        c := text.peak(text);
+        IF c = "=" THEN
+            lex.sym := lxLE;
+            putchar(lex, c);
+            text.nextc(text)
-    END;
+        END
+    |">":
+        lex.sym := lxGT;
+        c := text.peak(text);
+        IF c = "=" THEN
+            lex.sym := lxGE;
+            putchar(lex, c);
+            text.nextc(text)
+        END
+    |":":
+        lex.sym := lxCOLON;
+        c := text.peak(text);
+        IF c = "=" THEN
+            lex.sym := lxASSIGN;
+            putchar(lex, c);
+            text.nextc(text)
+        END
+    |")":
+        lex.sym := lxRROUND
+    |"]":
+        lex.sym := lxRSQUARE
+    |"}":
+        lex.sym := lxRCURLY
+    END
+END delimiter;
+PROCEDURE Next* (scanner: SCANNER; VAR lex: LEX);
+VAR
+    c: CHAR;
+    text: TEXTDRV.TEXT;
+BEGIN
-    IF tLex = lxHEX THEN
+    text := scanner.text;
+    REPEAT
+        c := text.peak(text);
       IF ch = "H" THEN
-        PutNext(ch)
-      ELSIF ch = "X" THEN
-        tLex := lxCHX;
+        WHILE S.space(c) DO
-        PutNext(ch)
-      ELSE
-        tLex := lxERR1
-      END
-    ELSIF ch = "." THEN
-      sys.GET(bufpos, nextchr);
-      IF nextchr # "." THEN
-        tLex := lxREAL;
-        PutNext(ch);
-        WHILE Digit(ch) DO
-          PutNext(ch)
-        END;
-        IF (ch = "E") OR (ch = "D") THEN
-          PutNext(ch);
-          IF (ch = "+") OR (ch = "-") THEN
-            PutNext(ch)
-          END;
+            text.nextc(text);
-          IF ~Digit(ch) THEN
-            tLex := lxERR2
-          ELSE
-            WHILE Digit(ch) DO
-              PutNext(ch)
-            END
-          END
-        END
-      END
-    END
-  END;
-  PutChar(0X)
-END Number;
-PROCEDURE Delim(ch: CHAR): INTEGER;
-VAR Res: INTEGER;
-BEGIN
-  CASE ch OF
-  |"+": Res := lxPlus
-  |"-": Res := lxMinus
-  |"*": Res := lxMult
-  |"/": Res := lxSlash
-  |"~": Res := lxNot
-  |"&": Res := lxAnd
-  |",": Res := lxComma
+            c := text.peak(text)
-  |";": Res := lxSemi
+        END;
-  |"|": Res := lxStick
-  |"[": Res := lxLSquare
-  |"{": Res := lxLCurly
-  |"^": Res := lxCaret
-  |"=": Res := lxEQ
-  |"#": Res := lxNE
-  |")": Res := lxRRound
-  |"]": Res := lxRSquare
-  |"}": Res := lxRCurly
-  |">": Res := lxGT
-  |"<": Res := lxLT
-  |":": Res := lxColon
-  ELSE
-  END
-  RETURN Res
-END Delim;
-PROCEDURE Comment;
-VAR c, level: INTEGER; cont: BOOLEAN;
-BEGIN
-  c := 1;
-  level := 1;
-  cont := TRUE;
-  WHILE cont & (level > 0) DO
-    Next;
-    CASE ch OF
-    |"(": c := 2
-    |")": IF c = 3 THEN DEC(level) END; c := 1
-    |"*": IF c = 2 THEN INC(level); c := 1 ELSE c := 3 END
-    |0X : cont := FALSE
-    ELSE
-          c := 1
-    END;
-  END;
-  IF cont THEN
-    Next
-  END
-END Comment;
-PROCEDURE GetLex*;
-BEGIN
-  WHILE Space(ch) DO
-    Next
-  END;
-  coord.col := ccol;
-  coord.line := cline;
+        lex.s[0]     := 0X;
-  count := 0;
+        lex.length   := 0;
-  CASE ch OF
+        lex.sym      := lxUNDEF;
+        lex.pos.line := text.line;
-  |"A".."Z", "a".."z", "_":
+        lex.pos.col  := text.col;
-    Ident;
+        lex.ident    := NIL;
+        lex.over     := FALSE;
-    id := AddNode(Lex);
-    tLex := id.tLex;
+        IF S.letter(c) THEN
-  |"0".."9":
+            ident(text, lex)
-    Number;
+        ELSIF S.digit(c) THEN
+            number(text, lex, scanner.range)
-    CASE tLex OF
+        ELSIF (c = '"') OR (c = "'") THEN
-    |lxINT:  vINT := StrToInt(Lex)
-    |lxHEX:  vINT := StrToInt16(Lex)
-    |lxCHX:  vCHX := StrToChx(Lex)
+            string(text, lex)
-    |lxREAL: vFLT := StrToFloat(Lex)
-    ELSE
+        ELSIF vocabulary.delimiters[ORD(c)] THEN
-    END
+            delimiter(text, lex, scanner.range)
-  |22X:
-    tLex := lxSTRING;
-    Next;
-    WHILE (ch # 22X) & (ch >= 20X) DO
+        ELSIF c = 0X THEN
+            lex.sym := lxEOF;
+            IF text.eof THEN
+                INC(lex.pos.col)
+            END
+        ELSE
+            putchar(lex, c);
+            text.nextc(text);
+            lex.sym := lxERROR04
+        END;
+        IF lex.sym < 0 THEN
+            lex.error := -lex.sym
+        ELSE
+            lex.error := 0
+        END
+    UNTIL lex.sym # lxCOMMENT
+END Next;
+PROCEDURE NewScanner (): SCANNER;
+VAR
+    scan:  SCANNER;
+    citem: C.ITEM;
+BEGIN
+    citem := C.pop(scanners);
+    IF citem = NIL THEN
+        NEW(scan)
+    ELSE
+        scan := citem(SCANNER)
-      PutNext(ch)
+    END
+    RETURN scan
+END NewScanner;
+PROCEDURE open* (name: ARRAY OF CHAR): SCANNER;
+VAR
+    scanner: SCANNER;
+    text:    TEXTDRV.TEXT;
+BEGIN
+    text := TEXTDRV.create();
+    IF text.open(text, name) THEN
+        scanner := NewScanner();
+        scanner.text   := text;
-    END;
+        scanner.range  := FALSE
+    ELSE
+        scanner := NIL;
+        TEXTDRV.destroy(text)
+    END
+    RETURN scanner
+END open;
     IF ch = 22X THEN
-      Next
-    ELSE
-      tLex := lxERR3
-    END;
-    PutChar(0X);
+PROCEDURE close* (VAR scanner: SCANNER);
+BEGIN
-    INC(count);
+    IF scanner # NIL THEN
-    IF count > STRLENGTH THEN
+        IF scanner.text # NIL THEN
-      tLex := lxERR11
+            TEXTDRV.destroy(scanner.text)
-    END
-  |"/":
-    tLex := Delim(ch);
-    PutNext(ch);
-    IF ch = "/" THEN
-      WHILE (ch >= 20X) OR (ch = 9X) DO
-        PutNext(ch)
-      END;
-      GetLex
-    END;
-    PutChar(0X)
-  |">", "<", ":":
-    tLex := Delim(ch);
-    PutNext(ch);
-    IF ch = "=" THEN
-      CASE tLex OF
-      |lxLT:    tLex := lxLE
-      |lxGT:    tLex := lxGE
-      |lxColon: tLex := lxAssign
-      ELSE
-      END;
-      PutNext(ch)
+        END;
-    END;
-    PutChar(0X)
-  |".":
-    tLex := lxDot;
+        C.push(scanners, scanner);
-    PutNext(ch);
-    IF ch = "." THEN
-      tLex := lxDbl;
-      PutNext(ch)
-    END;
+        scanner := NIL
-    PutChar(0X)
-  |"(":
-    tLex := lxLRound;
+    END
-    PutNext(ch);
+END close;
-    IF ch = "*" THEN
-      Comment;
-      GetLex
-    END;
+PROCEDURE init;
-    PutChar(0X)
+VAR
-  |"+", "-", "*", "~", "&", ",", ";", "|",
-   "[", "{", "^", "=", "#", ")", "]", "}":
+    i: INTEGER;
-    tLex := Delim(ch);
-    PutChar(ch);
+    delim: ARRAY 23 OF CHAR;
-    PutNext(0X)
-  |0X:
-    tLex := lxEOF;
+    PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD);
-    PutChar(0X)
+    BEGIN
-  ELSE
+        vocabulary.KW[i] := kw;
-    tLex := lxERR4
+        INC(i)
-  END
+    END enterkw;
-END GetLex;
+BEGIN
-PROCEDURE AddNodeKey(Name: UTILS.STRING; key: INTEGER);
+    scanners := C.create();
-VAR node: NODE;
-BEGIN
+    FOR i := 0 TO 255 DO
-  node := AddNode(Name);
+        vocabulary.delimiters[i] := FALSE
-  node.tLex := key
+    END;
-END AddNodeKey;
+    delim := "+-*/~&.,;|([{^=#<>:)]}";
-PROCEDURE Init;
-VAR i: INTEGER; node: NODE;
+    FOR i := 0 TO LEN(delim) - 2 DO
-BEGIN
+        vocabulary.delimiters[ORD(delim[i])] := TRUE
-  FOR i := 0 TO LEN(Nodes) - 1 DO
+    END;
-    NEW(node);
-    UTILS.MemErr(node = NIL);
+    i := 0;
-    sys.PUT(sys.ADR(node.Name), i);
+    enterkw(i, "ARRAY");
-    node.Left := NIL;
+    enterkw(i, "BEGIN");
+    enterkw(i, "BY");
-    node.Right := NIL;
+    enterkw(i, "CASE");
-    node.tLex := lxIDENT;
+    enterkw(i, "CONST");
-    Nodes[i] := node
+    enterkw(i, "DIV");
-  END;
-  _START := AddNode("lib_init");
+    enterkw(i, "DO");
-  _version := AddNode("version");
-  AddNodeKey("MOD", lxMOD);
+    enterkw(i, "ELSE");
-  AddNodeKey("ELSE", lxELSE);
-  AddNodeKey("RETURN", lxRETURN);
+    enterkw(i, "ELSIF");
+    enterkw(i, "END");
-  AddNodeKey("CASE", lxCASE);
+    enterkw(i, "FALSE");
-  AddNodeKey("IF", lxIF);
+    enterkw(i, "FOR");
-  AddNodeKey("POINTER", lxPOINTER);
+    enterkw(i, "IF");
-  AddNodeKey("TYPE", lxTYPE);
+    enterkw(i, "IMPORT");

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/SCAN.ob07 – Rev 6613 → 7597