XProfan

Deutsch

p.specht

Verdacht bestätigt: MOD funktioniert mit negativen Werten, indem es selbst negativ wird. Pascal-MOD arbeitet auf Unsigned-Integers, wird also nie negativ. Mittels einiger Kopfstände geht das nun auch in XProfan (mein MODf() arbeitet auf Floats und wird auch nicht negativ), sodaß zumindest die erste Prüfsumme (die für die XOR-Methode) nun mit der Pascal-Vorlage übereinstimmt.

Bin also weiter am tüfteln...

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

19.02.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

« Dieser Beitrag wurde als Lösung gekennzeichnet. »

p.specht

Geschafft: Die 2. Checksumme stimmte wegen einer falsch benannten Variable nicht. Nun scheint es zu funktionieren - was man allerdings erst nach vielen Tests annehmen kann. Deshalb bleibt die Sache vorläufig im Beta-Stadium. Sollten Fehler auftauchen, bitte hier melden!
Gruss

Kompilieren Markieren Separieren

WindowTitle "PROGRAM RosettaISAAC V2.2-beta"
'(PD) Public Domain, transposed to XProfan-11.2a in
'Feb. 2020 by P.Specht(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, Shift, Accumulate, Add, and Count"
'which are the principal bitwise operations employed. To date - after 24 years of
'existence ISAAC has not 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 see 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, after ten calls the values of
    'aa, bb, and cc in hexadecimal will be d4d3f473, 902c0691, and 0000000a.
    declare i&,x&,y&
    inc cc&// cc just gets incremented once per 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 Mix

    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

        Mix

    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

        Mix'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]
            Mix()'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 first 256 values will 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 range

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

ENDproc

// Convert an 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-Funktion: -1,0,+1
    return (x!>0)-(x!<0)

endproc

proc floor :parameters x!

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

21.02.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Georg
Teles

Super

ich war gerade dabei, den Code durchzuforsten weil meine Materie ist es nicht.
Mein erster Gedanke war auch der MOD.

XProfan X2
TC-Programming [...]

XProfan 8.0 - 10.0 - X2 - X3 - X4

19.02.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

p.specht

Kompilieren Markieren Separieren

WindowTitle "PROGRAM RosettaISAAC V2.2-beta"
'(PD) Public Domain, transposed to XProfan-11.2a in
'Feb. 2020 by P.Specht(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, Shift, Accumulate, Add, and Count"
'which are the principal bitwise operations employed. To date - after 24 years of
'existence ISAAC has not 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 see 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, after ten calls the values of
    'aa, bb, and cc in hexadecimal will be d4d3f473, 902c0691, and 0000000a.
    declare i&,x&,y&
    inc cc&// cc just gets incremented once per 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 Mix

    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

        Mix

    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

        Mix'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]
            Mix()'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 first 256 values will 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 range

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

ENDproc

// Convert an 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-Funktion: -1,0,+1
    return (x!>0)-(x!<0)

endproc

proc floor :parameters x!

    ' Gaussklammer-Funktion
    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-Funktion
    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