Français
Source/ Codesnippets

Bit-hacks dans XProfan

 

p.specht

qui dans XProfan-11 eingebaute Not()-Funktion arbeitet sur Logisch 1 (véritable) ou bien 0 (faux) hin. un Binäres NOT sollte dagegen qui bits einer Integerzahl invertieren. une mathématique Version des binären NOT pourrait folgendermaßen lauten:
var x&=251:imprimer right$(mkstr$(" ",32)+suis$(x&),32)
imprimer right$(mkstr$(" ",32)+suis$(-x&-1),32):waitinput

Elegant ist cela mais pas justement. Ersatzweise peux cela binäre Not dans XProfan-11 mais z.B. aussi par un Xor(,) erreicht volonté. chez signed Integers kehrt cela allerdings cela Vorzeichen um.

Eventuell peux beim Effacer des n. bits (0..31) einer Integerzahl x& folgendes verwendet volonté (XProfan kennt en supplément mais aussi eigene bit-Manipulationsbefehle):
declare y&,x&,n&:x&=555:n&=0:y&=x& & xor(1<<n&,2^32-1):imprimer y&:waitinput

Ist qui Integerzahl justement ou bien ungerade?:
var x&=554:imprimer x&,"ist",si(x& & 1,"ungerade","gerade"):waitinput

Ist bit n& (0..31) im Integerwert x& gesetzt?
var n&=7:imprimer (x& &(1<<n&))>0:waitinput

Ändere ("Toggle") cela n. bit im Integerwert x&
n&=1:y& = int(XOr(y&,1<<n&)):imprimer y&
y& = int(XOr(y&,1<<n&)):imprimer y&:waitinput

Lösche cela jeweils rechteste 1-bit:
y&=32^2-1
y& = y& & (y&-1) :imprimer suis$(y&)
y& = y& & (y&-1) :imprimer suis$(y&)
y& = y& & (y&-1) :imprimer suis$(y&)
y& = y& & (y&-1) :imprimer suis$(y&)
waitinput

Isoliere cela am weitesten à droite stehende 1-bit:
whileloop 12:x&= rnd(2^32-1):imprimer right$(mkstr$(" ",32)+suis$(x&),32)

    x& = x& & -x& :imprimer right$(mkstr$(" ",32)+suis$(x&),32):imprimer:waitinput
    endwhile: imprimer "Ready.":waitinput

Schalte alle bits à droite vom derzeit rechtesten sur 1 (ist aucun 'rechteste 1' vorhanden, schalte ALLE sur 1)
whileloop 12:x& = 2^rnd(31):imprimer right$(mkstr$(" ",32)+suis$(x&),32)

    x&=x& | (x&-1)
    imprimer right$(mkstr$(" ",32)+suis$(x&),32):imprimer:waitinput :endwhile :imprimer "OK" :waitinput

Isoliere cela am weitesten à droite stehenden 0-bit (= Zeige avec einer 1 puis):
imprimer:whileloop 12:x& =rnd(2^32-1):imprimer right$(mkstr$(" ",32)+suis$(x&),32)
y& = Xor(x&,2^32-1) & (x&+1)
imprimer right$(mkstr$(" ",32)+suis$(y&),32):imprimer:waitinput :endwhile :imprimer "Done." :waitinput

Schalte cela rechteste 0-bit sur 1:
imprimer:whileloop 12:x& =rnd(2^32-1):imprimer right$(mkstr$(" ",32)+suis$(x&),32)
y& = x& | (x&+1)
imprimer right$(mkstr$(" ",32)+suis$(y&),32):imprimer:waitinput :endwhile :imprimer "Done." :waitinput

Ist une numéro une Zweierpotenz (= 2 hoch Integerzahl zw. 0 et 31)?
(attention: 0 wird ici fälschlicherweise comme une 2-hoch numéro behandelt!)
n&=2^30:imprimer n&,«Est- ";si((n& & (-n&))=n&,si(n&,"eine","keine"),"keine");" Zweierpotenz!":waitinput

Den rechtesten zusammenhängenden Block de 1-bits sur 0-bits mettons:
var x&=%10001100001111000111100011110000
imprimer right$(mkstr$(" ",32)+suis$(x&),32)
x&=((x& | (x&-1))+1) & x&
imprimer right$(mkstr$(" ",32)+suis$(x&),32):waitinput

Schnelles Zählen qui 1il-bits:
proc pop2 :parameters x&

    x&=x&-((x&>>1) & $55555555)
    x&=(x& & $33333333)+((x&>>2) & $33333333)
    x&=(x&+(x&>>4)) & $0F0F0F0F
    x&=x&+(x&>>8)
    x&=x&+(x&>>16)
    return x& & $0000003F

endproc

proc pop4 :parameters x&

    declare n&
    n&=(x&>>1) & $77777777'Count bits dans
    x&=x&-n&'each 4-bit field
    n&=(n&>>1) & $77777777
    x&=x&-n&
    n&=(n&>>1) & $77777777
    x&=x&-n&
    x&=(x&+(x&>>4)) & $0F0F0F0F'Get byte sums.
    x&= x&*$01010101'Ajouter le bytes.
    return x&>>24

endproc

x&=%11111111111111111111111111111111
imprimer pop2(x&),"bit stehen sur 1"
x&=3:imprimer pop2(x&),"bit stehen sur 1":imprimer pop4(x&),"bits stehen sur 1":waitinput

source u.a.:  [...] 
 
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
14.05.2021  
 




p.specht

ici encore un kleiner Trick zum Austausch ganzer Bit-Gruppen:
cls
var x&=111
var y&=222
imprimer "  auparavant: ";x&,y&
x& = xor(x&,y&)
y& = xor(x&,y&)
x& = xor(x&,y&)
imprimer " après: ";x&,y&
waitinput
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
22.05.2021  
 




p.specht

Bits retourner
=============
quelquefois verhält sich Selbstbau-Peripherie verkehrt. sur qui Gründe voudrais je ici pas plus eingehen ... qui Solution liegt dans einer schnellen Proc, qui qui bit-Reihenfolge dedans einer 4-Byte Long-Variable& umkehrt. cela Beispiel ist léger à autre Gegebenheiten (Nibble, Byte, Word, mittels Erweiterung aussi sur Quadword) anpassbar... - ou bien aussi à den change größerer Einheiten dans qui Bitfolge, z.B. qui Bytes dans einem DWord.
Windowtitle "  Reverse DWord bits dans 5 Lines of Code"
'Q: https://graphics.stanford.edu/~seander/bithacks.html#ReverseParallel
'Transscript CPP to XProfan-11.2a, 2018-03 by P.Specht, Vienna/Austria
Fenêtre Style 24:CLS:font 2:imprimer
Déclarer b&,v&' 32-bit doubleword to reverse bit l'ordre

Proc ReverseBits :parameters v&

    v& = ((v& >> 1) & $55555555) | ((v& & $55555555) << 1)
    v& = ((v& >> 2) & $33333333) | ((v& & $33333333) << 2)
    v& = ((v& >> 4) & $0F0F0F0F) | ((v& & $0F0F0F0F) << 4)
    v& = ((v& >> 8) & $00FF00FF) | ((v& & $00FF00FF) << 8)
    v& = ( v& >> 16            ) | ( v&             << 16)
    return v&

endproc

Proc showBits :parameters v&

    imprimer " %";right$(mkstr$("0",31)+suis$(v&),32)

endproc

Proc checkrev :parameters b&,v&

    whileloop 0,31:ifnot testbit(b&,&Boucle)=testbit(v&,31-&Boucle)

        imprimer " Bit",si(&Boucle<10," ",»);&Boucle,"not reversed!":endif
        endwhile:imprimer "\n +++"

    endproc

    Begin:
    b& = %01100100101100111010101010101111 : showbits b& : imprimer
    v& = ReverseBits(b&)   : showbits v&
    CheckRev b&,v&
    waitinput
    Fin
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
26.05.2021  
 




p.specht

RotateLeft, RotateRight
=====================
Shiftbefehle existieren dans XProfan, Rotate-Befehle pas. cela changement wir maintenant, zumindest quoi Rotation sans Einbeziehung eines zusätzlichen Carry-bits betrifft: qui Rotationsweite ist de 1 jusqu'à 31 einstellbar (sinnvoll jeweils seulement jusqu'à max. 15, par-dessus hinaus sollte on simple qui Rotationsrichtung changement). aussi qui Bitbreite qui Rotation ist entre 32 bit jusqu'à 2 bit herunter einstellbar.
cls:font 2
var x&=%00100111
var n&= 1'[1..31]
var w&=32'[2..32]
var nu$="00"

proc RotL :parameters x&,n&,w&

    return (x&<<n&) | (x&>>(w&-n&))

endproc

proc RotR :parameters x&,n&,w&

    return (x&>>n&) | (x&<<(w&-n&))

endproc

nu$=mkstr$("0",w&)

tandis que 1

    locate 2,2
    imprimer right$(nu$+suis$(x&),w&)
    sound 300,30
    waitinput 1000
    x&=RotL(x&,n&,w&)

Wend


RotateWide sur 2 x 32 bit
=======================
XProfan-11 kannte encore aucun QuadInt, mais quelquefois peux on sich là avec deux einfachen Int behelfen. Unelegant, mais comme Demo muss es reichen:
cls:font 2
declare x&,y&,a&,b&,c&,d&,w&,n&,nu$
w&=32'2..32
nu$=mkstr$("0",w&)
n&=1
x&=%10101001100011100001111

repeat

    locate 2,2
    imprimer translate$(right$(nu$+suis$(y&),w&)+»+right$(nu$+suis$(x&),w&),"0","°")
    waitinput 400
    ROTLw

until 0

Proc ROTRw

    a&=x&>>n&
    b&=x&<<(w&-n&)
    c&=y&>>n&
    d&=y&<<(w&-n&)
    x& = a& | d&
    y& = b& | c&

endproc

Proc ROTLw

    a&=x&<<n&
    b&=x&>>(w&-n&)
    c&=y&<<n&
    d&=y&>>(w&-n&)
    x& = a& | d&
    y& = b& | c&

endproc


Nochmal rotieren laisser, diesmal sur 3 DWords. Braucht garantiert aucun...
Fenêtre 0,0-%maxx,100
font 2
declare x&,y&,z&,a&,b&,c&,d&,e&,f&,w&,n&,nu$
w&=32'2..32
nu$=mkstr$("0",w&)
n&=1
x&=%10101001100011100001111

repeat

    locate 2,2
    imprimer translate$(\
    right$(nu$+suis$(z&),w&)+"."+\
    right$(nu$+suis$(y&),w&)+"."+\
    right$(nu$+suis$(x&),w&)\
    ,"0","°")
    waitinput 20
    ROTLw

until 0

Proc ROTRw

    a&=x&>>n&
    b&=x&<<(w&-n&)
    c&=y&>>n&
    d&=y&<<(w&-n&)
    e&=z&>>n&
    f&=z&<<(w&-n&)
    x& = a& | d&
    y& = c& | f&
    z& = e& | b&

endproc

Proc ROTLw

    a&=x&<<n&
    b&=x&>>(w&-n&)
    c&=y&<<n&
    d&=y&>>(w&-n&)
    e&=z&<<n&
    f&=z&>>(w&-n&)
    x& = a& | f&
    y& = c& | b&
    z& = e& | d&

endproc

 
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
27.05.2021  
 




p.specht

ROR32 / ROL32 sur "unsigned Integers"
================================
mon Routinenvergleich hat derzeit folgende Favoriten (~31 µs/Rotation),
Überdrehungs-verifiziert de -1024 jusqu'à +1024 Rotationsschritten:
Proc RoR32 :parameters a&,b&

    b&=b& & 31
    return a&<<(32-b&) | a&>>b&

ENDPROC

Proc RoL32 :parameters a&,b&

    b&=b& & 31
    return a&<<b& | a&>>(32-b&)

ENDPROC

 
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
30.05.2021  
 




p.specht

qui 8 bits dans einem Byte mittig spiegeln
================================
var b&=%10100011
b& = b& & 255
imprimer right$("0000000"+suis$(b&),8)
b& = (((b& * $0802 & $22110) | (b& * $8020 & $88440)) * $10101 >> 16) & 255
imprimer right$("0000000"+suis$(b&),8)
waitinput

Simpler Bit-Reverser pour 32-bit (signed or unsigned) Integers
============================================
qui nachstehende Proc velours Testprogramm spiegelt alle bits einer XProfan 32-bit Integervariable à qui Mitte. Beschleunigungsversuche a la C++ Code verliefen jusqu'à dato mais négative, là sich Shift-À gauche chez negativen Shift-Schritten - anders comme dans C - pas umkehrt. qui l'affaire ici ist ausgiebig getestet, bleibt mais toutefois sans chacun Gewähr!
Titre de la fenêtre "REVERSE32 pour 32bit Signed et Unsigned Integervariablen"
Cls:font 2:Randomiser:Déclarer b&

Proc Reverse32

    parameters v&
    declare r&

    Whileloop 32

        r&=r&<<1
        r&=r& | (v& & 1)
        v&=v&>>1

    Endwhile

    return r&

ENDPROC

Proc Lbin$ :parameters x&

    return right$("000000000000000000000000000000000"+suis$(x&),32)

endproc

Proc Testprt

    imprimer " ";Lbin$(b&);"\n ";Lbin$(Reverse32(b&))

ENDPROC

' Tests
b&=%10110011100011110000111110000000 : Testprt : imprimer
b&=%0  : Testprt : imprimer
waitinput 3000

WHILELOOP 0,31

    b&=2^&Boucle
    Testprt

    ifnot b&=Reverse32(Reverse32(b&))

        imprimer "Reversing Error at ";b&,Reverse32(Reverse32(b&))
        testprt
        sound 2000,200
        waitinput

    endif

    waitinput 100

ENDWHILE

waitinput 2000

WHILELOOP 0,31

    b&=2^32-2^&Boucle
    Testprt

    ifnot b&=Reverse32(Reverse32(b&))

        imprimer "Reversing Error at ";b&,Reverse32(Reverse32(b&))
        testprt
        sound 2000,200
        waitinput

    endif

    waitinput 100

ENDWHILE

waitinput 3000

whileloop 5000

    si &Boucle/50 mod 2

        Titre de la fenêtre "  AUTO TEST MODE running Test Nr. "+str$(&Boucle)

    d'autre

        Titre de la fenêtre "                                              "+\
        "Test Nr. "+str$(&Boucle)

    endif

    b&=rnd(2^31-1)*(1-2*(rnd()<0.33))

    ifnot b&=Reverse32(Reverse32(b&))

        imprimer "Reversing Error at ";b&,Reverse32(Reverse32(b&))
        testprt
        sound 2000,200
        waitinput

    endif

    waitinput 22
    Cas %clé=27:pause

endwhile

imprimer "\n Random Tests:"

WHILELOOP 1000

    b&=rnd(2^31-1)*(1-2*(rnd()<0.5))
    Testprt
    Waitinput 2000
    cas %clé=27:BREAK

ENDWHILE

imprimer "\n Tests done. BYE!"
Waitinput 4000
FIN
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
30.05.2021  
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

3.721 Views

Untitledvor 0 min.
RudiB.07.03.2022
p.specht21.11.2021
R.Schneider20.11.2021
Uwe Lang20.11.2021
plus...

Themeninformationen

cet Thema hat 1 participant:

p.specht (6x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.


d'accordDatenschutzerklärung
je voudrais keinen Cookie