\ rsa.f \ RSA Encryption algorithm. Currently a WIP \ Version 2025-08-29 Copyright Gan Uesli Starling include D:\FYBB\defs.f \ for super-strings : ~~ CR ." ~~" .S KEY DROP ; 0 [IF] FYI Notes.. Public key: ( (3, 3127) ) Private key: ( (2011, 3127) ) To encrypt the message "HI" (where H = 8 and I = 9): [ c = 89^3 \ (\text{mod} \ 3127) = 1394 ] To decrypt: [ m = 1394^{2011} \ (\text{mod} \ 3127) = 89 ] Thus, "HI" is successfully encrypted and decrypted [THEN] VARIABLE rsa_carry 0 rsa_carry ! 32 VALUE RSA_LGTH \ Counted arrays: big-endian; 1st cell is count. CREATE rsa_p RSA_LGTH 1 CELLS + ALLOT ALIGN CREATE rsa_q RSA_LGTH 1 CELLS + ALLOT ALIGN CREATE rsa_n RSA_LGTH 2 * 1 CELLS + ALLOT ALIGN : pq.erase ( addr ) 0 OVER ! 1 CELLS + RSA_LGTH ERASE ; : n.erase rsa_n 0 OVER ! 1 CELLS + RSA_LGTH 2 * ERASE ; rsa_p pq.erase rsa_q pq.erase n.erase \ Add single byte into array at Nth position, carrying as necessary : pq.c+ ( c-addr c ptr -- ) \ Counted array, additament, carry pointer. 2 PICK 1 CELLS + ( c-addr c ptr addr ) \ To right of counter RSA_LGTH + ( c-addr c ptr addr ) \ Rightmost place SWAP - ( c-addr c addr ) \ Current place >us ( c-addr c ) \ Keep on 3rd stack BEGIN ( c-addr c ) us@ C@ + ( c-addr u ) \ Add c to current place DUP $FF AND ( c-addr u c ) \ Separate least signficiant us@ C! ( c-addr u ) \ Store least significant 8 RSHIFT ( c-addr c ) \ A new least signficant DUP 0<> ( c-addr c flg ) \ But is it zero? OVER 1 CELLS + ( c-addr c flg addr ) \ Left-most storage addr of counted c-array us@ < ( c-addr c flg flg ) \ Not at end of c-array? AND ( c-addr c flg ) \ Neither of those WHILE us> 1- >us ( c-addr c ) \ Move pointer to left REPEAT DROP ( c-addr ) DUP 1 CELLS + ( c-addr addr ) \ Left-most place of c-array RSA_LGTH + ( c-addr addr ) \ Right-most place of c-array us> - 1+ ( c-addr u ) \ Count of places carried to OVER C@ ( c-addr u u ) \ Count prior to opperation OVER < IF \ Carry-to more than count SWAP ! ( ) \ Store new count ELSE \ Carry-to less than count 2DROP ( ) \ Old count stands THEN ; \ Add a number into c-array : pq.u+ ( c-addr u -- ) RSA_LGTH 0 DO ( c-addr u ) OVER OVER $FF AND ( c-addr u c-addr c ) \ Least significant byte I pq.c+ ( c-addr u ) 8 RSHIFT ( c-addr u' ) DUP 0= IF ( c-addr u' ) \ No more digits to add? 2DROP ( ) LEAVE ( ) \ Done THEN LOOP ; \ Set count of array from number of leading zeros. \ Sub-routine used by pq.borrow : pq.count.fix ( addr ) 1 CELLS + RSA_LGTH 0 DO DUP I + C@ 0<> IF RSA_LGTH I - LEAVE THEN LOOP SWAP 1 CELLS - ! ; \ Borrow a digit. Sub-routine used by pq.c- : pq.borrow ( addr addr ) \ Boundary, place BEGIN 2DUP > \ Don't borow into count-cell of array WHILE DUP C@ ( addr addr c ) 0> IF 1- ( addr addr c' ) SWAP C! ( addr ) LEAVE THEN 1+ ( addr addr ) REPEAT ( addr ) pq.count.fix ; \ Subtract a single byte from array at Nth position, borrowing as necessary : pq.c- ( c-addr c ptr -- ) \ Counted array, additament, carry pointer. 2 PICK 1 CELLS + ( c-addr c ptr addr ) \ To right of counter RSA_LGTH + ( c-addr c ptr addr ) \ Rightmost place SWAP - ( c-addr c addr ) \ Current place >R ( c-addr c ) \ Keep on R stack BEGIN ( c-addr c ) R@ C@ ( c-addr c c ) \ Fetch minuend byte 2DUP > IF \ Subtrahend byte > minuend byte? 2 PICK 1 CELLS + ( c-addr c c addr ) \ Place-boundary for borrowing R@ 1+ ( c-addr c c addr addr ) \ Next higher place pq.borrow ( c-addr c c ) \ Borrow down from higher place(s) $100 OR ( c-addr c c' ) \ Borrow accomplished THEN SWAP - ( c-addr u ) \ Subtract c from current place R@ C! ( c-addr u ) \ Store least significant REPEAT DROP ( c-addr ) ; \ Display contents of c-array as hex. : pq.show ( c-addr -- ) CR 1 CELLS + RSA_LGTH 1+ 0 DO DUP I + C@ byte. \ byte. from defs.f LOOP DROP ; : test.pq.u+ CR CR ." Testing pq.u+ ..." rsa_p pq.erase rsa_p $3A8F05C5 pq.u+ CR ." Look for value hex value 3A8F05C5 to be in c-array." rsa_p pq.show rsa_p $AFAD114F pq.u+ CR ." Look for value hex value EA3C1714 to be in c-array." rsa_p pq.show ; test.pq.u+ \ CR ." Count of rsa_p is " rsa_p @ . \ pq.count.fix \ CR ." Count of rsa_p is " rsa_p @ . : test.pq.c- CR CR ." Testing pq.c- ..." rsa_p 5 pq.c- CR ." Look for value hex value EA3C170F to be in c-array." rsa_p pq.show ; \ test.pq.c- FALSE [IF] : string.integer.! ( b-addr c-addr c ) 1 >us \ 1's place multiplier. Increments to 10th's, 100th's, etc. 0 SWAP ROT ( b-addr c c-addr ) \ Initialize an accumulator OVER + 1- SWAP ( b-addr c-addr' c ) \ c-addr' = c-addr+c-1, the right-most char 0 DO ( b-addr c-addr' ) DUP C@ ( b-addr c-addr' c ) \ Get right-most char DUP BL = IF DROP LEAVE THEN \ No more digits in string 48 - ( b-addr c-addr' u ) \ Downscale from ASCII DUP 0< OVER 9 > OR \ Not 0 thru 9 ? IF CR ." Oops! Not a digit at word string.to.integer in file.f" CR LEAVE THEN us@ M* ( b-addr c-addr' d ) \ Promote to current Nth's place ROT + SWAP ( u c-addr ) 1- ( u c-addr' ) \ Decrement c-addr one char to left us> 10 * >us \ Next digit left is 10x higher. LOOP us> 2DROP ( u ) ; \ Generate RSA value of n _PRIMES1_ COUNT path_primes cs.copy 125000 7 get.prime 1 - \ 1st prime (largest) minus 1 _PRIMES2_ COUNT path_primes cs.copy 125000 7 get.prime 1 - \ 2nd prime (2nd largest) minus 1 * CR CR ." RSA n = " . CR CR [THEN]