Back to home page

EIC code displayed by LXR

 
 

    


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

0001 /*
0002  *  qp_exe_dyn_str.h  --
0003  *
0004  *  Original:  7-Feb-1996 15:45
0005  *
0006  *  Author:   Maarten Ballintijn <Maarten.Ballintijn@cern.ch>
0007  *
0008  *  $Id$
0009  *
0010  *  $Log$
0011  *  Revision 1.3  1996/04/29 11:42:30  maartenb
0012  *  - Small cleanup.
0013  *
0014  *  Revision 1.2  1996/04/23 18:38:26  maartenb
0015  *  - Add RCS keywords
0016  *
0017  *
0018  */
0019 
0020 /* 1 dimensional case */
0021 case FC_CWN_DYN_BOOL + (OP_BASE):
0022         {
0023             int i, stride, start, end, max;
0024             OP_TYPE *ptr;
0025 
0026             stride = *pc++; /* stride is always one for 1 dim */
0027                     /* but we leave it in for regularity */
0028             max = *pc++;
0029             if ( max <= 0 ) {
0030                 /* variable length, get index variable */
0031                 max = *CWNBlock[-max].p;
0032             }
0033 
0034             start = *pc++;
0035             if ( start == 0 ) {
0036                 /* pop */
0037                 start = stack[frame[framep]];
0038                 POP_FRAME(1);
0039             }
0040 
0041             end = *pc++;
0042             if ( end == -1 ) {
0043                 end = start;
0044             } else if ( end == -2 ) {
0045                 end = max;
0046             } else if ( end == 0 ) {
0047                 /* pop */
0048                 end = stack[frame[framep]];
0049                 POP_FRAME(1);
0050             }
0051 
0052             /* now check consistency */
0053 
0054             if ( 1 > start ) {
0055                 sf_report( "Evt %ld: Index out of range,"
0056                     " start(%d) < 1\n", ievt, start );
0057                 *errp = R_MATH_ERROR;
0058                 running = FALSE;
0059                 break;
0060             }
0061             if ( end > max ) {
0062                 sf_report( "Evt %ld: Index out of range,"
0063                     " end(%d) > max(%d)\n",
0064                     ievt, end, max );
0065                 *errp = R_MATH_ERROR;
0066                 running = FALSE;
0067                 break;
0068             }
0069 
0070             if ( start <= end ) {
0071                 /* put on stack */
0072                 NEW_FRAME( OP_DTYPE, end - start + 1, ptr );
0073                 for ( i=start-1 ; i < end ; i++ ) {
0074                     *ptr++ = ((OP_TYPE *) np->p)[ i ];
0075 
0076                 }
0077 
0078                 if ( info_flag ) {
0079                     SHAPE_PUSH_1( end - start + 1 );
0080                 }
0081             } else {
0082                 /* put empty frame on stack */
0083                 NEW_FRAME( OP_DTYPE, 0, ptr );
0084                 if ( info_flag ) {
0085                     SHAPE_PUSH_1( 0 );
0086                 }
0087             }
0088         }
0089         break;
0090 
0091 /* 2 dimensional case */
0092 case FC_CWN_DYN_BOOL + (OP_BASE) + 16:
0093         {
0094             int     i, j, info_mask;
0095             int     stride1, start1, end1, max1;
0096             int     stride2, start2, end2, max2;
0097             OP_TYPE     *ptr;
0098 
0099             info_mask = 0;
0100             stride1 = *pc++;/* stride is always one for 1 dim */
0101                     /* but we leave it in for regularity */
0102             max1 = *pc++;
0103             if ( max1 <= 0 ) {
0104                 /* variable length, get index variable */
0105                 max1 = *CWNBlock[-max1].p;
0106             }
0107 
0108             start1 = *pc++;
0109             if ( start1 == 0 ) {
0110                 /* pop */
0111                 start1 = stack[frame[framep]];
0112                 POP_FRAME(1);
0113             }
0114 
0115             end1 = *pc++;
0116             if ( end1 == -1 ) {
0117                 end1 = start1;
0118                 info_mask |= 1;
0119             } else if ( end1 == -2 ) {
0120                 end1 = max1;
0121             } else if ( end1 == 0 ) {
0122                 /* pop */
0123                 end1 = stack[frame[framep]];
0124                 POP_FRAME(1);
0125             }
0126 
0127             /* now check consistency */
0128 
0129             if ( 1 > start1 ) {
0130                 sf_report( "Evt %ld: Index 1 out of range,"
0131                     " start(%d) < 1\n", ievt, start1 );
0132                 *errp = R_MATH_ERROR;
0133                 running = FALSE;
0134                 break;
0135             }
0136             if ( end1 > max1 ) {
0137                 sf_report( "Evt %ld: Index 1 out of range,"
0138                     " end(%d) > max(%d)\n",
0139                     ievt, end1, max1 );
0140                 *errp = R_MATH_ERROR;
0141                 running = FALSE;
0142                 break;
0143             }
0144 
0145 
0146             stride2 = *pc++;/* stride is always one for 1 dim */
0147                     /* but we leave it in for regularity */
0148             max2 = *pc++;
0149             if ( max2 <= 0 ) {
0150                 /* variable length, get index variable */
0151                 max2 = *CWNBlock[-max2].p;
0152             }
0153 
0154             start2 = *pc++;
0155             if ( start2 == 0 ) {
0156                 /* pop */
0157                 start2 = stack[frame[framep]];
0158                 POP_FRAME(1);
0159             }
0160 
0161             end2 = *pc++;
0162             if ( end2 == -1 ) {
0163                 end2 = start2;
0164                 info_mask |= 2;
0165             } else if ( end2 == -2 ) {
0166                 end2 = max2;
0167             } else if ( end2 == 0 ) {
0168                 /* pop */
0169                 end2 = stack[frame[framep]];
0170                 POP_FRAME(1);
0171             }
0172 
0173             /* now check consistency */
0174 
0175             if ( 1 > start2 ) {
0176                 sf_report( "Evt %ld: Index 2 out of range,"
0177                     " start(%d) < 1\n", ievt, start2 );
0178                 *errp = R_MATH_ERROR;
0179                 running = FALSE;
0180                 break;
0181             }
0182             if ( end2 > max2 ) {
0183                 sf_report( "Evt %ld: Index 2 out of range,"
0184                     " end(%d) > max(%d)\n",
0185                     ievt, end2, max2 );
0186                 *errp = R_MATH_ERROR;
0187                 running = FALSE;
0188                 break;
0189             }
0190 
0191             if ( (start1<=end1) && max2 != 0 && (start2<=end2) ) {
0192                 /* put on stack */
0193                 NEW_FRAME( OP_DTYPE, (end1-start1+1)*(end2-start2+1), ptr );
0194                 for ( j=start2-1 ; j < end2 ; j++ ) {
0195                     for ( i=start1-1 ; i < end1 ; i++ ) {
0196                         *ptr++ = ((OP_TYPE *) np->p)[ i + j * stride2 ];
0197                     }
0198                 }
0199             } else {
0200                 /* put empty frame on stack */
0201                 NEW_FRAME( OP_DTYPE, 0, ptr );
0202             }
0203 
0204             if ( info_flag ) {
0205                 int     r1, r2;
0206 
0207                 r1 = start1<=end1 ? end1-start1+1 : 0 ;
0208                 r2 = start2<=end2 ? end2-start2+1 : 0 ;
0209 
0210                 switch ( info_mask ) {
0211                 case 0:
0212                     SHAPE_PUSH_2( r1, r2 ); break;
0213                 case 1:
0214                     SHAPE_PUSH_1( r2 ); break;
0215                 case 2:
0216                     SHAPE_PUSH_1( r1 ); break;
0217                 case 3:
0218                     qp_abort( "scalar does have shape\n" );
0219                     break;
0220                 }
0221             }
0222         }
0223         break;
0224 
0225 /* 3 dimensional case */
0226 case FC_CWN_DYN_BOOL + (OP_BASE) + 32:
0227         {
0228             int     i, j, k, info_mask;
0229             int     stride1, start1, end1, max1;
0230             int     stride2, start2, end2, max2;
0231             int     stride3, start3, end3, max3;
0232             OP_TYPE     *ptr;
0233 
0234             info_mask = 0;
0235             stride1 = *pc++;/* stride is always one for 1 dim */
0236                     /* but we leave it in for regularity */
0237             max1 = *pc++;
0238             if ( max1 <= 0 ) {
0239                 /* variable length, get index variable */
0240                 max1 = *CWNBlock[-max1].p;
0241             }
0242 
0243             start1 = *pc++;
0244             if ( start1 == 0 ) {
0245                 /* pop */
0246                 start1 = stack[frame[framep]];
0247                 POP_FRAME(1);
0248             }
0249 
0250             end1 = *pc++;
0251             if ( end1 == -1 ) {
0252                 end1 = start1;
0253                 info_mask |= 1;
0254             } else if ( end1 == -2 ) {
0255                 end1 = max1;
0256             } else if ( end1 == 0 ) {
0257                 /* pop */
0258                 end1 = stack[frame[framep]];
0259                 POP_FRAME(1);
0260             }
0261 
0262             /* now check consistency */
0263 
0264             if ( 1 > start1 ) {
0265                 sf_report( "Evt %ld: Index 1 out of range,"
0266                     " start(%d) < 1\n", ievt, start1 );
0267                 *errp = R_MATH_ERROR;
0268                 running = FALSE;
0269                 break;
0270             }
0271             if ( end1 > max1 ) {
0272                 sf_report( "Evt %ld: Index 1 out of range,"
0273                     " end(%d) > max(%d)\n",
0274                     ievt, end1, max1 );
0275                 *errp = R_MATH_ERROR;
0276                 running = FALSE;
0277                 break;
0278             }
0279 
0280 
0281             stride2 = *pc++;
0282 
0283             max2 = *pc++;
0284             if ( max2 <= 0 ) {
0285                 /* variable length, get index variable */
0286                 max2 = *CWNBlock[-max2].p;
0287             }
0288 
0289             start2 = *pc++;
0290             if ( start2 == 0 ) {
0291                 /* pop */
0292                 start2 = stack[frame[framep]];
0293                 POP_FRAME(1);
0294             }
0295 
0296             end2 = *pc++;
0297             if ( end2 == -1 ) {
0298                 end2 = start2;
0299                 info_mask |= 2;
0300             } else if ( end2 == -2 ) {
0301                 end2 = max2;
0302             } else if ( end2 == 0 ) {
0303                 /* pop */
0304                 end2 = stack[frame[framep]];
0305                 POP_FRAME(1);
0306             }
0307 
0308             /* now check consistency */
0309 
0310             if ( 1 > start2 ) {
0311                 sf_report( "Evt %ld: Index 2 out of range,"
0312                     " start(%d) < 1\n", ievt, start2 );
0313                 *errp = R_MATH_ERROR;
0314                 running = FALSE;
0315                 break;
0316             }
0317             if ( end2 > max2 ) {
0318                 sf_report( "Evt %ld: Index 2 out of range,"
0319                     " end(%d) > max(%d)\n",
0320                     ievt, end2, max2 );
0321                 *errp = R_MATH_ERROR;
0322                 running = FALSE;
0323                 break;
0324             }
0325 
0326 
0327             stride3 = *pc++;
0328             max3 = *pc++;
0329             if ( max3 <= 0 ) {
0330                 /* variable length, get index variable */
0331                 max3 = *CWNBlock[-max3].p;
0332             }
0333 
0334             start3 = *pc++;
0335             if ( start3 == 0 ) {
0336                 /* pop */
0337                 start3 = stack[frame[framep]];
0338                 POP_FRAME(1);
0339             }
0340 
0341             end3 = *pc++;
0342             if ( end3 == -1 ) {
0343                 end3 = start3;
0344                 info_mask |= 4;
0345             } else if ( end3 == -2 ) {
0346                 end3 = max3;
0347             } else if ( end3 == 0 ) {
0348                 /* pop */
0349                 end3 = stack[frame[framep]];
0350                 POP_FRAME(1);
0351             }
0352 
0353             /* now check consistency */
0354 
0355             if ( 1 > start3 ) {
0356                 sf_report( "Evt %ld: Index 3 out of range,"
0357                     " start(%d) < 1\n", ievt, start3 );
0358                 *errp = R_MATH_ERROR;
0359                 running = FALSE;
0360                 break;
0361             }
0362             if ( end3 > max3 ) {
0363                 sf_report( "Evt %ld: Index 3 out of range,"
0364                     " end(%3) > max(%3)\n",
0365                     ievt, end3, max3 );
0366                 *errp = R_MATH_ERROR;
0367                 running = FALSE;
0368                 break;
0369             }
0370 
0371             if ( (start1<=end1) && (start2<=end2) &&
0372                 max3 != 0 && (start3<=end3) ) {
0373                 /* put on stack */
0374                 NEW_FRAME( OP_DTYPE, (end1-start1+1)*(end2-start2+1)*(end3-start3+1), ptr );
0375                 for ( k=start3-1 ; k < end3 ; k++ ) {
0376                     for ( j=start2-1 ; j < end2 ; j++ ) {
0377                         for ( i=start1-1 ; i < end1 ; i++ ) {
0378                             *ptr++ =((OP_TYPE *)np->p)[ i + j * stride2 + k * stride3 ];
0379                         }
0380                     }
0381                 }
0382             } else {
0383                 /* put empty frame on stack */
0384                 NEW_FRAME( OP_DTYPE, 0, ptr );
0385             }
0386 
0387             if ( info_flag ) {
0388                 int     r1, r2, r3;
0389 
0390                 r1 = start1<=end1 ? end1-start1+1 : 0 ;
0391                 r2 = start2<=end2 ? end2-start2+1 : 0 ;
0392                 r3 = start3<=end3 ? end3-start3+1 : 0 ;
0393 
0394                 switch ( info_mask ) {
0395                 case 0:
0396                     SHAPE_PUSH_3( r1, r2, r3 ); break;
0397                 case 1:
0398                     SHAPE_PUSH_2( r2, r3 ); break;
0399                 case 2:
0400                     SHAPE_PUSH_2( r1, r3 ); break;
0401                 case 3:
0402                     SHAPE_PUSH_1( r3 ); break;
0403                 case 4:
0404                     SHAPE_PUSH_2( r1, r2 ); break;
0405                 case 5:
0406                     SHAPE_PUSH_1( r2 ); break;
0407                 case 6:
0408                     SHAPE_PUSH_1( r1 ); break;
0409                 case 7:
0410                     qp_abort( "scalar does have shape\n" );
0411                     break;
0412                 }
0413             }
0414         }
0415         break;