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

 (*
     BSD 2-Clause License
-    Copyright (c) 2018-2020, Anton Krotov
+    Copyright (c) 2018-2021, Anton Krotov
     All rights reserved.
 *)
 MODULE SCAN;
+IMPORT TXT := TEXTDRV, ARITH, S := STRINGS, ERRORS, LISTS;
 IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, ERRORS, LISTS;
 CONST
     lxREPEAT*  = 75;  lxRETURN*  = 76;  lxTHEN*      = 77;  lxTO*      = 78;
     lxTRUE*    = 79;  lxTYPE*    = 80;  lxUNTIL*     = 81;  lxVAR*     = 82;
     lxWHILE*   = 83;
     lxERROR01* =  -1;  lxERROR02* =  -2;  lxERROR03* =  -3;  lxERROR04* =  -4;
-    lxERROR05* =  -5;  lxERROR06* =  -6;  lxERROR07* =  -7;  lxERROR08* =  -8;
+    lxERROR05* =  -5;  (*lxERROR06* =  -6;*)  lxERROR07* =  -7;  lxERROR08* =  -8;
     lxERROR09* =  -9;  lxERROR10* = -10;  lxERROR11* = -11;  lxERROR12* = -12;
     lxERROR13* = -13;
 TYPE
-TYPE
     TEXTSTR* = ARRAY TEXTLEN OF CHAR;
-    LEXSTR* = ARRAY LEXLEN OF CHAR;
+    IDSTR* = ARRAY IDLEN OF CHAR;
     DEF = POINTER TO RECORD (LISTS.ITEM)
+        ident: IDSTR
+    END;
+    STRING* = POINTER TO RECORD (LISTS.ITEM)
-        ident: LEXSTR
+        s*: TEXTSTR;
         offset*, offsetW*, hash: INTEGER
     END;
-    LEX* = RECORD
-        s*:         LEXSTR;
+    LEX* = RECORD
         length*:    INTEGER;
         sym*:       INTEGER;
         pos*:       POSITION;
         ident*:     IDENT;
-        string*:    IDENT;
-        value*:     ARITH.VALUE;
-        error*:     INTEGER;
+        string*:    STRING;
         value*:     ARITH.VALUE;
+        error*:     INTEGER
-        over:       BOOLEAN
     END;
-    SCANNER* = TXT.TEXT;
+    SCANNER* = TXT.TEXT;
-VAR
-    idents: AVL.NODE;
+    KEYWORD = ARRAY 10 OF CHAR;
+VAR
+    delimiters: ARRAY 256 OF BOOLEAN;
+    upto, LowerCase, _if: BOOLEAN;
+    strings, def: LISTS.LIST;
     delimiters: ARRAY 256 OF BOOLEAN;
+    KW: ARRAY 33 OF RECORD upper, lower: KEYWORD; uhash, lhash: INTEGER END;
-    NewIdent: IDENT;
-    upto, LowerCase, _if: BOOLEAN;
+PROCEDURE enterKW (s: KEYWORD; idx: INTEGER);
+BEGIN
+    KW[idx].lower := s;
-    def: LISTS.LIST;
+    KW[idx].upper := s;
+    S.UpCase(KW[idx].upper);
-PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
+    KW[idx].uhash := S.HashStr(KW[idx].upper);
-    RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)
+    KW[idx].lhash := S.HashStr(KW[idx].lower);
-END nodecmp;
+END enterKW;
-PROCEDURE enterid* (s: LEXSTR): IDENT;
+PROCEDURE checkKW (ident: IDENT): INTEGER;
+VAR
+    i, res: INTEGER;
+BEGIN
+    res := lxIDENT;
-VAR
-    newnode: BOOLEAN;
+    i := 0;
-    node:    AVL.NODE;
+    WHILE i < LEN(KW) DO
+        IF (KW[i].uhash = ident.hash) & (KW[i].upper = ident.s)
+        OR LowerCase & (KW[i].lhash = ident.hash) & (KW[i].lower = ident.s) THEN
+            res := i + lxKW;
+            i := LEN(KW)
-BEGIN
+        END;
-    NewIdent.s := s;
+        INC(i)
-    idents := AVL.insert(idents, NewIdent, nodecmp, newnode, node);
+    END
-    IF newnode THEN
+    RETURN res
+END checkKW;
+PROCEDURE enterStr* (s: TEXTSTR): STRING;
+VAR
+    str, res: STRING;
+    hash: INTEGER;
+BEGIN
+    hash := S.HashStr(s);
+    str := strings.first(STRING);
-        NEW(NewIdent);
+    res := NIL;
-        NewIdent.offset  := -1;
+    WHILE str # NIL DO
-        NewIdent.offsetW := -1;
+        IF (str.hash = hash) & (str.s = s) THEN
-        NewIdent.key := 0
+            res := str;
-    END
+            str := NIL
         ELSE
+            str := str.next(STRING)
+        END
+    END;
+    IF res = NIL THEN
+        NEW(res);
+        res.s := s;
+        res.offset  := -1;
-    RETURN node.data(IDENT)
+        res.offsetW := -1;
-END enterid;
+        res.hash := hash;
         LISTS.push(strings, res)
+    END
-PROCEDURE putchar (VAR lex: LEX; c: CHAR);
+    RETURN res
-BEGIN
+END enterStr;
-    IF lex.length < LEXLEN - 1 THEN
+PROCEDURE nextc (text: TXT.TEXT): CHAR;
-        lex.s[lex.length] := c;
+BEGIN
-        INC(lex.length);
+    TXT.next(text)
-        lex.s[lex.length] := 0X
+    RETURN text.peak
-    ELSE
+END nextc;
-        lex.over := TRUE
-    END
-END putchar;
+PROCEDURE setIdent* (VAR ident: IDENT; s: IDSTR);
+BEGIN
+    ident.s := s;
-PROCEDURE nextc (text: TXT.TEXT): CHAR;
+    ident.hash := S.HashStr(s)
-BEGIN
+END setIdent;
     TXT.next(text)
     RETURN text.peak
-END nextc;
 PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
 VAR
+    c: CHAR;
+    i: INTEGER;
-PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
+BEGIN
-VAR
+    c := text.peak;
-    c: CHAR;
+    ASSERT(S.letter(c));
+    i := 0;
+    WHILE (i < IDLEN - 1) & (S.letter(c) OR S.digit(c)) DO
+        lex.ident.s[i] := c;
+        INC(i);
+        c := nextc(text)
+    END;
+    lex.ident.s[i] := 0X;
+    lex.ident.hash := S.HashStr(lex.ident.s);
+    lex.sym := checkKW(lex.ident);
-BEGIN
+    IF S.letter(c) OR S.digit(c) THEN
-    c := text.peak;
+        ERRORS.WarningMsg(lex.pos.line, lex.pos.col, 2);
-    ASSERT(S.letter(c));
+        WHILE S.letter(c) OR S.digit(c) DO
+            c := nextc(text)
+        END
     END
-    WHILE S.letter(c) OR S.digit(c) DO
+END ident;
         putchar(lex, c);
         c := nextc(text)
-    END;
+PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
 TYPE
-    IF lex.over THEN
+    NUMSTR = ARRAY NUMLEN OF CHAR;
-        lex.sym := lxERROR06
+VAR
-    ELSE
+    c: CHAR;
-        lex.ident := enterid(lex.s);
+    hex: BOOLEAN;
-        IF lex.ident.key # 0 THEN
+    error, sym, i: INTEGER;
-            lex.sym := lex.ident.key
+    num: NUMSTR;
-        ELSE
-            lex.sym := lxIDENT
-        END
+    PROCEDURE push (VAR num: NUMSTR; VAR i: INTEGER; c: CHAR);
-    END
+    BEGIN
+        IF i < NUMLEN - 1 THEN
-END ident;
+            num[i] := c;
             INC(i)
         END
-PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
+    END push;
         ELSE
             c := nextc(text);
             IF c # "." THEN
-                putchar(lex, ".");
+                push(num, i, ".");
                 sym := lxFLOAT
             ELSE
                 sym := lxINTEGER;
                 text.peak := 7FX;
                 upto := TRUE
             END;
             WHILE S.digit(c) DO
-                putchar(lex, c);
+                push(num, i, c);
                 c := nextc(text)
             END;
-            IF c = "E" THEN
+            IF (c = "E") OR LowerCase & (c = "e") THEN
-                putchar(lex, c);
+                push(num, i, c);
                 c := nextc(text);
                 IF (c = "+") OR (c = "-") THEN
-                    putchar(lex, c);
+                    push(num, i, c);
                     c := nextc(text)
                 END;
                 IF S.digit(c) THEN
                     WHILE S.digit(c) DO
     ELSIF hex THEN
         sym := lxERROR01
     END;
-    IF lex.over & (sym >= 0) THEN
+    IF (i = NUMLEN - 1) & (sym >= 0) THEN
+        sym := lxERROR07
+    END;
         sym := lxERROR07
-    END;
+    num[i] := 0X;
     IF sym = lxINTEGER THEN
-        ARITH.iconv(lex.s, lex.value, error)
+        ARITH.iconv(num, lex.value, error)
     ELSIF (sym = lxHEX) OR (sym = lxCHAR) THEN
-        ARITH.hconv(lex.s, lex.value, error)
+        ARITH.hconv(num, lex.value, error)
     ELSIF sym = lxFLOAT THEN
-        ARITH.fconv(lex.s, lex.value, error)
+        ARITH.fconv(num, lex.value, error)
     END;
 PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
 VAR
+    c: CHAR;
-    c: CHAR;
+    i: INTEGER;
-    n: INTEGER;
+    str: TEXTSTR;
 BEGIN
     c  := nextc(text);
     n  := 0;
+    i := 0;
+    WHILE (i < LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
+        str[i] := c;
+        c := nextc(text);
+        INC(i)
+    END;
-    WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
+    str[i] := 0X;
         putchar(lex, c);
-        c := nextc(text);
+    IF (i = LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof THEN
-        INC(n)
-    END;
-    IF c = quot THEN
+        lex.sym := lxERROR05
-        TXT.next(text);
+    END;
         IF lex.over THEN
-            lex.sym := lxERROR05
+    IF c = quot THEN
-        ELSE
+        TXT.next(text);
-            IF n # 1 THEN
+        IF i # 1 THEN
-                lex.sym := lxSTRING
+            lex.sym := lxSTRING
-            ELSE
-                lex.sym := lxCHAR;
+        ELSE
-                ARITH.setChar(lex.value, ORD(lex.s[0]))
+            lex.sym := lxCHAR;
-            END
+            ARITH.setChar(lex.value, ORD(str[0]))
         END
-    ELSE
+    ELSIF lex.sym # lxERROR05 THEN
         lex.sym := lxERROR03
     END;
     UNTIL (depth = 0) OR text.eof
 END comment;
+PROCEDURE delimiter (text: TXT.TEXT; c: CHAR): INTEGER;
-PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
+VAR
-VAR
+    sym: INTEGER;
-    sym: INTEGER;
+    c0:  CHAR;
 BEGIN
-    putchar(lex, c);
+    c0 := c;
     c := nextc(text);
     |".":
         sym := lxPOINT;
         IF c = "." THEN
-            sym := lxRANGE;
-            putchar(lex, c);
+            sym := lxRANGE;
             TXT.next(text)
         END
     |"<":
         sym := lxLT;
         IF c = "=" THEN
-            sym := lxLE;
-            putchar(lex, c);
+            sym := lxLE;
             TXT.next(text)
         END
     |">":
         sym := lxGT;
         IF c = "=" THEN
-            sym := lxGE;
+        IF c = "=" THEN
-            putchar(lex, c);
+            sym := lxGE;
             TXT.next(text)
         END
-    |":":
-        sym := lxCOLON;
+    |":":
         sym := lxCOLON;
         IF c = "=" THEN
-            sym := lxASSIGN;
+        IF c = "=" THEN
         sym := lxRSQUARE
     |"}":
         sym := lxRCURLY
-    END;
     END
     lex.sym := sym
     RETURN sym
         Next(text, lex);
         check(lex.sym = lxIDENT, text, lex, 22);
         REPEAT
-            IF IsDef(lex.s) THEN
+            IF IsDef(lex.ident.s) THEN
                 skip := FALSE
             END;
         WHILE S.space(c) DO
             c := nextc(text)
-        END;
-        lex.s[0]     := 0X;
+        END;
         lex.length   := 0;
-        lex.pos.line := text.line;
-        lex.pos.col  := text.col;
-        lex.ident    := NIL;
+        lex.pos.line := text.line;
-        lex.over     := FALSE;
+        lex.pos.col  := text.col;
         IF S.letter(c) THEN
             ident(text, lex)
         ELSIF S.digit(c) THEN
             number(text, lex)
         ELSIF (c = '"') OR (c = "'") THEN
             string(text, lex, c)
         ELSIF delimiters[ORD(c)] THEN
-            delimiter(text, lex, c)
+            lex.sym := delimiter(text, c)
         ELSIF c = "$" THEN
             IF S.letter(nextc(text)) THEN
                 INC(lex.pos.col)
             END
         ELSIF (c = 7FX) & upto THEN
             upto := FALSE;
             lex.sym := lxRANGE;
-            putchar(lex, ".");
-            putchar(lex, ".");
             DEC(lex.pos.col);
             TXT.next(text)
         ELSE
-            putchar(lex, c);
             TXT.next(text);
             lex.sym := lxERROR04
         END;
 PROCEDURE init* (lower: BOOLEAN);
 VAR
     i: INTEGER;
     delim: ARRAY 23 OF CHAR;
-    PROCEDURE enterkw (key: INTEGER; kw: LEXSTR);
-    VAR
-        id: IDENT;
-        upper: LEXSTR;
-    BEGIN
-        IF LowerCase THEN
-            id := enterid(kw);
-            id.key := key
-        END;
-        upper := kw;
-        S.UpCase(upper);
-        id := enterid(upper);
-        id.key := key
-    END enterkw;
 BEGIN
     upto := FALSE;
     LowerCase := lower;
     FOR i := 0 TO LEN(delim) - 2 DO
         delimiters[ORD(delim[i])] := TRUE
-    END;
-    NEW(NewIdent);
-    NewIdent.s       := "";
-    NewIdent.offset  := -1;
-    NewIdent.offsetW := -1;
-    NewIdent.key     := 0;
-    idents := NIL;
+    END;
-    enterkw(lxARRAY, "array");
+    enterKW("array",      0);
-    enterkw(lxBEGIN, "begin");
+    enterKW("begin",      1);
-    enterkw(lxBY, "by");
+    enterKW("by",         2);
-    enterkw(lxCASE, "case");
+    enterKW("case",       3);
-    enterkw(lxCONST, "const");
+    enterKW("const",      4);
-    enterkw(lxDIV, "div");
+    enterKW("div",        5);
-    enterkw(lxDO, "do");
+    enterKW("do",         6);
-    enterkw(lxELSE, "else");
+    enterKW("else",       7);
-    enterkw(lxELSIF, "elsif");
+    enterKW("elsif",      8);
-    enterkw(lxEND, "end");
+    enterKW("end",        9);
-    enterkw(lxFALSE, "false");
+    enterKW("false",     10);
-    enterkw(lxFOR, "for");
+    enterKW("for",       11);
-    enterkw(lxIF, "if");
+    enterKW("if",        12);
-    enterkw(lxIMPORT, "import");
+    enterKW("import",    13);
-    enterkw(lxIN, "in");
+    enterKW("in",        14);
-    enterkw(lxIS, "is");
+    enterKW("is",        15);
-    enterkw(lxMOD, "mod");
+    enterKW("mod",       16);
-    enterkw(lxMODULE, "module");
+    enterKW("module",    17);
-    enterkw(lxNIL, "nil");
+    enterKW("nil",       18);
-    enterkw(lxOF, "of");
+    enterKW("of",        19);
-    enterkw(lxOR, "or");
+    enterKW("or",        20);
-    enterkw(lxPOINTER, "pointer");
+    enterKW("pointer",   21);
-    enterkw(lxPROCEDURE, "procedure");
+    enterKW("procedure", 22);
-    enterkw(lxRECORD, "record");
+    enterKW("record",    23);
-    enterkw(lxREPEAT, "repeat");
+    enterKW("repeat",    24);
-    enterkw(lxRETURN, "return");
+    enterKW("return",    25);
-    enterkw(lxTHEN, "then");
+    enterKW("then",      26);
-    enterkw(lxTO, "to");
+    enterKW("to",        27);
-    enterkw(lxTRUE, "true");
+    enterKW("true",      28);
-    enterkw(lxTYPE, "type");
+    enterKW("type",      29);
-    enterkw(lxUNTIL, "until");
+    enterKW("until",     30);
-    enterkw(lxVAR, "var");
-    enterkw(lxWHILE, "while")
+    enterKW("var",       31);
     enterKW("while",     32)
 END init;
     LISTS.push(def, item)
 END NewDef;
+BEGIN
-BEGIN
+    def := LISTS.create(NIL);
-    def := LISTS.create(NIL)
+    strings := LISTS.create(NIL)

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/source/SCAN.ob07 – Rev 8097 → 8859