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


(*
    BSD 2-Clause License
 
    Copyright (c) 2018-2019, Anton Krotov
    All rights reserved.
*)
 
MODULE SCAN;
 
IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS;
 
 
CONST
 
    LEXLEN = 1024;
 
    lxUNDEF*   =  0;  lxIDENT*   =  1;  lxINTEGER*   =  2;  lxHEX*     =  3;
    lxCHAR*    =  4;  lxFLOAT*   =  5;  lxSTRING*    =  6;  lxCOMMENT* =  7;
    lxEOF*     =  8;
 
    lxPLUS*    = 21;  lxMINUS*   = 22;  lxMUL*       = 23;  lxSLASH*   = 24;
    lxNOT*     = 25;  lxAND*     = 26;  lxPOINT*     = 27;  lxCOMMA*   = 28;
    lxSEMI*    = 29;  lxBAR*     = 30;  lxLROUND*    = 31;  lxLSQUARE* = 32;
    lxLCURLY*  = 33;  lxCARET*   = 34;  lxEQ*        = 35;  lxNE*      = 36;
    lxLT*      = 37;  lxGT*      = 38;  lxCOLON*     = 39;  lxRROUND*  = 40;
    lxRSQUARE* = 41;  lxRCURLY*  = 42;  lxLE*        = 43;  lxGE*      = 44;
    lxASSIGN*  = 45;  lxRANGE*   = 46;
 
    lxKW       = 51;
 
    lxARRAY*   = 51;  lxBEGIN*   = 52;  lxBY*        = 53;  lxCASE*    = 54;
    lxCONST*   = 55;  lxDIV*     = 56;  lxDO*        = 57;  lxELSE*    = 58;
    lxELSIF*   = 59;  lxEND*     = 60;  lxFALSE*     = 61;  lxFOR*     = 62;
    lxIF*      = 63;  lxIMPORT*  = 64;  lxIN*        = 65;  lxIS*      = 66;
    lxMOD*     = 67;  lxMODULE*  = 68;  lxNIL*       = 69;  lxOF*      = 70;
    lxOR*      = 71;  lxPOINTER* = 72;  lxPROCEDURE* = 73;  lxRECORD*  = 74;
    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;
    lxERROR09* =  -9;  lxERROR10* = -10;  lxERROR11* = -11;  lxERROR12* = -12;
    lxERROR13* = -13;
 
 
TYPE
 
    LEXSTR* = ARRAY LEXLEN OF CHAR;
 
    IDENT* = POINTER TO RECORD (AVL.DATA)
 
        s*: LEXSTR;
        offset*, offsetW*: INTEGER;
        key: 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* = TXT.TEXT;
 
 
 
 
VAR
 
 
    idents: AVL.NODE;
 
 
 
    delimiters: ARRAY 256 OF BOOLEAN;
 
    NewIdent: IDENT;
 
    upto: BOOLEAN;
 
 
PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
    RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)
END nodecmp;
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
PROCEDURE enterid* (s: LEXSTR): IDENT;
VAR
    newnode: BOOLEAN;
    node:    AVL.NODE;
 
BEGIN
    NewIdent.s := s;
    idents := AVL.insert(idents, NewIdent, nodecmp, newnode, node);
 
    IF newnode THEN
        NEW(NewIdent);
        NewIdent.offset  := -1;
        NewIdent.offsetW := -1;
        NewIdent.key := 0
    END
 
    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
    END
END putchar;
 
 
PROCEDURE nextc (text: TXT.TEXT): CHAR;
BEGIN
    TXT.next(text)
    RETURN text.peak
END nextc;
 
 
PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
VAR
    c: CHAR;
 
BEGIN
    c := text.peak;
    ASSERT(S.letter(c));
 
    WHILE S.letter(c) OR S.digit(c) DO
        putchar(lex, c);
        c := nextc(text)
    END;
 
    IF lex.over THEN
        lex.sym := lxERROR06
    ELSE
        lex.ident := enterid(lex.s);
        IF lex.ident.key # 0 THEN
            lex.sym := lex.ident.key
        ELSE
 
            lex.sym := lxIDENT
        END
    END
 
END ident;
 
 
PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
VAR
    c: CHAR;
    hex: BOOLEAN;
    error: INTEGER;
 
BEGIN
    c := text.peak;
    ASSERT(S.digit(c));
 
    error := 0;
 
    lex.sym := lxINTEGER;
    hex := FALSE;
 
    WHILE S.digit(c) DO
        putchar(lex, c);
        c := nextc(text)
    END;
 
    WHILE S.hexdigit(c) DO
        putchar(lex, c);
        c := nextc(text);
        hex := TRUE
    END;
 
    IF c = "H" THEN
        putchar(lex, c);
        TXT.next(text);
        lex.sym := lxHEX
 
    ELSIF c = "X" THEN
        putchar(lex, c);
        TXT.next(text);
        lex.sym := lxCHAR
 
    ELSIF c = "." THEN
 
        IF hex THEN
            lex.sym := lxERROR01
        ELSE
 
            c := nextc(text);
 
            IF c # "." THEN
                putchar(lex, ".");
                lex.sym := lxFLOAT
            ELSE
                lex.sym := lxINTEGER;
                text.peak := 7FX;
                upto := TRUE
            END;
 
            WHILE S.digit(c) DO
                putchar(lex, c);
                c := nextc(text)
            END;
 
            IF c = "E" THEN
 
                putchar(lex, c);
                c := nextc(text);
                IF (c = "+") OR (c = "-") THEN
                    putchar(lex, c);
                    c := nextc(text)
                END;
 
                IF S.digit(c) THEN
                    WHILE S.digit(c) DO
                        putchar(lex, c);
                        c := nextc(text)
                    END
                ELSE
                    lex.sym := lxERROR02
                END
 
            END
 
        END
 
    ELSIF hex THEN
        lex.sym := lxERROR01
 
    END;
 
    IF lex.over & (lex.sym >= 0) THEN
        lex.sym := lxERROR07
    END;
 
    IF lex.sym = lxINTEGER THEN
        ARITH.iconv(lex.s, lex.value, error)
    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;
 
    CASE error OF
    |0:
    |1: lex.sym := lxERROR08
    |2: lex.sym := lxERROR09
    |3: lex.sym := lxERROR10
    |4: lex.sym := lxERROR11
    |5: lex.sym := lxERROR12
    END
 
END number;
 
 
PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
VAR
    c: CHAR;
    n: INTEGER;
 
BEGIN
    c  := nextc(text);
    n  := 0;
 
    WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
        putchar(lex, c);
        c := nextc(text);
        INC(n)
    END;
 
    IF c = quot THEN
        TXT.next(text);
        IF lex.over THEN
            lex.sym := lxERROR05
        ELSE
            IF n # 1 THEN
                lex.sym := lxSTRING
            ELSE
                lex.sym := lxCHAR;
                ARITH.setChar(lex.value, ORD(lex.s[0]))
            END
        END
    ELSE
        lex.sym := lxERROR03
    END;
 
    IF lex.sym = lxSTRING THEN
        lex.string := enterid(lex.s);
        lex.value.typ := ARITH.tSTRING;
        lex.value.string := lex.string
    END
 
END string;
 
 
PROCEDURE comment (text: TXT.TEXT);
VAR
    c: CHAR;
    cond, depth: INTEGER;
 
BEGIN
    cond  := 0;
    depth := 1;
 
    REPEAT
 
        c := text.peak;
        TXT.next(text);
 
        IF c = "*" THEN
            IF cond = 1 THEN
                cond := 0;
                INC(depth)
            ELSE
               cond := 2
            END
        ELSIF c = ")" THEN
            IF cond = 2 THEN
                DEC(depth)
            END;
            cond := 0
        ELSIF c = "(" THEN
            cond := 1
        ELSE
            cond := 0
        END
 
    UNTIL (depth = 0) OR text.eof
 
END comment;
 
 
PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
BEGIN
    putchar(lex, c);
    c := nextc(text);
 
    CASE lex.s[0] OF
    |"+":
        lex.sym := lxPLUS
 
    |"-":
        lex.sym := lxMINUS
 
    |"*":
        lex.sym := lxMUL
 
    |"/":
        lex.sym := lxSLASH;
 
        IF c = "/" THEN
            lex.sym := lxCOMMENT;
            REPEAT
                TXT.next(text)
            UNTIL text.eol OR text.eof
        END
 
    |"~":
        lex.sym := lxNOT
 
    |"&":
        lex.sym := lxAND
 
    |".":
        lex.sym := lxPOINT;
 
        IF c = "." THEN
            lex.sym := lxRANGE;
            putchar(lex, c);
            TXT.next(text)
        END
 
    |",":
        lex.sym := lxCOMMA
 
    |";":
        lex.sym := lxSEMI
 
    |"|":
        lex.sym := lxBAR
 
    |"(":
        lex.sym := lxLROUND;
 
        IF c = "*" THEN
            lex.sym := lxCOMMENT;
            TXT.next(text);
            comment(text)
        END
 
    |"[":
        lex.sym := lxLSQUARE
 
    |"{":
        lex.sym := lxLCURLY
 
    |"^":
        lex.sym := lxCARET
 
    |"=":
        lex.sym := lxEQ
 
    |"#":
        lex.sym := lxNE
 
    |"<":
        lex.sym := lxLT;
 
        IF c = "=" THEN
            lex.sym := lxLE;
            putchar(lex, c);
            TXT.next(text)
        END
 
    |">":
        lex.sym := lxGT;
 
        IF c = "=" THEN
            lex.sym := lxGE;
            putchar(lex, c);
            TXT.next(text)
        END
 
    |":":
        lex.sym := lxCOLON;
 
        IF c = "=" THEN
            lex.sym := lxASSIGN;
            putchar(lex, c);
            TXT.next(text)
        END
 
    |")":
        lex.sym := lxRROUND
 
    |"]":
        lex.sym := lxRSQUARE
 
    |"}":
        lex.sym := lxRCURLY
 
    END
 
END delimiter;
 
 
PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
VAR
    c: CHAR;
 
BEGIN
 
    REPEAT
        c := text.peak;
 
        WHILE S.space(c) DO
            c := nextc(text)
        END;
 
        lex.s[0]     := 0X;
        lex.length   := 0;
        lex.pos.line := text.line;
        lex.pos.col  := text.col;
        lex.ident    := NIL;
        lex.over     := FALSE;
 
        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)
        ELSIF c = 0X THEN
            lex.sym := lxEOF;
            IF text.eof 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;
 
        IF lex.sym < 0 THEN
            lex.error := -lex.sym
        ELSE
            lex.error := 0
        END
 
    UNTIL lex.sym # lxCOMMENT
 
END Next;
 
 
PROCEDURE open* (name: ARRAY OF CHAR): SCANNER;
    RETURN TXT.open(name)
END open;
 
 
PROCEDURE close* (VAR scanner: SCANNER);
BEGIN
    TXT.close(scanner)
END close;
 
 
PROCEDURE init;
VAR
    i: INTEGER;
    delim: ARRAY 23 OF CHAR;
 
 
    PROCEDURE enterkw (key: INTEGER; kw: LEXSTR);
    VAR
        id: IDENT;
 
    BEGIN
        id := enterid(kw);
        id.key := key
    END enterkw;
 
 
BEGIN
    upto := FALSE;
 
    FOR i := 0 TO 255 DO
        delimiters[i] := FALSE
    END;
 
    delim := "+-*/~&.,;|([{^=#<>:)]}";
 
    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;
 
    enterkw(lxARRAY, "ARRAY");
    enterkw(lxBEGIN, "BEGIN");
    enterkw(lxBY, "BY");
    enterkw(lxCASE, "CASE");
    enterkw(lxCONST, "CONST");
    enterkw(lxDIV, "DIV");
    enterkw(lxDO, "DO");
    enterkw(lxELSE, "ELSE");
    enterkw(lxELSIF, "ELSIF");
    enterkw(lxEND, "END");
    enterkw(lxFALSE, "FALSE");
    enterkw(lxFOR, "FOR");
    enterkw(lxIF, "IF");
    enterkw(lxIMPORT, "IMPORT");
    enterkw(lxIN, "IN");
    enterkw(lxIS, "IS");
    enterkw(lxMOD, "MOD");
    enterkw(lxMODULE, "MODULE");
    enterkw(lxNIL, "NIL");
    enterkw(lxOF, "OF");
    enterkw(lxOR, "OR");
    enterkw(lxPOINTER, "POINTER");
    enterkw(lxPROCEDURE, "PROCEDURE");
    enterkw(lxRECORD, "RECORD");
    enterkw(lxREPEAT, "REPEAT");
    enterkw(lxRETURN, "RETURN");
    enterkw(lxTHEN, "THEN");
    enterkw(lxTO, "TO");
    enterkw(lxTRUE, "TRUE");
    enterkw(lxTYPE, "TYPE");
    enterkw(lxUNTIL, "UNTIL");
    enterkw(lxVAR, "VAR");
    enterkw(lxWHILE, "WHILE")
 
 
 
 
 
 
END init;
 
 
BEGIN
    init
END SCAN.
>

Rev 7693	Rev 7696
1	(*	1	(*
2	BSD 2-Clause License	2	BSD 2-Clause License
3		3
4	Copyright (c) 2018, 2019, Anton Krotov	4	Copyright (c) 2018-2019, Anton Krotov
5	All rights reserved.	5	All rights reserved.
6	*)	6	*)
7		7
8	MODULE SCAN;	8	MODULE SCAN;
9		9
10	IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS;	10	IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS;
11		11
12		12
13	CONST	13	CONST
14		14
15	LEXLEN = 1024;	15	LEXLEN = 1024;
16		16
17	lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3;	17	lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3;
18	lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7;	18	lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7;
19	lxEOF* = 8;	19	lxEOF* = 8;
20		20
21	lxPLUS* = 21; lxMINUS* = 22; lxMUL* = 23; lxSLASH* = 24;	21	lxPLUS* = 21; lxMINUS* = 22; lxMUL* = 23; lxSLASH* = 24;
22	lxNOT* = 25; lxAND* = 26; lxPOINT* = 27; lxCOMMA* = 28;	22	lxNOT* = 25; lxAND* = 26; lxPOINT* = 27; lxCOMMA* = 28;
23	lxSEMI* = 29; lxBAR* = 30; lxLROUND* = 31; lxLSQUARE* = 32;	23	lxSEMI* = 29; lxBAR* = 30; lxLROUND* = 31; lxLSQUARE* = 32;
24	lxLCURLY* = 33; lxCARET* = 34; lxEQ* = 35; lxNE* = 36;	24	lxLCURLY* = 33; lxCARET* = 34; lxEQ* = 35; lxNE* = 36;
25	lxLT* = 37; lxGT* = 38; lxCOLON* = 39; lxRROUND* = 40;	25	lxLT* = 37; lxGT* = 38; lxCOLON* = 39; lxRROUND* = 40;
26	lxRSQUARE* = 41; lxRCURLY* = 42; lxLE* = 43; lxGE* = 44;	26	lxRSQUARE* = 41; lxRCURLY* = 42; lxLE* = 43; lxGE* = 44;
27	lxASSIGN* = 45; lxRANGE* = 46;	27	lxASSIGN* = 45; lxRANGE* = 46;
28		28
29	lxKW = 51;	29	lxKW = 51;
30		30
31	lxARRAY* = 51; lxBEGIN* = 52; lxBY* = 53; lxCASE* = 54;	31	lxARRAY* = 51; lxBEGIN* = 52; lxBY* = 53; lxCASE* = 54;
32	lxCONST* = 55; lxDIV* = 56; lxDO* = 57; lxELSE* = 58;	32	lxCONST* = 55; lxDIV* = 56; lxDO* = 57; lxELSE* = 58;
33	lxELSIF* = 59; lxEND* = 60; lxFALSE* = 61; lxFOR* = 62;	33	lxELSIF* = 59; lxEND* = 60; lxFALSE* = 61; lxFOR* = 62;
34	lxIF* = 63; lxIMPORT* = 64; lxIN* = 65; lxIS* = 66;	34	lxIF* = 63; lxIMPORT* = 64; lxIN* = 65; lxIS* = 66;
35	lxMOD* = 67; lxMODULE* = 68; lxNIL* = 69; lxOF* = 70;	35	lxMOD* = 67; lxMODULE* = 68; lxNIL* = 69; lxOF* = 70;
36	lxOR* = 71; lxPOINTER* = 72; lxPROCEDURE* = 73; lxRECORD* = 74;	36	lxOR* = 71; lxPOINTER* = 72; lxPROCEDURE* = 73; lxRECORD* = 74;
37	lxREPEAT* = 75; lxRETURN* = 76; lxTHEN* = 77; lxTO* = 78;	37	lxREPEAT* = 75; lxRETURN* = 76; lxTHEN* = 77; lxTO* = 78;
38	lxTRUE* = 79; lxTYPE* = 80; lxUNTIL* = 81; lxVAR* = 82;	38	lxTRUE* = 79; lxTYPE* = 80; lxUNTIL* = 81; lxVAR* = 82;
39	lxWHILE* = 83;	39	lxWHILE* = 83;
40		40
41	lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4;	41	lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4;
42	lxERROR05* = -5; lxERROR06* = -6; lxERROR07* = -7; lxERROR08* = -8;	42	lxERROR05* = -5; lxERROR06* = -6; lxERROR07* = -7; lxERROR08* = -8;
43	lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12;	43	lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12;
44	lxERROR13* = -13;	44	lxERROR13* = -13;
45		45
46		46
47	TYPE	47	TYPE
48		48
49	LEXSTR* = ARRAY LEXLEN OF CHAR;	49	LEXSTR* = ARRAY LEXLEN OF CHAR;
50		50
51	IDENT* = POINTER TO RECORD (AVL.DATA)	51	IDENT* = POINTER TO RECORD (AVL.DATA)
52		52
53	s*: LEXSTR;	53	s*: LEXSTR;
54	offset, offsetW: INTEGER	54	offset, offsetW: INTEGER;
-		55	key: INTEGER
55		56
56	END;	57	END;
57		58
58	POSITION* = RECORD	59	POSITION* = RECORD
59		60
60	line, col: INTEGER	61	line, col: INTEGER
61		62
62	END;	63	END;
63		64
64	LEX* = RECORD	65	LEX* = RECORD
65		66
66	s*: LEXSTR;	67	s*: LEXSTR;
67	length*: INTEGER;	68	length*: INTEGER;
68	sym*: INTEGER;	69	sym*: INTEGER;
69	pos*: POSITION;	70	pos*: POSITION;
70	ident*: IDENT;	71	ident*: IDENT;
71	string*: IDENT;	72	string*: IDENT;
72	value*: ARITH.VALUE;	73	value*: ARITH.VALUE;
73	error*: INTEGER;	74	error*: INTEGER;
74		75
75	over: BOOLEAN	76	over: BOOLEAN
76		77
77	END;	78	END;
78		79
79	SCANNER* = TXT.TEXT;	80	SCANNER* = TXT.TEXT;
80		-
81	KEYWORD = ARRAY 10 OF CHAR;	-
82		81
83		82
84	VAR	83	VAR
85		84
86	vocabulary: RECORD	-
87		85	idents: AVL.NODE;
88	KW: ARRAY 33 OF KEYWORD;	-
89	delimiters: ARRAY 256 OF BOOLEAN;	-
90	idents: AVL.NODE;	86
91	ident: IDENT	87	delimiters: ARRAY 256 OF BOOLEAN;
92		88
93	END;	89	NewIdent: IDENT;
94		90
95	upto: BOOLEAN;	91	upto: BOOLEAN;
96		92
97		93
98	PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;	94	PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
99	RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)	95	RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)
100	END nodecmp;	96	END nodecmp;
101		97
102		-
103	PROCEDURE key (VAR lex: LEX);	-
104	VAR	-
105	L, R, M: INTEGER;	-
106	found: BOOLEAN;	-
107		-
108	BEGIN	-
109	L := 0;	-
110	R := LEN(vocabulary.KW) - 1;	-
111	found := FALSE;	-
112		-
113	REPEAT	-
114	M := (L + R) DIV 2;	-
115		-
116	IF lex.s # vocabulary.KW[M] THEN	-
117	IF lex.s > vocabulary.KW[M] THEN	-
118	L := M + 1	-
119	ELSE	-
120	R := M - 1	-
121	END	-
122	ELSE	-
123	found := TRUE;	-
124	lex.sym := lxKW + M	-
125	END	-
126	UNTIL found OR (L > R)	-
127	END key;	-
128		-
129		98
130	PROCEDURE enterid* (s: LEXSTR): IDENT;	99	PROCEDURE enterid* (s: LEXSTR): IDENT;
131	VAR	100	VAR
132	newnode: BOOLEAN;	101	newnode: BOOLEAN;
133	node: AVL.NODE;	102	node: AVL.NODE;
134		103
135	BEGIN	104	BEGIN
136	vocabulary.ident.s := s;	105	NewIdent.s := s;
137	vocabulary.idents := AVL.insert(vocabulary.idents, vocabulary.ident, nodecmp, newnode, node);	106	idents := AVL.insert(idents, NewIdent, nodecmp, newnode, node);
138		107
139	IF newnode THEN	108	IF newnode THEN
140	NEW(vocabulary.ident);	109	NEW(NewIdent);
141	vocabulary.ident.offset := -1;	110	NewIdent.offset := -1;
-		111	NewIdent.offsetW := -1;
142	vocabulary.ident.offsetW := -1	112	NewIdent.key := 0
143	END	113	END
144		114
145	RETURN node.data(IDENT)	115	RETURN node.data(IDENT)
146	END enterid;	116	END enterid;
147		117
148		118
149	PROCEDURE putchar (VAR lex: LEX; c: CHAR);	119	PROCEDURE putchar (VAR lex: LEX; c: CHAR);
150	BEGIN	120	BEGIN
151	IF lex.length < LEXLEN - 1 THEN	121	IF lex.length < LEXLEN - 1 THEN
152	lex.s[lex.length] := c;	122	lex.s[lex.length] := c;
153	INC(lex.length);	123	INC(lex.length);
154	lex.s[lex.length] := 0X	124	lex.s[lex.length] := 0X
155	ELSE	125	ELSE
156	lex.over := TRUE	126	lex.over := TRUE
157	END	127	END
158	END putchar;	128	END putchar;
159		129
160		130
161	PROCEDURE nextc (text: TXT.TEXT): CHAR;	131	PROCEDURE nextc (text: TXT.TEXT): CHAR;
162	BEGIN	132	BEGIN
163	TXT.next(text)	133	TXT.next(text)
164	RETURN text.peak	134	RETURN text.peak
165	END nextc;	135	END nextc;
166		136
167		137
168	PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);	138	PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
169	VAR	139	VAR
170	c: CHAR;	140	c: CHAR;
171		141
172	BEGIN	142	BEGIN
173	c := text.peak;	143	c := text.peak;
174	ASSERT(S.letter(c));	144	ASSERT(S.letter(c));
175		145
176	WHILE S.letter(c) OR S.digit(c) DO	146	WHILE S.letter(c) OR S.digit(c) DO
177	putchar(lex, c);	147	putchar(lex, c);
178	c := nextc(text)	148	c := nextc(text)
179	END;	149	END;
180		150
181	IF lex.over THEN	151	IF lex.over THEN
182	lex.sym := lxERROR06	152	lex.sym := lxERROR06
183	ELSE	153	ELSE
184	lex.sym := lxIDENT;	154	lex.ident := enterid(lex.s);
-		155	IF lex.ident.key # 0 THEN
185	key(lex)	156	lex.sym := lex.ident.key
186	END;	157	ELSE
187		-
188	IF lex.sym = lxIDENT THEN	158	lex.sym := lxIDENT
189	lex.ident := enterid(lex.s)	159	END
190	END	160	END
191		161
192	END ident;	162	END ident;
193		163
194		164
195	PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);	165	PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
196	VAR	166	VAR
197	c: CHAR;	167	c: CHAR;
198	hex: BOOLEAN;	168	hex: BOOLEAN;
199	error: INTEGER;	169	error: INTEGER;
200		170
201	BEGIN	171	BEGIN
202	c := text.peak;	172	c := text.peak;
203	ASSERT(S.digit(c));	173	ASSERT(S.digit(c));
204		174
205	error := 0;	175	error := 0;
206		176
207	lex.sym := lxINTEGER;	177	lex.sym := lxINTEGER;
208	hex := FALSE;	178	hex := FALSE;
209		179
210	WHILE S.digit(c) DO	180	WHILE S.digit(c) DO
211	putchar(lex, c);	181	putchar(lex, c);
212	c := nextc(text)	182	c := nextc(text)
213	END;	183	END;
214		184
215	WHILE S.hexdigit(c) DO	185	WHILE S.hexdigit(c) DO
216	putchar(lex, c);	186	putchar(lex, c);
217	c := nextc(text);	187	c := nextc(text);
218	hex := TRUE	188	hex := TRUE
219	END;	189	END;
220		190
221	IF c = "H" THEN	191	IF c = "H" THEN
222	putchar(lex, c);	192	putchar(lex, c);
223	TXT.next(text);	193	TXT.next(text);
224	lex.sym := lxHEX	194	lex.sym := lxHEX
225		195
226	ELSIF c = "X" THEN	196	ELSIF c = "X" THEN
227	putchar(lex, c);	197	putchar(lex, c);
228	TXT.next(text);	198	TXT.next(text);
229	lex.sym := lxCHAR	199	lex.sym := lxCHAR
230		200
231	ELSIF c = "." THEN	201	ELSIF c = "." THEN
232		202
233	IF hex THEN	203	IF hex THEN
234	lex.sym := lxERROR01	204	lex.sym := lxERROR01
235	ELSE	205	ELSE
236		206
237	c := nextc(text);	207	c := nextc(text);
238		208
239	IF c # "." THEN	209	IF c # "." THEN
240	putchar(lex, ".");	210	putchar(lex, ".");
241	lex.sym := lxFLOAT	211	lex.sym := lxFLOAT
242	ELSE	212	ELSE
243	lex.sym := lxINTEGER;	213	lex.sym := lxINTEGER;
244	text.peak := 7FX;	214	text.peak := 7FX;
245	upto := TRUE	215	upto := TRUE
246	END;	216	END;
247		217
248	WHILE S.digit(c) DO	218	WHILE S.digit(c) DO
249	putchar(lex, c);	219	putchar(lex, c);
250	c := nextc(text)	220	c := nextc(text)
251	END;	221	END;
252		222
253	IF c = "E" THEN	223	IF c = "E" THEN
254		224
255	putchar(lex, c);	225	putchar(lex, c);
256	c := nextc(text);	226	c := nextc(text);
257	IF (c = "+") OR (c = "-") THEN	227	IF (c = "+") OR (c = "-") THEN
258	putchar(lex, c);	228	putchar(lex, c);
259	c := nextc(text)	229	c := nextc(text)
260	END;	230	END;
261		231
262	IF S.digit(c) THEN	232	IF S.digit(c) THEN
263	WHILE S.digit(c) DO	233	WHILE S.digit(c) DO
264	putchar(lex, c);	234	putchar(lex, c);
265	c := nextc(text)	235	c := nextc(text)
266	END	236	END
267	ELSE	237	ELSE
268	lex.sym := lxERROR02	238	lex.sym := lxERROR02
269	END	239	END
270		240
271	END	241	END
272		242
273	END	243	END
274		244
275	ELSIF hex THEN	245	ELSIF hex THEN
276	lex.sym := lxERROR01	246	lex.sym := lxERROR01
277		247
278	END;	248	END;
279		249
280	IF lex.over & (lex.sym >= 0) THEN	250	IF lex.over & (lex.sym >= 0) THEN
281	lex.sym := lxERROR07	251	lex.sym := lxERROR07
282	END;	252	END;
283		253
284	IF lex.sym = lxINTEGER THEN	254	IF lex.sym = lxINTEGER THEN
285	ARITH.iconv(lex.s, lex.value, error)	255	ARITH.iconv(lex.s, lex.value, error)
286	ELSIF (lex.sym = lxHEX) OR (lex.sym = lxCHAR) THEN	256	ELSIF (lex.sym = lxHEX) OR (lex.sym = lxCHAR) THEN
287	ARITH.hconv(lex.s, lex.value, error)	257	ARITH.hconv(lex.s, lex.value, error)
288	ELSIF lex.sym = lxFLOAT THEN	258	ELSIF lex.sym = lxFLOAT THEN
289	ARITH.fconv(lex.s, lex.value, error)	259	ARITH.fconv(lex.s, lex.value, error)
290	END;	260	END;
291		261
292	CASE error OF	262	CASE error OF
293	\|0:	263	\|0:
294	\|1: lex.sym := lxERROR08	264	\|1: lex.sym := lxERROR08
295	\|2: lex.sym := lxERROR09	265	\|2: lex.sym := lxERROR09
296	\|3: lex.sym := lxERROR10	266	\|3: lex.sym := lxERROR10
297	\|4: lex.sym := lxERROR11	267	\|4: lex.sym := lxERROR11
298	\|5: lex.sym := lxERROR12	268	\|5: lex.sym := lxERROR12
299	END	269	END
300		270
301	END number;	271	END number;
302		272
303		273
304	PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);	274	PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
305	VAR	275	VAR
306	c: CHAR;	276	c: CHAR;
307	n: INTEGER;	277	n: INTEGER;
308		278
309	BEGIN	279	BEGIN
310	c := nextc(text);	280	c := nextc(text);
311	n := 0;	281	n := 0;
312		282
313	WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO	283	WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
314	putchar(lex, c);	284	putchar(lex, c);
315	c := nextc(text);	285	c := nextc(text);
316	INC(n)	286	INC(n)
317	END;	287	END;
318		288
319	IF c = quot THEN	289	IF c = quot THEN
320	TXT.next(text);	290	TXT.next(text);
321	IF lex.over THEN	291	IF lex.over THEN
322	lex.sym := lxERROR05	292	lex.sym := lxERROR05
323	ELSE	293	ELSE
324	IF n # 1 THEN	294	IF n # 1 THEN
325	lex.sym := lxSTRING	295	lex.sym := lxSTRING
326	ELSE	296	ELSE
327	lex.sym := lxCHAR;	297	lex.sym := lxCHAR;
328	ARITH.setChar(lex.value, ORD(lex.s[0]))	298	ARITH.setChar(lex.value, ORD(lex.s[0]))
329	END	299	END
330	END	300	END
331	ELSE	301	ELSE
332	lex.sym := lxERROR03	302	lex.sym := lxERROR03
333	END;	303	END;
334		304
335	IF lex.sym = lxSTRING THEN	305	IF lex.sym = lxSTRING THEN
336	lex.string := enterid(lex.s);	306	lex.string := enterid(lex.s);
337	lex.value.typ := ARITH.tSTRING;	307	lex.value.typ := ARITH.tSTRING;
338	lex.value.string := lex.string	308	lex.value.string := lex.string
339	END	309	END
340		310
341	END string;	311	END string;
342		312
343		313
344	PROCEDURE comment (text: TXT.TEXT);	314	PROCEDURE comment (text: TXT.TEXT);
345	VAR	315	VAR
346	c: CHAR;	316	c: CHAR;
347	cond, depth: INTEGER;	317	cond, depth: INTEGER;
348		318
349	BEGIN	319	BEGIN
350	cond := 0;	320	cond := 0;
351	depth := 1;	321	depth := 1;
352		322
353	REPEAT	323	REPEAT
354		324
355	c := text.peak;	325	c := text.peak;
356	TXT.next(text);	326	TXT.next(text);
357		327
358	IF c = "*" THEN	328	IF c = "*" THEN
359	IF cond = 1 THEN	329	IF cond = 1 THEN
360	cond := 0;	330	cond := 0;
361	INC(depth)	331	INC(depth)
362	ELSE	332	ELSE
363	cond := 2	333	cond := 2
364	END	334	END
365	ELSIF c = ")" THEN	335	ELSIF c = ")" THEN
366	IF cond = 2 THEN	336	IF cond = 2 THEN
367	DEC(depth)	337	DEC(depth)
368	END;	338	END;
369	cond := 0	339	cond := 0
370	ELSIF c = "(" THEN	340	ELSIF c = "(" THEN
371	cond := 1	341	cond := 1
372	ELSE	342	ELSE
373	cond := 0	343	cond := 0
374	END	344	END
375		345
376	UNTIL (depth = 0) OR text.eof	346	UNTIL (depth = 0) OR text.eof
377		347
378	END comment;	348	END comment;
379		349
380		350
381	PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);	351	PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
382	BEGIN	352	BEGIN
383	putchar(lex, c);	353	putchar(lex, c);
384	c := nextc(text);	354	c := nextc(text);
385		355
386	CASE lex.s[0] OF	356	CASE lex.s[0] OF
387	\|"+":	357	\|"+":
388	lex.sym := lxPLUS	358	lex.sym := lxPLUS
389		359
390	\|"-":	360	\|"-":
391	lex.sym := lxMINUS	361	lex.sym := lxMINUS
392		362
393	\|"*":	363	\|"*":
394	lex.sym := lxMUL	364	lex.sym := lxMUL
395		365
396	\|"/":	366	\|"/":
397	lex.sym := lxSLASH;	367	lex.sym := lxSLASH;
398		368
399	IF c = "/" THEN	369	IF c = "/" THEN
400	lex.sym := lxCOMMENT;	370	lex.sym := lxCOMMENT;
401	REPEAT	371	REPEAT
402	TXT.next(text)	372	TXT.next(text)
403	UNTIL text.eol OR text.eof	373	UNTIL text.eol OR text.eof
404	END	374	END
405		375
406	\|"~":	376	\|"~":
407	lex.sym := lxNOT	377	lex.sym := lxNOT
408		378
409	\|"&":	379	\|"&":
410	lex.sym := lxAND	380	lex.sym := lxAND
411		381
412	\|".":	382	\|".":
413	lex.sym := lxPOINT;	383	lex.sym := lxPOINT;
414		384
415	IF c = "." THEN	385	IF c = "." THEN
416	lex.sym := lxRANGE;	386	lex.sym := lxRANGE;
417	putchar(lex, c);	387	putchar(lex, c);
418	TXT.next(text)	388	TXT.next(text)
419	END	389	END
420		390
421	\|",":	391	\|",":
422	lex.sym := lxCOMMA	392	lex.sym := lxCOMMA
423		393
424	\|";":	394	\|";":
425	lex.sym := lxSEMI	395	lex.sym := lxSEMI
426		396
427	\|"\|":	397	\|"\|":
428	lex.sym := lxBAR	398	lex.sym := lxBAR
429		399
430	\|"(":	400	\|"(":
431	lex.sym := lxLROUND;	401	lex.sym := lxLROUND;
432		402
433	IF c = "*" THEN	403	IF c = "*" THEN
434	lex.sym := lxCOMMENT;	404	lex.sym := lxCOMMENT;
435	TXT.next(text);	405	TXT.next(text);
436	comment(text)	406	comment(text)
437	END	407	END
438		408
439	\|"[":	409	\|"[":
440	lex.sym := lxLSQUARE	410	lex.sym := lxLSQUARE
441		411
442	\|"{":	412	\|"{":
443	lex.sym := lxLCURLY	413	lex.sym := lxLCURLY
444		414
445	\|"^":	415	\|"^":
446	lex.sym := lxCARET	416	lex.sym := lxCARET
447		417
448	\|"=":	418	\|"=":
449	lex.sym := lxEQ	419	lex.sym := lxEQ
450		420
451	\|"#":	421	\|"#":
452	lex.sym := lxNE	422	lex.sym := lxNE
453		423
454	\|"<":	424	\|"<":
455	lex.sym := lxLT;	425	lex.sym := lxLT;
456		426
457	IF c = "=" THEN	427	IF c = "=" THEN
458	lex.sym := lxLE;	428	lex.sym := lxLE;
459	putchar(lex, c);	429	putchar(lex, c);
460	TXT.next(text)	430	TXT.next(text)
461	END	431	END
462		432
463	\|">":	433	\|">":
464	lex.sym := lxGT;	434	lex.sym := lxGT;
465		435
466	IF c = "=" THEN	436	IF c = "=" THEN
467	lex.sym := lxGE;	437	lex.sym := lxGE;
468	putchar(lex, c);	438	putchar(lex, c);
469	TXT.next(text)	439	TXT.next(text)
470	END	440	END
471		441
472	\|":":	442	\|":":
473	lex.sym := lxCOLON;	443	lex.sym := lxCOLON;
474		444
475	IF c = "=" THEN	445	IF c = "=" THEN
476	lex.sym := lxASSIGN;	446	lex.sym := lxASSIGN;
477	putchar(lex, c);	447	putchar(lex, c);
478	TXT.next(text)	448	TXT.next(text)
479	END	449	END
480		450
481	\|")":	451	\|")":
482	lex.sym := lxRROUND	452	lex.sym := lxRROUND
483		453
484	\|"]":	454	\|"]":
485	lex.sym := lxRSQUARE	455	lex.sym := lxRSQUARE
486		456
487	\|"}":	457	\|"}":
488	lex.sym := lxRCURLY	458	lex.sym := lxRCURLY
489		459
490	END	460	END
491		461
492	END delimiter;	462	END delimiter;
493		463
494		464
495	PROCEDURE Next* (text: SCANNER; VAR lex: LEX);	465	PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
496	VAR	466	VAR
497	c: CHAR;	467	c: CHAR;

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/SCAN.ob07 – Rev 7693 → 7696