Changeset 13422


Ignore:
Timestamp:
Jan 29, 2010, 12:46:10 PM (10 years ago)
Author:
gb
Message:

Simpler BIGNUM-LOGICAL-AND, BIGNUM-LOGICAL-IOR; call directly to the
new LAP functions.
Fix bugs/fenceposts in the ppc64 version of those LAP functions.

Location:
trunk/source/level-0
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/PPC/PPC64/ppc64-bignum.lisp

    r13418 r13422  
    342342;;; C.  (It's legal and desirable to do this more than 32 bits at a time.)
    343343
    344 (defppclapfunction %bignum-logior ((n 0) #|ra 0|# (a arg_x) (b arg_y) (c arg_z))
     344(defppclapfunction %bignum-logior ((n 0) (a arg_x) (b arg_y) (c arg_z))
    345345  (vpop imm0)
    346   (srwi. imm0 imm0 1)
    347   (la imm2 ppc64::misc-data-offset imm0)
    348   (b @test)
    349   @loop
    350   (cmpwi imm0 4)
     346  (srdi imm0 imm0 1)
     347  (andi. imm1 imm0 4)
     348  (la imm3 ppc64::misc-data-offset imm0)
     349  (beq @loop)
     350  (cmpdi imm0 4)
     351  (subi imm0 imm0 4)
     352  (subi imm3 imm3 4)
    351353  (lwzx imm1 a imm3)
    352354  (lwzx imm2 b imm3)
    353355  (or imm1 imm1 imm2)
    354356  (stwx imm1 c imm3)
    355   (subi imm0 imm0 4)
    356   @test
     357  (beqlr)
     358  @loop
     359  (subi imm0 imm0 8)
     360  (subi imm3 imm3 8)
     361  (cmpdi imm0 0)                        ;can't happen on 1st iteration
     362  (ldx imm1 a imm3)
     363  (ldx imm2 b imm3)
     364  (or imm1 imm1 imm2)
     365  (stdx imm1 c imm3)
    357366  (bne @loop)
    358367  (blr))
     
    363372;;; C.  (It's legal and desirable to do this more than 32 bits at a time.)
    364373
    365 (defppclapfunction %bignum-logand ((n 0) #|ra 0|# (a arg_x) (b arg_y) (c arg_z))
     374(defppclapfunction %bignum-logand ((n 0) (a arg_x) (b arg_y) (c arg_z))
    366375  (vpop imm0)
    367   (srwi. imm0 imm0 1)
    368   (la imm2 ppc64::misc-data-offset imm0)
    369   (b @test)
    370   @loop
    371   (cmpwi imm0 4)
     376  (srdi imm0 imm0 1)
     377  (andi. imm1 imm0 4)
     378  (la imm3 ppc64::misc-data-offset imm0)
     379  (beq @loop)
     380  (cmpdi imm0 4)
     381  (subi imm0 imm0 4)
     382  (subi imm3 imm3 4)
    372383  (lwzx imm1 a imm3)
    373384  (lwzx imm2 b imm3)
    374385  (and imm1 imm1 imm2)
    375386  (stwx imm1 c imm3)
    376   (subi imm0 imm0 4)
    377   @test
     387  (beqlr)
     388  @loop
     389  (subi imm0 imm0 8)
     390  (subi imm3 imm3 8)
     391  (cmpdi imm0 0)                        ;can't happen on 1st iteration
     392  (ldx imm1 a imm3)
     393  (ldx imm2 b imm3)
     394  (and imm1 imm1 imm2)
     395  (stdx imm1 c imm3)
    378396  (bne @loop)
    379397  (blr))
  • trunk/source/level-0/l0-bignum64.lisp

    r13419 r13422  
    12631263  (let* ((len-a (%bignum-length a))
    12641264         (len-b (%bignum-length b))
    1265          (a-plusp (bignum-plusp a))
    1266          (b-plusp (bignum-plusp b)))
    1267     (declare (type bignum-index len-a len-b))
    1268     (cond
    1269       ((< len-a len-b)
    1270        (if a-plusp
    1271          (logand-shorter-positive a len-a b (%allocate-bignum len-a))
    1272          (logand-shorter-negative a len-a b len-b (%allocate-bignum len-b))))
    1273       ((< len-b len-a)
    1274        (if b-plusp
    1275          (logand-shorter-positive b len-b a (%allocate-bignum len-b))
    1276          (logand-shorter-negative b len-b a len-a (%allocate-bignum len-a))))
    1277       (t (logand-shorter-positive a len-a b (%allocate-bignum len-a))))))
    1278 
    1279 ;;; LOGAND-SHORTER-POSITIVE -- Internal.
    1280 ;;;
    1281 ;;; This takes a shorter bignum, a and len-a, that is positive.  Because this
    1282 ;;; is AND, we don't care about any bits longer than a's since its infinite 0
    1283 ;;; sign bits will mask the other bits out of b.  The result is len-a big.
    1284 ;;;
    1285 (defun logand-shorter-positive (a len-a b res)
    1286   (declare (type bignum-type a b res)
    1287            (type bignum-index len-a))
    1288   (%bignum-logand len-a a b res)
    1289   (%normalize-bignum-macro res))
    1290 
    1291 ;;; LOGAND-SHORTER-NEGATIVE -- Internal.
    1292 ;;;
    1293 ;;; This takes a shorter bignum, a and len-a, that is negative.  Because this
    1294 ;;; is AND, we just copy any bits longer than a's since its infinite 1 sign
    1295 ;;; bits will include any bits from b.  The result is len-b big.
    1296 ;;;
    1297 (defun logand-shorter-negative (a len-a b len-b res)
    1298   (declare (type bignum-type a b res)
    1299            (type bignum-index len-a len-b))
    1300   (%bignum-logand len-a a b res)
    1301   (bignum-replace res b :start1 len-a :start2 len-a :end1 len-b :end2 len-b)
    1302   (%normalize-bignum-macro res))
    1303 
     1265         (shorter a)
     1266         (longer b)
     1267         (shorter-len len-a)
     1268         (longer-len len-b)
     1269         (shorter-positive (bignum-plusp a)))
     1270    (declare (type bignum-index len-a len-b shorter-len longer-len))
     1271    (when (< len-b len-a)
     1272      (setq shorter b
     1273            longer a
     1274            shorter-len len-b
     1275            longer-len len-a
     1276            shorter-positive (bignum-plusp b)))
     1277    (let* ((result (%allocate-bignum longer-len)))
     1278      (%bignum-logand shorter-len shorter longer result)
     1279      (unless shorter-positive
     1280        (bignum-replace result longer :start1 shorter-len :start2 shorter-len :end1 longer-len :end2 longer-len))
     1281      (%normalize-bignum-macro result))))
    13041282
    13051283
     
    14021380  (let* ((len-a (%bignum-length a))
    14031381         (len-b (%bignum-length b))
    1404          (a-plusp (bignum-plusp a))
    1405          (b-plusp (bignum-plusp b)))
    1406     (declare (type bignum-index len-a len-b))
    1407     (cond
    1408      ((< len-a len-b)
    1409       (if a-plusp
    1410           (logior-shorter-positive a len-a b len-b (%allocate-bignum len-b))
    1411           (logior-shorter-negative a len-a b len-b (%allocate-bignum len-b))))
    1412      ((< len-b len-a)
    1413       (if b-plusp
    1414           (logior-shorter-positive b len-b a len-a (%allocate-bignum len-a))
    1415           (logior-shorter-negative b len-b a len-a (%allocate-bignum len-a))))
    1416      (t (logior-shorter-positive a len-a b len-b (%allocate-bignum len-a))))))
    1417 
    1418 ;;; LOGIOR-SHORTER-POSITIVE -- Internal.
    1419 ;;;
    1420 ;;; This takes a shorter bignum, a and len-a, that is positive.  Because this
    1421 ;;; is IOR, we don't care about any bits longer than a's since its infinite
    1422 ;;; 0 sign bits will mask the other bits out of b out to len-b.  The result
    1423 ;;; is len-b long.
    1424 ;;;
    1425 (defun logior-shorter-positive (a len-a b len-b res)
    1426   (declare (type bignum-type a b res)
    1427            (type bignum-index len-a len-b))
    1428   (%bignum-logior len-a a b res)
    1429   (if (not (eql len-a len-b))
    1430     (bignum-replace res b :start1 len-a :start2 len-a :end1 len-b :end2 len-b))
    1431   (%normalize-bignum-macro res))
    1432 
    1433 ;;; LOGIOR-SHORTER-NEGATIVE -- Internal.
    1434 ;;;
    1435 ;;; This takes a shorter bignum, a and len-a, that is negative.  Because this
    1436 ;;; is IOR, we just copy any bits longer than a's since its infinite 1 sign
    1437 ;;; bits will include any bits from b.  The result is len-b long.
    1438 ;;;
    1439 (defun logior-shorter-negative (a len-a b len-b res)
    1440   (declare (type bignum-type a b res)
    1441            (type bignum-index len-a len-b))
    1442   (%bignum-logior len-a a b res)
    1443   (do ((i len-a (1+ i)))
    1444       ((= i len-b))
    1445     (declare (type bignum-index i))
    1446     (setf (bignum-ref res i) #xffffffff))
    1447   (%normalize-bignum-macro res))
    1448 
     1382         (longer-len len-b)
     1383         (shorter-len len-a)
     1384         (shorter a)
     1385         (longer b)
     1386         (shorter-positive (bignum-plusp a)))
     1387    (declare (type bignum-index len-a len-b longer-len shorter-len))
     1388    (when (< len-b len-a)
     1389      (setq shorter b
     1390            longer a
     1391            shorter-len len-b
     1392            longer-len len-a
     1393            shorter-positive (bignum-plusp b)))
     1394    (let* ((result (%allocate-bignum longer-len)))
     1395      (%bignum-logior shorter-len shorter longer result)
     1396      (unless (= shorter-len longer-len)
     1397        (if shorter-positive
     1398          (bignum-replace result longer :start1 shorter-len :start2 shorter-len :end1 longer-len :end2 longer-len)
     1399          (do* ((i shorter-len (1+ i)))
     1400               ((= i longer-len))
     1401            (declare (type bignum-index i))
     1402            (setf (bignum-ref result i) #xffffffff))))
     1403      (%normalize-bignum-macro result))))
    14491404
    14501405
Note: See TracChangeset for help on using the changeset viewer.