\ 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]
