net2o: Hex Artifact Content

Artifact c1952241e76200dd2a54d8fc3095b817271bd593:

File keccak.fs — part of check-in [295cbe28ec] at 2019-10-03 14:35:43 on branch trunk — HOSTPREFIX env variable (user: bernd size: 4377)
0000: 5c 20 6b 65 63 63 61 6b 20 77 72 61 70 70 65 72  \ keccak wrapper
0010: 0a 0a 5c 20 43 6f 70 79 72 69 67 68 74 20 c2 a9  ..\ Copyright ©
0020: 20 32 30 31 32 2d 32 30 31 35 20 20 20 42 65 72   2012-2015   Ber
0030: 6e 64 20 50 61 79 73 61 6e 0a 0a 5c 20 54 68 69  nd Paysan..\ Thi
0040: 73 20 70 72 6f 67 72 61 6d 20 69 73 20 66 72 65  s program is fre
0050: 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f 75 20  e software: you 
0060: 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 74 65  can redistribute
0070: 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 69 66   it and/or modif
0080: 79 0a 5c 20 69 74 20 75 6e 64 65 72 20 74 68 65  y.\ it under the
0090: 20 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e   terms of the GN
00a0: 55 20 41 66 66 65 72 6f 20 47 65 6e 65 72 61 6c  U Affero General
00b0: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20   Public License 
00c0: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a  as published by.
00d0: 5c 20 74 68 65 20 46 72 65 65 20 53 6f 66 74 77  \ the Free Softw
00e0: 61 72 65 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20  are Foundation, 
00f0: 65 69 74 68 65 72 20 76 65 72 73 69 6f 6e 20 33  either version 3
0100: 20 6f 66 20 74 68 65 20 4c 69 63 65 6e 73 65 2c   of the License,
0110: 20 6f 72 0a 5c 20 28 61 74 20 79 6f 75 72 20 6f   or.\ (at your o
0120: 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 65 72  ption) any later
0130: 20 76 65 72 73 69 6f 6e 2e 0a 0a 5c 20 54 68 69   version...\ Thi
0140: 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 73  s program is dis
0150: 74 72 69 62 75 74 65 64 20 69 6e 20 74 68 65 20  tributed in the 
0160: 68 6f 70 65 20 74 68 61 74 20 69 74 20 77 69 6c  hope that it wil
0170: 6c 20 62 65 20 75 73 65 66 75 6c 2c 0a 5c 20 62  l be useful,.\ b
0180: 75 74 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57  ut WITHOUT ANY W
0190: 41 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74  ARRANTY; without
01a0: 20 65 76 65 6e 20 74 68 65 20 69 6d 70 6c 69 65   even the implie
01b0: 64 20 77 61 72 72 61 6e 74 79 20 6f 66 0a 5c 20  d warranty of.\ 
01c0: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20  MERCHANTABILITY 
01d0: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41  or FITNESS FOR A
01e0: 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50   PARTICULAR PURP
01f0: 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 5c 20  OSE.  See the.\ 
0200: 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 72  GNU Affero Gener
0210: 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73  al Public Licens
0220: 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 69  e for more detai
0230: 6c 73 2e 0a 0a 5c 20 59 6f 75 20 73 68 6f 75 6c  ls...\ You shoul
0240: 64 20 68 61 76 65 20 72 65 63 65 69 76 65 64 20  d have received 
0250: 61 20 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e  a copy of the GN
0260: 55 20 41 66 66 65 72 6f 20 47 65 6e 65 72 61 6c  U Affero General
0270: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a   Public License.
0280: 5c 20 61 6c 6f 6e 67 20 77 69 74 68 20 74 68 69  \ along with thi
0290: 73 20 70 72 6f 67 72 61 6d 2e 20 20 49 66 20 6e  s program.  If n
02a0: 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f  ot, see <http://
02b0: 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65  www.gnu.org/lice
02c0: 6e 73 65 73 2f 3e 2e 0a 0a 72 65 71 75 69 72 65  nses/>...require
02d0: 20 72 65 63 2d 73 63 6f 70 65 2e 66 73 0a 72 65   rec-scope.fs.re
02e0: 71 75 69 72 65 20 75 6e 69 78 2f 63 70 75 2e 66  quire unix/cpu.f
02f0: 73 0a 0a 66 61 73 74 2d 6c 69 62 20 5b 49 46 5d  s..fast-lib [IF]
0300: 0a 20 20 20 20 72 65 71 75 69 72 65 20 6b 65 63  .    require kec
0310: 63 61 6b 66 61 73 74 2e 66 73 20 66 61 6c 73 65  cakfast.fs false
0320: 0a 5b 45 4c 53 45 5d 0a 20 20 20 20 5b 49 46 44  .[ELSE].    [IFD
0330: 45 46 5d 20 61 6e 64 72 6f 69 64 0a 09 73 22 20  EF] android..s" 
0340: 6c 69 62 6b 65 63 63 61 6b 2e 73 6f 22 20 63 2d  libkeccak.so" c-
0350: 6c 69 62 3a 6f 70 65 6e 2d 70 61 74 68 2d 6c 69  lib:open-path-li
0360: 62 20 64 72 6f 70 0a 20 20 20 20 5b 54 48 45 4e  b drop.    [THEN
0370: 5d 20 74 72 75 65 0a 5b 54 48 45 4e 5d 0a 5b 49  ] true.[THEN].[I
0380: 46 5d 0a 20 20 20 20 63 2d 6c 69 62 72 61 72 79  F].    c-library
0390: 20 6b 65 63 63 61 6b 0a 09 73 22 20 6b 65 63 63   keccak..s" kecc
03a0: 61 6b 22 20 61 64 64 2d 6c 69 62 0a 09 69 6e 63  ak" add-lib..inc
03b0: 6c 75 64 65 20 6b 65 63 63 61 6b 6c 69 62 2e 66  lude keccaklib.f
03c0: 73 0a 20 20 20 20 65 6e 64 2d 63 2d 6c 69 62 72  s.    end-c-libr
03d0: 61 72 79 0a 5b 54 48 45 4e 5d 0a 0a 5b 49 46 55  ary.[THEN]..[IFU
03e0: 4e 44 45 46 5d 20 63 72 79 70 74 6f 20 62 79 65  NDEF] crypto bye
03f0: 20 5b 54 48 45 4e 5d 20 5c 20 73 74 6f 70 20 68   [THEN] \ stop h
0400: 65 72 65 20 69 66 20 6c 69 62 63 6f 6d 70 69 6c  ere if libcompil
0410: 65 20 6f 6e 6c 79 0a 0a 32 35 20 38 20 2a 20 43  e only..25 8 * C
0420: 6f 6e 73 74 61 6e 74 20 6b 65 63 63 61 6b 23 0a  onstant keccak#.
0430: 31 32 38 20 43 6f 6e 73 74 61 6e 74 20 6b 65 63  128 Constant kec
0440: 63 61 6b 23 6d 61 78 0a 31 32 38 20 43 6f 6e 73  cak#max.128 Cons
0450: 74 61 6e 74 20 6b 65 63 63 61 6b 23 63 6b 73 0a  tant keccak#cks.
0460: 0a 55 56 61 6c 75 65 20 40 6b 65 63 63 61 6b 0a  .UValue @keccak.
0470: 32 34 20 56 61 6c 75 65 20 72 6f 75 6e 64 73 0a  24 Value rounds.
0480: 0a 3a 20 6b 65 63 63 61 6b 30 20 28 20 2d 2d 20  .: keccak0 ( -- 
0490: 29 20 40 6b 65 63 63 61 6b 20 4b 65 63 63 61 6b  ) @keccak Keccak
04a0: 49 6e 69 74 69 61 6c 69 7a 65 53 74 61 74 65 20  InitializeState 
04b0: 3b 0a 0a 3a 20 6b 65 63 63 61 6b 2a 20 28 20 2d  ;..: keccak* ( -
04c0: 2d 20 29 20 40 6b 65 63 63 61 6b 20 72 6f 75 6e  - ) @keccak roun
04d0: 64 73 20 4b 65 63 63 61 6b 46 20 3b 0a 3a 20 3e  ds KeccakF ;.: >
04e0: 6b 65 63 63 61 6b 20 28 20 61 64 64 72 20 75 20  keccak ( addr u 
04f0: 2d 2d 20 29 20 20 40 6b 65 63 63 61 6b 20 2d 72  -- )  @keccak -r
0500: 6f 74 20 4b 65 63 63 61 6b 41 62 73 6f 72 62 20  ot KeccakAbsorb 
0510: 3b 0a 3a 20 2b 6b 65 63 63 61 6b 20 28 20 61 64  ;.: +keccak ( ad
0520: 64 72 20 75 20 2d 2d 20 29 20 20 40 6b 65 63 63  dr u -- )  @kecc
0530: 61 6b 20 2d 72 6f 74 20 4b 65 63 63 61 6b 45 6e  ak -rot KeccakEn
0540: 63 72 79 70 74 20 3b 0a 3a 20 2d 6b 65 63 63 61  crypt ;.: -kecca
0550: 6b 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20  k ( addr u -- ) 
0560: 20 40 6b 65 63 63 61 6b 20 2d 72 6f 74 20 4b 65   @keccak -rot Ke
0570: 63 63 61 6b 44 65 63 72 79 70 74 20 3b 0a 3a 20  ccakDecrypt ;.: 
0580: 6b 65 63 63 61 6b 3e 20 28 20 61 64 64 72 20 75  keccak> ( addr u
0590: 20 2d 2d 20 29 20 20 40 6b 65 63 63 61 6b 20 2d   -- )  @keccak -
05a0: 72 6f 74 20 4b 65 63 63 61 6b 45 78 74 72 61 63  rot KeccakExtrac
05b0: 74 20 3b 0a 0a 3a 20 6d 6f 76 65 2d 72 65 70 20  t ;..: move-rep 
05c0: 28 20 73 72 63 61 64 64 72 20 75 31 20 64 65 73  ( srcaddr u1 des
05d0: 74 61 64 64 72 20 75 32 20 2d 2d 20 29 0a 20 20  taddr u2 -- ).  
05e0: 20 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 27    bounds ?DO..I'
05f0: 20 49 20 2d 20 75 6d 69 6e 20 32 64 75 70 20 49   I - umin 2dup I
0600: 20 73 77 61 70 20 6d 6f 76 65 0a 20 20 20 20 64   swap move.    d
0610: 75 70 20 2b 4c 4f 4f 50 20 20 32 64 72 6f 70 20  up +LOOP  2drop 
0620: 3b 0a 0a 5c 20 63 72 79 70 74 6f 20 61 70 69 20  ;..\ crypto api 
0630: 69 6e 74 65 67 72 61 74 69 6f 6e 0a 0a 63 72 79  integration..cry
0640: 70 74 6f 20 63 6c 61 73 73 0a 20 20 20 20 6b 65  pto class.    ke
0650: 63 63 61 6b 23 20 75 76 61 72 20 6b 65 63 63 61  ccak# uvar kecca
0660: 6b 2d 73 74 61 74 65 0a 20 20 20 20 6b 65 63 63  k-state.    kecc
0670: 61 6b 23 63 6b 73 20 75 76 61 72 20 6b 65 63 63  ak#cks uvar kecc
0680: 61 6b 2d 63 68 65 63 6b 73 75 6d 73 0a 20 20 20  ak-checksums.   
0690: 20 6b 65 63 63 61 6b 23 6d 61 78 20 75 76 61 72   keccak#max uvar
06a0: 20 6b 65 63 63 61 6b 2d 70 61 64 64 65 64 0a 65   keccak-padded.e
06b0: 6e 64 2d 63 6c 61 73 73 20 6b 65 63 63 61 6b 0a  nd-class keccak.
06c0: 0a 55 73 65 72 20 6b 65 63 63 61 6b 2d 74 0a 0a  .User keccak-t..
06d0: 3a 20 6b 65 63 63 61 6b 2d 69 6e 69 74 20 28 20  : keccak-init ( 
06e0: 2d 2d 20 29 0a 20 20 20 20 6b 65 63 63 61 6b 2d  -- ).    keccak-
06f0: 74 20 40 20 64 75 70 20 63 72 79 70 74 6f 2d 6f  t @ dup crypto-o
0700: 20 21 20 49 46 20 20 63 72 79 70 74 6f 2d 75 70   ! IF  crypto-up
0710: 20 40 20 75 70 40 20 3d 20 3f 45 58 49 54 20 20   @ up@ = ?EXIT  
0720: 54 48 45 4e 0a 20 20 20 20 5b 3a 20 6b 65 63 63  THEN.    [: kecc
0730: 61 6b 20 6e 65 77 20 64 75 70 20 63 72 79 70 74  ak new dup crypt
0740: 6f 2d 6f 20 21 20 6b 65 63 63 61 6b 2d 74 20 21  o-o ! keccak-t !
0750: 20 3b 5d 20 63 72 79 70 74 6f 2d 61 20 77 69 74   ;] crypto-a wit
0760: 68 2d 61 6c 6c 6f 63 61 74 65 72 0a 20 20 20 20  h-allocater.    
0770: 75 70 40 20 63 72 79 70 74 6f 2d 75 70 20 21 20  up@ crypto-up ! 
0780: 6b 65 63 63 61 6b 2d 73 74 61 74 65 20 74 6f 20  keccak-state to 
0790: 40 6b 65 63 63 61 6b 20 3b 0a 0a 3a 20 6b 65 63  @keccak ;..: kec
07a0: 63 61 6b 2d 66 72 65 65 20 63 72 79 70 74 6f 2d  cak-free crypto-
07b0: 6f 20 40 20 3f 64 75 70 2d 49 46 20 20 5b 3a 20  o @ ?dup-IF  [: 
07c0: 2e 64 69 73 70 6f 73 65 20 3b 5d 20 63 72 79 70  .dispose ;] cryp
07d0: 74 6f 2d 61 20 77 69 74 68 2d 61 6c 6c 6f 63 61  to-a with-alloca
07e0: 74 65 72 20 20 54 48 45 4e 0a 20 20 20 20 30 20  ter  THEN.    0 
07f0: 74 6f 20 40 6b 65 63 63 61 6b 20 63 72 79 70 74  to @keccak crypt
0800: 6f 2d 6f 20 6f 66 66 20 3b 0a 0a 6b 65 63 63 61  o-o off ;..kecca
0810: 6b 2d 69 6e 69 74 0a 0a 3a 6e 6f 6e 61 6d 65 20  k-init..:noname 
0820: 64 65 66 65 72 73 20 27 63 6f 6c 64 20 6b 65 63  defers 'cold kec
0830: 63 61 6b 2d 69 6e 69 74 20 3b 20 69 73 20 27 63  cak-init ; is 'c
0840: 6f 6c 64 0a 3a 6e 6f 6e 61 6d 65 20 64 65 66 65  old.:noname defe
0850: 72 73 20 27 69 6d 61 67 65 20 63 72 79 70 74 6f  rs 'image crypto
0860: 2d 6f 20 6f 66 66 20 20 6b 65 63 63 61 6b 2d 74  -o off  keccak-t
0870: 20 6f 66 66 20 3b 20 69 73 20 27 69 6d 61 67 65   off ; is 'image
0880: 0a 0a 27 20 6b 65 63 63 61 6b 2d 69 6e 69 74 20  ..' keccak-init 
0890: 74 6f 20 63 3a 69 6e 69 74 0a 27 20 6b 65 63 63  to c:init.' kecc
08a0: 61 6b 2d 66 72 65 65 20 74 6f 20 63 3a 66 72 65  ak-free to c:fre
08b0: 65 0a 3a 6e 6f 6e 61 6d 65 20 74 6f 20 40 6b 65  e.:noname to @ke
08c0: 63 63 61 6b 20 3b 20 74 6f 20 63 3a 6b 65 79 21  ccak ; to c:key!
08d0: 20 28 20 61 64 64 72 20 2d 2d 20 29 0a 5c 47 20   ( addr -- ).\G 
08e0: 75 73 65 20 61 64 64 72 20 61 73 20 6b 65 79 20  use addr as key 
08f0: 73 74 6f 72 61 67 65 0a 27 20 40 6b 65 63 63 61  storage.' @kecca
0900: 6b 20 74 6f 20 63 3a 6b 65 79 40 20 28 20 2d 2d  k to c:key@ ( --
0910: 20 61 64 64 72 20 29 0a 5c 47 20 6f 62 74 61 69   addr ).\G obtai
0920: 6e 20 74 68 65 20 6b 65 79 20 73 74 6f 72 61 67  n the key storag
0930: 65 0a 27 20 6b 65 63 63 61 6b 23 20 74 6f 20 63  e.' keccak# to c
0940: 3a 6b 65 79 23 20 28 20 2d 2d 20 6e 20 29 0a 5c  :key# ( -- n ).\
0950: 47 20 6f 62 74 61 69 6e 20 6b 65 79 20 73 74 6f  G obtain key sto
0960: 72 61 67 65 20 73 69 7a 65 0a 27 20 6b 65 63 63  rage size.' kecc
0970: 61 6b 30 20 74 6f 20 63 3a 30 6b 65 79 20 28 20  ak0 to c:0key ( 
0980: 2d 2d 20 29 0a 5c 47 20 73 65 74 20 7a 65 72 6f  -- ).\G set zero
0990: 20 6b 65 79 0a 3a 6e 6f 6e 61 6d 65 20 6b 65 63   key.:noname kec
09a0: 63 61 6b 30 20 6b 65 63 63 61 6b 23 6d 61 78 20  cak0 keccak#max 
09b0: 3e 6b 65 63 63 61 6b 20 3b 20 74 6f 20 3e 63 3a  >keccak ; to >c:
09c0: 6b 65 79 20 28 20 61 64 64 72 20 2d 2d 20 29 0a  key ( addr -- ).
09d0: 5c 47 20 6d 6f 76 65 20 31 32 38 20 62 79 74 65  \G move 128 byte
09e0: 73 20 66 72 6f 6d 20 61 64 64 72 20 74 6f 20 74  s from addr to t
09f0: 68 65 20 73 74 61 74 65 0a 3a 6e 6f 6e 61 6d 65  he state.:noname
0a00: 20 6b 65 63 63 61 6b 23 6d 61 78 20 6b 65 63 63   keccak#max kecc
0a10: 61 6b 3e 20 3b 20 74 6f 20 63 3a 6b 65 79 3e 20  ak> ; to c:key> 
0a20: 28 20 61 64 64 72 20 2d 2d 20 29 0a 5c 47 20 67  ( addr -- ).\G g
0a30: 65 74 20 31 32 38 20 62 79 74 65 73 20 66 72 6f  et 128 bytes fro
0a40: 6d 20 74 68 65 20 73 74 61 74 65 20 74 6f 20 61  m the state to a
0a50: 64 64 72 0a 27 20 6b 65 63 63 61 6b 2a 20 74 6f  ddr.' keccak* to
0a60: 20 63 3a 64 69 66 66 75 73 65 20 28 20 2d 2d 20   c:diffuse ( -- 
0a70: 29 0a 5c 47 20 70 65 72 66 6f 72 6d 20 61 20 64  ).\G perform a d
0a80: 69 66 66 75 73 65 20 72 6f 75 6e 64 0a 3a 6e 6f  iffuse round.:no
0a90: 6e 61 6d 65 20 28 20 61 64 64 72 20 75 20 2d 2d  name ( addr u --
0aa0: 20 29 0a 20 20 20 20 5c 47 20 45 6e 63 72 79 70   ).    \G Encryp
0ab0: 74 20 6d 65 73 73 61 67 65 20 69 6e 20 62 75 66  t message in buf
0ac0: 66 65 72 20 61 64 64 72 20 75 0a 20 20 20 20 40  fer addr u.    @
0ad0: 6b 65 63 63 61 6b 20 2d 72 6f 74 20 72 6f 75 6e  keccak -rot roun
0ae0: 64 73 20 4b 65 63 63 61 6b 45 6e 63 72 79 70 74  ds KeccakEncrypt
0af0: 4c 6f 6f 70 20 20 64 72 6f 70 0a 3b 20 74 6f 20  Loop  drop.; to 
0b00: 63 3a 65 6e 63 72 79 70 74 0a 3a 6e 6f 6e 61 6d  c:encrypt.:nonam
0b10: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a  e ( addr u -- ).
0b20: 20 20 20 20 5c 47 20 44 65 63 72 79 70 74 20 6d      \G Decrypt m
0b30: 65 73 73 61 67 65 20 69 6e 20 62 75 66 66 65 72  essage in buffer
0b40: 20 61 64 64 72 20 75 0a 20 20 20 20 40 6b 65 63   addr u.    @kec
0b50: 63 61 6b 20 2d 72 6f 74 20 72 6f 75 6e 64 73 20  cak -rot rounds 
0b60: 4b 65 63 63 61 6b 44 65 63 72 79 70 74 4c 6f 6f  KeccakDecryptLoo
0b70: 70 20 20 64 72 6f 70 0a 3b 20 74 6f 20 63 3a 64  p  drop.; to c:d
0b80: 65 63 72 79 70 74 20 28 20 61 64 64 72 20 75 20  ecrypt ( addr u 
0b90: 2d 2d 20 29 0a 3a 6e 6f 6e 61 6d 65 20 28 20 61  -- ).:noname ( a
0ba0: 64 64 72 20 75 20 74 61 67 20 2d 2d 20 29 0a 20  ddr u tag -- ). 
0bb0: 20 20 20 5c 47 20 45 6e 63 72 79 70 74 20 6d 65     \G Encrypt me
0bc0: 73 73 61 67 65 20 69 6e 20 62 75 66 66 65 72 20  ssage in buffer 
0bd0: 61 64 64 72 20 75 20 77 69 74 68 20 61 75 74 68  addr u with auth
0be0: 0a 20 20 20 20 7b 20 74 61 67 20 7d 20 40 6b 65  .    { tag } @ke
0bf0: 63 63 61 6b 20 2d 72 6f 74 20 72 6f 75 6e 64 73  ccak -rot rounds
0c00: 20 4b 65 63 63 61 6b 45 6e 63 72 79 70 74 4c 6f   KeccakEncryptLo
0c10: 6f 70 0a 20 20 20 20 6b 65 63 63 61 6b 2a 0a 20  op.    keccak*. 
0c20: 20 20 20 3e 72 20 6b 65 63 63 61 6b 2d 63 68 65     >r keccak-che
0c30: 63 6b 73 75 6d 73 20 6b 65 63 63 61 6b 23 63 6b  cksums keccak#ck
0c40: 73 20 6b 65 63 63 61 6b 3e 0a 20 20 20 20 6b 65  s keccak>.    ke
0c50: 63 63 61 6b 2d 63 68 65 63 6b 73 75 6d 73 20 74  ccak-checksums t
0c60: 61 67 20 37 20 61 6e 64 20 34 20 6c 73 68 69 66  ag 7 and 4 lshif
0c70: 74 20 2b 20 72 3e 20 24 31 30 20 6d 6f 76 65 0a  t + r> $10 move.
0c80: 3b 20 74 6f 20 63 3a 65 6e 63 72 79 70 74 2b 61  ; to c:encrypt+a
0c90: 75 74 68 20 28 20 61 64 64 72 20 75 20 74 61 67  uth ( addr u tag
0ca0: 20 2d 2d 20 29 0a 3a 6e 6f 6e 61 6d 65 20 28 20   -- ).:noname ( 
0cb0: 61 64 64 72 20 75 20 74 61 67 20 2d 2d 20 66 6c  addr u tag -- fl
0cc0: 61 67 20 29 0a 20 20 20 20 5c 47 20 44 65 63 72  ag ).    \G Decr
0cd0: 79 70 74 20 6d 65 73 73 61 67 65 20 69 6e 20 62  ypt message in b
0ce0: 75 66 66 65 72 20 61 64 64 72 20 75 2c 20 77 69  uffer addr u, wi
0cf0: 74 68 20 61 75 74 68 20 63 68 65 63 6b 0a 20 20  th auth check.  
0d00: 20 20 7b 20 74 61 67 20 7d 20 40 6b 65 63 63 61    { tag } @kecca
0d10: 6b 20 2d 72 6f 74 20 72 6f 75 6e 64 73 20 4b 65  k -rot rounds Ke
0d20: 63 63 61 6b 44 65 63 72 79 70 74 4c 6f 6f 70 0a  ccakDecryptLoop.
0d30: 20 20 20 20 6b 65 63 63 61 6b 2a 0a 20 20 20 20      keccak*.    
0d40: 6b 65 63 63 61 6b 2d 63 68 65 63 6b 73 75 6d 73  keccak-checksums
0d50: 20 6b 65 63 63 61 6b 23 63 6b 73 20 6b 65 63 63   keccak#cks kecc
0d60: 61 6b 3e 0a 20 20 20 20 6b 65 63 63 61 6b 2d 63  ak>.    keccak-c
0d70: 68 65 63 6b 73 75 6d 73 20 74 61 67 20 37 20 61  hecksums tag 7 a
0d80: 6e 64 20 34 20 6c 73 68 69 66 74 20 2b 20 24 31  nd 4 lshift + $1
0d90: 30 20 74 75 63 6b 20 73 74 72 3d 0a 3b 20 74 6f  0 tuck str=.; to
0da0: 20 63 3a 64 65 63 72 79 70 74 2b 61 75 74 68 20   c:decrypt+auth 
0db0: 28 20 61 64 64 72 20 75 20 74 61 67 20 2d 2d 20  ( addr u tag -- 
0dc0: 66 6c 61 67 20 29 0a 3a 6e 6f 6e 61 6d 65 20 28  flag ).:noname (
0dd0: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 5c 47 20   addr u -- ).\G 
0de0: 48 61 73 68 20 6d 65 73 73 61 67 65 20 69 6e 20  Hash message in 
0df0: 62 75 66 66 65 72 20 61 64 64 72 20 75 0a 20 20  buffer addr u.  
0e00: 20 20 42 45 47 49 4e 20 20 32 64 75 70 20 6b 65    BEGIN  2dup ke
0e10: 63 63 61 6b 23 6d 61 78 20 75 6d 69 6e 20 74 75  ccak#max umin tu
0e20: 63 6b 0a 09 64 75 70 20 6b 65 63 63 61 6b 23 6d  ck..dup keccak#m
0e30: 61 78 20 75 3c 20 49 46 0a 09 20 20 20 20 6b 65  ax u< IF..    ke
0e40: 63 63 61 6b 2d 70 61 64 64 65 64 20 6b 65 63 63  ccak-padded kecc
0e50: 61 6b 23 6d 61 78 20 3e 70 61 64 64 65 64 0a 09  ak#max >padded..
0e60: 20 20 20 20 6b 65 63 63 61 6b 2d 70 61 64 64 65      keccak-padde
0e70: 64 20 6b 65 63 63 61 6b 23 6d 61 78 0a 09 54 48  d keccak#max..TH
0e80: 45 4e 20 20 3e 6b 65 63 63 61 6b 20 20 6b 65 63  EN  >keccak  kec
0e90: 63 61 6b 2a 0a 20 20 20 20 2f 73 74 72 69 6e 67  cak*.    /string
0ea0: 20 64 75 70 20 30 3d 20 55 4e 54 49 4c 20 20 32   dup 0= UNTIL  2
0eb0: 64 72 6f 70 0a 3b 20 74 6f 20 63 3a 68 61 73 68  drop.; to c:hash
0ec0: 0a 3a 6e 6f 6e 61 6d 65 20 28 20 61 64 64 72 20  .:noname ( addr 
0ed0: 75 20 2d 2d 20 29 0a 5c 47 20 46 69 6c 6c 20 62  u -- ).\G Fill b
0ee0: 75 66 66 65 72 20 61 64 64 72 20 75 20 77 69 74  uffer addr u wit
0ef0: 68 20 50 52 4e 47 20 73 65 71 75 65 6e 63 65 0a  h PRNG sequence.
0f00: 20 20 20 20 32 64 75 70 20 65 72 61 73 65 20 40      2dup erase @
0f10: 6b 65 63 63 61 6b 20 2d 72 6f 74 20 72 6f 75 6e  keccak -rot roun
0f20: 64 73 20 4b 65 63 63 61 6b 45 6e 63 72 79 70 74  ds KeccakEncrypt
0f30: 4c 6f 6f 70 20 64 72 6f 70 0a 3b 20 74 6f 20 63  Loop drop.; to c
0f40: 3a 70 72 6e 67 0a 3a 6e 6f 6e 61 6d 65 20 28 20  :prng.:noname ( 
0f50: 61 64 64 72 20 75 20 2d 2d 20 29 20 3e 6b 65 63  addr u -- ) >kec
0f60: 63 61 6b 20 6b 65 63 63 61 6b 2a 20 3b 0a 5c 47  cak keccak* ;.\G
0f70: 20 61 62 73 6f 72 62 20 2b 20 68 61 73 68 20 66   absorb + hash f
0f80: 6f 72 20 61 20 6d 65 73 73 61 67 65 20 3c 3d 20  or a message <= 
0f90: 36 34 20 62 79 74 65 73 0a 74 6f 20 63 3a 73 68  64 bytes.to c:sh
0fa0: 6f 72 74 68 61 73 68 0a 27 20 6b 65 63 63 61 6b  orthash.' keccak
0fb0: 3e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a  > ( addr u -- ).
0fc0: 20 20 20 20 5c 47 20 65 78 74 72 61 63 74 20 73      \G extract s
0fd0: 68 6f 72 74 20 68 61 73 68 20 28 75 70 20 74 6f  hort hash (up to
0fe0: 20 36 34 20 62 79 74 65 73 29 0a 74 6f 20 63 3a   64 bytes).to c:
0ff0: 68 61 73 68 40 0a 3a 6e 6f 6e 61 6d 65 20 28 20  hash@.:noname ( 
1000: 78 31 32 38 20 61 64 64 72 20 75 20 2d 2d 20 29  x128 addr u -- )
1010: 0a 20 20 20 20 5c 47 20 73 65 74 20 6b 65 79 20  .    \G set key 
1020: 70 6c 75 73 20 74 77 65 61 6b 0a 20 20 20 20 6b  plus tweak.    k
1030: 65 63 63 61 6b 2d 70 61 64 64 65 64 20 6b 65 63  eccak-padded kec
1040: 63 61 6b 23 6d 61 78 20 64 75 70 20 32 2f 20 2f  cak#max dup 2/ /
1050: 73 74 72 69 6e 67 20 6d 6f 76 65 2d 72 65 70 0a  string move-rep.
1060: 20 20 20 20 6b 65 63 63 61 6b 2d 70 61 64 64 65      keccak-padde
1070: 64 20 6b 65 63 63 61 6b 23 6d 61 78 20 32 2f 20  d keccak#max 2/ 
1080: 62 6f 75 6e 64 73 20 44 4f 0a 09 36 34 6f 76 65  bounds DO..64ove
1090: 72 20 36 34 6f 76 65 72 20 49 20 6c 65 2d 31 32  r 64over I le-12
10a0: 38 21 20 20 24 31 30 20 2b 4c 4f 4f 50 20 20 36  8!  $10 +LOOP  6
10b0: 34 64 72 6f 70 20 36 34 64 72 6f 70 0a 20 20 20  4drop 64drop.   
10c0: 20 6b 65 63 63 61 6b 30 20 6b 65 63 63 61 6b 2d   keccak0 keccak-
10d0: 70 61 64 64 65 64 20 6b 65 63 63 61 6b 23 6d 61  padded keccak#ma
10e0: 78 20 3e 6b 65 63 63 61 6b 20 3b 0a 74 6f 20 63  x >keccak ;.to c
10f0: 3a 74 77 65 61 6b 6b 65 79 21 0a 0a 63 72 79 70  :tweakkey!..cryp
1100: 74 6f 2d 6f 20 40 20 43 6f 6e 73 74 61 6e 74 20  to-o @ Constant 
1110: 6b 65 63 63 61 6b 2d 6f 0a                       keccak-o.