3 IMPORT Strings
, DevCPM
, DevCPT
;
6 MaxIdLen
= LEN(DevCPT
.Name
);
10 if
= 1; then
= 2; else
= 3; elsif
= 4; end
= 5;
11 new
= 6; error
= 7; ident
= 8; plus
= 9; minus
= 10;
12 not
= 11; and
= 12; or
= 13; rpar
= 14; lpar
= 15; defined
= 16;
13 endcom
= 17; eof
= 18;
16 Context
= POINTER TO RECORD
17 next
: Context
; (* upper level block *)
18 alt
: BOOLEAN; (* else branch *)
19 val
: BOOLEAN; (* condition value, inverted if alt *)
20 ref
: INTEGER (* ELSIF count *)
23 Selector
= POINTER TO RECORD
30 ch
-: CHAR; (* current character *)
31 name
: DevCPT
.Name
; (* ident *)
34 sym
: BYTE; (* parser symbol *)
35 fold
: INTEGER; (* condition folding *)
41 PROCEDURE err (n
: SHORTINT);
45 PROCEDURE Identifier (VAR sym
: BYTE);
46 VAR i
, res
: INTEGER; n
: ARRAY MaxIdLen
OF CHAR;
49 n
[i
] := ch
; INC(i
); DevCPM
.Get(ch
)
50 UNTIL ~Strings
.IsIdent(ch
) OR (i
= MaxIdLen
);
51 IF i
= MaxIdLen
THEN err(240); DEC(i
) END ;
52 n
[i
] := 0X
; Strings
.StringToUtf8(n
, name
, res
); sym
:= ident
;
53 IF res
= 1 (*truncated*) THEN err(240) END
56 PROCEDURE Get (VAR sym
: BYTE);
58 DevCPM
.errpos
:= DevCPM
.curpos
- 1;
59 WHILE (ch
# DevCPM
.Eot
) & ((ch
<= " ") OR (ch
= 0A0X
)) DO DevCPM
.Get(ch
) END;
60 DevCPM
.startpos
:= DevCPM
.curpos
- 1;
62 | DevCPM
.Eot
: sym
:= eof
63 |
"&": sym
:= and
; DevCPM
.Get(ch
)
64 |
"(": sym
:= lpar
; DevCPM
.Get(ch
)
65 |
")": sym
:= rpar
; DevCPM
.Get(ch
)
67 sym
:= null
; DevCPM
.Get(ch
);
68 IF ch
= ">" THEN sym
:= endcom
; DevCPM
.Get(ch
) END
69 |
"+": sym
:= plus
; DevCPM
.Get(ch
)
70 |
"-": sym
:= minus
; DevCPM
.Get(ch
)
71 |
"D": Identifier(sym
); IF name
= "DEFINED" THEN sym
:= defined
END
72 |
"E": Identifier(sym
);
73 IF name
= "END" THEN sym
:= end
74 ELSIF name
= "ELSE" THEN sym
:= else
75 ELSIF name
= "ELSIF" THEN sym
:= elsif
76 ELSIF name
= "ERROR" THEN sym
:= error
78 |
"I": Identifier(sym
); IF name
= "IF" THEN sym
:= if
END
79 |
"N": Identifier(sym
); IF name
= "NEW" THEN sym
:= new
END
80 |
"O": Identifier(sym
); IF name
= "OR" THEN sym
:= or
END
81 |
"T": Identifier(sym
); IF name
= "THEN" THEN sym
:= then
END
82 |
"A".."C", "J".."M", "P".."S", "U".."Z", "a".."z", "_": Identifier(sym
)
83 |
"~": sym
:= not
; DevCPM
.Get(ch
)
85 IF Strings
.IsIdent(ch
) THEN Identifier(sym
) ELSE sym
:= null
; DevCPM
.Get(ch
) END
89 PROCEDURE New (IN name
: DevCPT
.Name
): Selector
;
93 WHILE (s
.next
# NIL) & (s
.next
.name$
# name$
) DO s
:= s
.next
END;
94 IF s
.next
= NIL THEN NEW(s
.next
); s
.next
.name
:= name$
; s
.next
.val
:= FALSE
100 PROCEDURE Old (IN name
: DevCPT
.Name
): Selector
;
104 WHILE (s
.next
# NIL) & (s
.next
.name$
# name$
) DO s
:= s
.next
END;
106 err(0); NEW(s
.next
); s
.next
.name
:= name$
; s
.next
.val
:= FALSE
111 PROCEDURE Find (IN name
: DevCPT
.Name
): Selector
;
115 WHILE (s
.next
# NIL) & (s
.next
.name$
# name$
) DO s
:= s
.next
END;
119 PROCEDURE Set
* (IN name
: DevCPT
.Name
; val
: BOOLEAN);
123 WHILE (s
.next
# NIL) & (s
.next
.name$
# name$
) DO s
:= s
.next
END;
124 IF s
.next
= NIL THEN NEW(s
.next
) END;
125 s
.next
.name
:= name$
; s
.next
.val
:= val
128 PROCEDURE ^
Expression (VAR x
: BOOLEAN; use
: BOOLEAN);
130 PROCEDURE Factor (VAR x
: BOOLEAN; use
: BOOLEAN);
134 IF use
THEN x
:= Old(name
).val
END; Get(sym
);
135 ELSIF sym
= defined
THEN
140 IF use
THEN x
:= Find(name
) # NIL END;
144 IF sym
# rpar
THEN err(23)
149 ELSIF sym
= lpar
THEN
150 Get(sym
); Expression(x
, use
);
151 IF sym
# rpar
THEN err(23)
155 Get(sym
); Factor(x
, use
); IF use
THEN x
:= ~x
END
161 PROCEDURE Term (VAR x
: BOOLEAN; use
: BOOLEAN);
166 Get(sym
); Factor(y
, use
& x
); IF use
& x
THEN x
:= x
& y
END
170 PROCEDURE Expression (VAR x
: BOOLEAN; use
: BOOLEAN);
175 Get(sym
); Term(y
, use
& ~x
); IF use
& ~x
THEN x
:= x
OR y
END
179 PROCEDURE Printable (): BOOLEAN;
183 WHILE (c
# NIL) & c
.val
DO c
:= c
.next
END;
187 PROCEDURE If (cond
: BOOLEAN);
190 NEW(c
); c
.next
:= top
; c
.alt
:= FALSE
; c
.val
:= cond
; c
.ref
:= 0; top
:= c
;
191 INC(fold
); skip
:= ~
Printable(); used
:= TRUE
196 IF top
.alt
THEN err(14) (* double ELSE *)
197 ELSE top
.alt
:= TRUE
; top
.val
:= ~top
.val
; skip
:= ~
Printable()
204 i
:= 0; ref
:= top
.ref
; DEC(fold
, ref
+ 1);
205 WHILE (top
# NIL) & (i
<= ref
) DO top
:= top
.next
; INC(i
) END;
206 IF top
= NIL THEN err(51); fold
:= 0; If(TRUE
) END;
211 VAR val
: BOOLEAN; s
: Selector
; use
: BOOLEAN;
213 ch
:= " "; Get(sym
); use
:= ~skip
;
217 IF use
THEN s
:= New(name
) END; Get(sym
);
218 IF (sym
= plus
) OR (sym
= minus
) THEN
219 IF use
THEN s
.val
:= sym
= plus
END; Get(sym
)
223 ELSIF sym
= ident
THEN
224 IF use
THEN s
:= Old(name
) END; Get(sym
);
225 IF (sym
= plus
) OR (sym
= minus
) THEN
226 IF use
THEN s
.val
:= sym
= plus
END; Get(sym
)
229 ELSIF sym
= error
THEN
230 IF use
THEN err(501) END; Get(sym
)
232 Get(sym
); Expression(val
, use
); If(val
);
233 IF sym
= then
THEN Get(sym
)
236 ELSIF sym
= elsif
THEN
237 IF fold
<= 1 THEN err(14) END; (* ELSIF without IF *)
238 Else
; Get(sym
); Expression(val
, use
); If(val
); INC(top
.ref
);
239 IF sym
= then
THEN Get(sym
)
242 ELSIF sym
= else
THEN
243 IF fold
<= 1 THEN err(14) END; (* ELSE without IF *)
246 IF fold
<= 1 THEN err(14) END; (* END without IF *)
251 IF sym
# endcom
THEN err(5) ELSE DevCPM
.errpos
:= DevCPM
.curpos
- 1 END
256 IF fold
# 1 THEN err(14) END
261 ch
:= " "; sym
:= eof
; name
:= "";
262 fold
:= 0; top
:= NIL; scope
:= NIL;
263 skip
:= FALSE
; used
:= FALSE