include/ntuple/qp_exev_op_num.h

0001 /*
0002  *  qp_exev_op_num.h  --
0003  *  Template for the simple numeric operations, vector data.
0004  *
0005  *  Original: 20-Jan-1995 16:57
0006  *
0007  *  Author:   Maarten Ballintijn <Maarten.Ballintijn@cern.ch>
0008  *
0009  *  $Id$
0010  *
0011  *  $Log$
0012  *  Revision 1.7  1996/05/13 08:19:08  maartenb
0013  *  - Removed remaining warning message about pow() operator.
0014  *
0015  *  Revision 1.6  1996/04/23 18:38:41  maartenb
0016  *  - Add RCS keywords
0017  *
0018  *
0019  */
0020
0021 case FC_PLUS + (OP_BASE):
0022 {
0023     OP_TYPE     tmp1, tmp2;
0024     int     i, n = 1;
0025
0026     if ( frame_size[framep] != 1 ) {
0027         o1 = &stack[frame[framep]];
0028         inc_o1 = datatype_size[OP_DTYPE];
0029         n = frame_size[framep];
0030     } else {
0031         tmp1 = *((OP_TYPE *) &stack[frame[framep]]);
0032         o1 = (Int32 *) &tmp1;
0033         inc_o1 = 0;
0034     }
0035     if ( frame_size[framep-1] != 1 ) {
0036         o2 = &stack[frame[framep-1]];
0037         inc_o2 = datatype_size[OP_DTYPE];
0038         qp_assert( n==1 || n==frame_size[framep-1] );
0039         n = frame_size[framep-1];
0040     } else {
0041         tmp2 = *((OP_TYPE *) &stack[frame[framep-1]]);
0042         o2 = (Int32 *) &tmp2;
0043         inc_o2 = 0;
0044     }
0045     POP_FRAME(2);
0046
0047     NEW_FRAME(OP_DTYPE,n,r);
0048     inc_r = datatype_size[OP_DTYPE];
0049
0050     o1 += inc_o1 * (n-1);
0051     o2 += inc_o2 * (n-1);
0052     r += inc_r * (n-1);
0053     for ( i=0 ; i < n ; i++ ) {
0054         *((OP_TYPE *) r) = *((OP_TYPE *) o1) + *((OP_TYPE *) o2);
0055         o1 -= inc_o1;
0056         o2 -= inc_o2;
0057         r -= inc_r;
0058     }
0059     break;
0060 }
0061
0062 case FC_MINUS + (OP_BASE):
0063 {
0064     OP_TYPE     tmp1, tmp2;
0065     int     i, n = 1;
0066
0067     if ( frame_size[framep] != 1 ) {
0068         o1 = &stack[frame[framep]];
0069         inc_o1 = datatype_size[OP_DTYPE];
0070         n = frame_size[framep];
0071     } else {
0072         tmp1 = *((OP_TYPE *) &stack[frame[framep]]);
0073         o1 = (Int32 *) &tmp1;
0074         inc_o1 = 0;
0075     }
0076     if ( frame_size[framep-1] != 1 ) {
0077         o2 = &stack[frame[framep-1]];
0078         inc_o2 = datatype_size[OP_DTYPE];
0079         qp_assert( n==1 || n==frame_size[framep-1] );
0080         n = frame_size[framep-1];
0081     } else {
0082         tmp2 = *((OP_TYPE *) &stack[frame[framep-1]]);
0083         o2 = (Int32 *) &tmp2;
0084         inc_o2 = 0;
0085     }
0086     POP_FRAME(2);
0087
0088     NEW_FRAME(OP_DTYPE,n,r);
0089     inc_r = datatype_size[OP_DTYPE];
0090
0091     o1 += inc_o1 * (n-1);
0092     o2 += inc_o2 * (n-1);
0093     r += inc_r * (n-1);
0094     for ( i=0 ; i < n ; i++ ) {
0095         *((OP_TYPE *) r) = *((OP_TYPE *) o1) - *((OP_TYPE *) o2);
0096         o1 -= inc_o1;
0097         o2 -= inc_o2;
0098         r -= inc_r;
0099     }
0100     break;
0101 }
0102
0103 case FC_TIMES + (OP_BASE):
0104 {
0105     OP_TYPE     tmp1, tmp2;
0106     int     i, n = 1;
0107
0108     if ( frame_size[framep] != 1 ) {
0109         o1 = &stack[frame[framep]];
0110         inc_o1 = datatype_size[OP_DTYPE];
0111         n = frame_size[framep];
0112     } else {
0113         tmp1 = *((OP_TYPE *) &stack[frame[framep]]);
0114         o1 = (Int32 *) &tmp1;
0115         inc_o1 = 0;
0116     }
0117     if ( frame_size[framep-1] != 1 ) {
0118         o2 = &stack[frame[framep-1]];
0119         inc_o2 = datatype_size[OP_DTYPE];
0120         qp_assert( n==1 || n==frame_size[framep-1] );
0121         n = frame_size[framep-1];
0122     } else {
0123         tmp2 = *((OP_TYPE *) &stack[frame[framep-1]]);
0124         o2 = (Int32 *) &tmp2;
0125         inc_o2 = 0;
0126     }
0127     POP_FRAME(2);
0128
0129     NEW_FRAME(OP_DTYPE,n,r);
0130     inc_r = datatype_size[OP_DTYPE];
0131
0132     o1 += inc_o1 * (n-1);
0133     o2 += inc_o2 * (n-1);
0134     r += inc_r * (n-1);
0135     for ( i=0 ; i < n ; i++ ) {
0136         *((OP_TYPE *) r) = *((OP_TYPE *) o1) * *((OP_TYPE *) o2);
0137         o1 -= inc_o1;
0138         o2 -= inc_o2;
0139         r -= inc_r;
0140     }
0141     break;
0142 }
0143
0144 case FC_DIV + (OP_BASE):
0145 {
0146     OP_TYPE     tmp1, tmp2;
0147     int     i, n = 1;
0148
0149     if ( frame_size[framep] != 1 ) {
0150         o1 = &stack[frame[framep]];
0151         inc_o1 = datatype_size[OP_DTYPE];
0152         n = frame_size[framep];
0153     } else {
0154         tmp1 = *((OP_TYPE *) &stack[frame[framep]]);
0155         o1 = (Int32 *) &tmp1;
0156         inc_o1 = 0;
0157     }
0158     if ( frame_size[framep-1] != 1 ) {
0159         o2 = &stack[frame[framep-1]];
0160         inc_o2 = datatype_size[OP_DTYPE];
0161         qp_assert( n==1 || n==frame_size[framep-1] );
0162         n = frame_size[framep-1];
0163     } else {
0164         tmp2 = *((OP_TYPE *) &stack[frame[framep-1]]);
0165         o2 = (Int32 *) &tmp2;
0166         inc_o2 = 0;
0167     }
0168     POP_FRAME(2);
0169
0170     NEW_FRAME(OP_DTYPE,n,r);
0171     inc_r = datatype_size[OP_DTYPE];
0172
0173     o1 += inc_o1 * (n-1);
0174     o2 += inc_o2 * (n-1);
0175     r += inc_r * (n-1);
0176     for ( i=0 ; i < n ; i++ ) {
0177         if ( *((OP_TYPE *) o2) == 0 ) {
0178             sf_report( "Divide by zero\n" );
0179             *errp = R_MATH_ERROR;
0180             running = FALSE;
0181             break;
0182         } else {
0183             *((OP_TYPE *) r) = *((OP_TYPE *) o1) / *((OP_TYPE *) o2);
0184         }
0185         o1 -= inc_o1;
0186         o2 -= inc_o2;
0187         r -= inc_r;
0188     }
0189     break;
0190 }
0191
0192
0193 case FC_POW + (OP_BASE):
0194 {
0195     OP_TYPE     tmp1, tmp2;
0196     int     i, n = 1;
0197
0198     if ( frame_size[framep] != 1 ) {
0199         o1 = &stack[frame[framep]];
0200         inc_o1 = datatype_size[OP_DTYPE];
0201         n = frame_size[framep];
0202     } else {
0203         tmp1 = *((OP_TYPE *) &stack[frame[framep]]);
0204         o1 = (Int32 *) &tmp1;
0205         inc_o1 = 0;
0206     }
0207     if ( frame_size[framep-1] != 1 ) {
0208         o2 = &stack[frame[framep-1]];
0209         inc_o2 = datatype_size[OP_DTYPE];
0210         qp_assert( n==1 || n==frame_size[framep-1] );
0211         n = frame_size[framep-1];
0212     } else {
0213         tmp2 = *((OP_TYPE *) &stack[frame[framep-1]]);
0214         o2 = (Int32 *) &tmp2;
0215         inc_o2 = 0;
0216     }
0217     POP_FRAME(2);
0218
0219     NEW_FRAME(OP_DTYPE,n,r);
0220     inc_r = datatype_size[OP_DTYPE];
0221
0222     o1 += inc_o1 * (n-1);
0223     o2 += inc_o2 * (n-1);
0224     r += inc_r * (n-1);
0225     for ( i=0 ; i < n ; i++ ) {
0226         double      x = *((OP_TYPE *) o1);
0227         double      y = *((OP_TYPE *) o2);
0228         double      dummy;
0229
0230         if ( ( x == 0. && y <= 0. ) || ( x < 0. &&  modf(y,&dummy) != 0.  ) ) {
0231             sf_report( "Illegal values for power: %lg**%lg\n", x, y );
0232             *errp = R_MATH_ERROR;
0233             running = FALSE;
0234             *((OP_TYPE *) r) = 0;
0235             break;
0236         } else {
0237             *((OP_TYPE *) r) = pow( x, y );
0238         }
0239         o1 -= inc_o1;
0240         o2 -= inc_o2;
0241         r -= inc_r;
0242     }
0243     break;
0244 }
0245
0246 case FC_UMINUS + (OP_BASE):     /* assume that signed and unsigned */
0247 {                   /* have the same aligment ... */
0248     int     i, n = 1;
0249
0250     o1 = &stack[frame[framep]];
0251     inc_o1 = datatype_size[OP_DTYPE];
0252     n = frame_size[framep];
0253     SET_FRAME_TYPE( datatype_signed[ OP_DTYPE ] );
0254
0255     o1 += inc_o1 * (n-1);
0256     for ( i=0 ; i < n ; i++ ) {
0257         *((OP_TYPE *) o1) = - *((OP_TYPE *) o1);
0258         o1 -= inc_o1;
0259     }
0260     break;
0261 }
0262
0263 case FC_MIN + (OP_BASE):
0264 {
0265     OP_TYPE     tmp1, tmp2;
0266     int     i, n = 1;
0267
0268     if ( frame_size[framep] != 1 ) {
0269         o1 = &stack[frame[framep]];
0270         inc_o1 = datatype_size[OP_DTYPE];
0271         n = frame_size[framep];
0272     } else {
0273         tmp1 = *((OP_TYPE *) &stack[frame[framep]]);
0274         o1 = (Int32 *) &tmp1;
0275         inc_o1 = 0;
0276     }
0277     if ( frame_size[framep-1] != 1 ) {
0278         o2 = &stack[frame[framep-1]];
0279         inc_o2 = datatype_size[OP_DTYPE];
0280         qp_assert( n==1 || n==frame_size[framep-1] );
0281         n = frame_size[framep-1];
0282     } else {
0283         tmp2 = *((OP_TYPE *) &stack[frame[framep-1]]);
0284         o2 = (Int32 *) &tmp2;
0285         inc_o2 = 0;
0286     }
0287     POP_FRAME(2);
0288
0289     NEW_FRAME(OP_DTYPE,n,r);
0290     inc_r = datatype_size[OP_DTYPE];
0291
0292     o1 += inc_o1 * (n-1);
0293     o2 += inc_o2 * (n-1);
0294     r += inc_r * (n-1);
0295     for ( i=0 ; i < n ; i++ ) {
0296         if ( *((OP_TYPE *) o1) < *((OP_TYPE *) o2) ) {
0297             *((OP_TYPE *) r) = *((OP_TYPE *) o1);
0298         } else {
0299             *((OP_TYPE *) r) = *((OP_TYPE *) o2);
0300         }
0301         o1 -= inc_o1;
0302         o2 -= inc_o2;
0303         r -= inc_r;
0304     }
0305     break;
0306 }
0307
0308 case FC_MAX + (OP_BASE):
0309 {
0310     OP_TYPE     tmp1, tmp2;
0311     int     i, n = 1;
0312
0313     if ( frame_size[framep] != 1 ) {
0314         o1 = &stack[frame[framep]];
0315         inc_o1 = datatype_size[OP_DTYPE];
0316         n = frame_size[framep];
0317     } else {
0318         tmp1 = *((OP_TYPE *) &stack[frame[framep]]);
0319         o1 = (Int32 *) &tmp1;
0320         inc_o1 = 0;
0321     }
0322     if ( frame_size[framep-1] != 1 ) {
0323         o2 = &stack[frame[framep-1]];
0324         inc_o2 = datatype_size[OP_DTYPE];
0325         qp_assert( n==1 || n==frame_size[framep-1] );
0326         n = frame_size[framep-1];
0327     } else {
0328         tmp2 = *((OP_TYPE *) &stack[frame[framep-1]]);
0329         o2 = (Int32 *) &tmp2;
0330         inc_o2 = 0;
0331     }
0332     POP_FRAME(2);
0333
0334     NEW_FRAME(OP_DTYPE,n,r);
0335     inc_r = datatype_size[OP_DTYPE];
0336
0337     o1 += inc_o1 * (n-1);
0338     o2 += inc_o2 * (n-1);
0339     r += inc_r * (n-1);
0340     for ( i=0 ; i < n ; i++ ) {
0341         if ( *((OP_TYPE *) o1) > *((OP_TYPE *) o2) ) {
0342             *((OP_TYPE *) r) = *((OP_TYPE *) o1);
0343         } else {
0344             *((OP_TYPE *) r) = *((OP_TYPE *) o2);
0345         }
0346         o1 -= inc_o1;
0347         o2 -= inc_o2;
0348         r -= inc_r;
0349     }
0350     break;
0351 }