Adding hashing utils, making vocab test more stable.

common/all_tests.fs

@@ -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

common/forth_namespace_tests.fs

@@ -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 

common/utils.fs

@@ -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

lib/hashing/hashing.fs

@@ -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

lib/hashing/sha1.fs

@@ -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

lib/hashing/sha1_tests.fs

@@ -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

lib/hashing/sha256.fs

@@ -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

lib/hashing/sha256_tests.fs

@@ -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