mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 21:32:26 +00:00
315 lines
11 KiB
Modula-2
315 lines
11 KiB
Modula-2
MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
|
|
|
|
IMPORT OPM;
|
|
|
|
CONST
|
|
MaxStrLen* = 256;
|
|
MaxIdLen = 32;
|
|
|
|
TYPE
|
|
Name* = ARRAY MaxIdLen OF CHAR;
|
|
String* = ARRAY MaxStrLen OF CHAR;
|
|
|
|
(* name, str, numtyp, intval, realval, lrlval are implicit results of Get *)
|
|
|
|
VAR
|
|
name*: Name;
|
|
str*: String;
|
|
numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
|
|
intval*: LONGINT; (* integer value or string length *)
|
|
realval*: REAL;
|
|
lrlval*: LONGREAL;
|
|
|
|
(*symbols:
|
|
| 0 1 2 3 4
|
|
---|--------------------------------------------------------
|
|
0 | null * / DIV MOD
|
|
5 | & + - OR =
|
|
10 | # < <= > >=
|
|
15 | IN IS ^ . ,
|
|
20 | : .. ) ] }
|
|
25 | OF THEN DO TO BY
|
|
30 | ( [ { ~ :=
|
|
35 | number NIL string ident ;
|
|
40 | | END ELSE ELSIF UNTIL
|
|
45 | IF CASE WHILE REPEAT FOR
|
|
50 | LOOP WITH EXIT RETURN ARRAY
|
|
55 | RECORD POINTER BEGIN CONST TYPE
|
|
60 | VAR PROCEDURE IMPORT MODULE eof *)
|
|
|
|
CONST
|
|
(* numtyp values *)
|
|
char = 1; integer = 2; real = 3; longreal = 4;
|
|
|
|
(*symbol values*)
|
|
null = 0; times = 1; slash = 2; div = 3; mod = 4;
|
|
and = 5; plus = 6; minus = 7; or = 8; eql = 9;
|
|
neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
|
|
in = 15; is = 16; arrow = 17; period = 18; comma = 19;
|
|
colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
|
|
of = 25; then = 26; do = 27; to = 28; by = 29;
|
|
lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
|
|
number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
|
|
bar = 40; end = 41; else = 42; elsif = 43; until = 44;
|
|
if = 45; case = 46; while = 47; repeat = 48; for = 49;
|
|
loop = 50; with = 51; exit = 52; return = 53; array = 54;
|
|
record = 55; pointer = 56; begin = 57; const = 58; type = 59;
|
|
var = 60; procedure = 61; import = 62; module = 63; eof = 64;
|
|
|
|
VAR
|
|
ch: CHAR; (*current character*)
|
|
|
|
PROCEDURE err(n: INTEGER);
|
|
BEGIN OPM.err(n)
|
|
END err;
|
|
|
|
PROCEDURE Str(VAR sym: SHORTINT);
|
|
VAR i: INTEGER; och: CHAR;
|
|
BEGIN i := 0; och := ch;
|
|
LOOP OPM.Get(ch);
|
|
IF ch = och THEN EXIT END ;
|
|
IF ch < " " THEN err(3); EXIT END ;
|
|
IF i = MaxStrLen-1 THEN err(241); EXIT END ;
|
|
str[i] := ch; INC(i)
|
|
END ;
|
|
OPM.Get(ch); str[i] := 0X; intval := i + 1;
|
|
IF intval = 2 THEN
|
|
sym := number; numtyp := 1; intval := ORD(str[0])
|
|
ELSE sym := string
|
|
END
|
|
END Str;
|
|
|
|
PROCEDURE Identifier(VAR sym: SHORTINT);
|
|
VAR i: INTEGER;
|
|
BEGIN i := 0;
|
|
REPEAT
|
|
name[i] := ch; INC(i); OPM.Get(ch)
|
|
UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch)) OR (i = MaxIdLen);
|
|
IF i = MaxIdLen THEN err(240); DEC(i) END ;
|
|
name[i] := 0X; sym := ident
|
|
END Identifier;
|
|
|
|
PROCEDURE Number;
|
|
VAR i, m, n, d, e: INTEGER; dig: ARRAY 24 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
|
|
|
|
PROCEDURE Ten(e: INTEGER): LONGREAL;
|
|
VAR x, p: LONGREAL;
|
|
BEGIN x := 1; p := 10;
|
|
WHILE e > 0 DO
|
|
IF ODD(e) THEN x := x*p END;
|
|
e := e DIV 2;
|
|
IF e > 0 THEN p := p*p END (* prevent overflow *)
|
|
END;
|
|
RETURN x
|
|
END Ten;
|
|
|
|
PROCEDURE Ord(ch: CHAR; hex: BOOLEAN): INTEGER;
|
|
BEGIN (* ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") *)
|
|
IF ch <= "9" THEN RETURN ORD(ch) - ORD("0")
|
|
ELSIF hex THEN RETURN ORD(ch) - ORD("A") + 10
|
|
ELSE err(2); RETURN 0
|
|
END
|
|
END Ord;
|
|
|
|
BEGIN (* ("0" <= ch) & (ch <= "9") *)
|
|
i := 0; m := 0; n := 0; d := 0;
|
|
LOOP (* read mantissa *)
|
|
IF ("0" <= ch) & (ch <= "9") OR (d = 0) & ("A" <= ch) & (ch <= "F") THEN
|
|
IF (m > 0) OR (ch # "0") THEN (* ignore leading zeros *)
|
|
IF n < LEN(dig) THEN dig[n] := ch; INC(n) END;
|
|
INC(m)
|
|
END;
|
|
OPM.Get(ch); INC(i)
|
|
ELSIF ch = "." THEN OPM.Get(ch);
|
|
IF ch = "." THEN (* ellipsis *) ch := 7FX; EXIT
|
|
ELSIF d = 0 THEN (* i > 0 *) d := i
|
|
ELSE err(2)
|
|
END
|
|
ELSE EXIT
|
|
END
|
|
END; (* 0 <= n <= m <= i, 0 <= d <= i *)
|
|
IF d = 0 THEN (* integer *)
|
|
IF n = m THEN intval := 0; i := 0;
|
|
IF ch = "X" THEN (* character *) OPM.Get(ch); numtyp := char;
|
|
IF n <= 2 THEN
|
|
WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
|
|
ELSE err(203)
|
|
END
|
|
ELSIF ch = "H" THEN (* hexadecimal *) OPM.Get(ch); numtyp := integer;
|
|
IF n <= OPM.MaxHDig THEN
|
|
IF (n = OPM.MaxHDig) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
|
|
WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
|
|
ELSE err(203)
|
|
END
|
|
ELSE (* decimal *) numtyp := integer;
|
|
WHILE i < n DO d := Ord(dig[i], FALSE); INC(i);
|
|
IF intval <= (MAX(LONGINT) - d) DIV 10 THEN intval := intval*10 + d
|
|
ELSE err(203)
|
|
END
|
|
END
|
|
END
|
|
ELSE err(203)
|
|
END
|
|
ELSE (* fraction *)
|
|
f := 0; e := 0; expCh := "E";
|
|
WHILE n > 0 DO (* 0 <= f < 1 *) DEC(n); f := (Ord(dig[n], FALSE) + f)/10 END;
|
|
IF (ch = "E") OR (ch = "D") THEN expCh := ch; OPM.Get(ch); neg := FALSE;
|
|
IF ch = "-" THEN neg := TRUE; OPM.Get(ch)
|
|
ELSIF ch = "+" THEN OPM.Get(ch)
|
|
END;
|
|
IF ("0" <= ch) & (ch <= "9") THEN
|
|
REPEAT n := Ord(ch, FALSE); OPM.Get(ch);
|
|
IF e <= (MAX(INTEGER) - n) DIV 10 THEN e := e*10 + n
|
|
ELSE err(203)
|
|
END
|
|
UNTIL (ch < "0") OR ("9" < ch);
|
|
IF neg THEN e := -e END
|
|
ELSE err(2)
|
|
END
|
|
END;
|
|
DEC(e, i-d-m); (* decimal point shift *)
|
|
IF expCh = "E" THEN numtyp := real;
|
|
IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
|
|
IF e < 0 THEN realval := SHORT(f / Ten(-e))
|
|
ELSE realval := SHORT(f * Ten(e))
|
|
END
|
|
ELSE err(203)
|
|
END
|
|
ELSE numtyp := longreal;
|
|
IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
|
|
IF e < 0 THEN lrlval := f / Ten(-e)
|
|
ELSE lrlval := f * Ten(e)
|
|
END
|
|
ELSE err(203)
|
|
END
|
|
END
|
|
END
|
|
END Number;
|
|
|
|
PROCEDURE Get*(VAR sym: SHORTINT);
|
|
VAR s: SHORTINT;
|
|
|
|
PROCEDURE Comment; (* do not read after end of file *)
|
|
BEGIN OPM.Get(ch);
|
|
LOOP
|
|
LOOP
|
|
WHILE ch = "(" DO OPM.Get(ch);
|
|
IF ch = "*" THEN Comment END
|
|
END ;
|
|
IF ch = "*" THEN OPM.Get(ch); EXIT END ;
|
|
IF ch = OPM.Eot THEN EXIT END ;
|
|
OPM.Get(ch)
|
|
END ;
|
|
IF ch = ")" THEN OPM.Get(ch); EXIT END ;
|
|
IF ch = OPM.Eot THEN err(5); EXIT END
|
|
END
|
|
END Comment;
|
|
|
|
BEGIN
|
|
OPM.errpos := OPM.curpos-1;
|
|
WHILE ch <= " " DO (*ignore control characters*)
|
|
IF ch = OPM.Eot THEN sym := eof; RETURN
|
|
ELSE OPM.Get(ch)
|
|
END
|
|
END ;
|
|
CASE ch OF (* ch > " " *)
|
|
| 22X, 27X : Str(s)
|
|
| "#" : s := neq; OPM.Get(ch)
|
|
| "&" : s := and; OPM.Get(ch)
|
|
| "(" : OPM.Get(ch);
|
|
IF ch = "*" THEN Comment; Get(s)
|
|
ELSE s := lparen
|
|
END
|
|
| ")" : s := rparen; OPM.Get(ch)
|
|
| "*" : s := times; OPM.Get(ch)
|
|
| "+" : s := plus; OPM.Get(ch)
|
|
| "," : s := comma; OPM.Get(ch)
|
|
| "-" : s := minus; OPM.Get(ch)
|
|
| "." : OPM.Get(ch);
|
|
IF ch = "." THEN OPM.Get(ch); s := upto ELSE s := period END
|
|
| "/" : s := slash; OPM.Get(ch)
|
|
| "0".."9": Number; s := number
|
|
| ":" : OPM.Get(ch);
|
|
IF ch = "=" THEN OPM.Get(ch); s := becomes ELSE s := colon END
|
|
| ";" : s := semicolon; OPM.Get(ch)
|
|
| "<" : OPM.Get(ch);
|
|
IF ch = "=" THEN OPM.Get(ch); s := leq ELSE s := lss END
|
|
| "=" : s := eql; OPM.Get(ch)
|
|
| ">" : OPM.Get(ch);
|
|
IF ch = "=" THEN OPM.Get(ch); s := geq ELSE s := gtr END
|
|
| "A": Identifier(s); IF name = "ARRAY" THEN s := array END
|
|
| "B": Identifier(s);
|
|
IF name = "BEGIN" THEN s := begin
|
|
ELSIF name = "BY" THEN s := by
|
|
END
|
|
| "C": Identifier(s);
|
|
IF name = "CASE" THEN s := case
|
|
ELSIF name = "CONST" THEN s := const
|
|
END
|
|
| "D": Identifier(s);
|
|
IF name = "DO" THEN s := do
|
|
ELSIF name = "DIV" THEN s := div
|
|
END
|
|
| "E": Identifier(s);
|
|
IF name = "END" THEN s := end
|
|
ELSIF name = "ELSE" THEN s := else
|
|
ELSIF name = "ELSIF" THEN s := elsif
|
|
ELSIF name = "EXIT" THEN s := exit
|
|
END
|
|
| "F": Identifier(s); IF name = "FOR" THEN s := for END
|
|
| "I": Identifier(s);
|
|
IF name = "IF" THEN s := if
|
|
ELSIF name = "IN" THEN s := in
|
|
ELSIF name = "IS" THEN s := is
|
|
ELSIF name = "IMPORT" THEN s := import
|
|
END
|
|
| "L": Identifier(s); IF name = "LOOP" THEN s := loop END
|
|
| "M": Identifier(s);
|
|
IF name = "MOD" THEN s := mod
|
|
ELSIF name = "MODULE" THEN s := module
|
|
END
|
|
| "N": Identifier(s); IF name = "NIL" THEN s := nil END
|
|
| "O": Identifier(s);
|
|
IF name = "OR" THEN s := or
|
|
ELSIF name = "OF" THEN s := of
|
|
END
|
|
| "P": Identifier(s);
|
|
IF name = "PROCEDURE" THEN s := procedure
|
|
ELSIF name = "POINTER" THEN s := pointer
|
|
END
|
|
| "R": Identifier(s);
|
|
IF name = "RECORD" THEN s := record
|
|
ELSIF name = "REPEAT" THEN s := repeat
|
|
ELSIF name = "RETURN" THEN s := return
|
|
END
|
|
| "T": Identifier(s);
|
|
IF name = "THEN" THEN s := then
|
|
ELSIF name = "TO" THEN s := to
|
|
ELSIF name = "TYPE" THEN s := type
|
|
END
|
|
| "U": Identifier(s); IF name = "UNTIL" THEN s := until END
|
|
| "V": Identifier(s); IF name = "VAR" THEN s := var END
|
|
| "W": Identifier(s);
|
|
IF name = "WHILE" THEN s := while
|
|
ELSIF name = "WITH" THEN s := with
|
|
END
|
|
| "G".."H", "J", "K", "Q", "S", "X".."Z": Identifier(s)
|
|
| "[" : s := lbrak; OPM.Get(ch)
|
|
| "]" : s := rbrak; OPM.Get(ch)
|
|
| "^" : s := arrow; OPM.Get(ch)
|
|
| "a".."z": Identifier(s)
|
|
| "{" : s := lbrace; OPM.Get(ch)
|
|
| "|" : s := bar; OPM.Get(ch)
|
|
| "}" : s := rbrace; OPM.Get(ch)
|
|
| "~" : s := not; OPM.Get(ch)
|
|
| 7FX : s := upto; OPM.Get(ch)
|
|
ELSE s := null; OPM.Get(ch)
|
|
END ;
|
|
sym := s
|
|
END Get;
|
|
|
|
PROCEDURE Init*;
|
|
BEGIN ch := " "
|
|
END Init;
|
|
|
|
END OPS.
|