blob: 2668b5263157efa6ee31f4e934a3040fa64a015b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
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
|
