1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
/*
* Copyright 1996 Thierry Bousch
* Licensed under the Gnu Public License, Version 2
*
* $Id: promote.c,v 2.4 1996/09/14 09:41:55 bousch Exp $
*
* Conversions (called promotions) between math-types.
*/
#include <stdio.h>
#include <stdlib.h>
#include "saml.h"
#include "saml-errno.h"
#include "saml-util.h"
#include "mnode.h"
#define HASHSIZE 59
#define HASH(t1,t2) ((unsigned)(t1^t2) % HASHSIZE)
typedef s_mnode* (*CV_routine)(s_mnode*, s_mnode*);
struct pr_data {
struct pr_data *next;
int t1, t2;
CV_routine cvr;
};
static struct pr_data *htable[HASHSIZE];
static CV_routine get_CV_routine (int t1, int t2)
{
int h = HASH(t1,t2);
struct pr_data *p;
for (p = htable[h]; p; p = p->next)
if (p->t1 == t1 && p->t2 == t2)
return p->cvr;
return NULL;
}
void register_CV_routine (int t1, int t2, void* fn)
{
int h;
struct pr_data *p;
char msg[100];
if (t1 != -1 && !MTYPE_OK(t1)) {
sprintf(msg, "math type %d out of bounds", t1);
saml_panic(msg);
}
if (!MTYPE_OK(t2)) {
sprintf(msg, "math type %d out of bounds", t2);
saml_panic(msg);
}
if (get_CV_routine(t1,t2)) {
sprintf(msg, "conversion function %d->%d already registered",
t1, t2);
saml_panic(msg);
}
#ifdef DEBUG_MTYPES
if (getenv("DEBUG_MTYPES"))
fprintf(stderr, " Conversion %d->%d\n", t1, t2);
#endif
p = malloc(sizeof(struct pr_data));
if (p == NULL)
panic_out_of_memory();
h = HASH(t1,t2);
p->next = htable[h];
htable[h] = p;
p->t1 = t1;
p->t2 = t2;
p->cvr = fn;
}
static s_mnode* promote3 (s_mnode* start, int t2, s_mnode* model)
{
int t1 = start->type;
CV_routine fn;
s_mnode *u, *v;
/*
* First attempt: is there a function to convert from t1 to t2 ?
* if yes, just call it.
*/
if ((fn = get_CV_routine(t1,t2)) != NULL)
return (*fn)(start, model);
/*
* If t1=t2, when we assume that no conversion is necessary,
* otherwise a conversion routine would have been available.
* For the same reason, don't touch "Void" objects.
*/
if (t1 == t2 || t1 == ST_VOID)
return copy_mnode(start);
/*
* Perhaps a generic conversion routine to type t2 ?
*/
if ((fn = get_CV_routine(-1,t2)) != NULL) {
u = (*fn)(start, model);
if (u->type == t2) return u;
unlink_mnode(u);
}
/*
* Last attempt: call mnode_make() to get an object of type t2,
* and then promote it to the model, which has the same type.
*/
u = mnode_make(t2, start);
if (u->type == t2)
v = promote3(u, t2, model);
else
v = mnode_error(SE_ICAST, "promote");
unlink_mnode(u);
return v;
}
s_mnode* mnode_promote (s_mnode* from, s_mnode* to)
{
return promote3(from, to->type, to);
}
s_mnode* mnode_cast (s_mnode* from, int typeid)
{
return promote3(from, typeid, NULL);
}
|
