~ubuntu-branches/ubuntu/trusty/picolisp/trusty

« back to all changes in this revision

Viewing changes to src64/big.l

  • Committer: Bazaar Package Importer
  • Author(s): Kan-Ru Chen
  • Date: 2011-07-11 17:48:35 UTC
  • Revision ID: james.westby@ubuntu.com-20110711174835-dwmwfgj6yfpny222
Tags: 3.0.7.2-2
* Sync to upstream tip.
* Drop two unused patches.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# 08jul11abu
 
1
# 09jul11abu
2
2
# (c) Software Lab. Alexander Burger
3
3
 
4
4
### Destructive primitives ###
2970
2970
   or E CNT  # Make short number
2971
2971
   ret
2972
2972
 
 
2973
# (hash 'any) -> cnt
 
2974
(code 'doHash 2)
 
2975
   push X
 
2976
   ld E (E CDR)  # Get arg
 
2977
   ld E (E)
 
2978
   eval  # Eval it
 
2979
   call initSeedE_E  # Initialize
 
2980
   ld X E  # Value in X
 
2981
   ld C 64  # Counter
 
2982
   ld E 0  # Result
 
2983
   do
 
2984
      ld A X  # Value XOR Result
 
2985
      xor A E
 
2986
      test A 1  # LSB set?
 
2987
      if nz  # Yes
 
2988
         xor E (hex "14002")  # CRC Polynom x**16 + x**15 + x**2 + 1
 
2989
      end
 
2990
      shr X 1  # Shift value
 
2991
      shr E 1  # and result
 
2992
      dec C  # Done?
 
2993
   until z  # Yes
 
2994
   inc E  # Plus 1
 
2995
   shl E 4  # Make short number
 
2996
   or E CNT  # Make short number
 
2997
   pop X
 
2998
   ret
 
2999
 
2973
3000
# (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
2974
3001
(code 'doRand 2)
2975
3002
   push X