Changeset 31364 in project


Ignore:
Timestamp:
09/10/14 18:27:24 (5 years ago)
Author:
sjamaan
Message:

numbers: Convert bitwise operations to core naming conventions

Location:
release/4/numbers/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/numbers/trunk/numbers-c.c

    r31362 r31364  
    12301230}
    12311231
    1232 static void
    1233 int_bitwise_int(C_word c, C_word self, C_word k, C_word op, C_word x, C_word y)
    1234 {
    1235   bignum_type bigx, bigy, result;
    1236  
    1237   if((x & C_FIXNUM_BIT) != 0)
    1238     bigx = bignum_allocate_from_fixnum(x);
    1239   else
    1240     bigx = big_of(x);
    1241 
    1242   if((y & C_FIXNUM_BIT) != 0)
    1243     bigy = bignum_allocate_from_fixnum(y);
    1244   else
    1245     bigy = big_of(y);
    1246 
    1247   result = ((BIGNUM_NEGATIVE_P (bigx))
    1248              ? (BIGNUM_NEGATIVE_P (bigy))
    1249                ? bignum_negneg_bitwise_op(C_unfix(op), bigx, bigy)
    1250                : bignum_posneg_bitwise_op(C_unfix(op), bigy, bigx)
    1251              : (BIGNUM_NEGATIVE_P (bigy))
    1252                ? bignum_posneg_bitwise_op(C_unfix(op), bigx, bigy)
    1253                : bignum_pospos_bitwise_op(C_unfix(op), bigx, bigy));
    1254        
    1255   if((x & C_FIXNUM_BIT) != 0)
    1256     BIGNUM_DEALLOCATE(bigx);
    1257   if((y & C_FIXNUM_BIT) != 0)
    1258     BIGNUM_DEALLOCATE(bigy);
    1259 
    1260   C_return_bignum(k, result);
    1261 }
    1262 
    1263 static bignum_type
    1264 bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
    1265 {
    1266   bignum_type result;
    1267   bignum_length_type max_length;
    1268 
    1269   bignum_digit_type *scan1, *end1, digit1;
    1270   bignum_digit_type *scan2, *end2, digit2;
    1271   bignum_digit_type *scanr, *endr;
    1272 
    1273   max_length =  (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
    1274                ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2);
    1275 
    1276   result = bignum_allocate(max_length, 0);
    1277 
    1278   scanr = BIGNUM_START_PTR(result);
    1279   scan1 = BIGNUM_START_PTR(arg1);
    1280   scan2 = BIGNUM_START_PTR(arg2);
    1281   endr = scanr + max_length;
    1282   end1 = scan1 + BIGNUM_LENGTH(arg1);
    1283   end2 = scan2 + BIGNUM_LENGTH(arg2);
    1284 
    1285   while (scanr < endr) {
    1286     digit1 = (scan1 < end1) ? *scan1++ : 0;
    1287     digit2 = (scan2 < end2) ? *scan2++ : 0;
    1288     /*
    1289     fprintf(stderr, "[pospos op = %d, i = %ld, d1 = %lx, d2 = %lx]\n",
    1290             op, endr - scanr, digit1, digit2);
    1291             */
    1292     *scanr++ = (op == bignum_and_op) ? digit1 & digit2 :
    1293                (op == bignum_ior_op) ? digit1 | digit2 :
    1294                                        digit1 ^ digit2;
    1295   }
    1296   return bignum_trim(result);
    1297 }
    1298 
    1299 static bignum_type
    1300 bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
    1301 {
    1302   bignum_type result;
    1303   bignum_length_type max_length;
    1304 
    1305   bignum_digit_type *scan1, *end1, digit1;
    1306   bignum_digit_type *scan2, *end2, digit2, carry2;
    1307   bignum_digit_type *scanr, *endr;
    1308 
    1309   char neg_p = op == bignum_ior_op || op == bignum_xor_op;
    1310 
    1311   max_length =  (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2) + 1)
    1312                ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2) + 1;
    1313 
    1314   result = bignum_allocate(max_length, neg_p);
    1315 
    1316   scanr = BIGNUM_START_PTR(result);
    1317   scan1 = BIGNUM_START_PTR(arg1);
    1318   scan2 = BIGNUM_START_PTR(arg2);
    1319   endr = scanr + max_length;
    1320   end1 = scan1 + BIGNUM_LENGTH(arg1);
    1321   end2 = scan2 + BIGNUM_LENGTH(arg2);
    1322 
    1323   carry2 = 1;
    1324 
    1325   while (scanr < endr) {
    1326     digit1 = (scan1 < end1) ? *scan1++ : 0;
    1327     digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK)
    1328              + carry2;
    1329 
    1330     if (digit2 < BIGNUM_RADIX)
    1331       carry2 = 0;
    1332     else
    1333       {
    1334         digit2 = (digit2 - BIGNUM_RADIX);
    1335         carry2 = 1;
    1336       }
    1337    
    1338     *scanr++ = (op == bignum_and_op) ? digit1 & digit2 :
    1339                (op == bignum_ior_op) ? digit1 | digit2 :
    1340                                        digit1 ^ digit2;
    1341   }
    1342  
    1343   if (neg_p)
    1344     bignum_negate_magnitude(result);
    1345 
    1346   return bignum_trim(result);
    1347 }
    1348 
    1349 static bignum_type
    1350 bignum_negneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
    1351 {
    1352   bignum_type result;
    1353   bignum_length_type max_length;
    1354 
    1355   bignum_digit_type *scan1, *end1, digit1, carry1;
    1356   bignum_digit_type *scan2, *end2, digit2, carry2;
    1357   bignum_digit_type *scanr, *endr;
    1358 
    1359   char neg_p = op == bignum_and_op || op == bignum_ior_op;
    1360 
    1361   max_length =  (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
    1362                ? BIGNUM_LENGTH(arg1) + 1 : BIGNUM_LENGTH(arg2) + 1;
    1363 
    1364   result = bignum_allocate(max_length, neg_p);
    1365 
    1366   scanr = BIGNUM_START_PTR(result);
    1367   scan1 = BIGNUM_START_PTR(arg1);
    1368   scan2 = BIGNUM_START_PTR(arg2);
    1369   endr = scanr + max_length;
    1370   end1 = scan1 + BIGNUM_LENGTH(arg1);
    1371   end2 = scan2 + BIGNUM_LENGTH(arg2);
    1372 
    1373   carry1 = 1;
    1374   carry2 = 1;
    1375 
    1376   while (scanr < endr) {
    1377     digit1 = (~((scan1 < end1) ? *scan1++ : 0) & BIGNUM_DIGIT_MASK) + carry1;
    1378     digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK) + carry2;
    1379 
    1380     if (digit1 < BIGNUM_RADIX)
    1381       carry1 = 0;
    1382     else
    1383       {
    1384         digit1 = (digit1 - BIGNUM_RADIX);
    1385         carry1 = 1;
    1386       }
    1387    
    1388     if (digit2 < BIGNUM_RADIX)
    1389       carry2 = 0;
    1390     else
    1391       {
    1392         digit2 = (digit2 - BIGNUM_RADIX);
    1393         carry2 = 1;
    1394       }
    1395    
    1396     *scanr++ = (op == bignum_and_op) ? digit1 & digit2 :
    1397                (op == bignum_ior_op) ? digit1 | digit2 :
    1398                                        digit1 ^ digit2;
    1399   }
    1400 
    1401   if (neg_p)
    1402     bignum_negate_magnitude(result);
    1403 
    1404   return bignum_trim(result);
    1405 }
    1406 
    1407 static void
    1408 bignum_negate_magnitude(bignum_type arg)
    1409 {
    1410   bignum_digit_type *scan;
    1411   bignum_digit_type *end;
    1412   bignum_digit_type digit;
    1413   bignum_digit_type carry;
    1414 
    1415   scan = BIGNUM_START_PTR(arg);
    1416   end = scan + BIGNUM_LENGTH(arg);
    1417 
    1418   carry = 1;
    1419 
    1420   while (scan < end) {
    1421     digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
    1422 
    1423     if (digit < BIGNUM_RADIX)
    1424       carry = 0;
    1425     else
    1426       {
    1427         digit = (digit - BIGNUM_RADIX);
    1428         carry = 1;
    1429       }
    1430    
    1431     *scan++ = digit;
    1432   }
    1433 }
    1434 
    14351232/**
    14361233 * Below you will find the functions that have been refactored to
     
    14651262static void bignum_abs_2(C_word c, C_word self, C_word result);
    14661263static void bignum_random_2(C_word c, C_word self, C_word result);
     1264static void bignum_maybe_negate_magnitude(C_word k, C_word result);
     1265static void bignum_negneg_bitwise_op(C_word c, C_word self, C_word result);
     1266static void bignum_posneg_bitwise_op(C_word c, C_word self, C_word result);
     1267static void bignum_pospos_bitwise_op(C_word c, C_word self, C_word result);
    14671268
    14681269/* Eventually this will probably need to be integrated into C_2_plus. */
     
    25892390  C_kontinue(k, C_bignum_normalize(result));
    25902391}
     2392
     2393
     2394/* op identifies the operator: 0 means AND, 1 means IOR, 2 means XOR */
     2395void C_ccall
     2396C_u_2_integer_bitwise_op(C_word c, C_word self, C_word k, C_word op, C_word x, C_word y)
     2397{
     2398  C_word kab[C_SIZEOF_FIX_BIGNUM*2 + C_SIZEOF_CLOSURE(5)], *ka = kab, k2,
     2399         size, negp;
     2400 
     2401  if (x & C_FIXNUM_BIT)
     2402    x = C_a_u_i_fix_to_big(&ka, x);
     2403
     2404  if (y & C_FIXNUM_BIT)
     2405    y = C_a_u_i_fix_to_big(&ka, y);
     2406
     2407# define nmax(x, y)     ((x) > (y) ? (x) : (y)) /* From runtime.c */
     2408
     2409  if (C_bignum_negativep(x)) {
     2410    if (C_bignum_negativep(y)) {
     2411      negp = C_mk_bool(op == C_fix(0) || op == C_fix(1)); /* and / ior */
     2412      size = C_fix(nmax(C_bignum_size(x) + 1, C_bignum_size(y) + 1));
     2413      k2 = C_closure(&ka, 5, (C_word)bignum_negneg_bitwise_op, k, op, x, y);
     2414    } else {
     2415      negp = C_mk_bool(op == C_fix(1) || op == C_fix(2)); /* ior / xor */
     2416      size = C_fix(nmax(C_bignum_size(y), C_bignum_size(x) + 1)); /*!*/
     2417      k2 = C_closure(&ka, 5, (C_word)bignum_posneg_bitwise_op, k, op, y, x);
     2418    }
     2419  } else {
     2420    if (C_bignum_negativep(y)) {
     2421      negp = C_mk_bool(op == C_fix(1) || op == C_fix(2)); /* ior / xor */
     2422      size = C_fix(nmax(C_bignum_size(x), C_bignum_size(y) + 1));
     2423      k2 = C_closure(&ka, 5, (C_word)bignum_posneg_bitwise_op, k, op, x, y);
     2424    } else {
     2425      negp = C_SCHEME_FALSE;
     2426      size = C_fix(nmax(C_bignum_size(x), C_bignum_size(y)));
     2427      k2 = C_closure(&ka, 5, (C_word)bignum_pospos_bitwise_op, k, op, x, y);
     2428    }
     2429  }
     2430
     2431# undef nmax
     2432
     2433  C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
     2434}
     2435
     2436static void
     2437bignum_pospos_bitwise_op(C_word c, C_word self, C_word result)
     2438{
     2439  C_word k = C_block_item(self, 1),
     2440         op = C_block_item(self, 2),
     2441         arg1 = C_block_item(self, 3),
     2442         arg2 = C_block_item(self, 4),
     2443         *scanr = C_bignum_digits(result),
     2444         *endr = scanr + C_bignum_size(result),
     2445         *scan1 = C_bignum_digits(arg1),
     2446         *end1 = scan1 + C_bignum_size(arg1),
     2447         *scan2 = C_bignum_digits(arg2),
     2448         *end2 = scan2 + C_bignum_size(arg2),
     2449         digit1, digit2;
     2450
     2451  while (scanr < endr) {
     2452    digit1 = (scan1 < end1) ? *scan1++ : 0;
     2453    digit2 = (scan2 < end2) ? *scan2++ : 0;
     2454    *scanr++ = (op == C_fix(0)) ? digit1 & digit2 :
     2455               (op == C_fix(1)) ? digit1 | digit2 :
     2456                                  digit1 ^ digit2;
     2457  }
     2458  C_bignum_destructive_trim(result);
     2459  C_kontinue(k, C_bignum_normalize(result));
     2460}
     2461
     2462static void
     2463bignum_posneg_bitwise_op(C_word c, C_word self, C_word result)
     2464{
     2465  C_word k = C_block_item(self, 1),
     2466         op = C_block_item(self, 2),
     2467         arg1 = C_block_item(self, 3),
     2468         arg2 = C_block_item(self, 4),
     2469         *scanr = C_bignum_digits(result),
     2470         *endr = scanr + C_bignum_size(result),
     2471         *scan1 = C_bignum_digits(arg1),
     2472         *end1 = scan1 + C_bignum_size(arg1),
     2473         *scan2 = C_bignum_digits(arg2),
     2474         *end2 = scan2 + C_bignum_size(arg2),
     2475         digit1, digit2, carry2 = 1;
     2476
     2477  while (scanr < endr) {
     2478    digit1 = (scan1 < end1) ? *scan1++ : 0;
     2479    digit2 = (~((scan2 < end2) ? *scan2++ : 0) & C_BIGNUM_DIGIT_MASK) + carry2;
     2480
     2481    if (C_fitsinbignumdigitp(digit2)) {
     2482      carry2 = 0;
     2483    } else {
     2484      digit2 &= C_BIGNUM_DIGIT_MASK;
     2485      carry2 = 1;
     2486    }
     2487   
     2488    *scanr++ = (op == C_fix(0)) ? digit1 & digit2 :
     2489               (op == C_fix(1)) ? digit1 | digit2 :
     2490                                  digit1 ^ digit2;
     2491  }
     2492
     2493  bignum_maybe_negate_magnitude(k, result);
     2494}
     2495
     2496static void
     2497bignum_negneg_bitwise_op(C_word c, C_word self, C_word result)
     2498{
     2499  C_word k = C_block_item(self, 1),
     2500         op = C_block_item(self, 2),
     2501         arg1 = C_block_item(self, 3),
     2502         arg2 = C_block_item(self, 4),
     2503         *scanr = C_bignum_digits(result),
     2504         *endr = scanr + C_bignum_size(result),
     2505         *scan1 = C_bignum_digits(arg1),
     2506         *end1 = scan1 + C_bignum_size(arg1),
     2507         *scan2 = C_bignum_digits(arg2),
     2508         *end2 = scan2 + C_bignum_size(arg2),
     2509         digit1, digit2, carry1 = 1, carry2 = 1;
     2510
     2511  while (scanr < endr) {
     2512    digit1 = (~((scan1 < end1) ? *scan1++ : 0) & C_BIGNUM_DIGIT_MASK) + carry1;
     2513    digit2 = (~((scan2 < end2) ? *scan2++ : 0) & C_BIGNUM_DIGIT_MASK) + carry2;
     2514
     2515    if (C_fitsinbignumdigitp(digit1)) {
     2516      carry1 = 0;
     2517    } else {
     2518      digit1 &= C_BIGNUM_DIGIT_MASK;
     2519      carry1 = 1;
     2520    }
     2521    if (C_fitsinbignumdigitp(digit2)) {
     2522      carry2 = 0;
     2523    } else {
     2524      digit2 &= C_BIGNUM_DIGIT_MASK;
     2525      carry2 = 1;
     2526    }
     2527   
     2528    *scanr++ = (op == C_fix(0)) ? digit1 & digit2 :
     2529               (op == C_fix(1)) ? digit1 | digit2 :
     2530                                  digit1 ^ digit2;
     2531  }
     2532
     2533  bignum_maybe_negate_magnitude(k, result);
     2534}
     2535
     2536static void
     2537bignum_maybe_negate_magnitude(C_word k, C_word result)
     2538{
     2539  if (C_bignum_negativep(result)) {
     2540    C_word *scan, *end, digit, carry;
     2541
     2542    scan = C_bignum_digits(result);
     2543    end = scan + C_bignum_size(result);
     2544    carry = 1;
     2545
     2546    while (scan < end) {
     2547      digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
     2548
     2549      if (C_fitsinbignumdigitp(digit)) {
     2550        carry = 0;
     2551      } else {
     2552        digit &= C_BIGNUM_DIGIT_MASK;
     2553        carry = 1;
     2554      }
     2555   
     2556      *scan++ = digit;
     2557    }
     2558  }
     2559  C_bignum_destructive_trim(result);
     2560  C_kontinue(k, C_bignum_normalize(result));
     2561}
  • release/4/numbers/trunk/numbers-c.h

    r31353 r31364  
    1414#define RAT_TAG       1
    1515#define COMP_TAG      2
    16 
    17 enum bignum_bitwise_ops
    18 {
    19   bignum_and_op,
    20   bignum_ior_op,
    21   bignum_xor_op
    22 };
    2316
    2417enum bignum_comparison
     
    4134static void bignum_destructive_copy(bignum_type, bignum_type);
    4235static bignum_type bignum_new_sign(bignum_type, int);
    43 static bignum_type bignum_add(bignum_type, bignum_type);
    44 static bignum_type bignum_add_unsigned(bignum_type, bignum_type, int);
    45 static bignum_type bignum_subtract(bignum_type, bignum_type);
    46 static bignum_type bignum_subtract_unsigned(bignum_type, bignum_type);
    47 static bignum_type bignum_multiply_unsigned(bignum_type, bignum_type, int);
    48 static bignum_type bignum_multiply_unsigned_small_factor(bignum_type,
    49                                                          bignum_digit_type, int);
    50 static void bignum_destructive_scale_up(bignum_type, bignum_digit_type);
    51 static void bignum_destructive_add(bignum_type, bignum_digit_type);
    5236static void bignum_divide_unsigned_large_denominator(bignum_type, bignum_type,
    5337                                                     bignum_type *,
     
    8569                                                               int);
    8670static enum bignum_comparison bignum_compare_unsigned(bignum_type, bignum_type);
    87 static bignum_type double_to_bignum(double);
    88 static bignum_type bignum_bitwise_and(bignum_type, bignum_type);
    89 static bignum_type bignum_bitwise_ior(bignum_type, bignum_type);
    90 static bignum_type bignum_bitwise_xor(bignum_type, bignum_type);
    91 static bignum_type bignum_bitwise_not(bignum_type);
    92 static bignum_type bignum_arithmetic_shift(bignum_type, C_word);
    93 static bignum_type bignum_magnitude_ash(bignum_type, C_word);
    94 static bignum_type bignum_pospos_bitwise_op(int, bignum_type, bignum_type);
    95 static bignum_type bignum_posneg_bitwise_op(int, bignum_type, bignum_type);
    96 static bignum_type bignum_negneg_bitwise_op(int, bignum_type, bignum_type);
    97 static void bignum_negate_magnitude(bignum_type);
    9871
    9972#define BIGNUM_OUT_OF_BAND NULL
     
    245218
    246219void C_ccall C_u_int_shift_fix(C_word c, C_word self, C_word k, C_word x, C_word y);
     220void C_ccall C_u_2_integer_bitwise_op(C_word c, C_word self, C_word k, C_word op, C_word x, C_word y);
     221
    247222
    248223C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
  • release/4/numbers/trunk/numbers.scm

    r31353 r31364  
    8282(define-foreign-variable NONE integer)
    8383
    84 (define-foreign-variable bignum_and_op integer)
    85 (define-foreign-variable bignum_ior_op integer)
    86 (define-foreign-variable bignum_xor_op integer)
    87 
    8884;;; Error handling
    8985
     
    187183(define %flo->integer (##core#primitive "C_u_flo_to_int"))
    188184
    189 (define %int-bitwise-int (##core#primitive "int_bitwise_int"))
     185(define %int-bitwise-int (##core#primitive "C_u_2_integer_bitwise_op"))
    190186(define %int-shift-fix (##core#primitive "C_u_int_shift_fix"))
    191187(define-inline (%int-length i) (##core#inline "C_u_i_int_length" i))
     
    16961692        (let ((xi (##sys#slot xs 0)))
    16971693          (loop
    1698            (%int-bitwise-int bignum_and_op x (%->integer 'bitwise-and xi))
     1694           (%int-bitwise-int 0 x (%->integer 'bitwise-and xi))
    16991695           (##sys#slot xs 1) ) ) ) ) )
    17001696
     
    17051701        (let ((xi (##sys#slot xs 0)))
    17061702          (loop
    1707            (%int-bitwise-int bignum_ior_op x (%->integer 'bitwise-ior xi))
     1703           (%int-bitwise-int 1 x (%->integer 'bitwise-ior xi))
    17081704           (##sys#slot xs 1) ) ) ) ) )
    17091705
     
    17141710        (let ((xi (##sys#slot xs 0)))
    17151711          (loop
    1716            (%int-bitwise-int bignum_xor_op x (%->integer 'bitwise-xor xi))
     1712           (%int-bitwise-int 2 x (%->integer 'bitwise-xor xi))
    17171713           (##sys#slot xs 1) ) ) ) ) )
    17181714
Note: See TracChangeset for help on using the changeset viewer.