XProfan

English

p.specht

The in XProfan-11 installed hardship()-function operates on logical 1 (true) or 0 (wrong) there. One Binäres NOT ought to against it The bits of/ one Integerzahl invertieren. an mathematical Version the binären NOT could folgendermaßen lauten:

Compile Mark Separation

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

elegant is the but not straight. Ersatzweise can the binäre hardship in XProfan-11 but z.B. too through one Xor(,) access go. with signed Integers kehrt the though the omen circa.

possible can at Delete the n. bits (0..31) of/ one Integerzahl x& the following uses go (XProfan knows moreover but too Own bit-Manipulationsbefehle):

Compile Mark Separation

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

is The Integerzahl straight or ungerade?:

Compile Mark Separation

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

is bit n& (0..31) in the Integerwert x& staid?

Compile Mark Separation

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

Ändere ("Toggle") the n. bit in the Integerwert x&

Compile Mark Separation

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

Lösche the each rechteste 1-bit:

Compile Mark Separation

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

Isoliere the on the weitesten right stehende 1-bit:

Compile Mark Separation

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

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

Schalte any bits right of presently rechtesten on 1 (is no 'rechteste 1' present, schalte ALLE on 1)

Compile Mark Separation

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

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

Isoliere the on the weitesten right stehenden 0-bit (= show with of/ one 1 hereon):

Compile Mark Separation

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

Schalte the rechteste 0-bit on 1:

Compile Mark Separation

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

is a number a Zweierpotenz (= 2 high Integerzahl zw. 0 and 31)?
(caution: 0 becomes here fälschlicherweise as a 2-high number treats!)

Compile Mark Separation

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

whom rechtesten coherent block of 1-bits on 0-bits settle:

Compile Mark Separation

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

fast count the 1it-bits:

Compile Mark Separation

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 stand on 1"
x&=3:print pop2(x&),"bit stand on 1":print pop4(x&),"bits stand on 1":waitinput

fountain u.a.: [...]

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

05/14/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

p.specht

here another small ploy to that replacement whole bit-groups:

Compile Mark Separation

cls
var x&=111
var y&=222
print "  before: ";x&,y&
x& = xor(x&,y&)
y& = xor(x&,y&)
x& = xor(x&,y&)
print " hereafter: ";x&,y&
waitinput

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

05/22/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

p.specht

Bits turnabout
=============
sometimes behave itself Selbstbau-Peripherie wrong. On The Reasons would like I not moreover come in

... The Solution lying in a speedy Proc, The The bit-Order within of/ one 4-byte Long-Variable& umkehrt. the example is easy on others Gegebenheiten (Nibble, byte, Word, through expansion on Quadword) anpassbar... - or on whom change larger units in the Bitfolge, z.B. the Bytes in a DWord.

Compile Mark Separation

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.woodpecker, Vienna/Austria
Window Style 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)+be$(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'...

05/26/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

p.specht

RotateLeft, RotateRight
=====================
Shiftbefehle existieren in XProfan, Rotate-command not. the Change we now, at least what Rotation without Einbeziehung one additional Carry-bits concerns: The Rotationsweite is of 1 To 31 adjustable (meaningfully each only To max. 15, moreover ought to one simply The Rotationsrichtung Change). too The Bitbreite the Rotation is between 32 bit To 2 bit down adjustable.

Compile Mark Separation

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$+be$(x&),w&)
    sound 300,30
    waitinput 1000
    x&=RotL(x&,n&,w&)

wend

RotateWide over 2 x 32 bit
=======================
XProfan-11 knew yet no QuadInt, but sometimes can itself there with two einfachen Int behelfen. Unelegant, but as demonstration must it wealthy:

Compile Mark Separation

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$+be$(y&),w&)+":"+right$(nu$+be$(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 rotate let, this time over 3 DWords. need guaranteeing none...

Compile Mark Separation

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$+be$(z&),w&)+"."+\
    right$(nu$+be$(y&),w&)+"."+\
    right$(nu$+be$(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'...

05/27/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

p.specht

ROR32 / ROL32 on "unsigned Integers"
================================
my Routinenvergleich has presently following Favoriten (~31 µs/Rotation),
Überdrehungs-verifiziert of -1024 To +1024 Rotationsschritten:

Compile Mark Separation

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'...

05/30/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

p.specht

The 8 bits in a byte center spiegeln
================================

Compile Mark Separation

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

Simpler bit-Reverser for 32-bit (signed or unsigned) Integers
============================================
The nachstehende Proc velvet Testprogramm spiegelt any bits of/ one XProfan 32-bit Integervariable on the middle. Beschleunigungsversuche a la C++ code verliefen To dato but negative, there itself Invoice values-Left with negativen Invoice values-stepped - differently as in C - not umkehrt. The thing here's extensively tested, remaining but nevertheless without each Gewähr!

Compile Mark Separation

Window Title "REVERSE32 for 32bit Signed and 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"+be$(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

        Window Title "  AUTO TEST MODE running Test Nr. "+st$(&Loop)

    else

        Window Title "                                              "+\
        "Test Nr. "+st$(&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