660b443c |
1 | /* -*-c-*- |
2 | * |
3 | * $Id: mpstuff.c,v 1.1 2004/04/02 18:04:01 mdw Exp $ |
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 | |
29 | /*----- Revision history --------------------------------------------------* |
30 | * |
31 | * $Log: mpstuff.c,v $ |
32 | * Revision 1.1 2004/04/02 18:04:01 mdw |
33 | * Initial checkin. |
34 | * |
35 | */ |
36 | |
37 | /*----- Header files ------------------------------------------------------*/ |
38 | |
39 | #include "catacomb-perl.h" |
40 | |
41 | /*----- Main code ---------------------------------------------------------*/ |
42 | |
43 | /* --- Convert Perl integers to multiprecision --- */ |
44 | |
45 | mp *mp_fromiv(mp *d, IV iv) |
46 | { |
47 | MP_FROMINT(d, IV, iv); |
48 | return (d); |
49 | } |
50 | |
51 | IV mp_toiv(mp *x) |
52 | { |
53 | IV i; |
54 | MP_TOINT(x, IV, IV_MAX, i); |
55 | return (i); |
56 | } |
57 | |
58 | /* --- Parse Perl strings into integers --- */ |
59 | |
60 | typedef struct mptext_svctx { |
61 | SV *sv; |
62 | STRLEN i; |
63 | } mptext_svctx; |
64 | |
65 | static int svget(void *p) |
66 | { |
67 | mptext_svctx *c = p; |
68 | if (c->i >= SvCUR(c->sv)) |
69 | return (EOF); |
70 | return ((unsigned char)SvPVX(c->sv)[c->i++]); |
71 | } |
72 | |
73 | static void svunget(int ch, void *p) |
74 | { |
75 | mptext_svctx *c = p; |
76 | if (ch == EOF || c->i == 0) |
77 | return; |
78 | c->i--; |
79 | } |
80 | |
81 | static int svput(const char *s, size_t sz, void *p) |
82 | { |
83 | mptext_svctx *c = p; |
84 | sv_catpvn(c->sv, (char *)s, sz); |
85 | return (0); |
86 | } |
87 | |
88 | static const mptext_ops mptext_svops = { svget, svunget, svput }; |
89 | |
90 | mp *mp_readsv(mp *m, SV *sv, STRLEN *off, int radix) |
91 | { |
92 | mptext_svctx c; |
93 | STRLEN len; |
94 | SvPV(sv, len); |
95 | if (!SvPOK(sv)) |
96 | return (0); |
97 | c.sv = sv; |
98 | c.i = off ? *off : 0; |
99 | m = mp_read(m, radix, &mptext_svops, &c); |
100 | if (off) |
101 | *off = c.i; |
102 | return (m); |
103 | } |
104 | |
105 | int mp_writesv(mp *m, SV *sv, int radix) |
106 | { |
107 | mptext_svctx c; |
108 | int rc; |
109 | STRLEN len; |
110 | SvPV(sv, len); |
111 | c.sv = sv; |
112 | rc = mp_write(m, radix, &mptext_svops, &c); |
113 | return (rc); |
114 | } |
115 | |
116 | /* --- Conversion to and from SVs --- */ |
117 | |
118 | mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...) |
119 | { |
120 | mp *m; |
121 | if (SvROK(sv)) { |
122 | if (sv_derived_from(sv, "Catacomb::MP")) |
123 | m = (mp *)SvIV((SV *)SvRV(sv)); |
124 | else { |
125 | va_list ap; |
126 | SV *t = NEWSV(0, 0); |
127 | va_start(ap, keep); |
128 | sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0); |
129 | croak("%s is not of type Catacomb::MP", SvPVX(t)); |
130 | SvREFCNT_dec(t); |
131 | } |
132 | } else { |
133 | if (SvIOK(sv)) |
134 | m = mp_fromiv(MP_NEW, SvIV(sv)); |
135 | else |
136 | m = mp_readsv(MP_NEW, sv, 0, radix); |
137 | if (m && !keep) |
138 | RET_MP(m); /* Kill temporary later */ |
139 | } |
140 | return (m); |
141 | } |
142 | |
143 | /*----- That's all, folks -------------------------------------------------*/ |