Back to home page

EIC code displayed by LXR
 
 

    

File indexing completed on 2025-02-21 10:05:31 

0001 /*
0002  *  qp_exe_dyn_templ.h  --
0003  *
0004  *  Original:  4-Apr-1995 15:50
0005  *
0006  *  Author:   Maarten Ballintijn <Maarten.Ballintijn@cern.ch>
0007  *
0008  *  $Id$
0009  *
0010  *  $Log$
0011  *  Revision 1.8  1996/05/13 16:23:40  maartenb
0012  *  - Add 4+ dimension dynamic array access.
0013  *
0014  *  Revision 1.7  1996/05/06 09:18:08  maartenb
0015  *  - Introduce a consistent reporting of array bound errors
0016  *
0017  *  - Cleanup dynamic non scalar access.
0018  *
0019  *  Revision 1.6  1996/04/26 09:09:11  maartenb
0020  *  - Implemented dynamic access to 3dim arrays.
0021  *
0022  *  Revision 1.5  1996/04/23 18:38:27  maartenb
0023  *  - Add RCS keywords
0024  *
0025  *
0026  */
0027 
0028 /* 1 dimensional case */
0029 case FC_CWN_DYN_BOOL + (OP_BASE):
0030         {
0031             int i, stride, start, end, max;
0032             OP_TYPE *ptr;
0033 
0034             stride = *pc++; /* stride is always one for 1 dim */
0035                     /* but we leave it in for regularity */
0036             max = *pc++;
0037             if ( max <= 0 ) {
0038                 /* variable length, get index variable */
0039                 max = *CWNBlock[-max].p;
0040             }
0041 
0042             start = *pc++;
0043             if ( start == 0 ) {
0044                 /* pop */
0045                 start = stack[frame[framep]];
0046                 POP_FRAME(1);
0047             }
0048 
0049             end = *pc++;
0050             if ( end == -1 ) {
0051                 end = start;
0052             } else if ( end == -2 ) {
0053                 end = max;
0054             } else if ( end == 0 ) {
0055                 /* pop */
0056                 end = stack[frame[framep]];
0057                 POP_FRAME(1);
0058             }
0059 
0060             /* now check consistency */
0061 
0062             if ( 1 > start ) {
0063                 qp_report_bounds(ievt,np->name,1,start,end,max);
0064                 *errp = R_MATH_ERROR;
0065                 running = FALSE;
0066                 break;
0067             }
0068             if ( end > max ) {
0069                 qp_report_bounds(ievt,np->name,1,start,end,max);
0070                 *errp = R_MATH_ERROR;
0071                 running = FALSE;
0072                 break;
0073             }
0074 
0075             if ( start <= end ) {
0076                 /* put on stack */
0077                 NEW_FRAME( OP_DTYPE, end - start + 1, ptr );
0078                 for ( i=start-1 ; i < end ; i++ ) {
0079                     *ptr++ = ((OP_TYPE *) np->p)[ i ];
0080 
0081                 }
0082 
0083                 if ( info_flag ) {
0084                     SHAPE_PUSH_1( end - start + 1 );
0085                 }
0086             } else {
0087                 /* put empty frame on stack */
0088                 NEW_FRAME( OP_DTYPE, 0, ptr );
0089                 if ( info_flag ) {
0090                     SHAPE_PUSH_1( 0 );
0091                 }
0092             }
0093         }
0094         break;
0095 
0096 /* 2 dimensional case */
0097 case FC_CWN_DYN_BOOL + (OP_BASE) + 16:
0098         {
0099             int     i, j, info_mask;
0100             int     stride1, start1, end1, max1;
0101             int     stride2, start2, end2, max2;
0102             OP_TYPE     *ptr;
0103 
0104             info_mask = 0;
0105             stride1 = *pc++;/* stride is always one for 1 dim */
0106                     /* but we leave it in for regularity */
0107             max1 = *pc++;
0108             if ( max1 <= 0 ) {
0109                 /* variable length, get index variable */
0110                 max1 = *CWNBlock[-max1].p;
0111             }
0112 
0113             start1 = *pc++;
0114             if ( start1 == 0 ) {
0115                 /* pop */
0116                 start1 = stack[frame[framep]];
0117                 POP_FRAME(1);
0118             }
0119 
0120             end1 = *pc++;
0121             if ( end1 == -1 ) {
0122                 end1 = start1;
0123                 info_mask |= 1;
0124             } else if ( end1 == -2 ) {
0125                 end1 = max1;
0126             } else if ( end1 == 0 ) {
0127                 /* pop */
0128                 end1 = stack[frame[framep]];
0129                 POP_FRAME(1);
0130             }
0131 
0132             /* now check consistency */
0133 
0134             if ( 1 > start1 ) {
0135                 qp_report_bounds(ievt,np->name,1,start1,end1,max1);
0136                 *errp = R_MATH_ERROR;
0137                 running = FALSE;
0138                 break;
0139             }
0140             if ( end1 > max1 ) {
0141                 qp_report_bounds(ievt,np->name,1,start1,end1,max1);
0142                 *errp = R_MATH_ERROR;
0143                 running = FALSE;
0144                 break;
0145             }
0146 
0147 
0148             stride2 = *pc++;/* stride is always one for 1 dim */
0149                     /* but we leave it in for regularity */
0150             max2 = *pc++;
0151             if ( max2 <= 0 ) {
0152                 /* variable length, get index variable */
0153                 max2 = *CWNBlock[-max2].p;
0154             }
0155 
0156             start2 = *pc++;
0157             if ( start2 == 0 ) {
0158                 /* pop */
0159                 start2 = stack[frame[framep]];
0160                 POP_FRAME(1);
0161             }
0162 
0163             end2 = *pc++;
0164             if ( end2 == -1 ) {
0165                 end2 = start2;
0166                 info_mask |= 2;
0167             } else if ( end2 == -2 ) {
0168                 end2 = max2;
0169             } else if ( end2 == 0 ) {
0170                 /* pop */
0171                 end2 = stack[frame[framep]];
0172                 POP_FRAME(1);
0173             }
0174 
0175             /* now check consistency */
0176 
0177             if ( 1 > start2 ) {
0178                 qp_report_bounds(ievt,np->name,2,start2,end2,max2);
0179                 *errp = R_MATH_ERROR;
0180                 running = FALSE;
0181                 break;
0182             }
0183             if ( end2 > max2 ) {
0184                 qp_report_bounds(ievt,np->name,2,start2,end2,max2);
0185                 *errp = R_MATH_ERROR;
0186                 running = FALSE;
0187                 break;
0188             }
0189 
0190             if ( (start1<=end1) && max2 != 0 && (start2<=end2) ) {
0191                 /* put on stack */
0192                 NEW_FRAME( OP_DTYPE, (end1-start1+1)*(end2-start2+1), ptr );
0193                 for ( j=start2-1 ; j < end2 ; j++ ) {
0194                     for ( i=start1-1 ; i < end1 ; i++ ) {
0195                         *ptr++ = ((OP_TYPE *) np->p)[ i + j * stride2 ];
0196                     }
0197                 }
0198             } else {
0199                 /* put empty frame on stack */
0200                 NEW_FRAME( OP_DTYPE, 0, ptr );
0201             }
0202 
0203             if ( info_flag ) {
0204                 int     r1, r2;
0205 
0206                 r1 = start1<=end1 ? end1-start1+1 : 0 ;
0207                 r2 = start2<=end2 ? end2-start2+1 : 0 ;
0208 
0209                 switch ( info_mask ) {
0210                 case 0:
0211                     SHAPE_PUSH_2( r1, r2 ); break;
0212                 case 1:
0213                     SHAPE_PUSH_1( r2 ); break;
0214                 case 2:
0215                     SHAPE_PUSH_1( r1 ); break;
0216                 case 3:
0217                     qp_abort( "scalar does have shape\n" );
0218                     break;
0219                 }
0220             }
0221         }
0222         break;
0223 
0224 /* 3 dimensional case */
0225 case FC_CWN_DYN_BOOL + (OP_BASE) + 32:
0226         {
0227             int     i, j, k, info_mask;
0228             int     stride1, start1, end1, max1;
0229             int     stride2, start2, end2, max2;
0230             int     stride3, start3, end3, max3;
0231             OP_TYPE     *ptr;
0232 
0233             info_mask = 0;
0234             stride1 = *pc++;/* stride is always one for 1 dim */
0235                     /* but we leave it in for regularity */
0236             max1 = *pc++;
0237             if ( max1 <= 0 ) {
0238                 /* variable length, get index variable */
0239                 max1 = *CWNBlock[-max1].p;
0240             }
0241 
0242             start1 = *pc++;
0243             if ( start1 == 0 ) {
0244                 /* pop */
0245                 start1 = stack[frame[framep]];
0246                 POP_FRAME(1);
0247             }
0248 
0249             end1 = *pc++;
0250             if ( end1 == -1 ) {
0251                 end1 = start1;
0252                 info_mask |= 1;
0253             } else if ( end1 == -2 ) {
0254                 end1 = max1;
0255             } else if ( end1 == 0 ) {
0256                 /* pop */
0257                 end1 = stack[frame[framep]];
0258                 POP_FRAME(1);
0259             }
0260 
0261             /* now check consistency */
0262 
0263             if ( 1 > start1 ) {
0264                 qp_report_bounds(ievt,np->name,1,start1,end1,max1);
0265                 *errp = R_MATH_ERROR;
0266                 running = FALSE;
0267                 break;
0268             }
0269             if ( end1 > max1 ) {
0270                 qp_report_bounds(ievt,np->name,1,start1,end1,max1);
0271                 *errp = R_MATH_ERROR;
0272                 running = FALSE;
0273                 break;
0274             }
0275 
0276 
0277             stride2 = *pc++;
0278 
0279             max2 = *pc++;
0280             if ( max2 <= 0 ) {
0281                 /* variable length, get index variable */
0282                 max2 = *CWNBlock[-max2].p;
0283             }
0284 
0285             start2 = *pc++;
0286             if ( start2 == 0 ) {
0287                 /* pop */
0288                 start2 = stack[frame[framep]];
0289                 POP_FRAME(1);
0290             }
0291 
0292             end2 = *pc++;
0293             if ( end2 == -1 ) {
0294                 end2 = start2;
0295                 info_mask |= 2;
0296             } else if ( end2 == -2 ) {
0297                 end2 = max2;
0298             } else if ( end2 == 0 ) {
0299                 /* pop */
0300                 end2 = stack[frame[framep]];
0301                 POP_FRAME(1);
0302             }
0303 
0304             /* now check consistency */
0305 
0306             if ( 1 > start2 ) {
0307                 qp_report_bounds(ievt,np->name,2,start2,end2,max2);
0308                 *errp = R_MATH_ERROR;
0309                 running = FALSE;
0310                 break;
0311             }
0312             if ( end2 > max2 ) {
0313                 qp_report_bounds(ievt,np->name,2,start2,end2,max2);
0314                 *errp = R_MATH_ERROR;
0315                 running = FALSE;
0316                 break;
0317             }
0318 
0319 
0320             stride3 = *pc++;
0321             max3 = *pc++;
0322             if ( max3 <= 0 ) {
0323                 /* variable length, get index variable */
0324                 max3 = *CWNBlock[-max3].p;
0325             }
0326 
0327             start3 = *pc++;
0328             if ( start3 == 0 ) {
0329                 /* pop */
0330                 start3 = stack[frame[framep]];
0331                 POP_FRAME(1);
0332             }
0333 
0334             end3 = *pc++;
0335             if ( end3 == -1 ) {
0336                 end3 = start3;
0337                 info_mask |= 4;
0338             } else if ( end3 == -2 ) {
0339                 end3 = max3;
0340             } else if ( end3 == 0 ) {
0341                 /* pop */
0342                 end3 = stack[frame[framep]];
0343                 POP_FRAME(1);
0344             }
0345 
0346             /* now check consistency */
0347 
0348             if ( 1 > start3 ) {
0349                 qp_report_bounds(ievt,np->name,3,start3,end3,max3);
0350                 *errp = R_MATH_ERROR;
0351                 running = FALSE;
0352                 break;
0353             }
0354             if ( end3 > max3 ) {
0355                 qp_report_bounds(ievt,np->name,3,start3,end3,max3);
0356                 *errp = R_MATH_ERROR;
0357                 running = FALSE;
0358                 break;
0359             }
0360 
0361             if ( (start1<=end1) && (start2<=end2) &&
0362                 max3 != 0 && (start3<=end3) ) {
0363                 /* put on stack */
0364                 NEW_FRAME( OP_DTYPE, (end1-start1+1)*(end2-start2+1)*(end3-start3+1), ptr );
0365                 for ( k=start3-1 ; k < end3 ; k++ ) {
0366                     for ( j=start2-1 ; j < end2 ; j++ ) {
0367                         for ( i=start1-1 ; i < end1 ; i++ ) {
0368                             *ptr++ =((OP_TYPE *)np->p)[ i + j * stride2 + k * stride3 ];
0369                         }
0370                     }
0371                 }
0372             } else {
0373                 /* put empty frame on stack */
0374                 NEW_FRAME( OP_DTYPE, 0, ptr );
0375             }
0376 
0377             if ( info_flag ) {
0378                 int     r1, r2, r3;
0379 
0380                 r1 = start1<=end1 ? end1-start1+1 : 0 ;
0381                 r2 = start2<=end2 ? end2-start2+1 : 0 ;
0382                 r3 = start3<=end3 ? end3-start3+1 : 0 ;
0383 
0384                 switch ( info_mask ) {
0385                 case 0:
0386                     SHAPE_PUSH_3( r1, r2, r3 ); break;
0387                 case 1:
0388                     SHAPE_PUSH_2( r2, r3 ); break;
0389                 case 2:
0390                     SHAPE_PUSH_2( r1, r3 ); break;
0391                 case 3:
0392                     SHAPE_PUSH_1( r3 ); break;
0393                 case 4:
0394                     SHAPE_PUSH_2( r1, r2 ); break;
0395                 case 5:
0396                     SHAPE_PUSH_1( r2 ); break;
0397                 case 6:
0398                     SHAPE_PUSH_1( r1 ); break;
0399                 case 7:
0400                     qp_abort( "scalar does have shape\n" );
0401                     break;
0402                 }
0403             }
0404         }
0405         break;
0406 
0407 /* 4+ dimensional case */
0408 case FC_CWN_DYN_BOOL + (OP_BASE) + 48:
0409 {
0410     typedef struct _traverse_ {
0411         int start, end, max, stride, ii, base;
0412     } Traverse;
0413 
0414     register Traverse   *sp, *done;
0415     register OP_TYPE    *ptr;
0416     Traverse        st[MAX_DIMENSION+1];
0417     int         j, info[MAX_DIMENSION];
0418     int         ndim, frame_len;
0419     bool            empty;
0420 
0421     ndim = *pc++; /* get the number of dimensions */
0422     done = &st[ndim];
0423 
0424     j = 0; /* for the shape info */
0425     for ( sp = st ; sp < done ; sp++ ) {
0426         sp->stride = *pc++;/* stride is always 1 for 1 */
0427             /* but we leave it in for regularity */
0428         sp->max = *pc++;
0429         if ( sp->max <= 0 ) {
0430             /* var length, get index variable */
0431             sp->max = *CWNBlock[-sp->max].p;
0432         }
0433 
0434         sp->start = *pc++;
0435         if ( sp->start == 0 ) {
0436             /* pop */
0437             sp->start = stack[frame[framep]];
0438             POP_FRAME(1);
0439         }
0440 
0441         sp->end = *pc++;
0442         if ( sp->end == -1 ) {
0443             sp->end = sp->start;
0444         } else if ( sp->end == -2 ) {
0445             sp->end = sp->max;
0446             info[j++] = sp->end - sp->start + 1;
0447         } else if ( sp->end == 0 ) {
0448             /* pop */
0449             sp->end = stack[frame[framep]];
0450             POP_FRAME(1);
0451             info[j++] = sp->end - sp->start + 1;
0452         }
0453 
0454         /* now check consistency */
0455 
0456         if ( 1 > sp->start ) {
0457             qp_report_bounds(ievt,np->name,(sp-st)+1,
0458                 sp->start,sp->end,sp->max);
0459             *errp = R_MATH_ERROR;
0460             running = FALSE;
0461             break;
0462         }
0463         if ( sp->end > sp->max ) {
0464             qp_report_bounds(ievt,np->name,(sp-st)+1,
0465                 sp->start,sp->end,sp->max);
0466             *errp = R_MATH_ERROR;
0467             running = FALSE;
0468             break;
0469         }
0470     }
0471 
0472     empty = FALSE;
0473     frame_len = 1;
0474     for ( sp = st ; sp < done ; sp++ ) {
0475         if ( sp->start > sp->end ) {
0476             empty = TRUE;
0477             break;
0478         }
0479         if ( sp == done-1 && sp->max == 0 ) {
0480             empty = TRUE;
0481             break;
0482         }
0483 
0484         frame_len *= sp->end - sp->start + 1;
0485 
0486     }
0487 
0488 
0489     if ( ! empty ) {
0490 
0491         /* put on stack */
0492         NEW_FRAME( OP_DTYPE, frame_len, ptr );
0493         done->base = 0;
0494         sp = done - 1;
0495         sp->ii = sp->start - 1;
0496         sp->base = sp[1].base + sp->ii*sp->stride;
0497 
0498         while ( 1 ) {
0499             if (  sp->ii < sp->end ) {
0500                 if ( sp > st ) {
0501                     sp -= 1;
0502                     sp->ii = sp->start - 1;
0503                     sp->base = sp[1].base +
0504                         sp->ii*sp->stride;
0505                 } else {
0506                     *ptr++ = ((OP_TYPE *)np->p)[sp->base];
0507                     sp->ii += 1;
0508                     sp->base += sp->stride;
0509                 }
0510             } else {
0511                 sp->ii = sp->start - 1;
0512                 sp->base = sp->base + sp->ii*sp->stride;
0513                 sp += 1;
0514                 if ( sp == done ) break;
0515                 sp->ii += 1;
0516                 sp->base += sp->stride;
0517             }
0518         }
0519 
0520     } else {
0521         /* put empty frame on stack */
0522         NEW_FRAME( OP_DTYPE, 0, ptr );
0523     }
0524 
0525     if ( info_flag ) {
0526         SHAPE_PUSH_N( j, info );
0527     }
0528 }
0529 break;
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated by the 2.3.7 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!