language: Forth (gforth-0.7.0)
date: 173 days 13 hours ago
link:
visibility: public 
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
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277

0 Value fd-in
0 Value fd-out
create XX1 10000 ALLOT
create temp 10000 ALLOT
create pff 100000 chars allot
variable contador
 
: TEXT PAD 258 BL FILL  WORD COUNT PAD SWAP  MOVE ;
: leuser
        CR ." Forneça o nome do arquivo a processar: "
        TIB 40 ACCEPT #TIB !  0 >IN !
        1 TEXT  PAD 40 r/o open-file throw to fd-in
        CR ." Forneça o arquivo resultado: "
        TIB 40 ACCEPT #TIB !  0 >IN !
        1 TEXT  PAD 40 w/o create-file throw to fd-out
        CR ." Processando.................... " ;
 
 
\ INICIO CALCULO MD5
 
variable a    variable b    variable c    variable d
1 a !
 
variable md5len
 
create buf[] 64 allot
create part[] 64 allot
create md5pad 64 allot   md5pad 64 0 fill  128 md5pad c!
 
: lroll
  2dup 32 swap - rshift  rot rot lshift or ;
 
a c@ [if]
 
  : endian@   @ ;
  : endian!   ! ;
 
[else]
  : endian@
    >r r@ 3 + c@ 8 lshift   r@ 2 + c@ + 8 lshift
    r@ 1 + c@ + 8 lshift  r> c@ + ;
 
  : endian!
    >r 256 /mod swap r@ c!  256 /mod swap r@ 1+ c!
    256 /mod swap r@ 2 + c! r> 3 + c! ;
 
[then]
 
: f()  rot dup invert rot and rot rot and or ;
 
: g()  swap over invert and rot rot and or ;
 
: h()  xor xor ;
 
: i()  invert rot or xor ;
 
 
: ff()  >r  cells buf[] + endian@ + >r
  2over nip >r f() + r> swap r> + r> lroll + ;
 
: gg()  >r  cells buf[] + endian@ +  >r
  2over nip >r  g() + r> swap r> + r> lroll + ;
 
: hh()  >r  cells buf[] + endian@ + >r
  2over nip >r  h() + r> swap r> + r> lroll + ;
 
: ii()  >r  cells buf[] + endian@ + >r
  2over nip >r  i() + r> swap r> + r> lroll + ;
 
 
hex
: round1
  a @ b @ c @ d @ 0d76aa478 00 07 ff() a !
  d @ a @ b @ c @ 0e8c7b756 01 0c ff() d !
  c @ d @ a @ b @ 0242070db 02 11 ff() c !
  b @ c @ d @ a @ 0c1bdceee 03 16 ff() b !
  a @ b @ c @ d @ 0f57c0faf 04 07 ff() a !
  d @ a @ b @ c @ 04787c62a 05 0c ff() d !
  c @ d @ a @ b @ 0a8304613 06 11 ff() c !
  b @ c @ d @ a @ 0fd469501 07 16 ff() b !
  a @ b @ c @ d @ 0698098d8 08 07 ff() a !
  d @ a @ b @ c @ 08b44f7af 09 0c ff() d !
  c @ d @ a @ b @ 0ffff5bb1 0a 11 ff() c !
  b @ c @ d @ a @ 0895cd7be 0b 16 ff() b !
  a @ b @ c @ d @ 06b901122 0c 07 ff() a !
  d @ a @ b @ c @ 0fd987193 0d 0c ff() d !
  c @ d @ a @ b @ 0a679438e 0e 11 ff() c !
  b @ c @ d @ a @ 049b40821 0f 16 ff() b !
  ;
 
: round2
  a @ b @ c @ d @ 0f61e2562 01 05 gg() a !
  d @ a @ b @ c @ 0c040b340 06 09 gg() d !
  c @ d @ a @ b @ 0265e5a51 0b 0e gg() c !
  b @ c @ d @ a @ 0e9b6c7aa 00 14 gg() b !
  a @ b @ c @ d @ 0d62f105d 05 05 gg() a !
  d @ a @ b @ c @  02441453 0a 09 gg() d !
  c @ d @ a @ b @ 0d8a1e681 0f 0e gg() c !
  b @ c @ d @ a @ 0e7d3fbc8 04 14 gg() b !
  a @ b @ c @ d @ 021e1cde6 09 05 gg() a !
  d @ a @ b @ c @ 0c33707d6 0e 09 gg() d !
  c @ d @ a @ b @ 0f4d50d87 03 0e gg() c !
  b @ c @ d @ a @ 0455a14ed 08 14 gg() b !
  a @ b @ c @ d @ 0a9e3e905 0d 05 gg() a !
  d @ a @ b @ c @ 0fcefa3f8 02 09 gg() d !
  c @ d @ a @ b @ 0676f02d9 07 0e gg() c !
  b @ c @ d @ a @ 08d2a4c8a 0c 14 gg() b !
  ;
 
: round3
  a @ b @ c @ d @ 0fffa3942 05 04 hh() a !
  d @ a @ b @ c @ 08771f681 08 0b hh() d !
  c @ d @ a @ b @ 06d9d6122 0b 10 hh() c !
  b @ c @ d @ a @ 0fde5380c 0e 17 hh() b !
  a @ b @ c @ d @ 0a4beea44 01 04 hh() a !
  d @ a @ b @ c @ 04bdecfa9 04 0b hh() d !
  c @ d @ a @ b @ 0f6bb4b60 07 10 hh() c !
  b @ c @ d @ a @ 0bebfbc70 0a 17 hh() b !
  a @ b @ c @ d @ 0289b7ec6 0d 04 hh() a !
  d @ a @ b @ c @ 0eaa127fa 00 0b hh() d !
  c @ d @ a @ b @ 0d4ef3085 03 10 hh() c !
  b @ c @ d @ a @  04881d05 06 17 hh() b !
  a @ b @ c @ d @ 0d9d4d039 09 04 hh() a !
  d @ a @ b @ c @ 0e6db99e5 0c 0b hh() d !
  c @ d @ a @ b @ 01fa27cf8 0f 10 hh() c !
  b @ c @ d @ a @ 0c4ac5665 02 17 hh() b !
  ;
 
: round4
  a @ b @ c @ d @ 0f4292244 00 06 ii() a !
  d @ a @ b @ c @ 0432aff97 07 0a ii() d !
  c @ d @ a @ b @ 0ab9423a7 0e 0f ii() c !
  b @ c @ d @ a @ 0fc93a039 05 15 ii() b !
  a @ b @ c @ d @ 0655b59c3 0c 06 ii() a !
  d @ a @ b @ c @ 08f0ccc92 03 0a ii() d !
  c @ d @ a @ b @ 0ffeff47d 0a 0f ii() c !
  b @ c @ d @ a @ 085845dd1 01 15 ii() b !
  a @ b @ c @ d @ 06fa87e4f 08 06 ii() a !
  d @ a @ b @ c @ 0fe2ce6e0 0f 0a ii() d !
  c @ d @ a @ b @ 0a3014314 06 0f ii() c !
  b @ c @ d @ a @ 04e0811a1 0d 15 ii() b !
  a @ b @ c @ d @ 0f7537e82 04 06 ii() a !
  d @ a @ b @ c @ 0bd3af235 0b 0a ii() d !
  c @ d @ a @ b @ 02ad7d2bb 02 0f ii() c !
  b @ c @ d @ a @ 0eb86d391 09 15 ii() b !
  ;
decimal
 
: transform
  a @ b @   c @ d @  round1 round2 round3 round4
  d @ + d !  c @ + c !    b @ + b !  a @ + a !  ;
 
 
hex
: md5int
  067452301 a !   0efcdab89 b !
  098badcfe c !   010325476 d !
  0 md5len !  ;
decimal
 
-1 value md5int?
 
: setlen
  md5len @ 8 m*  buf[] 60 + ! buf[] 56 + ! ;
 
: dofullblocks
  begin  dup 63 >
  while  64 - swap dup buf[] 64 move
         64 + swap transform
  repeat ;
 
: movepartial
  swap over buf[] swap move
  md5pad over buf[] + rot 64 swap - move ;
 
: dofinal
  2dup movepartial dup 55 >
  if  transform  buf[] 64 0 fill then
  2drop setlen transform  ;
 
: md5full
  md5int dup md5len +!  dofullblocks dofinal ;
 
 
: savepart
  md5len @ 64 mod if  part[] swap move  else  2drop  then  ;
 
: movepart
  2dup 64 swap - min >r  part[] + >r over r> r@ move
  swap r@ + swap r> - ;
 
 
: md5update
  md5int? if md5int false to md5int? then
  md5len @ 64 mod over md5len +!
  dup if    2dup + 63 >
            if    movepart part[] 64 dofullblocks  dofullblocks
savepart cr
            else  movepart 2drop then
      else  drop dofullblocks savepart then ;
 
 
: md5final
  md5int? if md5int false to md5int? then
  md5len @ 64 mod over md5len +!
  dup if    2dup + 63 >
            if    movepart part[] 64 dofullblocks  dofullblocks
dofinal
            else  movepart 2drop part[] md5len @ 64 mod dofinal then
      else  drop dofullblocks dofinal then ;
 
create digit$
  48 c, 49 c, 50 c, 51 c, 52 c, 53 c, 54 c, 55 c, 56 c, 57 c,
  97 c, 98 c, 99 c, 100 c, 101 c, 102 c,
 
: intdigits
  0 pad ! ;
: savedigit
  pad c@ 1+ dup pad c! pad + c! ;
: bytedigits
  dup 4 rshift digit$ + c@ savedigit  15 and digit$ + c@ savedigit ;
a c@ [if]
 
  : celldigits
    dup 4 + swap do i c@ bytedigits loop ;
 
[else]
 
  : celldigits
    dup 3 + do i c@ bytedigits -1 +loop ;
 
[then]
: md5string
  intdigits a celldigits b celldigits c celldigits d celldigits
  true to md5int? ;
 
: .md5
   md5full md5string ;
 
\ FIM CALCULO MD5
 
: cap
temp contador c@ pff place
pff count .md5 ;
 
 
: escreve
pad count fd-out write-line THROW
fd-out close-file throw ;
 
: ler
xx1 10000 fd-in read-line throw .
contador !
fd-in close-file throw ;
 
 
: bota 0 contador @ do xx1 i + c@ 0 > if xx1 i + c@ then
-1 +loop ;
 
: pbuf contador @ 0 do temp i + ! loop ;
 
: inicio
leuser
ler
bota
pbuf
cap
escreve
CR ." Arquivo Processado."
CR ." Pressione qualquer tecla para sair "
;
 
inicio
key
exit
 
 
  • upload with new input
  • # 2:   show   clone   input   173 days 13 hours ago    Runtime error
  • # 1:   hide   clone   input   173 days 13 hours ago

    result: Success     time: 0.01s    memory: 7508 kB     returned value: 0 

    Forneça o nome do arquivo a processar: