XProfan

Deutsch

p.specht

Die in XProfan-11 eingebaute Not()-Funktion arbeitet auf Logisch 1 (Wahr) oder 0 (falsch) hin. Ein Binäres NOT sollte dagegen die bits einer Integerzahl invertieren. Eine mathematische Version des binären NOT könnte folgendermaßen lauten:

Kompilieren Markieren Separieren

var x&=251:print right$(mkstr$(" ",32)+bin$(x&),32)
print right$(mkstr$(" ",32)+bin$(-x&-1),32):waitinput

Elegant ist das aber nicht gerade. Ersatzweise kann das binäre Not in XProfan-11 aber z.B. auch durch ein Xor(,) erreicht werden. Bei signed Integers kehrt das allerdings das Vorzeichen um.

Eventuell kann beim Löschen des n. bits (0..31) einer Integerzahl x& folgendes verwendet werden (XProfan kennt dazu aber auch eigene bit-Manipulationsbefehle):

Kompilieren Markieren Separieren

declare y&,x&,n&:x&=555:n&=0:y&=x& & xor(1<<n&,2^32-1):print y&:waitinput

Ist die Integerzahl gerade oder ungerade?:

Kompilieren Markieren Separieren

var x&=554:print x&,"ist",if(x& & 1,"ungerade","gerade"):waitinput

Ist bit n& (0..31) im Integerwert x& gesetzt?

Kompilieren Markieren Separieren

var n&=7:print (x& &(1<<n&))>0:waitinput

Ändere ("Toggle") das n. bit im Integerwert x&

Kompilieren Markieren Separieren

n&=1:y& = int(XOr(y&,1<<n&)):print y&
y& = int(XOr(y&,1<<n&)):print y&:waitinput

Lösche das jeweils rechteste 1-bit:

Kompilieren Markieren Separieren

y&=32^2-1
y& = y& & (y&-1) :print bin$(y&)
y& = y& & (y&-1) :print bin$(y&)
y& = y& & (y&-1) :print bin$(y&)
y& = y& & (y&-1) :print bin$(y&)
waitinput

Isoliere das am weitesten rechts stehende 1-bit:

Kompilieren Markieren Separieren

whileloop 12:x&= rnd(2^32-1):print right$(mkstr$(" ",32)+bin$(x&),32)

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

Schalte alle bits rechts vom derzeit rechtesten auf 1 (ist keine 'rechteste 1' vorhanden, schalte ALLE auf 1)

Kompilieren Markieren Separieren

whileloop 12:x& = 2^rnd(31):print right$(mkstr$(" ",32)+bin$(x&),32)

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

Isoliere das am weitesten rechts stehenden 0-bit (= Zeige mit einer 1 darauf):

Kompilieren Markieren Separieren

print:whileloop 12:x& =rnd(2^32-1):print right$(mkstr$(" ",32)+bin$(x&),32)
y& = Xor(x&,2^32-1) & (x&+1)
print right$(mkstr$(" ",32)+bin$(y&),32):print:waitinput :endwhile :print "Done." :waitinput

Schalte das rechteste 0-bit auf 1:

Kompilieren Markieren Separieren

print:whileloop 12:x& =rnd(2^32-1):print right$(mkstr$(" ",32)+bin$(x&),32)
y& = x& | (x&+1)
print right$(mkstr$(" ",32)+bin$(y&),32):print:waitinput :endwhile :print "Done." :waitinput

Ist eine Zahl eine Zweierpotenz (= 2 hoch Integerzahl zw. 0 und 31)?
(Vorsicht: 0 wird hier fälschlicherweise als eine 2-hoch Zahl behandelt!)

Kompilieren Markieren Separieren

n&=2^30:print n&,"ist ";if((n& & (-n&))=n&,if(n&,"eine","keine"),"keine");" Zweierpotenz!":waitinput

Den rechtesten zusammenhängenden Block von 1-bits auf 0-bits setzen:

Kompilieren Markieren Separieren

var x&=%10001100001111000111100011110000
print right$(mkstr$(" ",32)+bin$(x&),32)
x&=((x& | (x&-1))+1) & x&
print right$(mkstr$(" ",32)+bin$(x&),32):waitinput

Schnelles Zählen der 1er-bits:

Kompilieren Markieren Separieren

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 in
    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'Add the bytes.
    return x&>>24

endproc

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

Quelle u.a.: [...]

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

14.05.2021 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

p.specht

Hier noch ein kleiner Trick zum Austausch ganzer Bit-Gruppen:

Kompilieren Markieren Separieren

cls
var x&=111
var y&=222
print "  Vorher: ";x&,y&
x& = xor(x&,y&)
y& = xor(x&,y&)
x& = xor(x&,y&)
print " Nachher: ";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 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

p.specht

Bits umdrehen
=============
Manchmal verhält sich Selbstbau-Peripherie verkehrt. Auf die Gründe möchte ich hier nicht weiter eingehen

... Die Lösung liegt in einer schnellen Proc, die die bit-Reihenfolge innerhalb einer 4-Byte Long-Variable& umkehrt. Das Beispiel ist leicht an andere Gegebenheiten (Nibble, Byte, Word, mittels Erweiterung auch auf Quadword) anpassbar... - oder auch an den Tausch größerer Einheiten in der Bitfolge, z.B. der Bytes in einem DWord.

Kompilieren Markieren Separieren

Windowtitle "  Reverse DWord bits in 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
WindowStyle 24:CLS:font 2:print
Declare b&,v&' 32-bit doubleword to reverse bit order

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&

    print " %";right$(mkstr$("0",31)+bin$(v&),32)

endproc

Proc checkrev :parameters b&,v&

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

        print " Bit",if(&Loop<10," ","");&Loop,"not reversed!":endif
        endwhile:print "\n +++"

    endproc

    Begin:
    b& = %01100100101100111010101010101111 : showbits b& : print
    v& = ReverseBits(b&)   : showbits v&
    CheckRev b&,v&
    waitinput
    End

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

26.05.2021 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

p.specht

RotateLeft, RotateRight
=====================
Shiftbefehle existieren in XProfan, Rotate-Befehle nicht. Das ändern wir jetzt, zumindest was Rotation ohne Einbeziehung eines zusätzlichen Carry-bits betrifft: Die Rotationsweite ist von 1 bis 31 einstellbar (sinnvoll jeweils nur bis max. 15, darüber hinaus sollte man einfach die Rotationsrichtung ändern). Auch die Bitbreite der Rotation ist zwischen 32 bit bis 2 bit herunter einstellbar.

Kompilieren Markieren Separieren

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&)

while 1

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

wend

RotateWide über 2 x 32 bit
=======================
XProfan-11 kannte noch keine QuadInt, aber manchmal kann man sich da mit zwei einfachen Int behelfen. Unelegant, aber als Demo muss es reichen:

Kompilieren Markieren Separieren

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
    print translate$(right$(nu$+bin$(y&),w&)+":"+right$(nu$+bin$(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 lassen, diesmal über 3 DWords. Braucht garantiert keiner...

Kompilieren Markieren Separieren

Window 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
    print translate$(\
    right$(nu$+bin$(z&),w&)+"."+\
    right$(nu$+bin$(y&),w&)+"."+\
    right$(nu$+bin$(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 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

p.specht

ROR32 / ROL32 auf "unsigned Integers"
================================
Mein Routinenvergleich hat derzeit folgende Favoriten (~31 µs/Rotation),
Überdrehungs-verifiziert von -1024 bis +1024 Rotationsschritten:

Kompilieren Markieren Separieren

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 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

p.specht

Die 8 bits in einem Byte mittig spiegeln
================================

Kompilieren Markieren Separieren

var b&=%10100011
b& = b& & 255
print right$("0000000"+bin$(b&),8)
b& = (((b& * $0802 & $22110) | (b& * $8020 & $88440)) * $10101 >> 16) & 255
print right$("0000000"+bin$(b&),8)
waitinput

Simpler Bit-Reverser für 32-bit (signed or unsigned) Integers
============================================
Die nachstehende Proc samt Testprogramm spiegelt alle bits einer XProfan 32-bit Integervariable an der Mitte. Beschleunigungsversuche a la C++ Code verliefen bis dato aber negativ, da sich Shift-Left bei negativen Shift-Schritten - anders als in C - nicht umkehrt. Die Sache hier ist ausgiebig getestet, bleibt aber dennoch ohne jede Gewähr!

Kompilieren Markieren Separieren

WindowTitle "REVERSE32 für 32bit Signed und Unsigned Integervariablen"
Cls:font 2:Randomize:Declare 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"+bin$(x&),32)

endproc

Proc Testprt

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

EndProc

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

WHILELOOP 0,31

    b&=2^&Loop
    Testprt

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

        print "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^&Loop
    Testprt

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

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

    endif

    waitinput 100

ENDWHILE

waitinput 3000

whileloop 5000

    if &Loop/50 mod 2

        WindowTitle "  AUTO TEST MODE running Test Nr. "+str$(&Loop)

    else

        WindowTitle "                                              "+\
        "Test Nr. "+str$(&Loop)

    endif

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

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

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

    endif

    waitinput 22
    Case %key=27:break

endwhile

print "\n Random Tests:"

WHILELOOP 1000

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

ENDWHILE

print "\n Tests done. BYE!"
Waitinput 4000
END