MODULE LSS; (* NW 16.10.93 / 13.8.2018*) IMPORT Texts, Oberon; CONST IdLen* = 32; NofKeys = 11; (*symbols*) null = 0; arrow* = 1; times* = 2; div* = 3; and* = 4; plus* = 5; minus* = 6; or* = 7; xor* = 8; not* = 9; eql* = 10; neq* = 11; lss* = 12; leq* = 13; gtr* = 14; geq* = 15; at* = 16; apo* = 17; period* = 18; comma* = 19; colon* = 20; rparen* = 21; rbrak* = 22; rbrace* = 23; then* = 24; lparen* = 26; lbrak* = 27; lbrace* = 28; repl* = 29; becomes* = 30; integer* = 31; ident* = 32; ts* = 33; semicolon* = 40; end* = 41; const* = 51; type* = 52; reg* = 53; var* = 54; out* = 55; inout* = 56; in* = 57; begin* = 58; module* = 59; eof = 60; TYPE Ident* = ARRAY IdLen OF CHAR; VAR val*: LONGINT; id*: Ident; error*: BOOLEAN; ch: CHAR; errpos: LONGINT; R: Texts.Reader; W: Texts.Writer; key: ARRAY NofKeys OF Ident; symno: ARRAY NofKeys OF INTEGER; PROCEDURE Mark*(msg: ARRAY OF CHAR); VAR p: LONGINT; BEGIN p := Texts.Pos(R); IF p > errpos+2 THEN Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1); Texts.WriteString(W, " err: "); Texts.WriteString(W, msg); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END ; errpos := p; error := TRUE END Mark; PROCEDURE identifier(VAR sym: INTEGER); VAR i: INTEGER; BEGIN i := 0; REPEAT IF i < IdLen THEN id[i] := ch; INC(i) END ; Texts.Read(R, ch) UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "Z") & (ch < "a") OR (ch > "z"); IF ch = "'" THEN IF i < IdLen THEN id[i] := ch; INC(i) END ; Texts.Read(R, ch) END ; IF i = IdLen THEN Mark("ident too long"); id[IdLen-1] := 0X ELSE id[i] := 0X END ; i := 0; WHILE (i < NofKeys) & (id # key[i]) DO INC(i) END ; IF i < NofKeys THEN sym := symno[i] ELSE sym := ident END END identifier; PROCEDURE Number(VAR sym: INTEGER); VAR i, k, h, n, d: LONGINT; hex: BOOLEAN; dig: ARRAY 16 OF LONGINT; BEGIN sym := integer; i := 0; k := 0; n := 0; hex := FALSE; REPEAT IF n < 16 THEN d := ORD(ch)-30H; IF d >= 10 THEN hex := TRUE ; d := d - 7 END ; dig[n] := d; INC(n) ELSE Mark("too many digits"); n := 0 END ; Texts.Read(R, ch) UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F"); IF ch = "H" THEN (*hex*) REPEAT h := dig[i]; k := k*10H + h; INC(i) (*no overflow check*) UNTIL i = n; Texts.Read(R, ch) ELSE IF hex THEN Mark("illegal hex digit") END ; REPEAT k := k*10 + dig[i]; INC(i) UNTIL i = n END ; val := k END Number; PROCEDURE comment; BEGIN Texts.Read(R, ch); REPEAT WHILE ~R.eot & (ch # "*") DO IF ch = "(" THEN Texts.Read(R, ch); IF ch = "*" THEN comment END ELSE Texts.Read(R, ch) END END ; WHILE ch = "*" DO Texts.Read(R, ch) END UNTIL (ch = ")") OR R.eot; IF ~R.eot THEN Texts.Read(R, ch) ELSE Mark("comment not terminated") END END comment; PROCEDURE Get*(VAR sym: INTEGER); BEGIN REPEAT WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END; IF R.eot THEN sym := eof ELSIF ch < "A" THEN IF ch < "0" THEN IF ch = "!" THEN Texts.Read(R, ch); sym := repl ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq ELSIF ch = "$" THEN Texts.Read(R, ch); sym := null ELSIF ch = "&" THEN Texts.Read(R, ch); sym := and ELSIF ch = "'" THEN Texts.Read(R, ch); sym := apo ELSIF ch = "(" THEN Texts.Read(R, ch); IF ch = "*" THEN sym := null; comment ELSE sym := lparen END ELSIF ch = ")" THEN Texts.Read(R, ch); sym := rparen ELSIF ch = "*" THEN Texts.Read(R, ch); sym := times ELSIF ch = "+" THEN Texts.Read(R, ch); sym := plus ELSIF ch = "," THEN Texts.Read(R, ch); sym := comma ELSIF ch = "-" THEN Texts.Read(R, ch); IF ch = ">" THEN Texts.Read(R, ch); sym := then ELSE sym := minus END ELSIF ch = "." THEN Texts.Read(R, ch); sym := period ELSIF ch = "/" THEN Texts.Read(R, ch); sym := div ELSE sym := null END ELSIF ch <= "9" THEN Number(sym) ELSIF ch = ":" THEN Texts.Read(R, ch); IF ch = "=" THEN Texts.Read(R, ch); sym := becomes ELSE sym := colon END ELSIF ch = ";" THEN Texts.Read(R, ch); sym := semicolon ELSIF ch = "<" THEN Texts.Read(R, ch); IF ch = "=" THEN Texts.Read(R, ch); sym := leq ELSE sym := lss END ELSIF ch = "=" THEN Texts.Read(R, ch); sym := eql ELSIF ch = ">" THEN Texts.Read(R, ch); IF ch = "=" THEN Texts.Read(R, ch); sym := geq ELSE sym := gtr END ELSIF ch = "?" THEN Texts.Read(R, ch); sym := then ELSIF ch = "@" THEN Texts.Read(R, ch); sym := at ELSE sym := null END ELSIF ch <= "Z" THEN identifier(sym) ELSIF ch < "a" THEN IF ch = "[" THEN Texts.Read(R, ch); sym := lbrak ELSIF ch = "]" THEN Texts.Read(R, ch); sym := rbrak ELSIF ch = "^" THEN Texts.Read(R, ch); sym := xor ELSE sym := null END ELSIF ch <= "z" THEN identifier(sym) ELSIF ch <= "{" THEN Texts.Read(R, ch); sym := lbrace ELSIF ch <= "|" THEN Texts.Read(R, ch); sym := or ELSIF ch <= "}" THEN Texts.Read(R, ch); sym := rbrace ELSIF ch <= "~" THEN Texts.Read(R, ch); sym := not ELSE sym := null END UNTIL sym # null END Get; PROCEDURE Init*(T: Texts.Text; pos: LONGINT); BEGIN error := FALSE; errpos := pos; Texts.OpenReader(R, T, pos); Texts.Read(R, ch) END Init; BEGIN Texts.OpenWriter(W); key[ 0] := "BEGIN"; symno[0] := begin; key[ 1] := "CONST"; symno[1] := const; key[ 2] := "END"; symno[2] := end; key[3] := "IN"; symno[3] := in; key[4] := "INOUT"; symno[4] := inout; key[5] := "MODULE"; symno[5] := module; key[6] := "OUT"; symno[6] := out; key[7] := "REG"; symno[7] := reg; key[8] := "TYPE"; symno[8] := type; key[9] := "VAR"; symno[9] := var; key[10] := "TS"; symno[10] := ts END LSS.