Annotation of rpl/modules/sets/types.rplc, revision 1.6
1.1 bertrand 1: #define TYPE_DECLARATION
2: #include "src/rplexternals.h"
3: #include "sets.h"
4:
5: // Les objets de type ensemble sont délimités par ([ ]) et ne contiennent
6: // que des entiers.
7:
1.2 bertrand 8: // Attention : ces fonctions sont à écrire directement en C et non
9: // en RPL/C car elles interviennent dans le noyau RPL/2.
10:
1.4 bertrand 11: /*
12: ================================================================================
13: Fonction permettant d'extraire un objet d'une suite de caractères
14:
15: Cette fonction est utilisée par la routine recherche_instruction_suivante()
16: du RPL/2.
17: ================================================================================
18: */
19:
1.1 bertrand 20: declareTypeExtension(parse)
21: if ((*rptr) == '(')
22: {
23: rptr++;
24:
25: if ((*rptr) == '[')
26: {
27: rptr++;
28: while((*rptr) != 0)
29: {
30: switch (*rptr)
31: {
32: case '0':
33: case '1':
34: case '2':
35: case '3':
36: case '4':
37: case '5':
38: case '6':
39: case '7':
40: case '8':
41: case '9':
42: case ' ':
43: {
44: break;
45: }
46:
47: case ']':
48: {
49: rptr++;
50:
51: if ((*rptr) == ')')
52: {
53: rptr++;
54: return(sizeOfParse);
55: }
56: else
57: {
58: parseError;
59: }
60: }
61:
62: default:
63: {
64: parseError;
65: }
66: }
67:
68: rptr++;
69: }
70: }
71: }
1.6 ! bertrand 72:
! 73: parseError;
1.1 bertrand 74: endTypeExtension
75:
1.4 bertrand 76:
77: /*
78: ================================================================================
79: La fonction declareTypeExtension(new) est utilisée par la fonction
80: recherche_type() du RPL/2. Elle se charge d'allouer et d'initialiser
81: le champ objet de la struct_objet allouée par recherche_type().
82: ================================================================================
83: */
84:
1.3 bertrand 85: static int
86: fonction_ordre(const void *a, const void *b)
87: {
88: if ((*((integer8 *) a)) < (*((integer8 *) b)))
89: {
90: return(-1);
91: }
92: if ((*((integer8 *) a)) > (*((integer8 *) b)))
93: {
94: return(1);
95: }
96:
97: return(0);
98: }
99:
1.1 bertrand 100: declareTypeExtension(new)
1.2 bertrand 101: // Si le premier caractère de la chaîne est '(' et que le dernier est ')',
102: // on les retire.
103:
1.3 bertrand 104: char *tmp;
105:
106: integer8 current_value;
107: integer8 i;
108: integer8 j;
109: integer8 nb_elements;
110: integer8 *vecteur;
1.2 bertrand 111:
112: if (((*iptr) == '(') && ((*(iptr + strlen(iptr) - 1)) == ')'))
113: {
114: if ((tmp = malloc((strlen(iptr) + 1) * sizeof(unsigned char)))
115: == NULL)
116: {
1.4 bertrand 117: typeSystemError;
1.2 bertrand 118: }
119:
120: // Sauvegarde de l'instruction courante.
121: strcpy(tmp, iptr);
122:
123: // Création d'une nouvelle instruction courante amputée de ses premier
124: // et dernier caractères.
125: memmove(iptr, iptr + 1, strlen(iptr) - 2);
126: *(iptr + strlen(iptr) - 2) = 0;
127:
1.4 bertrand 128: searchType(strcpy(iptr, tmp), free(tmp));
1.2 bertrand 129:
130: // Restauration de l'instruction courante
1.4 bertrand 131: strcpy(iptr, tmp);
132: free(tmp);
1.2 bertrand 133:
1.4 bertrand 134: // On doit avoir un vecteur d'entiers au niveau 1 de la pile.
1.3 bertrand 135: // Si ce n'est pas le cas, il y a une erreur.
136:
137: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != VIN)
138: {
139: typeError;
140: }
141:
142: nb_elements = (*((struct_vecteur *) (*(*(*s_etat_processus)
143: .l_base_pile).donnee).objet)).taille;
144:
145: if (nb_elements > 0)
146: {
147: if ((vecteur = malloc(nb_elements * sizeof(integer8))) == NULL)
148: {
1.4 bertrand 149: typeSystemError;
1.3 bertrand 150: }
151:
152: for(i = 0; i < nb_elements; i++)
153: {
154: vecteur[i] = ((integer8 *) (*((struct_vecteur *)
155: (*(*(*s_etat_processus)
156: .l_base_pile).donnee).objet)).tableau)[i];
157: }
158:
159: qsort(vecteur, nb_elements, sizeof(integer8), fonction_ordre);
160:
161: // Élimination des doublons
162:
163: current_value = vecteur[0];
164:
165: for(i = 1, j = 1; i < nb_elements; i++)
166: {
167: if (vecteur[i] != current_value)
168: {
169: vecteur[j++] = vecteur[i];
170: current_value = vecteur[i];
171: }
172: }
173:
174: nb_elements = j;
175:
176: if ((vecteur = realloc(vecteur, nb_elements * sizeof(integer8)))
177: == NULL)
178: {
1.4 bertrand 179: typeSystemError;
1.3 bertrand 180: }
181: }
182: else
183: {
184: // cas de l'ensemble vide
185: if ((vecteur = malloc(0)) == NULL)
186: {
1.4 bertrand 187: typeSystemError;
1.3 bertrand 188: }
189: }
190:
191: if (((*arg) = malloc(sizeof(set_t))) == NULL)
1.2 bertrand 192: {
1.4 bertrand 193: typeSystemError;
1.2 bertrand 194: }
195:
1.3 bertrand 196: (**((set_t **) arg)).size = nb_elements;
197: (**((set_t **) arg)).values = vecteur;
198:
1.2 bertrand 199: instruction_drop(s_etat_processus);
200: typeFound(ISET);
201: }
202:
203: typeError;
1.1 bertrand 204: endTypeExtension
205:
1.4 bertrand 206:
207: /*
208: ================================================================================
209: Fonction de duplication d'un objet.
210:
211: Cet objet doit être alloué puis copié.
212: ================================================================================
213: */
214:
1.3 bertrand 215: declareTypeExtension(dup)
216: integer8 i;
217:
218: struct_objet *n_arg;
219:
220: if ((n_arg = allocation(s_etat_processus, EXT)) == NULL)
221: {
1.4 bertrand 222: typeSystemError;
1.3 bertrand 223: }
224:
225: if (((*n_arg).objet = malloc(sizeof(set_t))) == NULL)
226: {
1.4 bertrand 227: typeSystemError;
1.3 bertrand 228: }
229:
230: (*((set_t *) ((*n_arg).objet))).size = (*((set_t *) (**((struct_objet **)
231: arg)).objet)).size;
232: (*n_arg).descripteur_bibliotheque =
233: (**((struct_objet **) arg)).descripteur_bibliotheque;
234: (*n_arg).extension_type =
235: (**((struct_objet **) arg)).extension_type;
236:
1.5 bertrand 237: if (((*((set_t *) ((*n_arg).objet))).values = malloc((*((set_t *)
238: ((*n_arg).objet))).size * sizeof(integer8))) == NULL)
239: {
240: typeSystemError;
241: }
242:
1.3 bertrand 243: for(i = 0; i < (*((set_t *) (**((struct_objet **) arg)).objet)).size; i++)
244: {
245: (*((set_t *) ((*n_arg).objet))).values[i] =
246: (*((set_t *) (**((struct_objet **) arg)).objet)).values[i];
247: }
248:
1.5 bertrand 249: (*((struct_objet **) arg)) = n_arg;
1.3 bertrand 250: typeSuccess;
251: endTypeExtension
252:
1.4 bertrand 253:
254: /*
255: ================================================================================
256: Fonction de libération d'un objet. À l'instar de la fonction new qui n'alloue
257: pas la struct_objet, la fonction drop ne doit pas la libérer.
258: ================================================================================
259: */
260:
1.3 bertrand 261: declareTypeExtension(drop)
262: free((*((set_t *) (**((struct_objet **) arg)).objet)).values);
263: free((**((struct_objet **) arg)).objet);
264: typeSuccess;
265: endTypeExtension
266:
1.4 bertrand 267:
268: /*
269: ================================================================================
270: Fonction créant une chaîne de caractère depuis l'objet pour affichage
271: ================================================================================
272: */
273:
1.2 bertrand 274: declareTypeExtension(disp)
1.4 bertrand 275: int i;
276:
277: string e;
278: string s;
279: string t;
280:
281: if ((s = malloc(3 * sizeof(unsigned char))) == NULL)
282: {
283: typeSystemError;
284: }
285:
286: strcpy(s, "([");
287:
288: for(i = 0; i < (*((set_t *) (*((struct_objet *) (*arg))).objet)).size; i++)
289: {
290: if ((e = (string) integerFormat(&((*((set_t *)
291: (*((struct_objet *) (*arg))).objet)).values[i]))) == NULL)
292: {
293: typeSystemError;
294: }
295:
296: t = s;
297:
298: if ((s = malloc((strlen(t) + strlen(e) + 2) * sizeof(unsigned char)))
299: == NULL)
300: {
301: typeSystemError;
302: }
303:
304: strcpy(s, t);
305: free(t);
306: strcat(s, " ");
307: strcat(s, e);
308: free(e);
309: }
310:
311: t = s;
312:
313: if ((s = malloc((strlen(t) + 4) * sizeof(unsigned char))) == NULL)
314: {
315: typeSystemError;
316: }
317:
318: strcpy(s, t);
319: free(t);
320: strcat(s, " ])");
321:
322: (*arg) = s;
1.3 bertrand 323: typeSuccess;
1.1 bertrand 324: endTypeExtension
325:
1.4 bertrand 326: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to types.rplc CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / modules / sets