Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/runtime/c-libs/smlnj-ccalls/c-calls.c
ViewVC logotype

Annotation of /sml/trunk/src/runtime/c-libs/smlnj-ccalls/c-calls.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 107 - (view) (download) (as text)

1 : monnier 2 /* c-calls.c
2 :     *
3 :     * COPYRIGHT (c) 1995 by AT&T Bell Laboratories.
4 :     *
5 :     * C-side support for calling user C functions from SML/NJ.
6 :     *
7 :     */
8 :    
9 :     #include <string.h>
10 :     #include "ml-base.h"
11 :     #include "ml-values.h"
12 :     #include "ml-objects.h"
13 :     #if defined(INDIRECT_CFUNC)
14 :     # include "c-library.h"
15 :     #endif
16 :     #include "ml-c.h"
17 :     #include "c-calls.h"
18 :    
19 :    
20 :     /* assumptions:
21 :     *
22 :     * Word_t fits in a machine word
23 :     *
24 :     * restrictions:
25 :     * C function args must fit in Word_t
26 :     * C's double is the largest return value from a function
27 :     */
28 :    
29 :     ml_val_t dummyRoot = ML_unit; /* empty root for GC */
30 :    
31 :     /* visible_msp used to expose msp to C code */
32 :     ml_state_t *visible_msp = NULL;
33 :    
34 :     #define CONS_SZB (3*WORD_SZB) /* desc + car + cdr */
35 :     #define CADDR_SZB (2*WORD_SZB) /* string desc + ptr */
36 :    
37 :     #define MK_SOME(msp,v) recAlloc1(msp,v)
38 :    
39 :     #define NULLARY_DATACON INT_CtoML(0)
40 :    
41 :     /* this map must correspond to the layout of the type cdata and ctype
42 :     datatypes defined in ML_FILES
43 :     */
44 :    
45 :     #define MLADDR_CODE '@'
46 :     #define MLARRAY_CODE 'A'
47 :     #define MLCHAR_CODE 'C'
48 :     #define MLDOUBLE_CODE 'D'
49 :     #define MLFLOAT_CODE 'R'
50 :     #define MLFUNCTION_CODE 'F'
51 :     #define MLINT_CODE 'I'
52 :     #define MLLONG_CODE 'L'
53 :     #define MLPTR_CODE 'P'
54 :     #define MLSHORT_CODE 'i'
55 :     #define MLSTRING_CODE 'S'
56 :     #define MLOPENSTRUCT_CODE '('
57 :     #define MLCLOSESTRUCT_CODE ')'
58 :     #define MLOPENUNION_CODE '<'
59 :     #define MLCLOSEUNION_CODE '>'
60 :     #define MLVECTOR_CODE 'B'
61 :     #define MLVOID_CODE 'V'
62 :     #define MLPAD_CODE '#'
63 :    
64 :     #define MLSTRUCT_CODE MLOPENSTRUCT_CODE
65 :     #define MLUNION_CODE MLOPENUNION_CODE
66 :    
67 :    
68 :     /* this enumeration must match the sml/nj tags on the cdata datatype */
69 :     /* see c-calls.sml */
70 :    
71 :     #define MLADDR_TAG 0
72 :     #define MLARRAY_TAG 1
73 :     #define MLCHAR_TAG 2
74 :     #define MLDOUBLE_TAG 3
75 :     #define MLFLOAT_TAG 4
76 :     #define MLFUNCTION_TAG 5
77 :     #define MLINT_TAG 6
78 :     #define MLLONG_TAG 7
79 :     #define MLPTR_TAG 8
80 :     #define MLSHORT_TAG 9
81 :     #define MLSTRING_TAG 10
82 :     #define MLSTRUCT_TAG 11
83 :     #define MLUNION_TAG 12
84 :     #define MLVECTOR_TAG 13
85 :     /* #define MLVOID_TAG not used */
86 :    
87 :     /* map from datatype tags to single char descriptor (aka code) */
88 :     char typeMap[] = {MLADDR_CODE,
89 :     MLARRAY_CODE,
90 :     MLCHAR_CODE,
91 :     MLDOUBLE_CODE,
92 :     MLFLOAT_CODE,
93 :     MLFUNCTION_CODE,
94 :     MLINT_CODE,
95 :     MLLONG_CODE,
96 :     MLPTR_CODE,
97 :     MLSHORT_CODE,
98 :     MLSTRING_CODE,
99 :     MLSTRUCT_CODE,
100 :     MLUNION_CODE,
101 :     MLVECTOR_CODE,
102 :     MLVOID_CODE};
103 :    
104 :     /* utility functions */
105 :    
106 :     #define CHAR_RANGE 255 /* must agree with CharRange in c-calls.sml */
107 :    
108 :     PVT int extractUnsigned(unsigned char **s,int bytes)
109 :     {
110 :     int r = 0;
111 :    
112 :     while (bytes--)
113 :     r = r * CHAR_RANGE + (int) *((*s)++) - 1;
114 :     return r;
115 :     }
116 :    
117 :    
118 :    
119 :     /* could (should) use stdlib's strdup instead of this */
120 :     PVT char *mk_strcpy(char *s)
121 :     {
122 :     char *p;
123 :    
124 : monnier 8 if ((p = (char *) MALLOC(strlen(s)+1)) == NULL)
125 : monnier 2 Die("couldn't make string copy during C call\n");
126 :     return strcpy(p,s);
127 :     }
128 :    
129 :     Word_t *checked_memalign(int n,int align)
130 :     {
131 :     Word_t *p;
132 :    
133 :     if (align < sizeof(Word_t))
134 :     align = sizeof(Word_t);
135 : monnier 8 if ((p = (Word_t *)MALLOC(n)) == NULL)
136 : monnier 2 Die("couldn't alloc memory for C call\n");
137 :    
138 :     ASSERT(((Word_t)p & (Word_t)(align-1)) != 0);
139 :    
140 :     return p;
141 :     }
142 :    
143 :     PVT ml_val_t recAlloc1(ml_state_t *msp,ml_val_t v)
144 :     {
145 :     ml_val_t ret;
146 :    
147 :     REC_ALLOC1(msp,ret,v);
148 :     return ret;
149 :     }
150 :    
151 :     PVT ml_val_t mkWord32(ml_state_t *msp, Word_t p)
152 :     {
153 :     ML_AllocWrite(msp, 0, MAKE_DESC(sizeof(Word_t), DTAG_string));
154 :     ML_AllocWrite(msp, 1, (ml_val_t)p);
155 :     return ML_Alloc(msp, sizeof(Word_t));
156 :     }
157 :    
158 :     PVT Word_t getWord32(ml_val_t v)
159 :     {
160 :     return (Word_t) REC_SEL(v,0);
161 :     }
162 :    
163 :     #define MK_CADDR(msp,p) mkWord32(msp,(Word_t) (p))
164 :     #define GET_CADDR(v) (Word_t *)getWord32(v)
165 :    
166 :     PVT ml_val_t double_CtoML(ml_state_t *msp,double g)
167 :     {
168 :     ml_val_t res;
169 :    
170 :     #ifdef DEBUG_C_CALLS
171 :     SayDebug("double_CtoML: building an ML double %l.15f\n", g);
172 :     #endif
173 :     /* Force REALD_SZB alignment */
174 :     msp->ml_allocPtr = (ml_val_t *)((Addr_t)(msp->ml_allocPtr) | WORD_SZB);
175 :     ML_AllocWrite(msp,0,DESC_reald);
176 :     res = ML_Alloc(msp,(sizeof(double)>>2));
177 :     memcpy (res, &g, sizeof(double));
178 :     return res;
179 :     }
180 :    
181 :     /* ptrs to storage alloc'd by the interface. */
182 :     typedef struct ptr_desc {
183 :     Word_t *ptr;
184 :     struct ptr_desc *next;
185 :     } ptrlist_t;
186 :    
187 :     PVT ptrlist_t *ptrlist = NULL;
188 :    
189 :     #ifdef DEBUG_C_CALLS
190 :     PVT int ptrlist_len()
191 :     {
192 :     int i = 0;
193 :     ptrlist_t *p = ptrlist;
194 :    
195 :     while (p != NULL) {
196 :     i++;
197 :     p = p->next;
198 :     }
199 :     return i;
200 :     }
201 :     #endif
202 :    
203 :    
204 :     PVT void keep_ptr(Word_t *p)
205 :     {
206 :     ptrlist_t *q = (ptrlist_t *) checked_alloc(sizeof(ptrlist_t));
207 :    
208 :     #ifdef DEBUG_C_CALLS
209 :     SayDebug("keeping ptr %x, |ptrlist|=%d\n", p, ptrlist_len());
210 :     #endif
211 :    
212 :     q->ptr = p;
213 :     q->next = ptrlist;
214 :     ptrlist = q;
215 :     }
216 :    
217 :     PVT void free_ptrlist()
218 :     {
219 :     ptrlist_t *p;
220 :    
221 :     #ifdef DEBUG_C_CALLS
222 :     SayDebug("freeing ptr list, |ptrlist|=%d\n",ptrlist_len());
223 :     #endif
224 :     p = ptrlist;
225 :     while (p != NULL) {
226 :     ptrlist = ptrlist->next;
227 : monnier 8 FREE(p->ptr); /* the block */
228 :     FREE(p); /* the block's descriptor */
229 : monnier 2 p = ptrlist;
230 :     }
231 :     }
232 :    
233 :     PVT ml_val_t ptrlist_to_MLlist(ml_state_t *msp)
234 :     {
235 :     ml_val_t lp = LIST_nil;
236 :     ml_val_t v;
237 :     ptrlist_t *p;
238 :    
239 :     #ifdef DEBUG_C_CALLS
240 :     int i = 0;
241 :     SayDebug("converting ptrlist (|ptrlist|=%d) to ML list ",ptrlist_len());
242 :     #endif
243 :     p = ptrlist;
244 :     while (p != NULL) {
245 :     #ifdef DEBUG_C_CALLS
246 :     i++;
247 :     #endif
248 :     ptrlist = p->next;
249 :     v = MK_CADDR(msp,p->ptr);
250 :     LIST_cons(msp, lp, v, lp);
251 : monnier 8 FREE(p);
252 : monnier 2 p = ptrlist;
253 :     }
254 :     #ifdef DEBUG_C_CALLS
255 :     SayDebug("of length %d\n", i);
256 :     #endif
257 :     return lp;
258 :     }
259 :    
260 :     /* return the number of bytes the ptrlist will occupy in the ML heap */
261 :     PVT int ptrlist_space()
262 :     {
263 :     int n = 0;
264 :     ptrlist_t *p;
265 :    
266 :     p = ptrlist;
267 :     while (p != NULL) {
268 :     p = p->next;
269 :     n += CONS_SZB + CADDR_SZB;
270 :     }
271 :     #ifdef DEBUG_C_CALLS
272 :     SayDebug("space for ptrlist is %d, |ptrlist|=%d\n",n,ptrlist_len());
273 :     #endif
274 :     return n;
275 :     }
276 :    
277 :     PVT void save_ptrlist(ptrlist_t **save)
278 :     {
279 :     #ifdef DEBUG_C_CALLS
280 :     SayDebug("saving ptrlist, |ptrlist|=%d\n", ptrlist_len());
281 :     #endif
282 :     *save = ptrlist;
283 :     ptrlist = NULL;
284 :     }
285 :    
286 :     PVT void restore_ptrlist(ptrlist_t *save)
287 :     {
288 :     ptrlist = save;
289 :     #ifdef DEBUG_C_CALLS
290 :     SayDebug("restoring ptrlist, |ptrlist|=%d\n", ptrlist_len());
291 :     #endif
292 :     }
293 :    
294 :     ml_val_t revMLList(ml_val_t l,ml_val_t r)
295 :     {
296 :     if (l == LIST_nil)
297 :     return r;
298 :     else {
299 :     ml_val_t tmp = LIST_tl(l);
300 :    
301 :     LIST_tl(l) = r;
302 :     return revMLList(tmp,l);
303 :     }
304 :     }
305 :    
306 :    
307 :     #define SMALL_SPACE 0 /* size to 'NeedGC' for a small obj, say <10 words */
308 :    
309 :     PVT void spaceCheck(ml_state_t *msp, int bytes, ml_val_t *one_root)
310 :     {
311 :     /* assume the ONE_K buffer will absorb descriptors, '\0' terminators */
312 :     if (NeedGC(msp,bytes + ONE_K)) {
313 :     #ifdef DEBUG_C_CALLS
314 :     SayDebug("spaceCheck: invoking GC\n");
315 :     #endif
316 :     InvokeGCWithRoots(msp,0,one_root,NIL(ml_val_t *));
317 :     if (NeedGC(msp,bytes + ONE_K))
318 :     Error("spaceCheck: cannot alloc ML space for ML-C conversion\n");
319 :     }
320 :     }
321 :    
322 :    
323 :     /* interface functions */
324 :    
325 :     PVT char *too_many_args = "c-calls with more than 15 args not supported\n";
326 :    
327 :     /* call_word_fn
328 :     * used when the return type fits into a machine word (Word_t)
329 :     */
330 :     PVT Word_t call_word_fn(Word_t (*f)(),int n,Word_t *args)
331 :     {
332 :     Word_t ret = 0;
333 :    
334 :     switch(n) {
335 :     case 0:
336 :     ret = (*f)();
337 :     break;
338 :     case 1:
339 :     ret = (*f)(args[0]);
340 :     break;
341 :     case 2:
342 :     ret = (*f)(args[0],args[1]);
343 :     break;
344 :     case 3:
345 :     ret = (*f)(args[0],args[1],args[2]);
346 :     break;
347 :     case 4:
348 :     ret = (*f)(args[0],args[1],args[2],args[3]);
349 :     break;
350 :     case 5:
351 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4]);
352 :     break;
353 :     case 6:
354 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
355 :     args[5]);
356 :     break;
357 :     case 7:
358 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
359 :     args[5],args[6]);
360 :     break;
361 :     case 8:
362 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
363 :     args[5],args[6],args[7]);
364 :     break;
365 :     case 9:
366 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
367 :     args[5],args[6],args[7],args[8]);
368 :     break;
369 :     case 10:
370 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
371 :     args[5],args[6],args[7],args[8],args[9]);
372 :     break;
373 :     case 11:
374 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
375 :     args[5],args[6],args[7],args[8],args[9],
376 :     args[10]);
377 :     break;
378 :     case 12:
379 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
380 :     args[5],args[6],args[7],args[8],args[9],
381 :     args[10],args[11]);
382 :     break;
383 :     case 13:
384 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
385 :     args[5],args[6],args[7],args[8],args[9],
386 :     args[10],args[11],args[12]);
387 :     break;
388 :     case 14:
389 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
390 :     args[5],args[6],args[7],args[8],args[9],
391 :     args[10],args[11],args[12],args[13]);
392 :     break;
393 :     case 15:
394 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
395 :     args[5],args[6],args[7],args[8],args[9],
396 :     args[10],args[11],args[12],args[13],args[14]);
397 :     break;
398 :     default:
399 :     /* shouldn't happen; ML side assures this */
400 :     Error(too_many_args);
401 :     }
402 :    
403 :     #ifdef DEBUG_C_CALLS
404 :     SayDebug("call_word_fn: return=0x%x\n",ret);
405 :     #endif
406 :     return ret;
407 :     }
408 :    
409 :     /* call_double_fn
410 :     */
411 :     PVT double call_double_fn(double (*f)(),int n,Word_t *args)
412 :     {
413 :     double ret;
414 :    
415 :     switch(n) {
416 :     case 0:
417 :     ret = (*f)();
418 :     break;
419 :     case 1:
420 :     ret = (*f)(args[0]);
421 :     break;
422 :     case 2:
423 :     ret = (*f)(args[0],args[1]);
424 :     break;
425 :     case 3:
426 :     ret = (*f)(args[0],args[1],args[2]);
427 :     break;
428 :     case 4:
429 :     ret = (*f)(args[0],args[1],args[2],args[3]);
430 :     break;
431 :     case 5:
432 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4]);
433 :     break;
434 :     case 6:
435 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
436 :     args[5]);
437 :     break;
438 :     case 7:
439 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
440 :     args[5],args[6]);
441 :     break;
442 :     case 8:
443 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
444 :     args[5],args[6],args[7]);
445 :     break;
446 :     case 9:
447 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
448 :     args[5],args[6],args[7],args[8]);
449 :     break;
450 :     case 10:
451 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
452 :     args[5],args[6],args[7],args[8],args[9]);
453 :     break;
454 :     default:
455 :     /* shouldn't happen; ML side assures this */
456 :     Error(too_many_args);
457 :     }
458 :     return ret;
459 :     }
460 :    
461 :     /* call_float_fn
462 :     */
463 :     PVT float call_float_fn(float (*f)(),int n,Word_t *args)
464 :     {
465 :     float ret;
466 :    
467 :     switch(n) {
468 :     case 0:
469 :     ret = (*f)();
470 :     break;
471 :     case 1:
472 :     ret = (*f)(args[0]);
473 :     break;
474 :     case 2:
475 :     ret = (*f)(args[0],args[1]);
476 :     break;
477 :     case 3:
478 :     ret = (*f)(args[0],args[1],args[2]);
479 :     break;
480 :     case 4:
481 :     ret = (*f)(args[0],args[1],args[2],args[3]);
482 :     break;
483 :     case 5:
484 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4]);
485 :     break;
486 :     case 6:
487 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
488 :     args[5]);
489 :     break;
490 :     case 7:
491 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
492 :     args[5],args[6]);
493 :     break;
494 :     case 8:
495 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
496 :     args[5],args[6],args[7]);
497 :     break;
498 :     case 9:
499 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
500 :     args[5],args[6],args[7],args[8]);
501 :     break;
502 :     case 10:
503 :     ret = (*f)(args[0],args[1],args[2],args[3],args[4],
504 :     args[5],args[6],args[7],args[8],args[9]);
505 :     break;
506 :     default:
507 :     /* shouldn't happen; ML side assures this */
508 :     Error(too_many_args);
509 :     }
510 :     return ret;
511 :     }
512 :    
513 :     /* error handling */
514 :    
515 :     #define NO_ERR 0
516 :     #define ERR_TYPEMISMATCH 1
517 :     #define ERR_EMPTY_AGGREGATE 2
518 :     #define ERR_SZ_MISMATCH 3
519 :     #define ERR_WRONG_ARG_COUNT 4
520 :     #define ERR_TOO_MANY_ARGS 5
521 :    
522 :     PVT char *errtbl[] = {
523 :     "no error",
524 :     "type mismatch",
525 :     "empty aggregate",
526 :     "array/vector size does not match registered size",
527 :     "wrong number of args in C call",
528 :     "current max of 10 args to C fn",
529 :     };
530 :    
531 :     PVT char errbuf[100];
532 :    
533 :     PVT ml_val_t RaiseError(ml_state_t *msp,int err)
534 :     {
535 :     sprintf(errbuf,"SML/NJ-C-Interface: %s",errtbl[err]);
536 : monnier 8 return RAISE_ERROR(msp, errbuf);
537 : monnier 2 }
538 :    
539 :    
540 :     /* char *nextdatum(char *t)
541 :     *
542 :     * must match typeToCtl in c-calls.sml
543 :     */
544 :     PVT char *nextdatum(char *t)
545 :     {
546 :     int level = 0;
547 :    
548 :     do {
549 :     switch(*t) {
550 :     case MLFUNCTION_CODE: {
551 :     int nargs, i;
552 :    
553 :     t++; /* skip code */
554 :     nargs = extractUnsigned((unsigned char **)&t,1);
555 :     /* skip arg types AND return type */
556 :     for (i = 0; i < nargs+1; i++) {
557 :     t = nextdatum(t);
558 :     }
559 :     }
560 :     break;
561 :     case MLPTR_CODE:
562 :     /* can fall through as long as Cptr has 4 bytes of sz info */
563 :     case MLARRAY_CODE:
564 :     case MLVECTOR_CODE:
565 :     t = nextdatum(t+5); /* skip 4 bytes of sz info & code */
566 :     break;
567 :     case MLOPENUNION_CODE:
568 :     t++; /* skip 1 byte of sz info ; fall through */
569 :     case MLOPENSTRUCT_CODE:
570 :     t++; /* skip code */
571 :     level++;
572 :     break;
573 :     case MLCLOSEUNION_CODE:
574 :     case MLCLOSESTRUCT_CODE:
575 :     t++; /* skip code */
576 :     level--;
577 :     break;
578 :     case MLINT_CODE:
579 :     case MLSHORT_CODE:
580 :     case MLLONG_CODE:
581 :     /* skip 1 byte of size; fall through */
582 :     t++;
583 :     default:
584 :     t++; /* skip simple type */
585 :     break;
586 :     }
587 :     } while (level);
588 :     return t;
589 :     }
590 :    
591 :     PVT void mkCint(Word_t src,Word_t **dst,int bytes)
592 :     {
593 :     #ifdef DEBUG_C_CALLS
594 :     SayDebug("mkCint: placing integer into %d bytes at %x\n", bytes, *dst);
595 :     #endif
596 :    
597 : monnier 106 #ifdef BYTE_ORDER_BIG
598 : monnier 2 src <<= (sizeof(Word_t) - bytes)*8;
599 : monnier 106 #endif
600 : monnier 2 memcpy (*dst, &src, bytes);
601 :     (*(Byte_t **)dst) += bytes;
602 :     }
603 :    
604 :     PVT void mkMLint(Word_t **src,Word_t *dst,int bytes)
605 :     {
606 :     #ifdef DEBUG_C_CALLS
607 :     SayDebug("mkMLint: reading integer from %x into %d bytes\n", *src, bytes);
608 :     #endif
609 :    
610 :     memcpy (dst, *src, bytes);
611 : monnier 106 #ifdef BYTE_ORDER_BIG
612 : monnier 2 *dst >>= (sizeof(Word_t) - bytes)*8;
613 : monnier 106 #endif
614 : monnier 2 *(Byte_t **)src += bytes;
615 :     }
616 :    
617 :    
618 :     #define DO_PAD(p,t) (*(Byte_t **)(p) += extractUnsigned((unsigned char **)(t),1))
619 :     #define IF_PAD_DO_PAD(p,t) {if (**t == MLPAD_CODE) {++(*t); DO_PAD(p,t);}}
620 :    
621 :     int datumMLtoC(ml_state_t *msp,char **t,Word_t **p,ml_val_t datum)
622 :     {
623 :     int tag = REC_SELINT(datum,0);
624 :     ml_val_t val = REC_SEL(datum,1);
625 :     int err = NO_ERR;
626 :     int sz = 0;
627 :    
628 :     while (**t == MLPAD_CODE) {
629 :     ++(*t); /* advance past code */
630 :     #ifdef DEBUG_C_CALLS
631 :     SayDebug("datumMLtoC: adding pad from %x ", *p);
632 :     #endif
633 :     DO_PAD(p,t);
634 :     #ifdef DEBUG_C_CALLS
635 :     SayDebug(" to %x\n", *p);
636 :     #endif
637 :     }
638 :     if (typeMap[tag] != **t) {
639 :     #ifdef DEBUG_C_CALLS
640 :     SayDebug("datumMLtoC: type mismatch %c != %d\n",**t,tag);
641 :     #endif
642 :     return ERR_TYPEMISMATCH;
643 :     }
644 :     switch(*(*t)++) {
645 :     case MLFUNCTION_CODE: {
646 :     char *argtypes[N_ARGS], *rettype;
647 :     char *this_arg, *next_arg;
648 :     int nargs, len, i;
649 :    
650 :     nargs = extractUnsigned((unsigned char **)t,1);
651 :     #ifdef DEBUG_C_CALLS
652 :     SayDebug("datumMLtoC: function with %d args\n", nargs);
653 :     #endif
654 :     this_arg = *t;
655 :     for (i = 0; i < nargs; i++) {
656 :     next_arg = nextdatum(this_arg);
657 :     len = next_arg - this_arg;
658 :     argtypes[i] = (char *)checked_alloc(len+1); /* len plus null */
659 :     strncpy(argtypes[i],this_arg,len);
660 :     argtypes[i][len] = '\0';
661 :     this_arg = next_arg;
662 :     #ifdef DEBUG_C_CALLS
663 :     SayDebug("datumMLtoC: function arg[%d] is \"%s\"\n",
664 :     i,argtypes[i]);
665 :     #endif
666 :     }
667 :     /* get the return type */
668 :     next_arg = nextdatum(this_arg);
669 :     len = next_arg - this_arg;
670 :     rettype = (char *)checked_alloc(len+1); /* len plus null */
671 :     strncpy(rettype,this_arg,len);
672 :     rettype[len] = '\0';
673 :     #ifdef DEBUG_C_CALLS
674 :     SayDebug("datumMLtoC: function returns \"%s\"\n",
675 :     rettype);
676 :     #endif
677 :     *t = next_arg;
678 :     *(*p)++ = mk_C_function(msp,val,nargs,argtypes,rettype);
679 :     #ifdef DEBUG_C_CALLS
680 :     SayDebug("datumMLtoC: made C function\n");
681 :     #endif
682 :     }
683 :     break;
684 :     case MLPTR_CODE: {
685 :     int szb, align;
686 :     Word_t *q;
687 :    
688 :     szb = extractUnsigned((unsigned char **)t,4);
689 :     align = extractUnsigned((unsigned char **)t,1);
690 :     #ifdef DEBUG_C_CALLS
691 :     SayDebug("datumMLtoC: ptr szb=%d, align=%d\n", szb, align);
692 :     #endif
693 :     q = checked_memalign(szb,align);
694 :     keep_ptr(q);
695 :     *(*p)++ = (Word_t) q;
696 :     #ifdef DEBUG_C_CALLS
697 :     SayDebug("datumMLtoC: ptr substructure at %x\n", q);
698 :     #endif
699 :     if (err = datumMLtoC(msp,t,&q,val))
700 :     return err;
701 :     }
702 :     break;
703 :     case MLCHAR_CODE:
704 :     *(*(Byte_t **)p)++ = (Byte_t) INT_MLtoC(val);
705 :     break;
706 :     case MLFLOAT_CODE:
707 :     sz = sizeof(float);
708 :     /* fall through */
709 :     case MLDOUBLE_CODE: {
710 :     double g;
711 :    
712 :     if (!sz) {
713 :     /* came in through MLDOUBLE_CODE */
714 :     sz = sizeof(double);
715 :     }
716 :     memcpy (&g, (Word_t *)val, sizeof(double));
717 :     #ifdef DEBUG_C_CALLS
718 :     SayDebug("datumMLtoC: ML real %l.15f:%l.15f %.15f\n", *(double *)val, g, (float) g);
719 :     #endif
720 :     if (sz == sizeof(float))
721 :     *(*(float **)p)++ = (float) g;
722 :     else
723 :     *(*(double **)p)++ = g;
724 :     }
725 :     break;
726 :     case MLINT_CODE:
727 :     case MLSHORT_CODE:
728 :     case MLLONG_CODE:
729 :     #ifdef DEBUG_C_CALLS
730 :     SayDebug("datumMLtoC: integer %d\n", getWord32(val));
731 :     #endif
732 :     mkCint(getWord32(val),p,extractUnsigned((unsigned char **)t,1));
733 :     break;
734 :     case MLADDR_CODE:
735 :     #ifdef DEBUG_C_CALLS
736 :     SayDebug("datumMLtoC: addr %x\n", GET_CADDR(val));
737 :     #endif
738 :     *(*p)++ = (Word_t) GET_CADDR(val);
739 :     break;
740 :     case MLSTRING_CODE: {
741 :     char *r, *s;
742 :    
743 :     s = PTR_MLtoC(char,val);
744 :     #ifdef DEBUG_C_CALLS
745 :     SayDebug("datumMLtoC: string \"%s\"\n",s);
746 :     #endif
747 :     r = (char *) checked_alloc(strlen(s)+1);
748 :     strcpy(r,s);
749 :     keep_ptr((Word_t *) r);
750 :     *(*p)++ = (Word_t) r;
751 :     #ifdef DEBUG_C_CALLS
752 :     SayDebug("datumMLtoC: copied string \"%s\"=%x\n",r,r);
753 :     #endif
754 :     }
755 :     break;
756 :     case MLOPENSTRUCT_CODE: {
757 :     ml_val_t lp = val;
758 :     ml_val_t hd;
759 :    
760 :     #ifdef DEBUG_C_CALLS
761 :     SayDebug("datumMLtoC: struct\n");
762 :     #endif
763 :     while (**t != MLCLOSESTRUCT_CODE) {
764 :     hd = LIST_hd(lp);
765 :     if (err = datumMLtoC(msp,t,p,hd))
766 :     return err;
767 :     lp = LIST_tl(lp);
768 :     IF_PAD_DO_PAD(p,t);
769 :     }
770 :     (*t)++; /* advance past MLCLOSESTRUCT_CODE */
771 :     }
772 :     break;
773 :     case MLOPENUNION_CODE: {
774 :     Byte_t *init_p = (Byte_t *) *p;
775 :     char *next_try;
776 :    
777 :     sz = extractUnsigned((unsigned char **)t,1);
778 :     #ifdef DEBUG_C_CALLS
779 :     SayDebug("datumMLtoC: union of size %d\n", sz);
780 :     #endif
781 :     if ((**t) == MLCLOSEUNION_CODE)
782 :     return ERR_EMPTY_AGGREGATE;
783 :     next_try = nextdatum(*t);
784 :     /* try union types until one matches or all fail */
785 :     while ((err = datumMLtoC(msp,t,p,val)) == ERR_TYPEMISMATCH) {
786 :     *t = next_try;
787 :     if ((**t) == MLCLOSEUNION_CODE) {
788 :     err = ERR_TYPEMISMATCH;
789 :     break;
790 :     }
791 :     next_try = nextdatum(*t);
792 :     *p = (Word_t *) init_p;
793 :     }
794 :     if (err)
795 :     return err;
796 :     while (**t != MLCLOSEUNION_CODE)
797 :     *t = nextdatum(*t);
798 :     (*t)++; /* advance past MLCLOSEUNION_CODE */
799 :     *p = (Word_t *) (init_p + sz);
800 :     }
801 :     break;
802 :     case MLARRAY_CODE:
803 :     case MLVECTOR_CODE: {
804 :     int nelems,elem_sz, i;
805 :     char *saved_t;
806 :    
807 :     nelems = extractUnsigned((unsigned char **)t,2);
808 :     elem_sz = extractUnsigned((unsigned char **)t,2);
809 :     #ifdef DEBUG_C_CALLS
810 :     SayDebug("datumMLtoC: array/vector of %d elems of size %d\n",
811 :     nelems, elem_sz);
812 :     #endif
813 :     i = sz = OBJ_LEN(val);
814 :     #ifdef DEBUG_C_CALLS
815 :     SayDebug("datumMLtoC: array/vector size is %d\n", sz);
816 :     #endif
817 :    
818 :     if (sz != nelems)
819 :     return ERR_SZ_MISMATCH;
820 :     saved_t = *t;
821 :     while (!err && i--) {
822 :     *t = saved_t;
823 :     err = datumMLtoC(msp,t,p,*(ml_val_t *)val++);
824 :     }
825 :     if (err)
826 :     return err;
827 :     }
828 :     break;
829 :     case MLCLOSESTRUCT_CODE:
830 :     case MLCLOSEUNION_CODE:
831 :     return ERR_EMPTY_AGGREGATE;
832 :     break;
833 :     default:
834 :     Die("datumMLtoC: cannot yet handle type\n");
835 :     }
836 :     return err;
837 :     }
838 :    
839 :     /* ML entry point for 'datumMLtoC' */
840 :     ml_val_t ml_datumMLtoC(ml_state_t *msp, ml_val_t arg)
841 :     {
842 :     /* no GCs can occur since no allocation on ML heap */
843 :     /* guaranteed that datum is a pointer (Cptr or Cstring) */
844 :     char *type = REC_SELPTR(char,arg,0);
845 :     ml_val_t datum = REC_SEL(arg,1);
846 :     int err = 0;
847 :     Word_t p, *q = &p;
848 :     ml_val_t lp, ret;
849 :     ptrlist_t *saved_pl;
850 :    
851 :     save_ptrlist(&saved_pl);
852 :     err = datumMLtoC(msp,&type,&q,datum);
853 :     if (err) {
854 :     free_ptrlist();
855 :     restore_ptrlist(saved_pl);
856 :     return RaiseError(msp,err);
857 :     }
858 :     /* return (result,list of pointers to alloc'd C objects) */
859 :     spaceCheck(msp,ptrlist_space(),&dummyRoot);
860 :     lp = ptrlist_to_MLlist(msp); /* this frees the ptr descriptors */
861 :     restore_ptrlist(saved_pl);
862 :     ret = MK_CADDR(msp,(Word_t *)p);
863 :     REC_ALLOC2(msp, ret, ret, lp);
864 :     return ret;
865 :     }
866 :    
867 :     PVT ml_val_t word_CtoML(ml_state_t *msp,char **t,Word_t **p, ml_val_t *root)
868 :     {
869 :     ml_val_t ret = ML_unit;
870 :     ml_val_t mlval = ML_unit;
871 :     int tag;
872 :     char code;
873 :    
874 :     switch(code = *(*t)++) {
875 :     case MLPAD_CODE:
876 :     #ifdef DEBUG_C_CALLS
877 :     SayDebug("word_CtoML: skipping pad %x ", *p);
878 :     #endif
879 :     DO_PAD(p,t);
880 :     #ifdef DEBUG_C_CALLS
881 :     SayDebug(" to %x\n", *p);
882 :     #endif
883 :     return word_CtoML(msp,t,p,root);
884 :     case MLVOID_CODE:
885 :     return NULLARY_DATACON;
886 :     case MLCHAR_CODE:
887 :     tag = MLCHAR_TAG;
888 :     mlval = INT_CtoML(**(Byte_t **)p);
889 :     (*(Byte_t **)p)++;
890 :     break;
891 :     case MLPTR_CODE: {
892 :     Word_t q;
893 :     #ifdef DEBUG_C_CALLS
894 :     SayDebug("word_CtoML: ptr %x\n", **(Word_t ****)p);
895 :     #endif
896 :     tag = MLPTR_TAG;
897 :     #ifdef DEBUG_C_CALLS
898 :     SayDebug("word_CtoML: size is %d\n",
899 :     extractUnsigned((unsigned char **)t,4));
900 :     SayDebug("word_CtoML: align is %d\n",
901 :     extractUnsigned((unsigned char **)t,1));
902 :     #else
903 :     *t += 5; /* 5 bytes of size */
904 :     #endif
905 :     q = **p;
906 :     mlval = word_CtoML(msp,t,(Word_t **) &q,root);
907 :     (*p)++;
908 :     }
909 :     break;
910 :     case MLINT_CODE:
911 :     tag = MLINT_TAG;
912 :     goto handle_int;
913 :     case MLSHORT_CODE:
914 :     tag = MLSHORT_TAG;
915 :     goto handle_int;
916 :     case MLLONG_CODE:
917 :     tag = MLLONG_TAG;
918 :     handle_int:
919 :     {
920 :     Word_t w;
921 :    
922 :     mkMLint(p,&w,extractUnsigned((unsigned char **)t,1));
923 :     mlval = mkWord32(msp,w);
924 :     }
925 :     break;
926 :     case MLADDR_CODE: {
927 :     Word_t *cp = ** (Word_t ***) p;
928 :    
929 :     #ifdef DEBUG_C_CALLS
930 :     SayDebug("word_CtoML: C addr %x\n", cp);
931 :     #endif
932 :     tag = MLADDR_TAG;
933 :     mlval = MK_CADDR(msp,cp);
934 :     (*p)++;
935 :     }
936 :     break;
937 :     case MLFLOAT_CODE: {
938 :     /* C floats become ML reals, which are doubles... */
939 :     tag = MLFLOAT_TAG;
940 :     mlval = double_CtoML(msp,(double) *(*(float **)p)++);
941 :     #ifdef DEBUG_C_CALLS
942 :     SayDebug("word_CtoML: made float %l.15f\n", *(double*)mlval);
943 :     #endif
944 :     }
945 :     break;
946 :     case MLDOUBLE_CODE: {
947 :     tag = MLDOUBLE_TAG;
948 :     mlval = double_CtoML(msp,*(*(double **)p)++);
949 :     #ifdef DEBUG_C_CALLS
950 :     SayDebug("word_CtoML: made double %l.15f\n", *(double*)mlval);
951 :     #endif
952 :     }
953 :     break;
954 :     case MLSTRING_CODE:
955 :     #ifdef DEBUG_C_CALLS
956 :     SayDebug("word_CtoML: string \"%s\"\n", (char *)**p);
957 :     #endif
958 :     tag = MLSTRING_TAG;
959 :     spaceCheck(msp,strlen((char *)**p),root);
960 :     mlval = ML_CString(msp,(char *) **p);
961 :     (*p)++;
962 :     break;
963 :     case MLOPENSTRUCT_CODE: {
964 :     ml_val_t local_root;
965 :    
966 :     tag = MLSTRUCT_TAG;
967 :     mlval = LIST_nil;
968 :    
969 :     #ifdef DEBUG_C_CALLS
970 :     SayDebug("word_CtoML: open struct\n");
971 :     #endif
972 :     while (**t != MLCLOSESTRUCT_CODE) {
973 :     LIST_cons(msp,local_root,mlval,*root);
974 :     ret = word_CtoML(msp,t,p,&local_root);
975 :     mlval = LIST_hd(local_root);
976 :     *root = LIST_tl(local_root);
977 :     LIST_cons(msp,mlval,ret,mlval);
978 :     IF_PAD_DO_PAD(p,t);
979 :     }
980 :     (*t)++; /* advance past MLCLOSESTRUCT_CODE */
981 :     mlval = revMLList(mlval,LIST_nil);
982 :     }
983 :     break;
984 :     case MLCLOSESTRUCT_CODE:
985 :     Die("word_CtoML: found lone MLCLOSESTRUCT_CODE");
986 :     case MLARRAY_CODE:
987 :     case MLVECTOR_CODE: {
988 :     int szb;
989 :     char *saved_t;
990 :     ml_val_t res,local_root;
991 :     int n,i;
992 :     Word_t dtag;
993 :    
994 :     tag = (code == MLARRAY_CODE) ? MLARRAY_TAG : MLVECTOR_TAG;
995 :     dtag = (code == MLARRAY_CODE) ? DTAG_array : DTAG_vector;
996 :     n = extractUnsigned((unsigned char **)t,2); /* number of elements */
997 :     szb = extractUnsigned((unsigned char **)t,2);/* element sz (bytes)*/
998 :     #ifdef DEBUG_C_CALLS
999 :     SayDebug("word_CtoML: array/vector with %d elems of size %d\n", n, szb);
1000 :     #endif
1001 :     saved_t = *t;
1002 :     spaceCheck(msp,szb*n,root);
1003 :     /* ML_AllocArray isn't used here since it might call GC */
1004 :     ML_AllocWrite (msp, 0, MAKE_DESC(n,dtag));
1005 :     mlval = ML_Alloc (msp, n);
1006 :     /* clear the array/vector so that it can be GC'd if necessary */
1007 :     for (i = 0; i < n; i++) {
1008 :     PTR_MLtoC(ml_val_t,mlval)[i] = ML_unit;
1009 :     }
1010 :     for (i = 0; i < n; i++) {
1011 :     *t = saved_t;
1012 :     LIST_cons(msp,local_root,mlval,*root);
1013 :     res = word_CtoML(msp,t,p,&local_root);
1014 :     mlval = LIST_hd(local_root);
1015 :     *root = LIST_tl(local_root);
1016 :     PTR_MLtoC(ml_val_t,mlval)[i] = res;
1017 :     }
1018 :     }
1019 :     break;
1020 :     default:
1021 :     #ifdef DEBUG_C_CALLS
1022 :     SayDebug("word_CtoML: bad type is '%c'\n", *(*t-1));
1023 :     #endif
1024 :     Die("word_CtoML: cannot yet handle type\n");
1025 :     }
1026 :     REC_ALLOC2(msp,ret,INT_CtoML(tag),mlval);
1027 :     return ret;
1028 :     }
1029 :    
1030 :     /* static c-calls-fns.c needs to see this */
1031 :     ml_val_t datumCtoML(ml_state_t *msp, char *type, Word_t p, ml_val_t *root)
1032 :     {
1033 :     ml_val_t ret;
1034 :    
1035 :     #ifdef DEBUG_C_CALLS
1036 :     SayDebug("datumCtoML: C address is %x\n", p);
1037 :     #endif
1038 :    
1039 :     #ifdef DEBUG_C_CALLS
1040 :     SayDebug("datumCtoML: type is %s\n", type);
1041 :     #endif
1042 :    
1043 :     switch (*type) {
1044 :     case MLDOUBLE_CODE:
1045 :     ret = double_CtoML(msp, *(double *)p);
1046 :     REC_ALLOC2(msp,ret,INT_CtoML(MLDOUBLE_TAG),ret);
1047 :     break;
1048 :     case MLFLOAT_CODE:
1049 :     ret = double_CtoML(msp, (double) (*(float *)p));
1050 :     REC_ALLOC2(msp,ret,INT_CtoML(MLFLOAT_TAG),ret);
1051 :     break;
1052 :     default: {
1053 :     Word_t *q = &p;
1054 :     ret = word_CtoML(msp,&type,&q,root);
1055 :     }
1056 :     break;
1057 :     }
1058 :     #ifdef DEBUG_C_CALLS
1059 :     SayDebug("datumCtoML: returning\n");
1060 :     #endif
1061 :     return ret;
1062 :     }
1063 :    
1064 :    
1065 :     /* ML entry point for 'datumCtoML' */
1066 :     ml_val_t ml_datumCtoML(ml_state_t *msp, ml_val_t arg)
1067 :     {
1068 :     /* make copies of things that GC may move */
1069 :     char *type = mk_strcpy(REC_SELPTR(char,arg,0));
1070 :     Word_t *caddr = GET_CADDR(REC_SEL(arg,1));
1071 :     ml_val_t ret;
1072 :    
1073 :     ret = datumCtoML(msp,type,(Word_t) caddr,&arg);
1074 : monnier 8 FREE(type);
1075 : monnier 2 return ret;
1076 :     }
1077 :    
1078 :    
1079 :     /* ML entry point for 'c_call' */
1080 :     ml_val_t ml_c_call(ml_state_t *msp, ml_val_t arg)
1081 :     {
1082 :     #if !defined(INDIRECT_CFUNC)
1083 :     Word_t (*f)() = (Word_t (*)())
1084 :     REC_SELPTR(Word_t,arg,0);
1085 :     #else
1086 :     Word_t (*f)() = (Word_t (*)())
1087 :     ((cfunc_binding_t *)REC_SELPTR(Word_t,arg,0))->cfunc;
1088 :     #endif
1089 :     int n_cargs = REC_SELINT(arg,1);
1090 :     ml_val_t carg_types = REC_SEL(arg,2); /* string list */
1091 :     char *cret_type = REC_SELPTR(char,arg,3);
1092 :     ml_val_t cargs = REC_SEL(arg,4); /* cdata list */
1093 :     bool_t auto_free = REC_SELINT(arg,5);
1094 :     ptrlist_t *saved_pl;
1095 :    
1096 :     ml_val_t p,q;
1097 :     ml_val_t ret;
1098 :     int i;
1099 :     Word_t vals[N_ARGS];
1100 :     Word_t w;
1101 :     int err = NO_ERR;
1102 :    
1103 :     if (n_cargs > N_ARGS) /* shouldn't see this; ML side insures this */
1104 :     return RaiseError(msp,ERR_TOO_MANY_ARGS);
1105 :    
1106 :     /* save the ptrlist since C can call ML can call C ... */
1107 :     save_ptrlist(&saved_pl);
1108 :    
1109 :     p = carg_types;
1110 :     q = cargs;
1111 :     i = 0;
1112 :     while (p != LIST_nil && q != LIST_nil) {
1113 :     char *carg_type = PTR_MLtoC(char,LIST_hd(p));
1114 :     Word_t *vp;
1115 :    
1116 :     #ifdef DEBUG_C_CALLS
1117 :     SayDebug("ml_c_call: arg %d:\"%s\"\n",i,carg_type);
1118 :     #endif
1119 :    
1120 :     vp = &vals[i];
1121 :     if (err = datumMLtoC(msp,&carg_type,&vp,LIST_hd(q)))
1122 :     break;
1123 :     i++;
1124 :     p = LIST_tl(p);
1125 :     q = LIST_tl(q);
1126 :     }
1127 :     #ifdef DEBUG_C_CALLS
1128 :     SayDebug("ml_c_call: rettype is \"%s\"\n", cret_type);
1129 :     #endif
1130 :    
1131 :     /* within ml_c_call, no ML allocation occurs above this point */
1132 :    
1133 :     if (!err && (i != n_cargs))
1134 :     err = ERR_WRONG_ARG_COUNT;
1135 :     if (err) {
1136 :     free_ptrlist();
1137 :     restore_ptrlist(saved_pl);
1138 :     return RaiseError(msp,err);
1139 :     }
1140 :     #ifdef DEBUG_C_CALLS
1141 :     SayDebug("ml_c_call: calling C function at %x\n", f);
1142 :     #endif
1143 :    
1144 :     /* expose msp so C has access to it */
1145 :     visible_msp = msp;
1146 :     switch (*cret_type) {
1147 :     case MLDOUBLE_CODE:
1148 :     ret = double_CtoML(msp,call_double_fn((double (*)())f,n_cargs,vals));
1149 :     REC_ALLOC2(msp,ret,INT_CtoML(MLDOUBLE_TAG),ret);
1150 :     break;
1151 :     case MLFLOAT_CODE:
1152 :     ret = double_CtoML(msp,
1153 :     (double) call_float_fn((float(*)())f,n_cargs,vals));
1154 :     REC_ALLOC2(msp,ret,INT_CtoML(MLFLOAT_TAG),ret);
1155 :     break;
1156 :     case MLCHAR_CODE: {
1157 :     Byte_t b = (Byte_t) call_word_fn(f,n_cargs,vals);
1158 :     Byte_t *bp = &b;
1159 :    
1160 :     ret = word_CtoML(msp,&cret_type,(Word_t **)&bp,&dummyRoot);
1161 :     }
1162 :     break;
1163 :     default: {
1164 :     Word_t w = call_word_fn(f,n_cargs,vals);
1165 :     Word_t *wp = &w;
1166 :    
1167 :     ret = word_CtoML(msp,&cret_type,&wp,&dummyRoot);
1168 :     }
1169 :     }
1170 :     #ifdef DEBUG_C_CALLS
1171 :     SayDebug("ml_c_call: returned from C function\n");
1172 :     #endif
1173 :    
1174 :     #ifdef DEBUG_C_CALLS
1175 :     SayDebug("ml_c_call: auto_free is %d\n",auto_free);
1176 :     #endif
1177 :    
1178 :     /* setup the return value, always a pair */
1179 :     {
1180 :     ml_val_t lp = LIST_nil;
1181 :    
1182 :     if (auto_free) {
1183 :     #ifdef DEBUG_C_CALLS
1184 :     SayDebug("ml_c_call: performing auto-free\n");
1185 :     #endif
1186 :    
1187 :     free_ptrlist();
1188 :     } else {
1189 :     /* return (result,list of pointers to alloc'd C objects) */
1190 :     #ifdef DEBUG_C_CALLS
1191 :     SayDebug("ml_c_call: returning list of caddrs\n");
1192 :     #endif
1193 :     spaceCheck(msp,ptrlist_space(),&ret);
1194 :     lp = ptrlist_to_MLlist(msp); /* this frees the ptr descriptors */
1195 :     }
1196 :     REC_ALLOC2(msp, ret, ret, lp);
1197 :     }
1198 :     restore_ptrlist(saved_pl); /* restore the previous ptrlist */
1199 :     return ret;
1200 :     }
1201 :    
1202 :    
1203 :     /* end of c-calls.c */

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0