alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Adding hashing utils, making vocab test more stable.

Browse Source
This commit is contained in:
Brad Nelson
2022-06-03 11:57:54 -07:00
parent f0cea166e4
commit d08831fe94
8 changed files with 278 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
common/all_tests.fs
View File

@ -24,4 +24,6 @@ needs float_tests.fs
needs forth_namespace_tests.fs
needs structures_tests.fs
needs including_tests/including_tests.fs
needs ../lib/hashing/sha1_tests.fs
needs ../lib/hashing/sha256_tests.fs
run-tests

6
common/forth_namespace_tests.fs
View File

@ -477,7 +477,7 @@ e: check-phase2
DEFINED? windows [IF]
e: test-windows-forth-namespace
internals voclist
internals ' graphics voclist-from
out: internals
out: graphics
out: ansi
@ -515,7 +515,7 @@ e: test-windows-forth-namespace
[ELSE] DEFINED? posix [IF]
e: test-posix-forth-namespace
internals voclist
internals ' sockets voclist-from
out: sockets
out: internals
out: graphics
@ -560,7 +560,7 @@ e: test-posix-forth-namespace
[ELSE]
e: test-esp32-forth-namespace
internals voclist
internals ' ansi voclist-from
out: ansi
out: registers
out: oled

3
common/utils.fs
View File

@ -77,7 +77,8 @@ internals definitions
dup >body see-vocabulary
>vocnext
repeat drop cr ;
: voclist last-vocabulary @ begin dup while dup see. cr >vocnext repeat drop ;
: voclist-from ( voc -- ) begin dup while dup see. cr >vocnext repeat drop ;
: voclist last-vocabulary @ voclist-from ;
: voc. ( voc -- ) 2 cells - see. ;
: vocs. ( voc -- ) dup voc. @ begin dup while
dup nonvoc? 0= if ." >> " dup 2 cells - voc. then

17
lib/hashing/hashing.fs Normal file
View File

@ -0,0 +1,17 @@
\ Copyright 2022 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
internals vocabulary hashing hashing definitions
only forth definitions

80
lib/hashing/sha1.fs Normal file
View File

@ -0,0 +1,80 @@
\ Copyright 2022 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs hashing.fs
internals hashing definitions
0 VALUE h0 0 VALUE h1 0 VALUE h2 0 VALUE h3 0 VALUE h4
0 VALUE a 0 VALUE b 0 VALUE c 0 VALUE d 0 VALUE e
CREATE w 80 4* ALLOT
: w@ ( n -- n ) 4* w + UL@ ;
: w! ( n n -- ) 4* w + L! ;
: 32-bit ( n -- n ) $ffffffff AND ;
: L+ ( n n -- n ) + 32-bit ;
: <<< ( n n -- n ) 2DUP LSHIFT -ROT 32 SWAP - RSHIFT OR 32-bit ;
VARIABLE ends
: <-> ( n - n ) ends ! 0 4 0 DO 8 LSHIFT ends I + C@ OR LOOP ;
: <->* ( a n -- ) 0 ?DO DUP UL@ <-> OVER L! 4 + LOOP DROP ;
: init $67452301 TO h0 $EFCDAB89 TO h1
$98BADCFE TO h2 $10325476 TO h3 $C3D2E1F0 TO h4 ;
: extend
80 16 DO
I 3 - w@ I 8 - w@ XOR I 14 - w@ XOR I 16 - w@ XOR 1 <<< I w!
LOOP
;
: step ( n i -- ) w@ + a 5 <<< + e L+ ( to temp )
d TO e c TO d b 30 <<< TO c a TO b ( from temp ) TO a ;
: start h0 TO A h1 TO b h2 TO c h3 TO d h4 TO e ;
: chunk1 20 0 DO b c AND b INVERT d AND XOR $5A827999 + I step LOOP ;
: chunk2 40 20 DO b c XOR d XOR $6ED9EBA1 + I step LOOP ;
: chunk3 60 40 DO b c AND b d AND XOR c d AND XOR $8F1BBCDC + I step LOOP ;
: chunk4 80 60 DO b c XOR d XOR $CA62C1D6 + I step LOOP ;
: finish a h0 L+ TO h0 b h1 L+ TO h1 c h2 L+ TO h2
d h3 L+ TO h3 e h4 L+ TO h4 ;
: chunk extend start chunk1 chunk2 chunk3 chunk4 finish ;
: >w { msg n }
w 64 ERASE msg w n CMOVE $80 w n + c! w 64 <->* ;
40 constant sha1-size
create sha1-hash sha1-size allot
: >dig ( a n -- a )
BASE @ >R HEX <# # # # # # # # # #> R> BASE !
ROT 2DUP + >R SWAP CMOVE R> ;
: format
sha1-hash h0 >dig h1 >dig h2 >dig h3 >dig h4 >dig DROP ;
: sha1 { msg n -- hash n } n 64 /mod { edge wholes }
init
wholes 0 ?DO msg 64 >w chunk 64 +TO msg LOOP
edge 0= IF
0 0 >w
ELSE
msg edge >w
edge 56 >= IF chunk w 64 ERASE THEN
THEN
n 8 * 16 RSHIFT 16 RSHIFT 14 w!
n 8 * 15 w! chunk
format sha1-hash sha1-size
;
forth definitions

30
lib/hashing/sha1_tests.fs Normal file
View File

@ -0,0 +1,30 @@
\ Copyright 2022 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs sha1.fs
e: test-sha1
hashing
s" The quick brown fox jumps over the lazy dog" sha1
s" 2FD4E1C67A2D28FCED849EE1BB76E7391B93EB12" str= assert
s" The quick brown fox jumps over the lazy cog" sha1
s" DE9F2C7FD25E1B3AFAD3E85A0BD17D9B100DB4B3" str= assert
0 0 sha1
s" DA39A3EE5E6B4B0D3255BFEF95601890AFD80709" str= assert
here 1024 32 fill here 1024 sha1
s" 84C169D0021D73D6A508C9A2859571EAF5D90687" str= assert
;e

111
lib/hashing/sha256.fs Normal file
View File

@ -0,0 +1,111 @@
\ Copyright 2022 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs hashing.fs
internals hashing definitions
0 VALUE h0 0 VALUE h1 0 VALUE h2 0 VALUE h3
0 VALUE h4 0 VALUE h5 0 VALUE h6 0 VALUE h7
0 VALUE a 0 VALUE b 0 VALUE c 0 VALUE d
0 VALUE e 0 VALUE f 0 VALUE g 0 VALUE h
0 VALUE temp1 0 VALUE temp2
CREATE w 64 4* ALLOT
: w@ ( n -- n ) 4* w + UL@ ;
: w! ( n n -- ) 4* w + L! ;
: L, ( n -- ) HERE L! 4 ALLOT ;
: 32-bit ( n -- n ) $ffffffff AND ;
: L+ ( n n -- n ) + 32-bit ;
: >>> ( n n -- n ) 2DUP RSHIFT -ROT 32 SWAP - LSHIFT OR 32-bit ;
VARIABLE ends
: <-> ( n - n ) ends ! 0 4 0 DO 8 LSHIFT ends I + C@ OR LOOP ;
: <->* ( a n -- ) 0 ?DO DUP UL@ <-> OVER L! 4 + LOOP DROP ;
CREATE k HEX
428a2f98 L, 71374491 L, b5c0fbcf L, e9b5dba5 L, 3956c25b L, 59f111f1 L, 923f82a4 L, ab1c5ed5 L,
d807aa98 L, 12835b01 L, 243185be L, 550c7dc3 L, 72be5d74 L, 80deb1fe L, 9bdc06a7 L, c19bf174 L,
e49b69c1 L, efbe4786 L, 0fc19dc6 L, 240ca1cc L, 2de92c6f L, 4a7484aa L, 5cb0a9dc L, 76f988da L,
983e5152 L, a831c66d L, b00327c8 L, bf597fc7 L, c6e00bf3 L, d5a79147 L, 06ca6351 L, 14292967 L,
27b70a85 L, 2e1b2138 L, 4d2c6dfc L, 53380d13 L, 650a7354 L, 766a0abb L, 81c2c92e L, 92722c85 L,
a2bfe8a1 L, a81a664b L, c24b8b70 L, c76c51a3 L, d192e819 L, d6990624 L, f40e3585 L, 106aa070 L,
19a4c116 L, 1e376c08 L, 2748774c L, 34b0bcb5 L, 391c0cb3 L, 4ed8aa4a L, 5b9cca4f L, 682e6ff3 L,
748f82ee L, 78a5636f L, 84c87814 L, 8cc70208 L, 90befffa L, a4506ceb L, bef9a3f7 L, c67178f2 L,
DECIMAL
: k@ ( n -- n ) 4* k + UL@ ;
: init
$6a09e667 TO h0 $bb67ae85 TO h1 $3c6ef372 TO h2 $a54ff53a TO h3
$510e527f TO h4 $9b05688c TO h5 $1f83d9ab TO h6 $5be0cd19 TO h7
;
: s0 { x } x 7 >>> x 18 >>> XOR x 3 RSHIFT XOR ;
: s1 { x } x 17 >>> x 19 >>> XOR x 10 RSHIFT XOR ;
: extend
64 16 DO
I 16 - w@ I 7 - w@ + I 15 - w@ s0 + I 2 - w@ s1 + I w!
LOOP
;
: maj { x y z -- n } x y AND x z AND XOR y z AND XOR ;
: ch { x y z -- n } x y AND x INVERT z AND XOR ;
: sh0 { x -- n } x 2 >>> x 13 >>> XOR x 22 >>> XOR ;
: sh1 { x -- n } x 6 >>> x 11 >>> XOR x 25 >>> XOR ;
: step { i }
h e sh1 + e f g ch + i k@ + i w@ L+ TO temp1
a sh0 a b c maj L+ TO temp2
g TO h f TO g e TO f d temp1 L+ TO e
c TO d b TO c a TO b temp1 temp2 L+ TO a
;
: chunk
extend
h0 TO a h1 TO b h2 TO c h3 TO d
h4 TO e h5 TO f h6 TO g h7 TO h
64 0 DO I step LOOP
a h0 L+ TO h0 b h1 L+ TO h1 c h2 L+ TO h2 d h3 L+ TO h3
e h4 L+ TO h4 f h5 L+ TO h5 g h6 L+ TO h6 h h7 L+ TO h7
;
: >w { msg n }
w 64 ERASE msg w n CMOVE $80 w n + c! w 64 <->* ;
64 constant sha256-size
create sha256-hash sha256-size allot
: >dig ( a n -- a )
BASE @ >R HEX <# # # # # # # # # #> R> BASE !
ROT 2DUP + >R SWAP CMOVE R> ;
: format
sha256-hash h0 >dig h1 >dig h2 >dig h3 >dig
h4 >dig h5 >dig h6 >dig h7 >dig DROP ;
: sha256 { msg n } n 64 /mod { edge wholes }
init
wholes 0 ?DO msg 64 >w chunk 64 +TO msg LOOP
edge 0= IF
0 0 >w
ELSE
msg edge >w
edge 56 >= IF chunk w 64 ERASE THEN
THEN
n 8 * 16 RSHIFT 16 RSHIFT 14 w!
n 8 * 15 w! chunk
format sha256-hash sha256-size
;
forth definitions

33
lib/hashing/sha256_tests.fs Normal file
View File

@ -0,0 +1,33 @@
\ Copyright 2022 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
needs sha256.fs
e: test-sha256
hashing
0 0 sha256
s" E3B0C44298FC1C149AFBF4C8996FB92427AE41E4649B934CA495991B7852B855" str= assert
s" A" sha256
s" 559AEAD08264D5795D3909718CDD05ABD49572E84FE55590EEF31A88A08FDFFD" str= assert
0 here ! here 1 sha256
s" 6E340B9CFFB37A989CA544E6BB780A2C78901D3FB33738768511A30617AFA01D" str= assert
s" The quick brown fox jumped over the lazy dog." sha256
s" 68B1282B91DE2C054C36629CB8DD447F12F096D3E3C587978DC2248444633483" str= assert
here 1024 32 fill here 1024 sha256
s" 67FA8B7E479417053708E46F2B3669C2F1C2857DF57ACBFF83AC6A06EA0232E9" str= assert
;e