File indexing completed on 2025-02-21 10:05:32
0001
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
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;
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