forked from KolibriOS/kolibrios
761 lines
16 KiB
Plaintext
761 lines
16 KiB
Plaintext
(*
|
|
BSD 2-Clause License
|
|
|
|
Copyright (c) 2018-2020, Anton Krotov
|
|
All rights reserved.
|
|
*)
|
|
|
|
MODULE SCAN;
|
|
|
|
IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, ERRORS, LISTS;
|
|
|
|
|
|
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;
|
|
|
|
DEF = POINTER TO RECORD (LISTS.ITEM)
|
|
|
|
ident: LEXSTR
|
|
|
|
END;
|
|
|
|
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, LowerCase, _if: BOOLEAN;
|
|
|
|
def: LISTS.LIST;
|
|
|
|
|
|
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, sym: INTEGER;
|
|
|
|
BEGIN
|
|
c := text.peak;
|
|
ASSERT(S.digit(c));
|
|
|
|
error := 0;
|
|
|
|
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);
|
|
sym := lxHEX
|
|
|
|
ELSIF c = "X" THEN
|
|
putchar(lex, c);
|
|
TXT.next(text);
|
|
sym := lxCHAR
|
|
|
|
ELSIF c = "." THEN
|
|
|
|
IF hex THEN
|
|
sym := lxERROR01
|
|
ELSE
|
|
|
|
c := nextc(text);
|
|
|
|
IF c # "." THEN
|
|
putchar(lex, ".");
|
|
sym := lxFLOAT
|
|
ELSE
|
|
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
|
|
sym := lxERROR02
|
|
END
|
|
|
|
END
|
|
|
|
END
|
|
|
|
ELSIF hex THEN
|
|
sym := lxERROR01
|
|
|
|
END;
|
|
|
|
IF lex.over & (sym >= 0) THEN
|
|
sym := lxERROR07
|
|
END;
|
|
|
|
IF sym = lxINTEGER THEN
|
|
ARITH.iconv(lex.s, lex.value, error)
|
|
ELSIF (sym = lxHEX) OR (sym = lxCHAR) THEN
|
|
ARITH.hconv(lex.s, lex.value, error)
|
|
ELSIF sym = lxFLOAT THEN
|
|
ARITH.fconv(lex.s, lex.value, error)
|
|
END;
|
|
|
|
CASE error OF
|
|
|0:
|
|
|1: sym := lxERROR08
|
|
|2: sym := lxERROR09
|
|
|3: sym := lxERROR10
|
|
|4: sym := lxERROR11
|
|
|5: sym := lxERROR12
|
|
END;
|
|
|
|
lex.sym := sym
|
|
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);
|
|
VAR
|
|
sym: INTEGER;
|
|
|
|
BEGIN
|
|
putchar(lex, c);
|
|
c := nextc(text);
|
|
|
|
CASE lex.s[0] OF
|
|
|"+":
|
|
sym := lxPLUS
|
|
|
|
|"-":
|
|
sym := lxMINUS
|
|
|
|
|"*":
|
|
sym := lxMUL
|
|
|
|
|"/":
|
|
sym := lxSLASH;
|
|
|
|
IF c = "/" THEN
|
|
sym := lxCOMMENT;
|
|
REPEAT
|
|
TXT.next(text)
|
|
UNTIL text.eol OR text.eof
|
|
END
|
|
|
|
|"~":
|
|
sym := lxNOT
|
|
|
|
|"&":
|
|
sym := lxAND
|
|
|
|
|".":
|
|
sym := lxPOINT;
|
|
|
|
IF c = "." THEN
|
|
sym := lxRANGE;
|
|
putchar(lex, c);
|
|
TXT.next(text)
|
|
END
|
|
|
|
|",":
|
|
sym := lxCOMMA
|
|
|
|
|";":
|
|
sym := lxSEMI
|
|
|
|
|"|":
|
|
sym := lxBAR
|
|
|
|
|"(":
|
|
sym := lxLROUND;
|
|
|
|
IF c = "*" THEN
|
|
sym := lxCOMMENT;
|
|
TXT.next(text);
|
|
comment(text)
|
|
END
|
|
|
|
|"[":
|
|
sym := lxLSQUARE
|
|
|
|
|"{":
|
|
sym := lxLCURLY
|
|
|
|
|"^":
|
|
sym := lxCARET
|
|
|
|
|"=":
|
|
sym := lxEQ
|
|
|
|
|"#":
|
|
sym := lxNE
|
|
|
|
|"<":
|
|
sym := lxLT;
|
|
|
|
IF c = "=" THEN
|
|
sym := lxLE;
|
|
putchar(lex, c);
|
|
TXT.next(text)
|
|
END
|
|
|
|
|">":
|
|
sym := lxGT;
|
|
|
|
IF c = "=" THEN
|
|
sym := lxGE;
|
|
putchar(lex, c);
|
|
TXT.next(text)
|
|
END
|
|
|
|
|":":
|
|
sym := lxCOLON;
|
|
|
|
IF c = "=" THEN
|
|
sym := lxASSIGN;
|
|
putchar(lex, c);
|
|
TXT.next(text)
|
|
END
|
|
|
|
|")":
|
|
sym := lxRROUND
|
|
|
|
|"]":
|
|
sym := lxRSQUARE
|
|
|
|
|"}":
|
|
sym := lxRCURLY
|
|
|
|
END;
|
|
|
|
lex.sym := sym
|
|
|
|
END delimiter;
|
|
|
|
|
|
PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
|
|
VAR
|
|
c: CHAR;
|
|
|
|
|
|
PROCEDURE check (cond: BOOLEAN; text: SCANNER; lex: LEX; errno: INTEGER);
|
|
BEGIN
|
|
IF ~cond THEN
|
|
ERRORS.ErrorMsg(text.fname, lex.pos.line, lex.pos.col, errno)
|
|
END
|
|
END check;
|
|
|
|
|
|
PROCEDURE IsDef (str: ARRAY OF CHAR): BOOLEAN;
|
|
VAR
|
|
cur: DEF;
|
|
|
|
BEGIN
|
|
cur := def.first(DEF);
|
|
WHILE (cur # NIL) & (cur.ident # str) DO
|
|
cur := cur.next(DEF)
|
|
END
|
|
|
|
RETURN cur # NIL
|
|
END IsDef;
|
|
|
|
|
|
PROCEDURE Skip (text: SCANNER);
|
|
VAR
|
|
i: INTEGER;
|
|
|
|
BEGIN
|
|
i := 0;
|
|
WHILE (i <= text.ifc) & ~text._skip[i] DO
|
|
INC(i)
|
|
END;
|
|
text.skip := i <= text.ifc
|
|
END Skip;
|
|
|
|
|
|
PROCEDURE prep_if (text: SCANNER; VAR lex: LEX);
|
|
VAR
|
|
skip: BOOLEAN;
|
|
|
|
BEGIN
|
|
INC(text.ifc);
|
|
text._elsif[text.ifc] := lex.sym = lxELSIF;
|
|
IF lex.sym = lxIF THEN
|
|
INC(text.elsec);
|
|
text._else[text.elsec] := FALSE
|
|
END;
|
|
_if := TRUE;
|
|
skip := TRUE;
|
|
text.skip := FALSE;
|
|
|
|
Next(text, lex);
|
|
check(lex.sym = lxLROUND, text, lex, 64);
|
|
|
|
Next(text, lex);
|
|
check(lex.sym = lxIDENT, text, lex, 22);
|
|
|
|
REPEAT
|
|
IF IsDef(lex.s) THEN
|
|
skip := FALSE
|
|
END;
|
|
|
|
Next(text, lex);
|
|
IF lex.sym = lxBAR THEN
|
|
Next(text, lex);
|
|
check(lex.sym = lxIDENT, text, lex, 22)
|
|
ELSE
|
|
check(lex.sym = lxRROUND, text, lex, 33)
|
|
END
|
|
UNTIL lex.sym = lxRROUND;
|
|
|
|
_if := FALSE;
|
|
text._skip[text.ifc] := skip;
|
|
Skip(text);
|
|
Next(text, lex)
|
|
END prep_if;
|
|
|
|
|
|
PROCEDURE prep_end (text: SCANNER; VAR lex: LEX);
|
|
BEGIN
|
|
check(text.ifc > 0, text, lex, 118);
|
|
IF lex.sym = lxEND THEN
|
|
WHILE text._elsif[text.ifc] DO
|
|
DEC(text.ifc)
|
|
END;
|
|
DEC(text.ifc);
|
|
DEC(text.elsec)
|
|
ELSIF (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
|
|
check(~text._else[text.elsec], text, lex, 118);
|
|
text._skip[text.ifc] := ~text._skip[text.ifc];
|
|
text._else[text.elsec] := lex.sym = lxELSE
|
|
END;
|
|
Skip(text);
|
|
IF lex.sym = lxELSIF THEN
|
|
prep_if(text, lex)
|
|
ELSE
|
|
Next(text, lex)
|
|
END
|
|
END prep_end;
|
|
|
|
|
|
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 = "$" THEN
|
|
IF S.letter(nextc(text)) THEN
|
|
ident(text, lex);
|
|
IF lex.sym = lxIF THEN
|
|
IF ~_if THEN
|
|
prep_if(text, lex)
|
|
END
|
|
ELSIF (lex.sym = lxEND) OR (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
|
|
IF ~_if THEN
|
|
prep_end(text, lex)
|
|
END
|
|
ELSE
|
|
check(FALSE, text, lex, 119)
|
|
END
|
|
ELSE
|
|
check(FALSE, text, lex, 119)
|
|
END
|
|
ELSIF c = 0X THEN
|
|
lex.sym := lxEOF;
|
|
text.skip := FALSE;
|
|
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) & ~text.skip
|
|
|
|
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* (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 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;
|
|
|
|
|
|
PROCEDURE NewDef* (str: ARRAY OF CHAR);
|
|
VAR
|
|
item: DEF;
|
|
|
|
BEGIN
|
|
NEW(item);
|
|
COPY(str, item.ident);
|
|
LISTS.push(def, item)
|
|
END NewDef;
|
|
|
|
|
|
BEGIN
|
|
def := LISTS.create(NIL)
|
|
END SCAN. |