How many "1" bits /Is Number a Power of 2
#1
Code:
'The FASTPROCs here are for both PBWin 10 and PBCC 6.
'For older PB versions change FASTPROC to FUNCTION.
'The demo (in PBMAIN below) would need significant change to compile in older
'versions of PB.
#compile exe
#dim all
#if %def(%pb_cc32) 'ignore this in PBWin
  #console off     'no unneeded in PBCC
#endif
'
'#### Please start thread in Programming for comments/questions. ####
'
'I want a solitare game that was not in old PB formum Source Code.
'Do it myself.
'That requires shuffling cards. Instead of repeating shuffle code for other
'games make a DLL.
'Shuffling requires PRNG(s), and seeds for PRNDs. They are useful for more
'than just card game, so another DLL.
'One of the PRNG algorithms fails if seed is a power of 2.
'
'(PRNG is pseudo Random Number Generator, NUT is Number Under Test.)
'
'How many bits are "1"?
''Simple use of the assembly POPCNT needed in power of 2 procs.
''is DWORD/LONG agnostic
fastproc BitCount(byval NUT as long) as long
  ! popcnt eax, NUT
  ! mov NUT, eax
end fastproc = NUT
'
'Is a DWORD number a power of 2?
fastproc IsPowerOf2Dw (byval NUT as long) as long
  ! mov ebx, NUT        'so not to modify NUT
  ! and ebx, &h00000001 'without this 1 returns as PO2
  !  jz IsEven
  ! jmp NotPO2
  IsEven:
  ! popcnt ebx, NUT
  ! cmp ebx, 1
  ! jne NotPO2
  ! mov NUT, -1
  ! jmp Done
  NotPO2:          '   -4 -8
  ! mov NUT, 0
  Done:
end fastproc = NUT
'
'Is a LONG number a power of 2?
''(Second procedure because in DWORD bit 31 is MSB of the number, while
'''in a LONG it is the sign flag and remaining bits are in 2s compliment
'''format.)
fastproc IsPowerOf2Lg (byval NUT as long) as long
  'check if NUT is negative
  !  bt NUT, 31
  ! jc NotPO2
  ! mov ebx, NUT
  ! and ebx, &00000001
  !  jz IsEven
  ! jmp NotPO2
  IsEven:
  ! popcnt ebx, NUT
  ! cmp ebx, 1
  ! jne NotPO2
  ! mov NUT, -1
  ! jmp Done
  NotPO2:
  ! mov NUT, 0
  Done:
end fastproc = NUT
'
'###############################################################################
function pbmain () as long
  local hTWin, NumD as dword
  local NumL, Retrn as long
  txt.window("BitCount, IsPowerOf2Dw and IsPowerOf2Lg"$$, 75, 50, 27, 40) _
                                                                        to hTWin
  '
  txt.color = %rgb_blue : txt.print "BitCount" : txt.color = %rgb_black
  NumL = 1 : Retrn = BitCount(NumL) : gosub PrintCount
  NumL = 2 : Retrn = BitCount(NumL) : gosub PrintCount
  NumL = 15 : Retrn = BitCount(NumL) : gosub PrintCount
  NumL = &h80050006 : Retrn = BitCount(NumL) : gosub PrintCount
  '
  txt.print : txt.color = %rgb_blue
  txt.print "Is DWORD a power of 2?"$$ : txt.color = %rgb_black
  NumD = 1 : Retrn = IsPowerOf2Dw(NumD) : gosub PrintDwd
  NumD = 4 : Retrn = IsPowerOf2Dw(NumD) : gosub PrintDwd
  NumD = 5 : Retrn = IsPowerOf2Dw(NumD) : gosub PrintDwd
  NumD = 4294967294 : Retrn = IsPowerOf2Dw(NumD) : gosub PrintDwd
  '
  txt.print  : txt.color = %rgb_blue
  txt.print "Is LONG a power of 2?"$$ : txt.color = %rgb_black
  NumL = 1 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  NumL = -1 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  NumL = 8 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  NumL = -8 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  NumL = 128 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  NumL = -128 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  NumL = 1024 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  NumL = -1024 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  NumL = 1026 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  NumL = -11026 : Retrn = IsPowerOf2Lg(NumL) : gosub PrintLng
  '
  txt.print
  txt.color = %rgb_green
  txt.print "Any key to close."$$
  txt.waitkey$
  exit function
  PrintCount:
    txt.print dec$(NumL) + " has " + dec$(Retrn) + " ""1"" bits."
  return
  PrintDwd:
    txt.print dec$(NumD);
    if Retrn then
      txt.print " is"$$
    else
      txt.print " is not"$$
    end if
  return
  PrintLng:
    txt.print dec$(NumL);
    if Retrn then
      txt.print " is"$$
    else
      txt.print " is not"$$
    end if
  return
end function
'#### Please start thread in Programming for comments/questions. ####
Reply


Forum Jump:


Users browsing this thread: Ian Vincent, 1 Guest(s)