MODULE DevCPR; IMPORT Strings, DevCPM, DevCPT; CONST MaxIdLen = LEN(DevCPT.Name); (* symbol values *) null = 0; if = 1; then = 2; else = 3; elsif = 4; end = 5; new = 6; error = 7; ident = 8; plus = 9; minus = 10; not = 11; and = 12; or = 13; rpar = 14; lpar = 15; defined = 16; endcom = 17; eof = 18; TYPE Context = POINTER TO RECORD next: Context; (* upper level block *) alt: BOOLEAN; (* else branch *) val: BOOLEAN; (* condition value, inverted if alt *) ref: INTEGER (* ELSIF count *) END; Selector = POINTER TO RECORD next: Selector; name: DevCPT.Name; val: BOOLEAN END; VAR ch-: CHAR; (* current character *) name: DevCPT.Name; (* ident *) VAR sym: BYTE; (* parser symbol *) fold: INTEGER; (* condition folding *) scope: Selector; top: Context; skip-: BOOLEAN; used-: BOOLEAN; PROCEDURE err (n: SHORTINT); BEGIN DevCPM.err(n) END err; PROCEDURE Identifier (VAR sym: BYTE); VAR i, res: INTEGER; n: ARRAY MaxIdLen OF CHAR; BEGIN i := 0; REPEAT n[i] := ch; INC(i); DevCPM.Get(ch) UNTIL ~Strings.IsIdent(ch) OR (i = MaxIdLen); IF i = MaxIdLen THEN err(240); DEC(i) END ; n[i] := 0X; Strings.StringToUtf8(n, name, res); sym := ident; IF res = 1 (*truncated*) THEN err(240) END END Identifier; PROCEDURE Get (VAR sym: BYTE); BEGIN DevCPM.errpos := DevCPM.curpos - 1; WHILE (ch # DevCPM.Eot) & ((ch <= " ") OR (ch = 0A0X)) DO DevCPM.Get(ch) END; DevCPM.startpos := DevCPM.curpos - 1; CASE ch OF | DevCPM.Eot: sym := eof | "&": sym := and; DevCPM.Get(ch) | "(": sym := lpar; DevCPM.Get(ch) | ")": sym := rpar; DevCPM.Get(ch) | "*": sym := null; DevCPM.Get(ch); IF ch = ">" THEN sym := endcom; DevCPM.Get(ch) END | "+": sym := plus; DevCPM.Get(ch) | "-": sym := minus; DevCPM.Get(ch) | "D": Identifier(sym); IF name = "DEFINED" THEN sym := defined END | "E": Identifier(sym); IF name = "END" THEN sym := end ELSIF name = "ELSE" THEN sym := else ELSIF name = "ELSIF" THEN sym := elsif ELSIF name = "ERROR" THEN sym := error END | "I": Identifier(sym); IF name = "IF" THEN sym := if END | "N": Identifier(sym); IF name = "NEW" THEN sym := new END | "O": Identifier(sym); IF name = "OR" THEN sym := or END | "T": Identifier(sym); IF name = "THEN" THEN sym := then END | "A".."C", "J".."M", "P".."S", "U".."Z", "a".."z", "_": Identifier(sym) | "~": sym := not; DevCPM.Get(ch) ELSE IF Strings.IsIdent(ch) THEN Identifier(sym) ELSE sym := null; DevCPM.Get(ch) END END END Get; PROCEDURE New (IN name: DevCPT.Name): Selector; VAR s: Selector; BEGIN s := scope; WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END; IF s.next = NIL THEN NEW(s.next); s.next.name := name$; s.next.val := FALSE ELSE err(1) END; RETURN s.next END New; PROCEDURE Old (IN name: DevCPT.Name): Selector; VAR s: Selector; BEGIN s := scope; WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END; IF s.next = NIL THEN err(0); NEW(s.next); s.next.name := name$; s.next.val := FALSE END; RETURN s.next END Old; PROCEDURE Find (IN name: DevCPT.Name): Selector; VAR s: Selector; BEGIN s := scope; WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END; RETURN s.next END Find; PROCEDURE Set* (IN name: DevCPT.Name; val: BOOLEAN); VAR s: Selector; BEGIN s := scope; WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END; IF s.next = NIL THEN NEW(s.next) END; s.next.name := name$; s.next.val := val END Set; PROCEDURE ^ Expression (VAR x: BOOLEAN; use: BOOLEAN); PROCEDURE Factor (VAR x: BOOLEAN; use: BOOLEAN); BEGIN x := FALSE; IF sym = ident THEN IF use THEN x := Old(name).val END; Get(sym); ELSIF sym = defined THEN Get(sym); IF sym = lpar THEN Get(sym); IF sym = ident THEN IF use THEN x := Find(name) # NIL END; Get(sym) ELSE err(48) END; IF sym # rpar THEN err(23) ELSE Get(sym) END ELSE err(40) END ELSIF sym = lpar THEN Get(sym); Expression(x, use); IF sym # rpar THEN err(23) ELSE Get(sym) END ELSIF sym = not THEN Get(sym); Factor(x, use); IF use THEN x := ~x END ELSE err(13) END END Factor; PROCEDURE Term (VAR x: BOOLEAN; use: BOOLEAN); VAR y: BOOLEAN; BEGIN Factor(x, use); WHILE sym = and DO Get(sym); Factor(y, use & x); IF use & x THEN x := x & y END END END Term; PROCEDURE Expression (VAR x: BOOLEAN; use: BOOLEAN); VAR y: BOOLEAN; BEGIN Term(x, use); WHILE sym = or DO Get(sym); Term(y, use & ~x); IF use & ~x THEN x := x OR y END END END Expression; PROCEDURE Printable (): BOOLEAN; VAR c: Context; BEGIN c := top; WHILE (c # NIL) & c.val DO c := c.next END; RETURN c = NIL END Printable; PROCEDURE If (cond: BOOLEAN); VAR c: Context; BEGIN NEW(c); c.next := top; c.alt := FALSE; c.val := cond; c.ref := 0; top := c; INC(fold); skip := ~Printable(); used := TRUE END If; PROCEDURE Else; BEGIN IF top.alt THEN err(14) (* double ELSE *) ELSE top.alt := TRUE; top.val := ~top.val; skip := ~Printable() END END Else; PROCEDURE End; VAR i, ref: INTEGER; BEGIN i := 0; ref := top.ref; DEC(fold, ref + 1); WHILE (top # NIL) & (i <= ref) DO top := top.next; INC(i) END; IF top = NIL THEN err(51); fold := 0; If(TRUE) END; skip := ~Printable() END End; PROCEDURE Parse*; VAR val: BOOLEAN; s: Selector; use: BOOLEAN; BEGIN ch := " "; Get(sym); use := ~skip; IF sym = new THEN Get(sym); IF sym = ident THEN IF use THEN s := New(name) END; Get(sym); IF (sym = plus) OR (sym = minus) THEN IF use THEN s.val := sym = plus END; Get(sym) END ELSE err(48) END ELSIF sym = ident THEN IF use THEN s := Old(name) END; Get(sym); IF (sym = plus) OR (sym = minus) THEN IF use THEN s.val := sym = plus END; Get(sym) ELSE err(41) END ELSIF sym = error THEN IF use THEN err(501) END; Get(sym) ELSIF sym = if THEN Get(sym); Expression(val, use); If(val); IF sym = then THEN Get(sym) ELSE err(27) END ELSIF sym = elsif THEN IF fold <= 1 THEN err(14) END; (* ELSIF without IF *) Else; Get(sym); Expression(val, use); If(val); INC(top.ref); IF sym = then THEN Get(sym) ELSE err(27) END ELSIF sym = else THEN IF fold <= 1 THEN err(14) END; (* ELSE without IF *) Else; Get(sym) ELSIF sym = end THEN IF fold <= 1 THEN err(14) END; (* END without IF *) End; Get(sym) ELSE err(14) END; IF sym # endcom THEN err(5) ELSE DevCPM.errpos := DevCPM.curpos - 1 END END Parse; PROCEDURE Check*; BEGIN IF fold # 1 THEN err(14) END END Check; PROCEDURE Close*; BEGIN ch := " "; sym := eof; name := ""; fold := 0; top := NIL; scope := NIL; skip := FALSE; used := FALSE END Close; PROCEDURE Init*; VAR s: Selector; BEGIN Close; If(TRUE); NEW(scope); Set("TRUE", TRUE); Set("FALSE", FALSE); used := FALSE END Init; END DevCPR.