123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367 |
- #include "debug.h"
- #include <alloc.h>
- #include <assert.h>
- #include <em.h>
- #include "LLlex.h"
- #include "chk_expr.h"
- #include "def.h"
- #include "desig.h"
- #include "idf.h"
- #include "main.h"
- #include "misc.h"
- #include "node.h"
- #include "scope.h"
- #include "type.h"
- MarkDef(nd, flags, on)
- register struct node *nd;
- unsigned short flags;
- {
- while( nd && nd->nd_class != Def ) {
- if( (nd->nd_class == Arrsel) ||
- (nd->nd_class == LinkDef) )
- nd = nd->nd_left;
- else if( nd->nd_class == Arrow )
- nd = nd->nd_right;
- else break;
- }
- if( nd && (nd->nd_class == Def) ) {
- if( (flags & D_SET) && on &&
- BlockScope != nd->nd_def->df_scope )
- nd->nd_def->df_flags |= D_SETINHIGH;
- if( on ) {
- /*
- if( (flags & D_SET) &&
- (nd->nd_def->df_flags & D_WITH) )
- node_warning(nd,
- "variable \"%s\" already referenced in with",
- nd->nd_def->df_idf->id_text);
- */
- nd->nd_def->df_flags |= flags;
- }
- else
- nd->nd_def->df_flags &= ~flags;
- }
- }
- AssertStat(expp, line)
- register struct node *expp;
- unsigned short line;
- {
- struct desig dsr;
- if( !ChkExpression(expp) )
- return;
- if( expp->nd_type != bool_type ) {
- node_error(expp, "type of assertion should be boolean");
- return;
- }
- if( !options['a'] && !err_occurred ) {
- dsr = InitDesig;
- CodeExpr(expp, &dsr, NO_LABEL);
- C_loc((arith)line);
- C_cal("_ass");
- }
- }
- AssignStat(left, right)
- register struct node *left, *right;
- {
- register struct type *ltp, *rtp;
- int retval = 0;
- struct desig dsr;
- retval = ChkExpression(right);
- MarkUsed(right);
- retval &= ChkLhs(left);
- ltp = left->nd_type;
- rtp = right->nd_type;
- MarkDef(left, (unsigned short)D_SET, 1);
- if( !retval ) return;
- if( ltp == int_type && rtp == long_type ) {
- right = MkNode(IntReduc, NULLNODE, right, &dot);
- right->nd_type = int_type;
- }
- else if( ltp == long_type && rtp == int_type ) {
- right = MkNode(IntCoerc, NULLNODE, right, &dot);
- right->nd_type = long_type;
- }
- if( !TstAssCompat(ltp, rtp) ) {
- node_error(left, "type incompatibility in assignment");
- return;
- }
- if( left->nd_class == Def &&
- (left->nd_def->df_flags & D_INLOOP) ) {
- node_error(left, "assignment to a control variable");
- return;
- }
- if( rtp == emptyset_type )
- right->nd_type = ltp;
- if( !err_occurred ) {
- dsr = InitDesig;
- CodeExpr(right, &dsr, NO_LABEL);
- if( rtp->tp_fund & (T_ARRAY | T_RECORD) )
- CodeAddress(&dsr);
- else {
- CodeValue(&dsr, rtp);
- if( ltp == real_type && BaseType(rtp) == int_type )
- Int2Real(rtp->tp_size);
- RangeCheck(ltp, rtp);
- }
- CodeMove(&dsr, left, rtp);
- }
- FreeNode(left);
- FreeNode(right);
- }
- ProcStat(nd)
- register struct node *nd;
- {
- if( !ChkCall(nd) ) return;
- if( nd->nd_type ) {
- node_error(nd, "procedure call expected");
- return;
- }
- }
- ChkForStat(nd)
- register struct node *nd;
- {
- register struct def *df;
- int retvar = 0;
- retvar = ChkVariable(nd);
- retvar &= ChkExpression(nd->nd_left);
- MarkUsed(nd->nd_left);
- retvar &= ChkExpression(nd->nd_right);
- MarkUsed(nd->nd_right);
- if( !retvar ) return;
- assert(nd->nd_class == Def);
- df = nd->nd_def;
- if( df->df_scope != BlockScope ) {
- node_error(nd, "for loop: control variable must be local");
- return;
- }
- assert(df->df_kind == D_VARIABLE);
- if( df->df_scope != GlobalScope && df->var_off >= 0 ) {
- node_error(nd,
- "for loop: control variable can't be a parameter");
- MarkDef(nd,(unsigned short)(D_LOOPVAR | D_SET | D_USED), 1);
- return;
- }
- if( !(df->df_type->tp_fund & T_ORDINAL) ) {
- node_error(nd, "for loop: control variable must be ordinal");
- MarkDef(nd,(unsigned short)(D_LOOPVAR | D_SET | D_USED), 1);
- return;
- }
- if( !TstCompat(df->df_type, nd->nd_left->nd_type) )
- node_error(nd,
- "for loop: initial value incompatible with control variable");
- if( !TstCompat(df->df_type, nd->nd_right->nd_type) )
- node_error(nd,
- "for loop: final value incompatible with control variable");
-
- if( df->df_type == long_type )
- node_error(nd, "for loop: control variable can not be a long");
- if( df->df_flags & D_INLOOP )
- node_error(nd, "for loop: control variable already used");
- if( df->df_flags & D_SETINHIGH )
- node_error(nd,
- "for loop: control variable already set in block");
- MarkDef(nd,(unsigned short) (D_LOOPVAR | D_INLOOP | D_SET | D_USED), 1);
- return;
- }
- EndForStat(nd)
- register struct node *nd;
- {
- register struct def *df;
- df = nd->nd_def;
- if( (df->df_scope != BlockScope) ||
- (df->df_scope != GlobalScope && df->var_off >= 0) ||
- !(df->df_type->tp_fund & T_ORDINAL)
- )
- return;
- MarkDef(nd,(unsigned short) (D_INLOOP | D_SET), 0);
- }
- arith
- CodeInitFor(nd, priority)
- register struct node *nd;
- {
- /* Push final-value, the value may only be evaluated
- once, so generate a temporary for it, when not a constant.
- */
- arith tmp;
- CodePExpr(nd);
- if( nd->nd_class != Value ) {
- tmp = NewInt(priority);
- C_dup(int_size);
- C_stl(tmp);
- return tmp;
- }
- return (arith) 0;
- }
- CodeFor(nd, stepsize, l1, l2)
- struct node *nd;
- label l1, l2;
- {
- /* Test if loop has to be done */
- if( stepsize == 1 ) /* TO */
- C_bgt(l2);
- else /* DOWNTO */
- C_blt(l2);
- /* Label at begin of the body */
- C_df_ilb(l1);
- RangeCheck(nd->nd_type, nd->nd_left->nd_type);
- CodeDStore(nd);
- }
- CodeEndFor(nd, stepsize, l1, l2, tmp2)
- struct node *nd;
- label l1, l2;
- arith tmp2;
- {
- /* Test if loop has to be done once more */
- CodePExpr(nd);
- C_dup(int_size);
- if( tmp2 )
- C_lol(tmp2);
- else
- CodePExpr(nd->nd_right);
- C_beq(l2);
- /* Increment/decrement the control-variable */
- if( stepsize == 1 ) /* TO */
- C_inc();
- else /* DOWNTO */
- C_dec();
- C_bra(l1);
- /* Exit label */
- C_df_ilb(l2);
- C_asp(int_size);
- }
- WithStat(nd)
- struct node *nd;
- {
- struct withdesig *wds;
- struct desig ds;
- struct scopelist *scl;
- if( nd->nd_type->tp_fund != T_RECORD ) {
- node_error(nd, "record variable expected");
- return;
- }
- MarkDef(nd, (unsigned short)(D_USED | D_SET | D_WITH), 1);
- /*
- if( (nd->nd_class == Arrow) &&
- (nd->nd_right->nd_type->tp_fund & T_FILE) ) {
- nd->nd_right->nd_def->df_flags |= D_WITH;
- }
- */
- scl = new_scopelist();
- scl->sc_scope = nd->nd_type->rec_scope;
- scl->next = CurrVis;
- CurrVis = scl;
- if( err_occurred ) return;
- /* Generate code */
- CodeDAddress(nd);
- wds = new_withdesig();
- wds->w_next = WithDesigs;
- WithDesigs = wds;
- wds->w_scope = scl->sc_scope;
- /* create a desig structure for the temporary */
- ds.dsg_kind = DSG_FIXED;
- ds.dsg_offset = NewPtr(1);
- ds.dsg_name = 0;
- /* need some pointertype to store pointer */
- CodeStore(&ds, nil_type);
- /* record is indirectly available */
- ds.dsg_kind = DSG_PFIXED;
- wds->w_desig = ds;
- }
- EndWith(saved_scl, nd)
- struct scopelist *saved_scl;
- struct node *nd;
- {
- /* restore scope, and release structures */
- struct scopelist *scl;
- struct withdesig *wds;
- struct node *nd1;
- while( CurrVis != saved_scl ) {
- /* release scopelist */
- scl = CurrVis;
- CurrVis = CurrVis->next;
- free_scopelist(scl);
- if( WithDesigs == 0 )
- continue; /* we didn't generate any code */
- /* release temporary */
- FreePtr(WithDesigs->w_desig.dsg_offset);
- /* release withdesig */
- wds = WithDesigs;
- WithDesigs = WithDesigs->w_next;
- free_withdesig(wds);
- }
- for( nd1 = nd; nd1 != NULLNODE; nd1 = nd1->nd_right ) {
- MarkDef(nd1->nd_left, (unsigned short)(D_WITH), 0);
- }
- FreeNode(nd);
- }
|