module sts/ia32/elf/begin.sts module sts/ia32/float/float.sts module sts/cipher.sts module sts/keygen.sts module sts/freq.sts module sts/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 drop 0 do dup 2bd = until swap float_fload swap float_fload float_add float_fstore swap 1 + od drop float_fload float_sqrt 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 nicedist float_less if bifreq_sp freq_sp calcdist bifreq_eng freq_eng calcdist float_less if 2 else 1 fi else bifreq_sp freq_sp calcdist nicedist float_less if 2 else 0 fi fi ; Remove frequencies from stack: 2c0 set 2c0 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 length 0 = if 'e' sys_write_err 'm' sys_write_err 'p' sys_write_err 't' sys_write_err 'y' sys_write_err newline sys_write_err sys_exit fi 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 ; 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 '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 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 0 = untilod drop length do 1 - swap drop dup 0 = untilod drop ; output key keylen do 1 - dup word_size mul key + @ dup 4 shr get_hex sys_write_err get_hex sys_write_err dup 0 = until space sys_write_err od drop newline sys_write_err sys_exit module sts/ia32/elf/end.sts