diff options
Diffstat (limited to 'main.sts')
| -rw-r--r-- | main.sts | 210 |
1 files changed, 0 insertions, 210 deletions
diff --git a/main.sts b/main.sts deleted file mode 100644 index f112c30..0000000 --- a/main.sts +++ /dev/null @@ -1,210 +0,0 @@ -module ia32/elf/begin.sts -module ia32/float/float.sts -module cipher.sts -module keygen.sts -module freq.sts -module bifreq.sts - -[ sd 0 swap drop ] - -defword nicedist - 1 float_iload a float_iload float_div -exit - -defword zeros - do dup 0 = until - 0 swap - 1 - od drop -exit - -defword clear - do dup 0 = until - swap drop - 1 - od drop -exit - -defword calcdist ; distance from ideal as sqrt sum square diff - 2c1 ref as calcdist.textfr - local calcdist.fr - 0 do dup 2be = until - dup word_size mul dup dup - calcdist.fr + @ float_fload - calcdist.textfr + @ float_fload - float_sub float_fstore dup float_fload float_fload - float_mul float_fstore swap calcdist.fr + ! - 1 + od - 0 do dup 2bd = until - swap float_fload swap float_fload float_add float_fstore swap - 1 + od drop - float_fload float_sqrt nicedist float_less -exit - -defword checktext - as checktext.length - local checktext.text - ; Count frequencies: - ; 676 latin bigrams: - 2a4 zeros local checktext.bifr - ; 26 latin letters: - 1a zeros local checktext.fr - ; count how much of each letter is in text: - 0 local checktext.hadalpha - 0 local checktext.bicount - 0 local checktext.count - checktext.length do 1 - - dup word_size mul checktext.text + @ - dup dup 'z' > 0 = swap 'a' < 0 = mul if - dup 'z' swap - word_size mul local checktext.i - checktext.i @ checktext.fr + @ 1 + checktext.i @ checktext.fr + ! - checktext.count @ 1 + checktext.count ! - checktext.hadalpha @ if - checktext.bicount @ 1 + checktext.bicount ! - checktext.hadalpha @ 1 - 1a mul checktext.i @ + - checktext.bifr + - dup @ 1 + swap ! - fi - 1 + checktext.hadalpha ! - else dup dup 'Z' > 0 = swap 'A' < 0 = mul if - dup 'Z' swap - word_size mul local checktext.i - checktext.i @ checktext.fr + @ 1 + checktext.i @ checktext.fr + ! - checktext.count @ 1 + checktext.count ! - checktext.hadalpha @ if - checktext.bicount @ 1 + checktext.bicount ! - checktext.hadalpha @ 1 - 1a mul checktext.i @ + - checktext.bifr + - dup @ 1 + swap ! - fi - 1 + checktext.hadalpha ! - else 0 checktext.hadalpha ! dup dup 8 > 0 = swap 1 < 0 = mul if - 2c3 clear - 0 exit fi dup dup 1f > 0 = swap e < 0 = mul if - 2c3 clear - 0 exit fi fi fi drop - dup 0 = untilod drop - ; At least 1/4 characters in text should be alphabetical: - checktext.count @ float_iload checktext.length float_iload float_div - 1 float_iload 4 float_iload float_div float_less if - 2c1 clear - 0 exit fi - ; Division by zero shall not pass: - checktext.bicount 0 = if 2c1 clear 0 exit fi - ; normalize: - 0 do dup 1a = until - dup word_size mul checktext.fr + dup @ float_iload - checktext.count @ float_iload - float_div float_fstore swap ! - 1 + od drop - 0 do dup 2a4 = until - dup word_size mul checktext.bifr + dup @ float_iload - checktext.bicount @ float_iload - float_div float_fstore swap ! - 1 + od drop - ; Decide if text is real: - bifreq_eng freq_eng calcdist if 1 else - 0 fi - ; Remove frequencies from stack: - 2c1 set - 2c1 clear -exit - -set_entry float_init ; this is program with floats - ; read file into stack - 0 do sys_read 0 = until - swap 1 + - od drop as length - local ciphertext - - 0 ; initial key is empty - do - ; generate next key to try - keygen as keylen local key - '.' sys_write_err - - ; decipher text (length is the same as for ciphertext) - keylen 1 - length do 1 - - as textpos local pos - textpos word_size mul ciphertext + @ - key - keylen - pos - cipher - swap textpos - dup 0 = untilod drop drop - local plaintext - - ; check deciphering attempt, exit if Ok or keylen = max (3) - keylen 3 = if eeeee else length checktext fi dup until drop - ; else remove the text from stack and place keylen back - 0 do dup length = until - swap drop 1 + - od drop keylen - od as langcode drop - - ; output language - langcode 1 = if - 'e' sys_write_err - 'n' sys_write_err - 'g' sys_write_err - 'l' sys_write_err - 'i' sys_write_err - 's' sys_write_err - 'h' sys_write_err - fi langcode 2 = if - 'd' sys_write_err - 'u' sys_write_err - 't' sys_write_err - 'c' sys_write_err - 'h' sys_write_err - fi langcode 3 = if - 'g' sys_write_err - 'e' sys_write_err - 'r' sys_write_err - 'm' sys_write_err - 'a' sys_write_err - 'n' sys_write_err - fi langcode 4 = if - 'f' sys_write_err - 'r' sys_write_err - 'e' sys_write_err - 'n' sys_write_err - 'c' sys_write_err - 'h' sys_write_err - fi langcode 5 = if - 's' sys_write_err - 'p' sys_write_err - 'a' sys_write_err - 'n' sys_write_err - 'i' sys_write_err - 's' sys_write_err - 'h' sys_write_err - fi langcode 6 = if - 'i' sys_write_err - 't' sys_write_err - 'a' sys_write_err - 'l' sys_write_err - 'i' sys_write_err - 'a' sys_write_err - 'n' sys_write_err - fi langcode eeeee = if - 'e' sys_write_err - 'r' sys_write_err - 'r' sys_write_err - 'o' sys_write_err - 'r' sys_write_err - fi newline sys_write_err - - ; output text - length do 1 - - dup word_size mul plaintext + @ sys_write - dup 1 = untilod drop - length do 1 - - swap drop - dup 1 = untilod drop - - ; output key - keylen do 1 - - dup word_size mul key + @ sys_write_err - dup 0 = untilod drop newline sys_write_err -sys_exit - -module ia32/elf/end.sts |