File indexing completed on 2025-02-21 10:05:31
0001
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021 case FC_CWN_DYN_BOOL + (OP_BASE):
0022 {
0023 int i, stride, start, end, max;
0024 OP_TYPE *ptr;
0025
0026 stride = *pc++;
0027
0028 max = *pc++;
0029 if ( max <= 0 ) {
0030
0031 max = *CWNBlock[-max].p;
0032 }
0033
0034 start = *pc++;
0035 if ( start == 0 ) {
0036
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
0048 end = stack[frame[framep]];
0049 POP_FRAME(1);
0050 }
0051
0052
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
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
0083 NEW_FRAME( OP_DTYPE, 0, ptr );
0084 if ( info_flag ) {
0085 SHAPE_PUSH_1( 0 );
0086 }
0087 }
0088 }
0089 break;
0090
0091
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++;
0101
0102 max1 = *pc++;
0103 if ( max1 <= 0 ) {
0104
0105 max1 = *CWNBlock[-max1].p;
0106 }
0107
0108 start1 = *pc++;
0109 if ( start1 == 0 ) {
0110
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
0123 end1 = stack[frame[framep]];
0124 POP_FRAME(1);
0125 }
0126
0127
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++;
0147
0148 max2 = *pc++;
0149 if ( max2 <= 0 ) {
0150
0151 max2 = *CWNBlock[-max2].p;
0152 }
0153
0154 start2 = *pc++;
0155 if ( start2 == 0 ) {
0156
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
0169 end2 = stack[frame[framep]];
0170 POP_FRAME(1);
0171 }
0172
0173
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
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
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
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++;
0236
0237 max1 = *pc++;
0238 if ( max1 <= 0 ) {
0239
0240 max1 = *CWNBlock[-max1].p;
0241 }
0242
0243 start1 = *pc++;
0244 if ( start1 == 0 ) {
0245
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
0258 end1 = stack[frame[framep]];
0259 POP_FRAME(1);
0260 }
0261
0262
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
0286 max2 = *CWNBlock[-max2].p;
0287 }
0288
0289 start2 = *pc++;
0290 if ( start2 == 0 ) {
0291
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
0304 end2 = stack[frame[framep]];
0305 POP_FRAME(1);
0306 }
0307
0308
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
0331 max3 = *CWNBlock[-max3].p;
0332 }
0333
0334 start3 = *pc++;
0335 if ( start3 == 0 ) {
0336
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
0349 end3 = stack[frame[framep]];
0350 POP_FRAME(1);
0351 }
0352
0353
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
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
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;