1 /* g/i.c
2 **
3 */
4 #include "all.h"
5
6 /* u3i_words():
7 **
8 ** Copy [a] words from [b] into an atom.
9 */
10 u3_noun
u3i_words(c3_w a_w,const c3_w * b_w)11 u3i_words(c3_w a_w,
12 const c3_w* b_w)
13 {
14 /* Strip trailing zeroes.
15 */
16 while ( a_w && !b_w[a_w - 1] ) {
17 a_w--;
18 }
19
20 /* Check for cat.
21 */
22 if ( !a_w ) {
23 return 0;
24 }
25 else if ( (a_w == 1) && !(b_w[0] >> 31) ) {
26 return b_w[0];
27 }
28
29 /* Allocate, fill, return.
30 */
31 {
32 c3_w* nov_w = u3a_walloc(a_w + c3_wiseof(u3a_atom));
33 u3a_atom* nov_u = (void*)nov_w;
34
35 nov_u->mug_w = 0;
36 nov_u->len_w = a_w;
37
38 /* Fill the words.
39 */
40 {
41 c3_w i_w;
42
43 for ( i_w=0; i_w < a_w; i_w++ ) {
44 nov_u->buf_w[i_w] = b_w[i_w];
45 }
46 }
47 return u3a_to_pug(u3a_outa(nov_w));
48 }
49 }
50
51 /* u3i_chubs():
52 **
53 ** Construct `a` double-words from `b`, LSD first, as an atom.
54 */
55 u3_atom
u3i_chubs(c3_w a_w,const c3_d * b_d)56 u3i_chubs(c3_w a_w,
57 const c3_d* b_d)
58 {
59 c3_w *b_w = c3_malloc(a_w * 8);
60 c3_w i_w;
61 u3_atom p;
62
63 for ( i_w = 0; i_w < a_w; i_w++ ) {
64 b_w[(2 * i_w)] = b_d[i_w] & 0xffffffffULL;
65 b_w[(2 * i_w) + 1] = b_d[i_w] >> 32ULL;
66 }
67 p = u3i_words((a_w * 2), b_w);
68 free(b_w);
69 return p;
70 }
71
72 /* u3i_bytes():
73 **
74 ** Copy `a` bytes from `b` to an LSB first atom.
75 */
76 u3_noun
u3i_bytes(c3_w a_w,const c3_y * b_y)77 u3i_bytes(c3_w a_w,
78 const c3_y* b_y)
79 {
80 /* Strip trailing zeroes.
81 */
82 while ( a_w && !b_y[a_w - 1] ) {
83 a_w--;
84 }
85
86 /* Check for cat.
87 */
88 if ( a_w <= 4 ) {
89 if ( !a_w ) {
90 return 0;
91 }
92 else if ( a_w == 1 ) {
93 return b_y[0];
94 }
95 else if ( a_w == 2 ) {
96 return (b_y[0] | (b_y[1] << 8));
97 }
98 else if ( a_w == 3 ) {
99 return (b_y[0] | (b_y[1] << 8) | (b_y[2] << 16));
100 }
101 else if ( (b_y[3] <= 0x7f) ) {
102 return (b_y[0] | (b_y[1] << 8) | (b_y[2] << 16) | (b_y[3] << 24));
103 }
104 }
105
106 /* Allocate, fill, return.
107 */
108 {
109 c3_w len_w = (a_w + 3) >> 2;
110 c3_w* nov_w = u3a_walloc((len_w + c3_wiseof(u3a_atom)));
111 u3a_atom* nov_u = (void*)nov_w;
112
113 nov_u->mug_w = 0;
114 nov_u->len_w = len_w;
115
116 /* Clear the words.
117 */
118 {
119 c3_w i_w;
120
121 for ( i_w=0; i_w < len_w; i_w++ ) {
122 nov_u->buf_w[i_w] = 0;
123 }
124 }
125
126 /* Fill the bytes.
127 */
128 {
129 c3_w i_w;
130
131 for ( i_w=0; i_w < a_w; i_w++ ) {
132 nov_u->buf_w[i_w >> 2] |= (b_y[i_w] << ((i_w & 3) * 8));
133 }
134 }
135 return u3a_to_pug(u3a_outa(nov_w));
136 }
137 }
138
139 /* u3i_mp():
140 **
141 ** Copy the GMP integer `a` into an atom, and clear it.
142 */
143 u3_noun
u3i_mp(mpz_t a_mp)144 u3i_mp(mpz_t a_mp)
145 {
146 /* Efficiency: unnecessary copy.
147 */
148 {
149 c3_w pyg_w = mpz_size(a_mp) * ((sizeof(mp_limb_t)) / 4);
150 c3_w *buz_w = alloca(pyg_w * 4);
151 c3_w i_w;
152
153 for ( i_w = 0; i_w < pyg_w; i_w++ ) {
154 buz_w[i_w] = 0;
155 }
156 mpz_export(buz_w, 0, -1, 4, 0, 0, a_mp);
157 mpz_clear(a_mp);
158
159 return u3i_words(pyg_w, buz_w);
160 }
161 }
162
163 /* u3i_vint():
164 **
165 ** Create `a + 1`.
166 */
167 u3_noun
u3i_vint(u3_noun a)168 u3i_vint(u3_noun a)
169 {
170 c3_assert(u3_none != a);
171
172 if ( _(u3a_is_cat(a)) ) {
173 c3_w vin_w = (a + 1);
174
175 if ( a == 0x7fffffff ) {
176 return u3i_words(1, &vin_w);
177 }
178 else return vin_w;
179 }
180 else if ( _(u3a_is_cell(a)) ) {
181 return u3m_bail(c3__exit);
182 }
183 else {
184 mpz_t a_mp;
185
186 u3r_mp(a_mp, a);
187 u3a_lose(a);
188
189 mpz_add_ui(a_mp, a_mp, 1);
190 return u3i_mp(a_mp);
191 }
192 }
193
194 c3_w BAD;
195
196 /* u3i_cell():
197 **
198 ** Produce the cell `[a b]`.
199 */
200 u3_noun
u3i_cell(u3_noun a,u3_noun b)201 u3i_cell(u3_noun a, u3_noun b)
202 {
203 u3t_on(mal_o);
204
205 #ifdef U3_CPU_DEBUG
206 u3R->pro.cel_d++;
207 #endif
208 {
209 // c3_w* nov_w = u3a_walloc(c3_wiseof(u3a_cell));
210 c3_w* nov_w = u3a_celloc();
211 u3a_cell* nov_u = (void *)nov_w;
212 u3_noun pro;
213
214 nov_u->mug_w = 0;
215 nov_u->hed = a;
216 nov_u->tel = b;
217
218 pro = u3a_to_pom(u3a_outa(nov_w));
219 #if 0
220 if ( (0x730e66cc == u3r_mug(pro)) &&
221 (c3__tssg == u3h(u3t(u3t(pro)))) ) {
222 static c3_w xuc_w;
223 fprintf(stderr, "BAD %x %p\r\n", pro, u3a_to_ptr(a));
224 BAD = pro;
225 if ( xuc_w == 1 ) u3m_bail(c3__exit);
226 xuc_w++;
227 }
228 #endif
229 #if 1
230 u3t_off(mal_o);
231 return pro;
232 #else
233 if ( !FOO ) return u3a_to_pom(u3a_outa(nov_w));
234 else {
235 u3_noun pro = u3a_to_pom(u3a_outa(nov_w));
236
237 u3m_p("leaked", pro);
238 printf("pro %u, %x\r\n", pro, u3r_mug(pro));
239 abort();
240 }
241 #endif
242 }
243 }
244
245 /* u3i_trel():
246 **
247 ** Produce the triple `[a b c]`.
248 */
249 u3_noun
u3i_trel(u3_noun a,u3_noun b,u3_noun c)250 u3i_trel(u3_noun a, u3_noun b, u3_noun c)
251 {
252 return u3i_cell(a, u3i_cell(b, c));
253 }
254
255 /* u3i_qual():
256 **
257 ** Produce the cell `[a b c d]`.
258 */
259 u3_noun
u3i_qual(u3_noun a,u3_noun b,u3_noun c,u3_noun d)260 u3i_qual(u3_noun a, u3_noun b, u3_noun c, u3_noun d)
261 {
262 return u3i_cell(a, u3i_trel(b, c, d));
263 }
264
265 /* u3i_string():
266 **
267 ** Produce an LSB-first atom from the C string `a`.
268 */
269 u3_noun
u3i_string(const c3_c * a_c)270 u3i_string(const c3_c* a_c)
271 {
272 return u3i_bytes(strlen(a_c), (c3_y *)a_c);
273 }
274
275 /* u3i_tape(): from a C string, to a list of bytes.
276 */
277 u3_atom
u3i_tape(const c3_c * txt_c)278 u3i_tape(const c3_c* txt_c)
279 {
280 if ( !*txt_c ) {
281 return u3_nul;
282 } else return u3i_cell(*txt_c, u3i_tape(txt_c + 1));
283 }
284
285 /* u3i_decimal():
286 **
287 ** Parse `a` as a list of decimal digits.
288 */
289 u3_atom
290 u3i_decimal(u3_noun a);
291
292 /* u3i_heximal():
293 **
294 ** Parse `a` as a list of hex digits.
295 */
296 u3_noun
297 u3i_heximal(u3_noun a);
298
299 /* u3i_list():
300 **
301 ** Generate a null-terminated list, with `u3_none` as terminator.
302 */
303 u3_noun
304 u3i_list(u3_weak one, ...);
305
306
307 /* u3i_molt():
308 **
309 ** Mutate `som` with a 0-terminated list of axis, noun pairs.
310 ** Axes must be cats (31 bit).
311 */
312 struct _molt_pair {
313 c3_w axe_w;
314 u3_noun som;
315 };
316
317 static c3_w
_molt_cut(c3_w len_w,struct _molt_pair * pms_m)318 _molt_cut(c3_w len_w,
319 struct _molt_pair* pms_m)
320 {
321 c3_w i_w, cut_t, cut_w;
322
323 cut_t = 0;
324 cut_w = 0;
325 for ( i_w = 0; i_w < len_w; i_w++ ) {
326 c3_w axe_w = pms_m[i_w].axe_w;
327
328 if ( (cut_t == 0) && (3 == u3x_cap(axe_w)) ) {
329 cut_t = 1;
330 cut_w = i_w;
331 }
332 pms_m[i_w].axe_w = u3x_mas(axe_w);
333 }
334 return cut_t ? cut_w : i_w;
335 }
336
337 static u3_noun // transfer
_molt_apply(u3_noun som,c3_w len_w,struct _molt_pair * pms_m)338 _molt_apply(u3_noun som, // retain
339 c3_w len_w,
340 struct _molt_pair* pms_m) // transfer
341 {
342 if ( len_w == 0 ) {
343 return u3a_gain(som);
344 }
345 else if ( (len_w == 1) && (1 == pms_m[0].axe_w) ) {
346 return pms_m[0].som;
347 }
348 else {
349 c3_w cut_w = _molt_cut(len_w, pms_m);
350
351 if ( c3n == u3a_is_cell(som) ) {
352 return u3m_bail(c3__exit);
353 }
354 else {
355 return u3i_cell
356 (_molt_apply(u3a_h(som), cut_w, pms_m),
357 _molt_apply(u3a_t(som), (len_w - cut_w), (pms_m + cut_w)));
358 }
359 }
360 }
361 u3_noun
u3i_molt(u3_noun som,...)362 u3i_molt(u3_noun som, ...)
363 {
364 va_list ap;
365 c3_w len_w;
366 struct _molt_pair* pms_m;
367 u3_noun pro;
368
369 /* Count.
370 */
371 len_w = 0;
372 {
373 va_start(ap, som);
374 while ( 1 ) {
375 if ( 0 == va_arg(ap, c3_w) ) {
376 break;
377 }
378 va_arg(ap, u3_weak*);
379 len_w++;
380 }
381 va_end(ap);
382 }
383 pms_m = alloca(len_w * sizeof(struct _molt_pair));
384
385 /* Install.
386 */
387 {
388 c3_w i_w;
389
390 va_start(ap, som);
391 for ( i_w = 0; i_w < len_w; i_w++ ) {
392 pms_m[i_w].axe_w = va_arg(ap, c3_w);
393 pms_m[i_w].som = va_arg(ap, u3_noun);
394 }
395 va_end(ap);
396 }
397
398 /* Apply.
399 */
400 pro = _molt_apply(som, len_w, pms_m);
401 u3a_lose(som);
402 return pro;
403 }
404
405