1 #include <Rinternals.h>
2 #include <stdlib.h>
3 #include <string.h>
4 #include <openssl/crypto.h>
5 #include <openssl/bn.h>
6 #include "utils.h"
7
r2bignum(SEXP x)8 BIGNUM *r2bignum(SEXP x){
9 if(!inherits(x, "bignum"))
10 error("Argument is not valid bignum");
11 BIGNUM *val = BN_bin2bn(RAW(x), LENGTH(x), NULL);
12 bail(val != NULL);
13 return val;
14 }
15
bignum2r(const BIGNUM * val)16 SEXP bignum2r(const BIGNUM *val){
17 SEXP out = PROTECT(allocVector(RAWSXP, BN_num_bytes(val)));
18 bail(BN_bn2bin(val, RAW(out)) >= 0);
19 setAttrib(out, R_ClassSymbol, mkString("bignum"));
20 UNPROTECT(1);
21 return out;
22 }
23
R_parse_bignum(SEXP x,SEXP hex)24 SEXP R_parse_bignum(SEXP x, SEXP hex){
25 BIGNUM *val = BN_new();
26 if(TYPEOF(x) == RAWSXP){
27 bail(NULL != BN_bin2bn(RAW(x), LENGTH(x), val));
28 } else if(asLogical(hex)){
29 bail(BN_hex2bn(&val, CHAR(STRING_ELT(x, 0))));
30 } else {
31 bail(BN_dec2bn(&val, CHAR(STRING_ELT(x, 0))));
32 }
33 SEXP res = bignum2r(val);
34 BN_free(val);
35 return res;
36 }
37
R_bignum_as_character(SEXP x,SEXP hex)38 SEXP R_bignum_as_character(SEXP x, SEXP hex){
39 BIGNUM *val = r2bignum(x);
40 char *str;
41 if(asLogical(hex)){
42 bail(!!(str = BN_bn2hex(val)));
43 } else {
44 bail(!!(str = BN_bn2dec(val)));
45 }
46 SEXP res = mkString(str);
47 OPENSSL_free(str);
48 BN_free(val);
49 return res;
50 }
51
R_bignum_as_integer(SEXP x)52 SEXP R_bignum_as_integer(SEXP x){
53 BIGNUM *val = r2bignum(x);
54 int res = BN_div_word(val, (BN_ULONG) INT_MAX + 1);
55 return ScalarInteger(BN_num_bits(val) ? NA_INTEGER : res);
56 }
57
R_bignum_add(SEXP x,SEXP y)58 SEXP R_bignum_add(SEXP x, SEXP y){
59 BIGNUM *val1 = r2bignum(x);
60 BIGNUM *val2 = r2bignum(y);
61 BIGNUM *out = BN_new();
62 bail(BN_add(out, val1, val2));
63 SEXP res = bignum2r(out);
64 BN_free(val1);
65 BN_free(val2);
66 BN_free(out);
67 return res;
68 }
69
R_bignum_subtract(SEXP x,SEXP y)70 SEXP R_bignum_subtract(SEXP x, SEXP y){
71 BIGNUM *val1 = r2bignum(x);
72 BIGNUM *val2 = r2bignum(y);
73 BIGNUM *out = BN_new();
74 bail(BN_sub(out, val1, val2));
75 SEXP res = bignum2r(out);
76 BN_free(val1);
77 BN_free(val2);
78 BN_free(out);
79 return res;
80 }
81
R_bignum_multiply(SEXP x,SEXP y)82 SEXP R_bignum_multiply(SEXP x, SEXP y){
83 BIGNUM *val1 = r2bignum(x);
84 BIGNUM *val2 = r2bignum(y);
85 BIGNUM *out = BN_new();
86 BN_CTX *ctx = BN_CTX_new();
87 bail(BN_mul(out, val1, val2, ctx));
88 SEXP res = bignum2r(out);
89 BN_free(val1);
90 BN_free(val2);
91 BN_free(out);
92 BN_CTX_free(ctx);
93 return res;
94 }
95
R_bignum_devide(SEXP x,SEXP y)96 SEXP R_bignum_devide(SEXP x, SEXP y){
97 BIGNUM *val1 = r2bignum(x);
98 BIGNUM *val2 = r2bignum(y);
99 BIGNUM *out = BN_new();
100 BN_CTX *ctx = BN_CTX_new();
101 bail(BN_div(out, NULL, val1, val2, ctx));
102 SEXP res = bignum2r(out);
103 BN_free(val1);
104 BN_free(val2);
105 BN_free(out);
106 BN_CTX_free(ctx);
107 return res;
108 }
109
R_bignum_mod(SEXP x,SEXP y)110 SEXP R_bignum_mod(SEXP x, SEXP y){
111 BIGNUM *val1 = r2bignum(x);
112 BIGNUM *val2 = r2bignum(y);
113 BIGNUM *out = BN_new();
114 BN_CTX *ctx = BN_CTX_new();
115 bail(BN_mod(out, val1, val2, ctx));
116 SEXP res = bignum2r(out);
117 BN_free(val1);
118 BN_free(val2);
119 BN_free(out);
120 BN_CTX_free(ctx);
121 return res;
122 }
123
R_bignum_exp(SEXP x,SEXP y)124 SEXP R_bignum_exp(SEXP x, SEXP y){
125 BIGNUM *val1 = r2bignum(x);
126 BIGNUM *val2 = r2bignum(y);
127 BIGNUM *out = BN_new();
128 BN_CTX *ctx = BN_CTX_new();
129 bail(BN_exp(out, val1, val2, ctx));
130 SEXP res = bignum2r(out);
131 BN_free(val1);
132 BN_free(val2);
133 BN_free(out);
134 BN_CTX_free(ctx);
135 return res;
136 }
137
R_bignum_mod_exp(SEXP x,SEXP y,SEXP m)138 SEXP R_bignum_mod_exp(SEXP x, SEXP y, SEXP m){
139 BIGNUM *val1 = r2bignum(x);
140 BIGNUM *val2 = r2bignum(y);
141 BIGNUM *val3 = r2bignum(m);
142 BIGNUM *out = BN_new();
143 BN_CTX *ctx = BN_CTX_new();
144 bail(BN_mod_exp(out, val1, val2, val3, ctx));
145 BN_free(val1);
146 BN_free(val2);
147 BN_free(val3);
148 SEXP res = bignum2r(out);
149 BN_free(out);
150 BN_CTX_free(ctx);
151 return res;
152 }
153
R_bignum_mod_inv(SEXP a,SEXP n)154 SEXP R_bignum_mod_inv(SEXP a, SEXP n){
155 BIGNUM *val1 = r2bignum(a);
156 BIGNUM *val2 = r2bignum(n);
157 BIGNUM *out = BN_new();
158 BN_CTX *ctx = BN_CTX_new();
159 bail(!!BN_mod_inverse(out, val1, val2, ctx));
160 BN_free(val1);
161 BN_free(val2);
162 SEXP res = bignum2r(out);
163 BN_free(out);
164 BN_CTX_free(ctx);
165 return res;
166 }
167
R_bignum_compare(SEXP x,SEXP y)168 SEXP R_bignum_compare(SEXP x, SEXP y){
169 BIGNUM *val1 = r2bignum(x);
170 BIGNUM *val2 = r2bignum(y);
171 int out = BN_cmp(val1, val2);
172 BN_free(val1);
173 BN_free(val2);
174 return ScalarInteger(out);
175 }
176
R_bignum_bits(SEXP x)177 SEXP R_bignum_bits(SEXP x){
178 BIGNUM *num = r2bignum(x);
179 return ScalarInteger(BN_num_bits(num));
180 }
181