660b443c |
1 | /* -*-c-*- |
2 | * |
a1a90aaf |
3 | * $Id$ |
660b443c |
4 | * |
5 | * MP manipulation stuff |
6 | * |
7 | * (c) 2001 Straylight/Edgeware |
8 | */ |
9 | |
10 | /*----- Licensing notice --------------------------------------------------* |
11 | * |
12 | * This file is part of the Perl interface to Catacomb. |
13 | * |
14 | * Catacomb/Perl is free software; you can redistribute it and/or modify |
15 | * it under the terms of the GNU General Public License as published by |
16 | * the Free Software Foundation; either version 2 of the License, or |
17 | * (at your option) any later version. |
18 | * |
19 | * Catacomb/Perl is distributed in the hope that it will be useful, |
20 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
21 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
22 | * GNU General Public License for more details. |
23 | * |
24 | * You should have received a copy of the GNU General Public License |
25 | * along with Catacomb/Perl; if not, write to the Free Software Foundation, |
26 | * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
27 | */ |
28 | |
660b443c |
29 | /*----- Header files ------------------------------------------------------*/ |
30 | |
31 | #include "catacomb-perl.h" |
32 | |
33 | /*----- Main code ---------------------------------------------------------*/ |
34 | |
35 | /* --- Convert Perl integers to multiprecision --- */ |
36 | |
37 | mp *mp_fromiv(mp *d, IV iv) |
38 | { |
39 | MP_FROMINT(d, IV, iv); |
40 | return (d); |
41 | } |
42 | |
43 | IV mp_toiv(mp *x) |
44 | { |
45 | IV i; |
46 | MP_TOINT(x, IV, IV_MAX, i); |
47 | return (i); |
48 | } |
49 | |
50 | /* --- Parse Perl strings into integers --- */ |
51 | |
52 | typedef struct mptext_svctx { |
53 | SV *sv; |
54 | STRLEN i; |
55 | } mptext_svctx; |
56 | |
57 | static int svget(void *p) |
58 | { |
59 | mptext_svctx *c = p; |
60 | if (c->i >= SvCUR(c->sv)) |
61 | return (EOF); |
62 | return ((unsigned char)SvPVX(c->sv)[c->i++]); |
63 | } |
64 | |
65 | static void svunget(int ch, void *p) |
66 | { |
67 | mptext_svctx *c = p; |
68 | if (ch == EOF || c->i == 0) |
69 | return; |
70 | c->i--; |
71 | } |
72 | |
73 | static int svput(const char *s, size_t sz, void *p) |
74 | { |
75 | mptext_svctx *c = p; |
76 | sv_catpvn(c->sv, (char *)s, sz); |
77 | return (0); |
78 | } |
79 | |
80 | static const mptext_ops mptext_svops = { svget, svunget, svput }; |
81 | |
82 | mp *mp_readsv(mp *m, SV *sv, STRLEN *off, int radix) |
83 | { |
84 | mptext_svctx c; |
85 | STRLEN len; |
86 | SvPV(sv, len); |
87 | if (!SvPOK(sv)) |
88 | return (0); |
89 | c.sv = sv; |
90 | c.i = off ? *off : 0; |
91 | m = mp_read(m, radix, &mptext_svops, &c); |
92 | if (off) |
93 | *off = c.i; |
94 | return (m); |
95 | } |
96 | |
fcd15e0b |
97 | int group_writesv(group *g, ge *x, SV *sv) |
98 | { |
99 | mptext_svctx c; |
100 | int rc; |
101 | STRLEN len; |
102 | sv_setpvn(sv, "", 0); |
103 | c.sv = sv; |
104 | rc = G_WRITE(g, x, &mptext_svops, &c); |
105 | return (rc); |
106 | } |
107 | |
660b443c |
108 | int mp_writesv(mp *m, SV *sv, int radix) |
109 | { |
110 | mptext_svctx c; |
111 | int rc; |
112 | STRLEN len; |
fcd15e0b |
113 | sv_setpvn(sv, "", 0); |
660b443c |
114 | c.sv = sv; |
115 | rc = mp_write(m, radix, &mptext_svops, &c); |
116 | return (rc); |
117 | } |
118 | |
119 | /* --- Conversion to and from SVs --- */ |
120 | |
fcd15e0b |
121 | mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...) |
660b443c |
122 | { |
123 | mp *m; |
124 | if (SvROK(sv)) { |
f9952aec |
125 | if (sv_derived_from(sv, "Catacomb::MP")) |
660b443c |
126 | m = (mp *)SvIV((SV *)SvRV(sv)); |
127 | else { |
128 | va_list ap; |
a1a90aaf |
129 | SV *t = sv_newmortal(); |
660b443c |
130 | va_start(ap, keep); |
131 | sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0); |
fcd15e0b |
132 | croak("%s is not of type Catacomb::MP", SvPVX(t)); |
660b443c |
133 | } |
f9952aec |
134 | if (m && keep) |
135 | MP_COPY(m); |
660b443c |
136 | } else { |
137 | if (SvIOK(sv)) |
138 | m = mp_fromiv(MP_NEW, SvIV(sv)); |
139 | else |
140 | m = mp_readsv(MP_NEW, sv, 0, radix); |
141 | if (m && !keep) |
fcd15e0b |
142 | RET_MP(m); /* Kill temporary later */ |
660b443c |
143 | } |
144 | return (m); |
145 | } |
146 | |
147 | /*----- That's all, folks -------------------------------------------------*/ |