lang/pc/comp/body.c

   1 #include        "debug.h"
   2
   3 #include        <alloc.h>
   4 #include        <assert.h>
   5 #include        <em.h>
   6
   7 #include        "LLlex.h"
   8 #include        "chk_expr.h"
   9 #include        "def.h"
  10 #include        "desig.h"
  11 #include        "idf.h"
  12 #include        "main.h"
  13 #include        "misc.h"
  14 #include        "node.h"
  15 #include        "scope.h"
  16 #include        "type.h"
  17
  18 MarkDef(nd, flags, on)
  19         register struct node *nd;
  20         unsigned short flags;
  21 {
  22         while( nd && nd->nd_class != Def ) {
  23                 if( (nd->nd_class == Arrsel) ||
  24                     (nd->nd_class == LinkDef) )
  25                         nd = nd->nd_left;
  26                 else if( nd->nd_class == Arrow )
  27                         nd = nd->nd_right;
  28                 else break;
  29         }
  30         if( nd && (nd->nd_class == Def) ) {
  31                 if( (flags & D_SET) && on &&
  32                     BlockScope != nd->nd_def->df_scope )
  33                         nd->nd_def->df_flags |= D_SETINHIGH;
  34                 if( on ) {
  35                         /*
  36                         if( (flags & D_SET) &&
  37                             (nd->nd_def->df_flags & D_WITH) )
  38                                 node_warning(nd,
  39                                 "variable \"%s\" already referenced in with",
  40                                 nd->nd_def->df_idf->id_text);
  41                         */
  42                         nd->nd_def->df_flags |= flags;
  43                 }
  44                 else
  45                         nd->nd_def->df_flags &= ~flags;
  46         }
  47 }
  48
  49 AssertStat(expp, line)
  50         register struct node *expp;
  51         unsigned short line;
  52 {
  53         struct desig dsr;
  54
  55         if( !ChkExpression(expp) )
  56                 return;
  57
  58         if( expp->nd_type != bool_type )        {
  59                 node_error(expp, "type of assertion should be boolean");
  60                 return;
  61         }
  62
  63         if( !options['a'] && !err_occurred ) {
  64                 dsr = InitDesig;
  65                 CodeExpr(expp, &dsr, NO_LABEL);
  66                 C_loc((arith)line);
  67                 C_cal("_ass");
  68         }
  69 }
  70
  71 AssignStat(left, right)
  72         register struct node *left, *right;
  73 {
  74         register struct type *ltp, *rtp;
  75         int retval = 0;
  76         struct desig dsr;
  77
  78         retval = ChkExpression(right);
  79         MarkUsed(right);
  80         retval &= ChkLhs(left);
  81
  82         ltp = left->nd_type;
  83         rtp = right->nd_type;
  84
  85         MarkDef(left, (unsigned short)D_SET, 1);
  86
  87         if( !retval ) return;
  88
  89         if( ltp == int_type && rtp == long_type )       {
  90                 right = MkNode(IntReduc, NULLNODE, right, &dot);
  91                 right->nd_type = int_type;
  92         }
  93         else if( ltp == long_type && rtp == int_type )  {
  94                 right = MkNode(IntCoerc, NULLNODE, right, &dot);
  95                 right->nd_type = long_type;
  96         }
  97
  98         if( !TstAssCompat(ltp, rtp) )   {
  99                 node_error(left, "type incompatibility in assignment");
 100                 return;
 101         }
 102
 103         if( left->nd_class == Def &&
 104             (left->nd_def->df_flags & D_INLOOP) )       {
 105                 node_error(left, "assignment to a control variable");
 106                 return;
 107         }
 108
 109         if( rtp == emptyset_type )
 110                 right->nd_type = ltp;
 111
 112         if( !err_occurred )     {
 113                 dsr = InitDesig;
 114                 CodeExpr(right, &dsr, NO_LABEL);
 115
 116                 if( rtp->tp_fund & (T_ARRAY | T_RECORD) )
 117                         CodeAddress(&dsr);
 118                 else    {
 119                         CodeValue(&dsr, rtp);
 120
 121                         if( ltp == real_type && BaseType(rtp) == int_type )
 122                                 Int2Real(rtp->tp_size);
 123
 124                         RangeCheck(ltp, rtp);
 125                 }
 126                 CodeMove(&dsr, left, rtp);
 127         }
 128
 129         FreeNode(left);
 130         FreeNode(right);
 131 }
 132
 133 ProcStat(nd)
 134         register struct node *nd;
 135 {
 136         if( !ChkCall(nd) ) return;
 137
 138         if( nd->nd_type )       {
 139                 node_error(nd, "procedure call expected");
 140                 return;
 141         }
 142 }
 143
 144 ChkForStat(nd)
 145         register struct node *nd;
 146 {
 147         register struct def *df;
 148         int retvar = 0;
 149
 150         retvar = ChkVariable(nd);
 151         retvar &= ChkExpression(nd->nd_left);
 152         MarkUsed(nd->nd_left);
 153         retvar &= ChkExpression(nd->nd_right);
 154         MarkUsed(nd->nd_right);
 155         if( !retvar ) return;
 156
 157         assert(nd->nd_class == Def);
 158
 159         df = nd->nd_def;
 160
 161         if( df->df_scope != BlockScope )        {
 162                 node_error(nd, "for loop: control variable must be local");
 163                 return;
 164         }
 165
 166         assert(df->df_kind == D_VARIABLE);
 167
 168         if( df->df_scope != GlobalScope && df->var_off >= 0 )   {
 169                 node_error(nd,
 170                             "for loop: control variable can't be a parameter");
 171                 MarkDef(nd,(unsigned short)(D_LOOPVAR | D_SET | D_USED), 1);
 172                 return;
 173         }
 174
 175         if( !(df->df_type->tp_fund & T_ORDINAL) )       {
 176                 node_error(nd, "for loop: control variable must be ordinal");
 177                 MarkDef(nd,(unsigned short)(D_LOOPVAR | D_SET | D_USED), 1);
 178                 return;
 179         }
 180
 181         if( !TstCompat(df->df_type, nd->nd_left->nd_type) )
 182                 node_error(nd,
 183                   "for loop: initial value incompatible with control variable");
 184
 185         if( !TstCompat(df->df_type, nd->nd_right->nd_type) )
 186                 node_error(nd,
 187                     "for loop: final value incompatible with control variable");
 188
 189         if( df->df_type == long_type )
 190                 node_error(nd, "for loop: control variable can not be a long");
 191
 192         if( df->df_flags & D_INLOOP )
 193                 node_error(nd, "for loop: control variable already used");
 194
 195         if( df->df_flags & D_SETINHIGH )
 196                 node_error(nd,
 197                             "for loop: control variable already set in block");
 198
 199         MarkDef(nd,(unsigned short) (D_LOOPVAR | D_INLOOP | D_SET | D_USED), 1);
 200
 201         return;
 202 }
 203
 204 EndForStat(nd)
 205         register struct node *nd;
 206 {
 207         register struct def *df;
 208
 209         df = nd->nd_def;
 210
 211         if( (df->df_scope != BlockScope) ||
 212             (df->df_scope != GlobalScope && df->var_off >= 0) ||
 213             !(df->df_type->tp_fund & T_ORDINAL)
 214           )
 215                 return;
 216
 217         MarkDef(nd,(unsigned short) (D_INLOOP | D_SET), 0);
 218 }
 219
 220 arith
 221 CodeInitFor(nd, priority)
 222         register struct node *nd;
 223 {
 224         /* Push final-value, the value may only be evaluated
 225            once, so generate a temporary for it, when not a constant.
 226         */
 227
 228         arith tmp;
 229
 230         CodePExpr(nd);
 231         if( nd->nd_class != Value )     {
 232                 tmp = NewInt(priority);
 233
 234                 C_dup(int_size);
 235                 C_stl(tmp);
 236
 237                 return tmp;
 238         }
 239         return (arith) 0;
 240 }
 241
 242 CodeFor(nd, stepsize, l1, l2)
 243         struct node *nd;
 244         label l1, l2;
 245 {
 246         /* Test if loop has to be done */
 247         if( stepsize == 1 )     /* TO */
 248                 C_bgt(l2);
 249         else                    /* DOWNTO */
 250                 C_blt(l2);
 251
 252         /* Label at begin of the body */
 253         C_df_ilb(l1);
 254
 255         RangeCheck(nd->nd_type, nd->nd_left->nd_type);
 256         CodeDStore(nd);
 257 }
 258
 259 CodeEndFor(nd, stepsize, l1, l2, tmp2)
 260         struct node *nd;
 261         label l1, l2;
 262         arith tmp2;
 263 {
 264         /* Test if loop has to be done once more */
 265         CodePExpr(nd);
 266         C_dup(int_size);
 267         if( tmp2 )
 268                 C_lol(tmp2);
 269         else
 270                 CodePExpr(nd->nd_right);
 271         C_beq(l2);
 272
 273         /* Increment/decrement the control-variable */
 274         if( stepsize == 1 )     /* TO */
 275                 C_inc();
 276         else                    /* DOWNTO */
 277                 C_dec();
 278         C_bra(l1);
 279
 280         /* Exit label */
 281         C_df_ilb(l2);
 282         C_asp(int_size);
 283 }
 284
 285 WithStat(nd)
 286         struct node *nd;
 287 {
 288         struct withdesig *wds;
 289         struct desig ds;
 290         struct scopelist *scl;
 291
 292         if( nd->nd_type->tp_fund != T_RECORD )  {
 293                 node_error(nd, "record variable expected");
 294                 return;
 295         }
 296
 297         MarkDef(nd, (unsigned short)(D_USED | D_SET | D_WITH), 1);
 298         /*
 299         if( (nd->nd_class == Arrow) &&
 300             (nd->nd_right->nd_type->tp_fund & T_FILE) ) {
 301                 nd->nd_right->nd_def->df_flags |= D_WITH;
 302         }
 303         */
 304
 305         scl = new_scopelist();
 306         scl->sc_scope = nd->nd_type->rec_scope;
 307         scl->next = CurrVis;
 308         CurrVis = scl;
 309
 310         if( err_occurred ) return;
 311
 312         /* Generate code */
 313
 314         CodeDAddress(nd);
 315
 316         wds = new_withdesig();
 317         wds->w_next = WithDesigs;
 318         WithDesigs = wds;
 319         wds->w_scope = scl->sc_scope;
 320
 321         /* create a desig structure for the temporary */
 322         ds.dsg_kind = DSG_FIXED;
 323         ds.dsg_offset = NewPtr(1);
 324         ds.dsg_name = 0;
 325
 326         /* need some pointertype to store pointer */
 327         CodeStore(&ds, nil_type);
 328
 329         /* record is indirectly available */
 330         ds.dsg_kind = DSG_PFIXED;
 331         wds->w_desig = ds;
 332 }
 333
 334 EndWith(saved_scl, nd)
 335         struct scopelist *saved_scl;
 336         struct node *nd;
 337 {
 338         /* restore scope, and release structures */
 339         struct scopelist *scl;
 340         struct withdesig *wds;
 341         struct node *nd1;
 342
 343         while( CurrVis != saved_scl )   {
 344
 345                 /* release scopelist */
 346                 scl = CurrVis;
 347                 CurrVis = CurrVis->next;
 348                 free_scopelist(scl);
 349
 350                 if( WithDesigs == 0 )
 351                         continue;       /* we didn't generate any code */
 352
 353                 /* release temporary */
 354                 FreePtr(WithDesigs->w_desig.dsg_offset);
 355
 356                 /* release withdesig */
 357                 wds = WithDesigs;
 358                 WithDesigs = WithDesigs->w_next;
 359                 free_withdesig(wds);
 360         }
 361
 362         for( nd1 = nd; nd1 != NULLNODE; nd1 = nd1->nd_right ) {
 363                 MarkDef(nd1->nd_left, (unsigned short)(D_WITH), 0);
 364         }
 365
 366         FreeNode(nd);
 367 }