123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291 |
- /*
- * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
- * See the copyright notice in the ACK home directory, in the file "Copyright".
- *
- * Author: Ceriel J.H. Jacobs
- */
- /* S T A T E M E N T S */
- /* $Id$ */
- {
- #include <assert.h>
- #include <em_arith.h>
- #include <em_label.h>
- #include "idf.h"
- #include "LLlex.h"
- #include "scope.h"
- #include "def.h"
- #include "type.h"
- #include "node.h"
- static int loopcount = 0; /* Count nested loops */
- extern t_node *EmptyStatement;
- }
- statement(register t_node **pnd;)
- {
- register t_node *nd;
- extern int return_occurred;
- } :
- /*
- * This part is not in the reference grammar. The reference grammar
- * states : assignment | ProcedureCall | ...
- * but this gives LL(1) conflicts
- */
- designator(pnd)
- [ { nd = dot2node(Stat, *pnd, NULLNODE);
- nd->nd_symb = '(';
- nd->nd_lineno = (*pnd)->nd_lineno;
- }
- ActualParameters(&(nd->nd_RIGHT))?
- |
- [ BECOMES
- | %erroneous '='
- { error("':=' expected instead of '='");
- DOT = BECOMES;
- }
- ]
- { nd = dot2node(Stat, *pnd, NULLNODE); }
- expression(&(nd->nd_RIGHT))
- ]
- { *pnd = nd; }
- /*
- * end of changed part
- */
- |
- IfStatement(pnd)
- |
- CaseStatement(pnd)
- |
- WHILE { *pnd = nd = dot2leaf(Stat); }
- expression(&(nd->nd_LEFT))
- DO
- StatementSequence(&(nd->nd_RIGHT))
- END
- |
- REPEAT { *pnd = nd = dot2leaf(Stat); }
- StatementSequence(&(nd->nd_LEFT))
- UNTIL
- expression(&(nd->nd_RIGHT))
- |
- { loopcount++; }
- LOOP { *pnd = nd = dot2leaf(Stat); }
- StatementSequence(&((*pnd)->nd_RIGHT))
- END
- { loopcount--; }
- |
- ForStatement(pnd)
- |
- WITH { *pnd = nd = dot2leaf(Stat); }
- designator(&(nd->nd_LEFT))
- DO
- StatementSequence(&(nd->nd_RIGHT))
- END
- |
- EXIT
- { if (!loopcount) error("EXIT not in a LOOP");
- *pnd = dot2leaf(Stat);
- }
- |
- ReturnStatement(pnd)
- { return_occurred = 1; }
- |
- /* empty */ { *pnd = EmptyStatement; }
- ;
- /*
- * The next two rules in-line in "Statement", because of an LL(1) conflict
- assignment:
- designator BECOMES expression
- ;
- ProcedureCall:
- designator ActualParameters?
- ;
- */
- StatementSequence(register t_node **pnd;)
- {
- t_node *nd;
- register t_node *nd1;
- } :
- statement(pnd)
- [ %persistent
- ';'
- statement(&nd)
- { if (nd != EmptyStatement) {
- nd1 = dot2node(Link, *pnd, nd);
- *pnd = nd1;
- nd1->nd_symb = ';';
- pnd = &(nd1->nd_RIGHT);
- }
- }
- ]*
- ;
- IfStatement(t_node **pnd;)
- {
- register t_node *nd;
- } :
- IF { nd = dot2leaf(Stat);
- *pnd = nd;
- }
- expression(&(nd->nd_LEFT))
- THEN { nd->nd_RIGHT = dot2leaf(Link);
- nd = nd->nd_RIGHT;
- }
- StatementSequence(&(nd->nd_LEFT))
- [
- ELSIF { nd->nd_RIGHT = dot2leaf(Stat);
- nd = nd->nd_RIGHT;
- nd->nd_symb = IF;
- }
- expression(&(nd->nd_LEFT))
- THEN { nd->nd_RIGHT = dot2leaf(Link);
- nd = nd->nd_RIGHT;
- }
- StatementSequence(&(nd->nd_LEFT))
- ]*
- [
- ELSE
- StatementSequence(&(nd->nd_RIGHT))
- |
- ]
- END
- ;
- CaseStatement(t_node **pnd;)
- {
- register t_node *nd;
- t_type *tp = 0;
- } :
- CASE { *pnd = nd = dot2leaf(Stat); }
- expression(&(nd->nd_LEFT))
- OF
- case(&(nd->nd_RIGHT), &tp)
- { nd = nd->nd_RIGHT; }
- [
- '|'
- case(&(nd->nd_RIGHT), &tp)
- { nd = nd->nd_RIGHT; }
- ]*
- [ ELSE StatementSequence(&(nd->nd_RIGHT))
- |
- ]
- END
- ;
- case(t_node **pnd; t_type **ptp;) :
- [ CaseLabelList(ptp, pnd)
- ':' { *pnd = dot2node(Link, *pnd, NULLNODE); }
- StatementSequence(&((*pnd)->nd_RIGHT))
- |
- ]
- { *pnd = dot2node(Link, *pnd, NULLNODE);
- (*pnd)->nd_symb = '|';
- }
- ;
- /* inline in statement; lack of space
- WhileStatement(t_node **pnd;)
- {
- register t_node *nd;
- }:
- WHILE { *pnd = nd = dot2leaf(Stat); }
- expression(&(nd->nd_LEFT))
- DO
- StatementSequence(&(nd->nd_RIGHT))
- END
- ;
- RepeatStatement(t_node **pnd;)
- {
- register t_node *nd;
- }:
- REPEAT { *pnd = nd = dot2leaf(Stat); }
- StatementSequence(&(nd->nd_LEFT))
- UNTIL
- expression(&(nd->nd_RIGHT))
- ;
- */
- ForStatement(t_node **pnd;)
- {
- register t_node *nd, *nd1;
- }:
- FOR { *pnd = nd = dot2leaf(Stat); }
- IDENT { nd1 = dot2leaf(Name); }
- BECOMES { nd->nd_LEFT = dot2node(Stat, nd1, dot2leaf(Link));
- nd1 = nd->nd_LEFT->nd_RIGHT;
- nd1->nd_symb = TO;
- }
- expression(&(nd1->nd_LEFT))
- TO
- expression(&(nd1->nd_RIGHT))
- { nd->nd_RIGHT = nd1 = dot2leaf(Link);
- nd1->nd_symb = BY;
- }
- [
- BY
- ConstExpression(&(nd1->nd_LEFT))
- { if (!(nd1->nd_LEFT->nd_type->tp_fund & T_INTORCARD)) {
- error("illegal type in BY clause");
- }
- }
- |
- { nd1->nd_LEFT = dot2leaf(Value);
- nd1->nd_LEFT->nd_INT = 1;
- }
- ]
- DO
- StatementSequence(&(nd1->nd_RIGHT))
- END
- ;
- /* inline in Statement; lack of space
- LoopStatement(t_node **pnd;):
- LOOP { *pnd = dot2leaf(Stat); }
- StatementSequence(&((*pnd)->nd_RIGHT))
- END
- ;
- WithStatement(t_node **pnd;)
- {
- register t_node *nd;
- }:
- WITH { *pnd = nd = dot2leaf(Stat); }
- designator(&(nd->nd_LEFT))
- DO
- StatementSequence(&(nd->nd_RIGHT))
- END
- ;
- */
- ReturnStatement(t_node **pnd;)
- {
- register t_def *df = CurrentScope->sc_definedby;
- register t_type *tp = df->df_type ? ResultType(df->df_type) : 0;
- register t_node *nd;
- } :
- RETURN { *pnd = nd = dot2leaf(Stat); }
- [
- expression(&(nd->nd_RIGHT))
- { if (scopeclosed(CurrentScope)) {
- error("a module body cannot return a value");
- }
- else if (! tp) {
- error("procedure \"%s\" is not a function, so cannot return a value", df->df_idf->id_text);
- }
- }
- |
- { if (tp) {
- error("function procedure \"%s\" must return a value", df->df_idf->id_text);
- }
- }
- ]
- ;
|