Back to home page

EIC code displayed by LXR

 
 

    


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

0001 /*
0002  *  qp_exe_fun_bitop_templ.h  --
0003  *
0004  *  Original: 27-Jan-1995 16:25
0005  *
0006  *  Author:   Maarten Ballintijn <Maarten.Ballintijn@cern.ch>
0007  *
0008  *  $Id$
0009  *
0010  *  $Log$
0011  *  Revision 1.5  1996/04/23 18:38:28  maartenb
0012  *  - Add RCS keywords
0013  *
0014  *
0015  */
0016 case FC_IOR + (OP_BASE):
0017 {
0018     register int        n;
0019     register char       *r, *o1, *o2;
0020     int         o1_inc, o2_inc;
0021     OP_TYPE         o1_tmp, o2_tmp;
0022 
0023     n = 1;
0024     if ( frame_size[framep] == 1 ) {
0025         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0026         o1 = (char *) &o1_tmp;
0027         o1_inc = 0;
0028     } else {
0029         o1 = (char *) &stack[frame[framep]];
0030         o1_inc = sizeof(OP_TYPE);
0031         n = frame_size[framep];
0032     }
0033     if ( frame_size[framep-1] == 1 ) {
0034         o2_tmp = *(OP_TYPE *) &stack[frame[framep-1]];
0035         o2 = (char *) &o2_tmp;
0036         o2_inc = 0;
0037     } else {
0038         o2 = (char *) &stack[frame[framep-1]];
0039         o2_inc = sizeof(OP_TYPE);
0040         n = frame_size[framep-1];
0041     }
0042 
0043     POP_FRAME(2);
0044     NEW_FRAME(OP_DTYPE,n,r);
0045 
0046     o1 += o1_inc * (n-1);
0047     o2 += o2_inc * (n-1);
0048     r += sizeof(OP_TYPE) * (n-1);
0049     for ( ; n > 0 ; n-- ) {
0050         *((OP_TYPE *) r) = *((OP_TYPE *) o1) | *((OP_TYPE *) o2);
0051         o1 -= o1_inc;
0052         o2 -= o2_inc;
0053         r -= sizeof(OP_TYPE);
0054     }
0055     break;
0056 }
0057 
0058 case FC_IAND + (OP_BASE):
0059 {
0060     register int        n;
0061     register char       *r, *o1, *o2;
0062     int         o1_inc, o2_inc;
0063     OP_TYPE         o1_tmp, o2_tmp;
0064 
0065     n = 1;
0066     if ( frame_size[framep] == 1 ) {
0067         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0068         o1 = (char *) &o1_tmp;
0069         o1_inc = 0;
0070     } else {
0071         o1 = (char *) &stack[frame[framep]];
0072         o1_inc = sizeof(OP_TYPE);
0073         n = frame_size[framep];
0074     }
0075     if ( frame_size[framep-1] == 1 ) {
0076         o2_tmp = *(OP_TYPE *) &stack[frame[framep-1]];
0077         o2 = (char *) &o2_tmp;
0078         o2_inc = 0;
0079     } else {
0080         o2 = (char *) &stack[frame[framep-1]];
0081         o2_inc = sizeof(OP_TYPE);
0082         n = frame_size[framep-1];
0083     }
0084 
0085     POP_FRAME(2);
0086     NEW_FRAME(OP_DTYPE,n,r);
0087 
0088     o1 += o1_inc * (n-1);
0089     o2 += o2_inc * (n-1);
0090     r += sizeof(OP_TYPE) * (n-1);
0091     for ( ; n > 0 ; n-- ) {
0092         *((OP_TYPE *) r) = *((OP_TYPE *) o1) & *((OP_TYPE *) o2);
0093         o1 -= o1_inc;
0094         o2 -= o2_inc;
0095         r -= sizeof(OP_TYPE);
0096     }
0097 
0098     break;
0099 }
0100 
0101 
0102 case FC_INOT + (OP_BASE):
0103 {
0104     register int        n;
0105     register OP_TYPE    *o1;
0106 
0107     n = frame_size[framep];
0108     o1 = (OP_TYPE *) &stack[frame[framep]];
0109     for ( ; n > 0 ; n--, o1++ ) {
0110         *((OP_TYPE *) o1) = ~ *((OP_TYPE *) o1);
0111     }
0112     break;
0113 }
0114 
0115 
0116 case FC_IEOR + (OP_BASE):
0117 {
0118     register int        n;
0119     register char       *r, *o1, *o2;
0120     int         o1_inc, o2_inc;
0121     OP_TYPE         o1_tmp, o2_tmp;
0122 
0123     n = 1;
0124     if ( frame_size[framep] == 1 ) {
0125         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0126         o1 = (char *) &o1_tmp;
0127         o1_inc = 0;
0128     } else {
0129         o1 = (char *) &stack[frame[framep]];
0130         o1_inc = sizeof(OP_TYPE);
0131         n = frame_size[framep];
0132     }
0133     if ( frame_size[framep-1] == 1 ) {
0134         o2_tmp = *(OP_TYPE *) &stack[frame[framep-1]];
0135         o2 = (char *) &o2_tmp;
0136         o2_inc = 0;
0137     } else {
0138         o2 = (char *) &stack[frame[framep-1]];
0139         o2_inc = sizeof(OP_TYPE);
0140         n = frame_size[framep-1];
0141     }
0142 
0143     POP_FRAME(2);
0144     NEW_FRAME(OP_DTYPE,n,r);
0145 
0146     o1 += o1_inc * (n-1);
0147     o2 += o2_inc * (n-1);
0148     r += sizeof(OP_TYPE) * (n-1);
0149     for ( ; n > 0 ; n-- ) {
0150         *((OP_TYPE *) r) = *((OP_TYPE *) o1) ^ *((OP_TYPE *) o2);
0151         o1 -= o1_inc;
0152         o2 -= o2_inc;
0153         r -= sizeof(OP_TYPE);
0154     }
0155 
0156     break;
0157 }
0158 
0159 
0160 case FC_BTEST + (OP_BASE):
0161 {
0162     register int        n;
0163     register char       *r, *o1, *o2;
0164     int         o1_inc, o2_inc;
0165     OP_TYPE         o1_tmp;
0166     Int32           o2_tmp;
0167 
0168     n = 1;
0169     if ( frame_size[framep] == 1 ) {
0170         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0171         o1 = (char *) &o1_tmp;
0172         o1_inc = 0;
0173     } else {
0174         o1 = (char *) &stack[frame[framep]];
0175         o1_inc = sizeof(OP_TYPE);
0176         n = frame_size[framep];
0177     }
0178     if ( frame_size[framep-1] == 1 ) {
0179         o2_tmp = *(Int32 *) &stack[frame[framep-1]];
0180         o2 = (char *) &o2_tmp;
0181         o2_inc = 0;
0182     } else {
0183         o2 = (char *) &stack[frame[framep-1]];
0184         o2_inc = sizeof(Int32);
0185         n = frame_size[framep-1];
0186     }
0187 
0188     POP_FRAME(2);
0189     NEW_FRAME(D_BOOL,n,r);
0190 
0191     o1 += o1_inc * (n-1);
0192     o2 += o2_inc * (n-1);
0193     r += sizeof(bool) * (n-1);
0194     for ( ; n > 0 ; n-- ) {
0195         *((bool *) r) = ( *((OP_TYPE *) o1) & (1 << *((Int32 *) o2)) ) != 0;
0196         o1 -= o1_inc;
0197         o2 -= o2_inc;
0198         r -= sizeof(bool);
0199     }
0200 
0201     break;
0202 }
0203 
0204 
0205 case FC_IBSET + (OP_BASE):
0206 {
0207     register int        n;
0208     register char       *r, *o1, *o2;
0209     int         o1_inc, o2_inc;
0210     OP_TYPE         o1_tmp;
0211     Int32           o2_tmp;
0212 
0213     n = 1;
0214     if ( frame_size[framep] == 1 ) {
0215         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0216         o1 = (char *) &o1_tmp;
0217         o1_inc = 0;
0218     } else {
0219         o1 = (char *) &stack[frame[framep]];
0220         o1_inc = sizeof(OP_TYPE);
0221         n = frame_size[framep];
0222     }
0223     if ( frame_size[framep-1] == 1 ) {
0224         o2_tmp = *(Int32 *) &stack[frame[framep-1]];
0225         o2 = (char *) &o2_tmp;
0226         o2_inc = 0;
0227     } else {
0228         o2 = (char *) &stack[frame[framep-1]];
0229         o2_inc = sizeof(Int32);
0230         n = frame_size[framep-1];
0231     }
0232 
0233     POP_FRAME(2);
0234     NEW_FRAME(OP_DTYPE,1,r);
0235 
0236     o1 += o1_inc * (n-1);
0237     o2 += o2_inc * (n-1);
0238     r += sizeof(OP_TYPE) * (n-1);
0239     for ( ; n > 0 ; n-- ) {
0240         *((OP_TYPE *) r) = *((OP_TYPE *) o1) | (1 << *((Int32 *) o2));
0241         o1 -= o1_inc;
0242         o2 -= o2_inc;
0243         r -= sizeof(OP_TYPE);
0244     }
0245 
0246     break;
0247 }
0248 
0249 
0250 case FC_IBCLR + (OP_BASE):
0251 {
0252     register int        n;
0253     register char       *r, *o1, *o2;
0254     int         o1_inc, o2_inc;
0255     OP_TYPE         o1_tmp;
0256     Int32           o2_tmp;
0257 
0258     n = 1;
0259     if ( frame_size[framep] == 1 ) {
0260         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0261         o1 = (char *) &o1_tmp;
0262         o1_inc = 0;
0263     } else {
0264         o1 = (char *) &stack[frame[framep]];
0265         o1_inc = sizeof(OP_TYPE);
0266         n = frame_size[framep];
0267     }
0268     if ( frame_size[framep-1] == 1 ) {
0269         o2_tmp = *(Int32 *) &stack[frame[framep-1]];
0270         o2 = (char *) &o2_tmp;
0271         o2_inc = 0;
0272     } else {
0273         o2 = (char *) &stack[frame[framep-1]];
0274         o2_inc = sizeof(Int32);
0275         n = frame_size[framep-1];
0276     }
0277 
0278     POP_FRAME(2);
0279     NEW_FRAME(OP_DTYPE,1,r);
0280 
0281     o1 += o1_inc * (n-1);
0282     o2 += o2_inc * (n-1);
0283     r += sizeof(OP_TYPE) * (n-1);
0284     for ( ; n > 0 ; n-- ) {
0285         *((OP_TYPE *) r) = *((OP_TYPE *) o1) & ~ (1 << *((Int32 *) o2));
0286         o1 -= o1_inc;
0287         o2 -= o2_inc;
0288         r -= sizeof(OP_TYPE);
0289     }
0290 
0291     break;
0292 }
0293 
0294 
0295 case FC_ISHFT + (OP_BASE):
0296 {
0297     register int        n;
0298     register char       *r, *o1, *o2;
0299     int         o1_inc, o2_inc;
0300     OP_TYPE         o1_tmp;
0301     Int32           o2_tmp;
0302 
0303     n = 1;
0304     if ( frame_size[framep] == 1 ) {
0305         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0306         o1 = (char *) &o1_tmp;
0307         o1_inc = 0;
0308     } else {
0309         o1 = (char *) &stack[frame[framep]];
0310         o1_inc = sizeof(OP_TYPE);
0311         n = frame_size[framep];
0312     }
0313     if ( frame_size[framep-1] == 1 ) {
0314         o2_tmp = *(Int32 *) &stack[frame[framep-1]];
0315         o2 = (char *) &o2_tmp;
0316         o2_inc = 0;
0317     } else {
0318         o2 = (char *) &stack[frame[framep-1]];
0319         o2_inc = sizeof(Int32);
0320         n = frame_size[framep-1];
0321     }
0322 
0323     POP_FRAME(2);
0324     NEW_FRAME(OP_DTYPE,1,r);
0325 
0326     o1 += o1_inc * (n-1);
0327     o2 += o2_inc * (n-1);
0328     r += sizeof(OP_TYPE) * (n-1);
0329     for ( ; n > 0 ; n-- ) {
0330         *((OP_TYPE *) r) = *((OP_TYPE *) o1) << *((Int32 *) o2);
0331         o1 -= o1_inc;
0332         o2 -= o2_inc;
0333         r -= sizeof(OP_TYPE);
0334     }
0335 
0336     break;
0337 }
0338 
0339 
0340 case FC_ISHFTC + (OP_BASE):
0341 {
0342     register int        n;
0343     register char       *r, *o1, *o2, *o3;
0344     int         o1_inc, o2_inc, o3_inc;
0345     OP_TYPE         o1_tmp;
0346     Int32           o2_tmp, o3_tmp;
0347 
0348     OP_TYPE         m, blob, mask;
0349     Int32           k, ic;
0350 
0351     n = 1;
0352     if ( frame_size[framep] == 1 ) {
0353         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0354         o1 = (char *) &o1_tmp;
0355         o1_inc = 0;
0356     } else {
0357         o1 = (char *) &stack[frame[framep]];
0358         o1_inc = sizeof(OP_TYPE);
0359         n = frame_size[framep];
0360     }
0361     if ( frame_size[framep-1] == 1 ) {
0362         o2_tmp = *(Int32 *) &stack[frame[framep-1]];
0363         o2 = (char *) &o2_tmp;
0364         o2_inc = 0;
0365     } else {
0366         o2 = (char *) &stack[frame[framep-1]];
0367         o2_inc = sizeof(Int32);
0368         n = frame_size[framep-1];
0369     }
0370     if ( frame_size[framep-2] == 1 ) {
0371         o3_tmp = *(Int32 *) &stack[frame[framep-2]];
0372         o3 = (char *) &o3_tmp;
0373         o3_inc = 0;
0374     } else {
0375         o3 = (char *) &stack[frame[framep-2]];
0376         o3_inc = sizeof(Int32);
0377         n = frame_size[framep-2];
0378     }
0379 
0380     POP_FRAME(3);
0381     NEW_FRAME(OP_DTYPE,1,r);
0382 
0383     o1 += o1_inc * (n-1);
0384     o2 += o2_inc * (n-1);
0385     o3 += o3_inc * (n-1);
0386     r += sizeof(OP_TYPE) * (n-1);
0387     for ( ; n > 0 ; n-- ) {
0388         m = (*(OP_TYPE *) o1);
0389         k = (*(Int32 *) o2);
0390         ic = (*(Int32 *) o3);
0391 
0392         if ( (ic <= 0) || (ic > 8 * sizeof( OP_TYPE )) ) {
0393             sf_report( "ISHFT: arg 3 (%d) outside range [1..%d]\n",
0394                 ic, 8 * sizeof( OP_TYPE ) );
0395             *errp = R_MATH_ERROR;
0396             running = FALSE;
0397             break;
0398         }
0399 
0400         k = k % ic;
0401         k = (k + ic) % ic; /* k is now positive and less than ic */
0402         if ( ic == (8 * sizeof( OP_TYPE )) ) {
0403             mask = ~ 0;
0404         } else {
0405             mask = (1 << ic) - 1;
0406         }
0407         blob = m & mask;
0408 
0409         blob = ((blob >> (ic - k)) | (blob << k)) & mask;
0410         m = ( m & ~ mask ) | blob;
0411 
0412         *((OP_TYPE *) r) = m;
0413 
0414         o1 -= o1_inc;
0415         o2 -= o2_inc;
0416         o3 -= o3_inc;
0417         r -= sizeof(OP_TYPE);
0418     }
0419 
0420     break;
0421 }
0422 
0423 
0424 case FC_IBITS + (OP_BASE):
0425 {
0426     register int        n;
0427     register char       *r, *o1, *o2, *o3;
0428     int         o1_inc, o2_inc, o3_inc;
0429     OP_TYPE         o1_tmp;
0430     Int32           o2_tmp, o3_tmp;
0431 
0432     OP_TYPE         mask;
0433     Int32           i, len;
0434 
0435     n = 1;
0436     if ( frame_size[framep] == 1 ) {
0437         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0438         o1 = (char *) &o1_tmp;
0439         o1_inc = 0;
0440     } else {
0441         o1 = (char *) &stack[frame[framep]];
0442         o1_inc = sizeof(OP_TYPE);
0443         n = frame_size[framep];
0444     }
0445     if ( frame_size[framep-1] == 1 ) {
0446         o2_tmp = *(Int32 *) &stack[frame[framep-1]];
0447         o2 = (char *) &o2_tmp;
0448         o2_inc = 0;
0449     } else {
0450         o2 = (char *) &stack[frame[framep-1]];
0451         o2_inc = sizeof(Int32);
0452         n = frame_size[framep-1];
0453     }
0454     if ( frame_size[framep-2] == 1 ) {
0455         o3_tmp = *(Int32 *) &stack[frame[framep-2]];
0456         o3 = (char *) &o3_tmp;
0457         o3_inc = 0;
0458     } else {
0459         o3 = (char *) &stack[frame[framep-2]];
0460         o3_inc = sizeof(Int32);
0461         n = frame_size[framep-2];
0462     }
0463 
0464     POP_FRAME(3);
0465     NEW_FRAME(OP_DTYPE,1,r);
0466 
0467     o1 += o1_inc * (n-1);
0468     o2 += o2_inc * (n-1);
0469     o3 += o3_inc * (n-1);
0470     r += sizeof(OP_TYPE) * (n-1);
0471     for ( ; n > 0 ; n-- ) {
0472 
0473         i = (*(Int32 *) o2);
0474         len = (*(Int32 *) o3);
0475 
0476         if ( (i < 0) || (i >= 8 * sizeof( OP_TYPE )) ) {
0477             sf_report( "IBITS: arg 2 (%d) outside range [0..%d]\n",
0478                 i, 8 * sizeof( OP_TYPE ) - 1 );
0479             *errp = R_MATH_ERROR;
0480             running = FALSE;
0481             break;
0482         }
0483         if ( (len <= 0) || (i+len > 8 * sizeof( OP_TYPE )) ) {
0484             sf_report( "IBITS: arg 3 (%d) outside range [1..%d] "
0485                 "(arg 2 is %d)\n", len, 8 * sizeof( OP_TYPE )-i, i );
0486             *errp = R_MATH_ERROR;
0487             running = FALSE;
0488             break;
0489         }
0490 
0491         if ( len == (8 * sizeof( OP_TYPE )) ) {
0492             mask = ~ 0;
0493         } else {
0494             mask = (1 << len) - 1;
0495         }
0496 
0497         *((OP_TYPE *) r) = ((*(OP_TYPE *) o1) >> i) & mask;
0498 
0499         o1 -= o1_inc;
0500         o2 -= o2_inc;
0501         o3 -= o3_inc;
0502         r -= sizeof(OP_TYPE);
0503     }
0504 
0505     break;
0506 }
0507 
0508 
0509 case FC_MVBITS + (OP_BASE):
0510 {
0511     register int        n;
0512     register char       *r, *o1, *o2, *o3, *o4, *o5;
0513     int         o1_inc, o2_inc, o3_inc, o4_inc, o5_inc;
0514     OP_TYPE         o1_tmp, o4_tmp;
0515     Int32           o2_tmp, o3_tmp, o5_tmp;
0516 
0517     OP_TYPE         mask;
0518     Int32           i, len, j;
0519 
0520     n = 1;
0521     if ( frame_size[framep] == 1 ) {
0522         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0523         o1 = (char *) &o1_tmp;
0524         o1_inc = 0;
0525     } else {
0526         o1 = (char *) &stack[frame[framep]];
0527         o1_inc = sizeof(OP_TYPE);
0528         n = frame_size[framep];
0529     }
0530     if ( frame_size[framep-1] == 1 ) {
0531         o2_tmp = *(Int32 *) &stack[frame[framep-1]];
0532         o2 = (char *) &o2_tmp;
0533         o2_inc = 0;
0534     } else {
0535         o2 = (char *) &stack[frame[framep-1]];
0536         o2_inc = sizeof(Int32);
0537         n = frame_size[framep-1];
0538     }
0539     if ( frame_size[framep-2] == 1 ) {
0540         o3_tmp = *(Int32 *) &stack[frame[framep-2]];
0541         o3 = (char *) &o3_tmp;
0542         o3_inc = 0;
0543     } else {
0544         o3 = (char *) &stack[frame[framep-2]];
0545         o3_inc = sizeof(Int32);
0546         n = frame_size[framep-2];
0547     }
0548     if ( frame_size[framep-3] == 1 ) {
0549         o4_tmp = *(OP_TYPE *) &stack[frame[framep-3]];
0550         o4 = (char *) &o4_tmp;
0551         o4_inc = 0;
0552     } else {
0553         o4 = (char *) &stack[frame[framep-3]];
0554         o4_inc = sizeof(OP_TYPE);
0555         n = frame_size[framep-3];
0556     }
0557     if ( frame_size[framep-4] == 1 ) {
0558         o5_tmp = *(Int32 *) &stack[frame[framep-4]];
0559         o5 = (char *) &o5_tmp;
0560         o5_inc = 0;
0561     } else {
0562         o5 = (char *) &stack[frame[framep-4]];
0563         o5_inc = sizeof(Int32);
0564         n = frame_size[framep-4];
0565     }
0566 
0567     POP_FRAME(5);
0568     NEW_FRAME(OP_DTYPE,1,r);
0569 
0570     o1 += o1_inc * (n-1);
0571     o2 += o2_inc * (n-1);
0572     o3 += o3_inc * (n-1);
0573     o4 += o4_inc * (n-1);
0574     o5 += o5_inc * (n-1);
0575     r += sizeof(OP_TYPE) * (n-1);
0576     for ( ; n > 0 ; n-- ) {
0577 
0578         i = (*(Int32 *) o2);
0579         len = (*(Int32 *) o3);
0580         j = (*(Int32 *) o5);
0581 
0582         if ( (i < 0) || (i >= 8 * sizeof( OP_TYPE )) ) {
0583             sf_report( "MVBITS: arg 2 (%d) outside range [0..%d]\n",
0584                 i, 8 * sizeof( OP_TYPE ) - 1 );
0585             *errp = R_MATH_ERROR;
0586             running = FALSE;
0587             break;
0588         }
0589         if ( (j < 0) || (j >= 8 * sizeof( OP_TYPE )) ) {
0590             sf_report( "MVBITS: arg 5 (%d) outside range [0..%d]\n",
0591                 j, 8 * sizeof( OP_TYPE ) - 1 );
0592             *errp = R_MATH_ERROR;
0593             running = FALSE;
0594             break;
0595         }
0596         if ( (len <= 0) || (i+len > 8 * sizeof( OP_TYPE )) ) {
0597             sf_report( "MVBITS: arg 3 (%d) outside range [1..%d] "
0598                 "(arg 2 is %d)\n", len, 8 * sizeof( OP_TYPE )-i, i );
0599             *errp = R_MATH_ERROR;
0600             running = FALSE;
0601             break;
0602         }
0603         if ( (j+len > 8 * sizeof( OP_TYPE )) ) {
0604             sf_report( "MVBITS: arg 3 (%d) outside range [1..%d] "
0605                 "(arg 4 is %d)\n", len, 8 * sizeof( OP_TYPE )-j, j );
0606             *errp = R_MATH_ERROR;
0607             running = FALSE;
0608             break;
0609         }
0610 
0611         if ( len == (8 * sizeof( OP_TYPE )) ) {
0612             mask = ~ 0;
0613         } else {
0614             mask = (1 << len) - 1;
0615         }
0616 
0617         *((OP_TYPE *) r) = ((((*(OP_TYPE *) o1) >> i) & mask) << j)
0618                 | ((*(OP_TYPE *) o4) & ~ (mask << j));
0619 
0620         o1 -= o1_inc;
0621         o2 -= o2_inc;
0622         o3 -= o3_inc;
0623         o4 -= o4_inc;
0624         o5 -= o5_inc;
0625         r -= sizeof(OP_TYPE);
0626     }
0627 
0628     break;
0629 }
0630 
0631 
0632 case FC_IABS + (OP_BASE):
0633 {
0634     register int        n;
0635     register OP_TYPE    *o1;
0636 
0637     n = frame_size[framep];
0638     o1 = (OP_TYPE *) &stack[frame[framep]];
0639     for ( ; n > 0 ; n--, o1++ ) {
0640         if ( *((OP_TYPE *) o1) < 0 ) {
0641             *((OP_TYPE *) o1) = - *((OP_TYPE *) o1);
0642         }
0643     }
0644     break;
0645 }
0646 
0647 
0648 case FC_IMOD + (OP_BASE):
0649 {
0650     register int        n;
0651     register char       *r, *o1, *o2;
0652     int         o1_inc, o2_inc;
0653     OP_TYPE         o1_tmp, o2_tmp;
0654 
0655     n = 1;
0656     if ( frame_size[framep] == 1 ) {
0657         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0658         o1 = (char *) &o1_tmp;
0659         o1_inc = 0;
0660     } else {
0661         o1 = (char *) &stack[frame[framep]];
0662         o1_inc = sizeof(OP_TYPE);
0663         n = frame_size[framep];
0664     }
0665     if ( frame_size[framep-1] == 1 ) {
0666         o2_tmp = *(OP_TYPE *) &stack[frame[framep-1]];
0667         o2 = (char *) &o2_tmp;
0668         o2_inc = 0;
0669     } else {
0670         o2 = (char *) &stack[frame[framep-1]];
0671         o2_inc = sizeof(OP_TYPE);
0672         n = frame_size[framep-1];
0673     }
0674 
0675     POP_FRAME(2);
0676     NEW_FRAME(OP_DTYPE,n,r);
0677 
0678     o1 += o1_inc * (n-1);
0679     o2 += o2_inc * (n-1);
0680     r += sizeof(OP_TYPE) * (n-1);
0681     for ( ; n > 0 ; n-- ) {
0682         if ( *((OP_TYPE *) o2) == 0 ) {
0683             sf_report( "Mod with divisor of zero\n" );
0684             *errp = R_MATH_ERROR;
0685             running = FALSE;
0686         } else {
0687             *((OP_TYPE *) r) = *((OP_TYPE *) o1) % *((OP_TYPE*) o2);
0688         }
0689         o1 -= o1_inc;
0690         o2 -= o2_inc;
0691         r -= sizeof(OP_TYPE);
0692     }
0693     break;
0694 }
0695 
0696 
0697 case FC_ISIGN + (OP_BASE):
0698 {
0699     register int        n;
0700     register char       *r, *o1, *o2;
0701     int         o1_inc, o2_inc;
0702     OP_TYPE         o1_tmp, o2_tmp;
0703 
0704     n = 1;
0705     if ( frame_size[framep] == 1 ) {
0706         o1_tmp = *(OP_TYPE *) &stack[frame[framep]];
0707         o1 = (char *) &o1_tmp;
0708         o1_inc = 0;
0709     } else {
0710         o1 = (char *) &stack[frame[framep]];
0711         o1_inc = sizeof(OP_TYPE);
0712         n = frame_size[framep];
0713     }
0714     if ( frame_size[framep-1] == 1 ) {
0715         o2_tmp = *(OP_TYPE *) &stack[frame[framep-1]];
0716         o2 = (char *) &o2_tmp;
0717         o2_inc = 0;
0718     } else {
0719         o2 = (char *) &stack[frame[framep-1]];
0720         o2_inc = sizeof(OP_TYPE);
0721         n = frame_size[framep-1];
0722     }
0723 
0724     POP_FRAME(2);
0725     NEW_FRAME(OP_DTYPE,n,r);
0726 
0727     o1 += o1_inc * (n-1);
0728     o2 += o2_inc * (n-1);
0729     r += sizeof(OP_TYPE) * (n-1);
0730     for ( ; n > 0 ; n-- ) {
0731         if (
0732             ( ( *((OP_TYPE *) o1) < 0 && *((OP_TYPE *) o2) > 0 ) )
0733             || 
0734             ( ( *((OP_TYPE *) o1) > 0 && *((OP_TYPE *) o2) < 0 ) )
0735         ) {
0736             *((OP_TYPE *) r) =  - *((OP_TYPE *) o1);
0737         } else {
0738             *((OP_TYPE *) r) = *((OP_TYPE *) o1);
0739         }
0740 
0741         o1 -= o1_inc;
0742         o2 -= o2_inc;
0743         r -= sizeof(OP_TYPE);
0744     }
0745     break;
0746 }
0747