XProfan

English

p.specht

suspicion confirm: MOD functions with negativen Values, because it self negative becomes. Pascal-MOD operates on Unsigned-Integers, becomes means never negative. Through some Kopfstände does it now too in XProfan (my MODf() operates on Floats and becomes neither negative), sodaß at least The first Prüfsumme (The for XOR-method) now with the Pascal-Presentation übereinstimmt.

be means moreover on the tüfteln...

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

02/19/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

« this Posting watts as Solution marked. »

p.specht

Geschafft: The 2. Checksumme stimmte because of of/ one wrong benannten Variable not. now shining it To functions - what though first to many Tests suppose can. therefore remaining The thing temporary in the Beta-Stadium. should Error come along, Please here report!
greeting

Compile Mark Separation

Window Title "PROGRAM RosettaISAAC V2.2-beta"
'(PD) Public Domain, transposed to XProfan-11.2a in
'Feb. 2020 by P.woodpecker(AT)gmx.at, Vienna/Austria/EU
'-----------------------------------------------------------------------------
'[The Improved] Random Number Generator ISAAC (C) by Bob Jenkins,
' March 1996, Public Domain, C-Source Intro: "You may use this code in any way
' you wish, and it is free.  No warrantee."
'-----------------------------------------------------------------------------
'[Rosetta Text:] ISAAC stands for "Indirection, Invoice values, Accumulate, Add, and Count"
'which are the principal bitwise operations employed. To date - anus 24 years of
'existence ISAAC has hardship been broken (unless GCHQ or NSA did it, but dont tell us).
'ISAAC thus deserves a lot more attention than it has received, and it would be
'salutary to sea it more universally implemented.
'-----------------------------------------------------------------------------
GOTO "FloatMaths"// uses MODf() on uInt instead of XProfan's MOD Operator
START:
CLS
Var iMode&=0
Def &iEncrypt 0
Def &iDecrypt 1
Def &true 1
Def &false 0
// TASK globals
Var msg$ = "a Top Secret secret"// Recommended max 4095 byte
var key$ = "this is my secret key"// Max. 256 byte are used
// Main Globals
var  xctx$ = ""// XOR ciphertext
var  mctx$ = ""// MOD ciphertext
var  xptx$ = ""// XOR decryption (plaintext)
var  mptx$ = ""// MOD decryption (plaintext)
// ISAAC vars have to be globals in XProfan:
// external results
declare randrsl&[255]
declare randcnt&
// internal state
declare  mm&[255]
declare  aa&,bb&,cc&
// inter proc
declare a&,b&,c&,d&,e&,f&,g&,h&

PROC ISAAC// PSEUDO RANDOM GENERATOR

    'If the initial internal state is all zero, anus ten calls the values of
    'aa, bb, and cc in hexadecimal wants be d4d3f473, 902c0691, and 0000000a.
    declare i&,x&,y&
    inc cc&// cc just gets incremented once by 256 results
    inc bb&,cc&// then combined with bb

    Whileloop 0,255:i&=&Loop

        x&=mm&[i&]

        SELECT (i& MOD 4)

            caseof 0:aa&=XOR(aa&,(aa&<<13))

            caseof 1:aa&=XOR(aa&,(aa&>>6))

            caseof 2:aa&=XOR(aa&,(aa&<<2))

            caseof 3:aa&=XOR(aa&,(aa&>>16))

        ENDSELECT

        aa&= mm&[(i&+128) MOD 256]+aa&
        y&= mm&[(x&>>2) MOD 256]+aa&+bb&
        mm&[i&]=y&
        bb&=mm&[(y&>>10) MOD 256]+x&
        randrsl&[i&]=bb&

    EndWhile

    // Additional: prepare to use the first set of results
    randcnt&=0

ENDPROC

Proc mixed

    a&=XOR(a&,(b&<<11)):inc d&,a&:inc b&,c&
    b&=XOR(b&,(c&>>2)):inc e&,b&:inc c&,d&
    c&=XOR(c&,(d&<<8)):inc f&,c&:inc d&,e&
    d&=XOR(d&,(e&>>16)):inc g&,d&:inc e&,f&
    e&=XOR(e&,(f&<<10)):inc h&,e&:inc f&,g&
    f&=XOR(f&,(g&>>4)):inc a&,f&:inc g&,h&
    g&=XOR(g&,(h&<<8)):inc b&,g&:inc h&,a&
    h&=XOR(h&,(a&>>9)):inc c&,h&:inc a&,b&

Endproc

Proc iRandInit :parameters flag&

    declare i&':init a,b,c,d,e,f,g,h 'In XProfan globaly!
    clear aa&,bb&,cc&
    a&=$9e3779b9// the golden ratio
    b&=a&:c&=a&:d&=a&:e&=a&:f&=a&:g&=a&:h&=a&

    Whileloop 0,3// scramble it

        mixed

    Endwhile

    i&=0

    REPEAT// fill in mm[]

        IF flag&// use all the information in the seed

            a&=a&+randrsl&[i&]
            b&=b&+randrsl&[i&+1]
            c&=c&+randrsl&[i&+2]
            d&=d&+randrsl&[i&+3]
            e&=e&+randrsl&[i&+4]
            f&=f&+randrsl&[i&+5]
            g&=g&+randrsl&[i&+6]
            h&=h&+randrsl&[i&+7]

        ENDIF

        mixed'mm[] using a-h
        mm&[i&]=a&
        mm&[i&+1]=b&
        mm&[i&+2]=c&
        mm&[i&+3]=d&
        mm&[i&+4]=e&
        mm&[i&+5]=f&
        mm&[i&+6]=g&
        mm&[i&+7]=h&
        inc i&,8

    UNTIL i& > 255

    IF flag&// do a second pass to make all of the seed affect all of mm

        i&=0

        REPEAT

            a&=a&+mm&[i&]
            b&=b&+mm&[i&+1]
            c&=c&+mm&[i&+2]
            d&=d&+mm&[i&+3]
            e&=e&+mm&[i&+4]
            f&=f&+mm&[i&+5]
            g&=g&+mm&[i&+6]
            h&=h&+mm&[i&+7]
            mixed()'mm[]
            mm&[i&]=a&
            mm&[i&+1]=b&
            mm&[i&+2]=c&
            mm&[i&+3]=d&
            mm&[i&+4]=e&
            mm&[i&+5]=f&
            mm&[i&+6]=g&
            mm&[i&+7]=h&
            inc i&,8

        UNTIL i& > 255

    ENDif

    ISAAC// fill in the first set of results
    randcnt&=0// prepare to use the first set of results

Endproc

Proc iSeed :parameters seed$,flag&

    // Seed ISAAC with a given string.
    // The string can be any size. The ridge 256 values wants be used.
    declare i&,m&
    mm&[]=0
    m&=Len(seed$)-1

    Whileloop 0,255:i&=&Loop

        // in case seed has less than 256 elements

        If i&>m&

            randrsl&[i&]=0
            // Pascal strings are 1-based, like in XProfan

        Else

            randrsl&[i&]=Ord(mid$(seed$,i&+1,1))

        Endif

    Endwhile

    // initialize ISAAC with seed
    iRandInit(flag&)

ENDPROC

Proc iRandom// Get a random 32-bit value 0..MAXINT

    declare iRandom&
    iRandom& = randrsl&[randcnt&]
    inc randcnt&

    IF randcnt&>255

        ISAAC
        randcnt&=0

    ENDif

    return if(iRandom&<0,iRandom&+2^32,iRandom&*1)'=float

Endproc

Proc iRandA// Get a random character in printable ASCII brat

    return intf(modf(iRandom(),95)+32)

ENDproc

// Convert on ASCII string to a hexadecimal string

Proc Ascii2Hex :parameters s$

    Declare i&,Ascii2Hex$
    Ascii2Hex$=""

    Whileloop len(s$):i&=&Loop

        Ascii2Hex$=Ascii2Hex$+Right$("0"+hex$(Ord(mid$(s$,i&,1))),2)

    Endwhile

    return Ascii2Hex$

ENDPROC// Ascii2Hex

Proc Vernam :parameters msg$

    // XOR encrypt on random stream. output: ASCII string
    Declare i&,vernam$
    Vernam$=""

    whileloop len(msg$):i&=&Loop

        Vernam$=Vernam$+Chr$(xor(iRandA(),Ord(mid$(msg$,i&,1))))

    endwhile

    return vernam$

Endproc// Vernam

Proc LetterNum :parameters letter$,start$

    // Get position of the letter in chosen alphabet
    return Ord(letter$) - Ord(start$)

Endproc// LetterNum

// Caesar-shift a character <shift> places: Generalized Vigenere

Proc Caesar :parameters m&,ch$,shift&,modulo&,start$

    Declare n&
    Case m& = &iDecrypt: shift& = -shift&
    n& = LetterNum(ch$, start$) + shift&
    n& = n& MOD modulo&
    Case n&<0:n& = n&+modulo&
    return Chr$(Ord(start$) + n&)

Endproc// Caesar

// Vigenere MOD 95 encryption & decryption. output: ASCII string

Proc Vigenere :parameters msg$,m&

    Declare i&,Vigenere$
    Vigenere$ = ""

    whileloop len(msg$):i&=&Loop

        Vigenere$ = Vigenere$ + Caesar(m&, mid$(msg$,i&,1), iRandA(), 95, " ")

    endwhile

    return Vigenere$

Endproc// Vigenere

BEGIN:
'Main Program
// 1) seed ISAAC with the key
iSeed(key$, &true)
// 2) Encryption
// a) XOR (Vernam)
xctx$ = Vernam(msg$)
// b) MOD (Vigenere)
mctx$ = Vigenere(msg$, &iEncrypt)
// 3) Decryption
iSeed(key$, &true)// key sentence, 0=totally new 1=useAllpreviouseRandoms
// a) XOR (Vernam)
xptx$ = Vernam(xctx$)
// b) MOD (Vigenere)
mptx$ = Vigenere(mctx$, &iDecrypt)
// program output
Print
print "Message: ", msg$
print "Key    : ", key$
Print "XOR    : ", Ascii2Hex(xctx$)
Print "MOD    : ", Ascii2Hex(mctx$)
Print "XOR dcr: ", xptx$
Print "MOD dcr: ", mptx$
'Check output:
'Message: a Top Secret secret
'Key    : this is my secret key
'XOR    : 1C0636190B1260233B35125F1E1D0E2F4C5422
'MOD    : 734270227D36772A783B4F2A5F206266236978
'XOR dcr: a Top Secret secret
'MOD dcr: a Top Secret secret
waitinput
END
FloatMaths:

proc sgn :parameters x!

    ' Signum-function: -1,0,+1
    return (x!>0)-(x!<0)

endproc

proc floor :parameters x!

    ' Gaussklammer-function
    case abs(x!)<(10^-35):return 0
    case x!>0:return intf(x!)
    return (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))

endproc

proc ceil :parameters x!

    ' Ceiling-function
    return -1*floor(-1*x!)

endproc

proc modf :parameters x!,y!

    ' Q: https://de.wikipedia.org/wiki/Modulo
    case abs(x!)<10^-35:return 0
    case abs(y!)<10^-35:return x!
    return sgn(y!)*abs(x!-y!*floor(x!/y!))

endproc

proc remn :parameters x!,y!

    ' Q: https://de.wikipedia.org/wiki/Modulo = Remnant()
    case abs(x!)<(10^-35):return 0
    case abs(y!)<(10^-35):return x!
    return sgn(x!)*abs(x!-y!*floor(x!/y!))

endproc

proc IsNeg :parameters x!

    return byte(Addr(x!),7)&%10000000>>7

endproc

proc frac :parameters x!

    var s!=sgn(x!)
    x!=abs(x!)
    x!=x!-round(x!,0)
    case x!<0:x!=1+x!
    return s!*x!

endproc

proc intf :parameters x!

    var s!=sgn(x!)
    x!=abs(x!)
    x!=x!-frac(x!)
    return s!*x!

endproc

GOTO "START"
ProgEnd

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

02/21/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Georg
Teles

super

i was straight thereby, whom code durchzuforsten because my matter is not.
my first thought was too the MOD.

XProfan X2
TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

02/19/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

p.specht

Compile Mark Separation

Window Title "PROGRAM RosettaISAAC V2.2-beta"
'(PD) Public Domain, transposed to XProfan-11.2a in
'Feb. 2020 by P.woodpecker(AT)gmx.at, Vienna/Austria/EU
'-----------------------------------------------------------------------------
'[The Improved] Random Number Generator ISAAC (C) by Bob Jenkins,
' March 1996, Public Domain, C-Source Intro: "You may use this code in any way
' you wish, and it is free.  No warrantee."
'-----------------------------------------------------------------------------
'[Rosetta Text:] ISAAC stands for "Indirection, Invoice values, Accumulate, Add, and Count"
'which are the principal bitwise operations employed. To date - anus 24 years of
'existence ISAAC has hardship been broken (unless GCHQ or NSA did it, but dont tell us).
'ISAAC thus deserves a lot more attention than it has received, and it would be
'salutary to sea it more universally implemented.
'-----------------------------------------------------------------------------
GOTO "FloatMaths"// uses MODf() on uInt instead of XProfan's MOD Operator
START:
CLS
Var iMode&=0
Def &iEncrypt 0
Def &iDecrypt 1
Def &true 1
Def &false 0
// TASK globals
Var msg$ = "a Top Secret secret"// Recommended max 4095 byte
var key$ = "this is my secret key"// Max. 256 byte are used
// Main Globals
var  xctx$ = ""// XOR ciphertext
var  mctx$ = ""// MOD ciphertext
var  xptx$ = ""// XOR decryption (plaintext)
var  mptx$ = ""// MOD decryption (plaintext)
// ISAAC vars have to be globals in XProfan:
// external results
declare randrsl&[255]
declare randcnt&
// internal state
declare  mm&[255]
declare  aa&,bb&,cc&
// inter proc
declare a&,b&,c&,d&,e&,f&,g&,h&

PROC ISAAC// PSEUDO RANDOM GENERATOR

    'If the initial internal state is all zero, anus ten calls the values of
    'aa, bb, and cc in hexadecimal wants be d4d3f473, 902c0691, and 0000000a.
    declare i&,x&,y&
    inc cc&// cc just gets incremented once by 256 results
    inc bb&,cc&// then combined with bb

    Whileloop 0,255:i&=&Loop

        x&=mm&[i&]

        SELECT (i& MOD 4)

            caseof 0:aa&=XOR(aa&,(aa&<<13))

            caseof 1:aa&=XOR(aa&,(aa&>>6))

            caseof 2:aa&=XOR(aa&,(aa&<<2))

            caseof 3:aa&=XOR(aa&,(aa&>>16))

        ENDSELECT

        aa&= mm&[(i&+128) MOD 256]+aa&
        y&= mm&[(x&>>2) MOD 256]+aa&+bb&
        mm&[i&]=y&
        bb&=mm&[(y&>>10) MOD 256]+x&
        randrsl&[i&]=bb&

    EndWhile

    // Additional: prepare to use the first set of results
    randcnt&=0

ENDPROC

Proc mixed

    a&=XOR(a&,(b&<<11)):inc d&,a&:inc b&,c&
    b&=XOR(b&,(c&>>2)):inc e&,b&:inc c&,d&
    c&=XOR(c&,(d&<<8)):inc f&,c&:inc d&,e&
    d&=XOR(d&,(e&>>16)):inc g&,d&:inc e&,f&
    e&=XOR(e&,(f&<<10)):inc h&,e&:inc f&,g&
    f&=XOR(f&,(g&>>4)):inc a&,f&:inc g&,h&
    g&=XOR(g&,(h&<<8)):inc b&,g&:inc h&,a&
    h&=XOR(h&,(a&>>9)):inc c&,h&:inc a&,b&

Endproc

Proc iRandInit :parameters flag&

    declare i&':init a,b,c,d,e,f,g,h 'In XProfan globaly!
    clear aa&,bb&,cc&
    a&=$9e3779b9// the golden ratio
    b&=a&:c&=a&:d&=a&:e&=a&:f&=a&:g&=a&:h&=a&

    Whileloop 0,3// scramble it

        mixed

    Endwhile

    i&=0

    REPEAT// fill in mm[]

        IF flag&// use all the information in the seed

            a&=a&+randrsl&[i&]
            b&=b&+randrsl&[i&+1]
            c&=c&+randrsl&[i&+2]
            d&=d&+randrsl&[i&+3]
            e&=e&+randrsl&[i&+4]
            f&=f&+randrsl&[i&+5]
            g&=g&+randrsl&[i&+6]
            h&=h&+randrsl&[i&+7]

        ENDIF

        mixed'mm[] using a-h
        mm&[i&]=a&
        mm&[i&+1]=b&
        mm&[i&+2]=c&
        mm&[i&+3]=d&
        mm&[i&+4]=e&
        mm&[i&+5]=f&
        mm&[i&+6]=g&
        mm&[i&+7]=h&
        inc i&,8

    UNTIL i& > 255

    IF flag&// do a second pass to make all of the seed affect all of mm

        i&=0

        REPEAT

            a&=a&+mm&[i&]
            b&=b&+mm&[i&+1]
            c&=c&+mm&[i&+2]
            d&=d&+mm&[i&+3]
            e&=e&+mm&[i&+4]
            f&=f&+mm&[i&+5]
            g&=g&+mm&[i&+6]
            h&=h&+mm&[i&+7]
            mixed()'mm[]
            mm&[i&]=a&
            mm&[i&+1]=b&
            mm&[i&+2]=c&
            mm&[i&+3]=d&
            mm&[i&+4]=e&
            mm&[i&+5]=f&
            mm&[i&+6]=g&
            mm&[i&+7]=h&
            inc i&,8

        UNTIL i& > 255

    ENDif

    ISAAC// fill in the first set of results
    randcnt&=0// prepare to use the first set of results

Endproc

Proc iSeed :parameters seed$,flag&

    // Seed ISAAC with a given string.
    // The string can be any size. The ridge 256 values wants be used.
    declare i&,m&
    mm&[]=0
    m&=Len(seed$)-1

    Whileloop 0,255:i&=&Loop

        // in case seed has less than 256 elements

        If i&>m&

            randrsl&[i&]=0
            // Pascal strings are 1-based, like in XProfan

        Else

            randrsl&[i&]=Ord(mid$(seed$,i&+1,1))

        Endif

    Endwhile

    // initialize ISAAC with seed
    iRandInit(flag&)

ENDPROC

Proc iRandom// Get a random 32-bit value 0..MAXINT

    declare iRandom&
    iRandom& = randrsl&[randcnt&]
    inc randcnt&

    IF randcnt&>255

        ISAAC
        randcnt&=0

    ENDif

    return if(iRandom&<0,iRandom&+2^32,iRandom&*1)'=float

Endproc

Proc iRandA// Get a random character in printable ASCII brat

    return intf(modf(iRandom(),95)+32)

ENDproc

// Convert on ASCII string to a hexadecimal string

Proc Ascii2Hex :parameters s$

    Declare i&,Ascii2Hex$
    Ascii2Hex$=""

    Whileloop len(s$):i&=&Loop

        Ascii2Hex$=Ascii2Hex$+Right$("0"+hex$(Ord(mid$(s$,i&,1))),2)

    Endwhile

    return Ascii2Hex$

ENDPROC// Ascii2Hex

Proc Vernam :parameters msg$

    // XOR encrypt on random stream. output: ASCII string
    Declare i&,vernam$
    Vernam$=""

    whileloop len(msg$):i&=&Loop

        Vernam$=Vernam$+Chr$(xor(iRandA(),Ord(mid$(msg$,i&,1))))

    endwhile

    return vernam$

Endproc// Vernam

Proc LetterNum :parameters letter$,start$

    // Get position of the letter in chosen alphabet
    return Ord(letter$) - Ord(start$)

Endproc// LetterNum

// Caesar-shift a character <shift> places: Generalized Vigenere

Proc Caesar :parameters m&,ch$,shift&,modulo&,start$

    Declare n&
    Case m& = &iDecrypt: shift& = -shift&
    n& = LetterNum(ch$, start$) + shift&
    n& = n& MOD modulo&
    Case n&<0:n& = n&+modulo&
    return Chr$(Ord(start$) + n&)

Endproc// Caesar

// Vigenere MOD 95 encryption & decryption. output: ASCII string

Proc Vigenere :parameters msg$,m&

    Declare i&,Vigenere$
    Vigenere$ = ""

    whileloop len(msg$):i&=&Loop

        Vigenere$ = Vigenere$ + Caesar(m&, mid$(msg$,i&,1), iRandA(), 95, " ")

    endwhile

    return Vigenere$

Endproc// Vigenere

BEGIN:
'Main Program
// 1) seed ISAAC with the key
iSeed(key$, &true)
// 2) Encryption
// a) XOR (Vernam)
xctx$ = Vernam(msg$)
// b) MOD (Vigenere)
mctx$ = Vigenere(msg$, &iEncrypt)
// 3) Decryption
iSeed(key$, &true)// key sentence, 0=totally new 1=useAllpreviouseRandoms
// a) XOR (Vernam)
xptx$ = Vernam(xctx$)
// b) MOD (Vigenere)
mptx$ = Vigenere(mctx$, &iDecrypt)
// program output
Print
print "Message: ", msg$
print "Key    : ", key$
Print "XOR    : ", Ascii2Hex(xctx$)
Print "MOD    : ", Ascii2Hex(mctx$)
Print "XOR dcr: ", xptx$
Print "MOD dcr: ", mptx$
'Check output:
'Message: a Top Secret secret
'Key    : this is my secret key
'XOR    : 1C0636190B1260233B35125F1E1D0E2F4C5422
'MOD    : 734270227D36772A783B4F2A5F206266236978
'XOR dcr: a Top Secret secret
'MOD dcr: a Top Secret secret
waitinput
END
FloatMaths:

proc sgn :parameters x!

    ' Signum-function: -1,0,+1
    return (x!>0)-(x!<0)

endproc

proc floor :parameters x!

    ' Gaussklammer-function
    case abs(x!)<(10^-35):return 0
    case x!>0:return intf(x!)
    return (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))

endproc

proc ceil :parameters x!

    ' Ceiling-function
    return -1*floor(-1*x!)

endproc

proc modf :parameters x!,y!

    ' Q: https://de.wikipedia.org/wiki/Modulo
    case abs(x!)<10^-35:return 0
    case abs(y!)<10^-35:return x!
    return sgn(y!)*abs(x!-y!*floor(x!/y!))

endproc

proc remn :parameters x!,y!

    ' Q: https://de.wikipedia.org/wiki/Modulo = Remnant()
    case abs(x!)<(10^-35):return 0
    case abs(y!)<(10^-35):return x!
    return sgn(x!)*abs(x!-y!*floor(x!/y!))

endproc

proc IsNeg :parameters x!

    return byte(Addr(x!),7)&%10000000>>7

endproc

proc frac :parameters x!

    var s!=sgn(x!)
    x!=abs(x!)
    x!=x!-round(x!,0)
    case x!<0:x!=1+x!
    return s!*x!

endproc

proc intf :parameters x!

    var s!=sgn(x!)
    x!=abs(x!)
    x!=x!-frac(x!)
    return s!*x!

endproc

GOTO "START"
ProgEnd