Annotation of rpl/src/rplexternals.h, revision 1.4
1.1 bertrand 1: /*
2: ================================================================================
1.4 ! bertrand 3: RPL/2 (R) version 4.0.12
1.1 bertrand 4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #ifndef INCLUSION_RPLARGS
24: # define INCLUSION_RPLARGS
25:
26: /*
27: ================================================================================
28: INCLUSIONS
29: ================================================================================
30: */
31:
32: # define RPLARGS
33: # define struct_processus void
34: # include "rpl.h"
35:
36: /*
37: ================================================================================
38: MACROS SPECIFIQUES
39: ================================================================================
40: */
41:
42: #define allocation(a) allocation((*rpl_arguments).s_etat_processus, a)
43: #define copie_objet(a, b) copie_objet((*rpl_arguments).s_etat_processus, a, b)
44: #define liberation(a) liberation((*rpl_arguments).s_etat_processus, a)
45:
46: /*
47: --------------------------------------------------------------------------------
48: Types
49: --------------------------------------------------------------------------------
50: */
51:
52: #define declareObject(object) struct_objet *object = NULL
53: #define declareInteger(integer) integer8 integer
54: #define declareReal(real) real8 real
55: #define declareComplex(complex) complex16 complex
56: #define declareDaisyChain(daisyChain) struct_liste_chainee *daisyChain = NULL
57:
58: #define getDaisyChainFromList(list, daisyChain) { \
59: typeof(list) __list = list; \
60: daisyChain = NULL; \
61: ifIsList(__list) { daisyChain = (*__list).objet; } \
62: else executionError("Type mistmatch error"); } while(0)
63:
64: #define fetchElementFromDaisyChain(daisyChain) \
65: ({ typeof(daisyChain) __daisyChain = daisyChain; \
66: if (__daisyChain == NULL) executionError("End of daisy chain"); \
67: (__daisyChain == NULL) ? NULL : (*__daisyChain).donnee; })
68:
69: #define replaceElementIntoDaisyChain(daisyChain, element) \
70: do { typeof(daisyChain) __daisyChain = daisyChain; \
71: if (__daisyChain == NULL) executionError("Nullified daisy chain"); \
72: (*__daisyChain).donnee = element; } while(0)
73:
74: #define nextElementOfDaisyChain(daisyChain) \
75: ({ typeof(daisyChain) __daisyChain = daisyChain; \
76: if (__daisyChain == NULL) executionError("End of daisy chain"); \
77: (__daisyChain == NULL) ? NULL : (*__daisyChain).suivant; })
78:
79: #define null NULL
80: #define nullify(ptr) { ptr = NULL; } while(0)
81: #define nullified(ptr) ((ptr) == NULL)
82:
83: #define postIncr(x) (x++)
84: #define preIncr(x) (++x)
85: #define postDecr(x) (x--)
86: #define preDecr(x) (--x)
87:
88: #define eq ==
89: #define ne !=
90: #define ge >=
91: #define gt >
92: #define le <=
93: #define lt <
94: #define not !
95: #define and &&
96: #define or ||
97: #define false 0
98: #define true -1
99:
100: #define setFalse(a) a = false
101: #define setTrue(a) a = true
102:
103: #define logical int
104: #define string char *
105: #define integer int
106:
107: #define declareStructure typedef struct {
108: #define declareUnion typedef union {
109: #define as(name) } name;
110:
111: #define target(a) (*a)
112: #define address(a) (&a)
113:
114: #define beginGroup {
115: #define endGroup }
116: #define beginMacro beginGroup
117: #define endMacro endGroup while(0)
118: #define stopRequest test_arret((*rpl_arguments).s_etat_processus)
119:
120: /*
121: --------------------------------------------------------------------------------
122: Constructeurs
123: --------------------------------------------------------------------------------
124: */
125:
126: #define HEADER \
127: int __constante; \
128: logical1 __evaluation; \
129: logical1 __validation_instruction = d_faux; \
130: logical1 __presence_aide = d_faux; \
131: logical1 __presence_validation = d_faux; \
132: unsigned char __indice_bit; \
133: unsigned char __indice_bloc; \
134: unsigned char __taille_bloc; \
135: unsigned char __type; \
136: t_8_bits __masque; \
137: { \
138: (*rpl_arguments).instruction_valide = 'Y'; \
139: (*rpl_arguments).erreur = 0; \
140: __constante = 0; \
141: __evaluation = d_faux;
142:
143: #define FUNCTION \
144: if (__validation_instruction == d_vrai) return; \
145: if (__presence_aide == d_faux) \
146: { \
147: systemError("Help string not defined"); \
148: } \
149: else if (__presence_validation == d_faux) \
150: { \
151: systemError("Number of arguments not defined"); \
152: } \
153: __indice_bit = 0; \
154: __indice_bloc = 0; \
155: __taille_bloc = 0; \
156: __type = 0; \
157: __masque = 0; \
158: {
159:
160: #define END \
161: strcpy((char *) __function_name, ""); \
162: if (__constante != 0) \
163: systemError("Constant definition error"); \
164: } } \
165: return;
166:
167: /*
168: --------------------------------------------------------------------------------
169: Déclaration des fonctions externes
170: --------------------------------------------------------------------------------
171: */
172:
173: #define declareExternalFunction(name) \
174: void __external_##name(struct_rpl_arguments *rpl_arguments) { \
175: char __function_name[] = "__external_"#name;
176:
177: #define useExternalFunction(function) \
178: void __external_##function(struct_rpl_arguments *rpl_arguments)
179:
180: #define libraryName(name) char __library_name[] = #name;
181:
182: #define __onLoading void __runOnLoading(struct_rpl_arguments *rpl_arguments)
183: #define __onClosing void __runOnClosing(struct_rpl_arguments *rpl_arguments)
184: #define declareSubroutine(when) __##when { \
185: char __function_name[] = #when; \
186: HEADER \
187: declareHelpString(""); \
188: numberOfArguments(0); \
189: FUNCTION
190: #define endSubroutine END }
191:
192: #define notice(s, ...) do { ufprintf(s, __VA_ARGS__); fflush(s); } while(0)
193: #define logger(...) do { syslog(LOG_NOTICE, __VA_ARGS__); } while(0)
194:
195: #define exportExternalFunctions(...) \
196: char **__external_symbols(unsigned long *nb_symbols) { \
197: char arguments[] = #__VA_ARGS__; \
198: char **tableau; \
199: char *ptr1, *ptr2; \
200: int drapeau; \
201: unsigned long i; \
202: (*nb_symbols) = 0; ptr1 = arguments; drapeau = 0; \
203: while((*ptr1) != 0) \
204: { \
205: if (((*ptr1) != ',') && ((*ptr1) != ' ')) drapeau = -1; \
206: ptr1++; \
207: } \
208: if (drapeau == 0) return(NULL); \
209: ptr1 = arguments; (*nb_symbols) = 1; \
210: while((*ptr1) != 0) if ((*ptr1++) == ',') (*nb_symbols)++; \
211: if ((tableau = malloc((*nb_symbols) * sizeof(char *))) == NULL) \
212: return(NULL); \
213: ptr2 = arguments; i = 0; \
214: while(*ptr2 != 0) \
215: { \
216: while(((*ptr2) == ' ') || ((*ptr2) == ',')) ptr2++; \
217: ptr1 = ptr2; \
218: while(((*ptr2) != 0) && ((*ptr2) != ',') && ((*ptr2) != ' ')) \
219: ptr2++; \
220: if ((tableau[i] = malloc((ptr2 + 2 + \
221: strlen(__library_name) - ptr1) * \
222: sizeof(unsigned char))) == NULL) \
223: return(NULL); \
224: sprintf(tableau[i], "%s$", __library_name); \
225: strncat(&tableau[i][strlen(tableau[i])], ptr1, ptr2 - ptr1); \
226: i++; \
227: if ((*ptr2) != 0) \
228: { \
229: while((*ptr2) == ' ') ptr2++; \
230: if ((*ptr2) == ',') ptr2++; \
231: } \
232: } \
233: (*nb_symbols) = i; \
234: return(tableau); \
235: }
236:
237: #define endExternalFunction return; }
238:
239: #define callExternalFunction(function) { \
240: __taille_bloc = sizeof(t_8_bits) * 8; \
241: __indice_bloc = (35 - 1) / __taille_bloc; \
242: __indice_bit = (35 - 1) % __taille_bloc; \
243: __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
244: __evaluation = ((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) \
245: ? d_vrai : d_faux; \
246: __masque = ~(((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1)); \
247: (*rpl_arguments).drapeaux_etat[__indice_bloc] &= __masque; \
248: __external_##function(rpl_arguments); \
249: if (__evaluation == d_vrai) \
250: { \
251: __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
252: (*rpl_arguments).drapeaux_etat[__indice_bloc] |= __masque; \
253: } \
254: else \
255: { \
256: __masque = ~(((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1)); \
257: (*rpl_arguments).drapeaux_etat[__indice_bloc] &= __masque; \
258: } } while(0)
259:
260: /*
261: --------------------------------------------------------------------------------
262: Macros spécifiques à l'en-tête
263: --------------------------------------------------------------------------------
264: */
265:
266: #define declareHelpString(h) { \
267: __presence_aide = d_vrai; \
268: if ((*rpl_arguments).affichage_arguments == 'Y') \
269: { \
270: uprintf("%s\n", h); \
271: return; \
272: } } while(0)
273:
274: #define declareSymbolicConstant { \
275: numberOfArguments(0); \
276: (*rpl_arguments).constante_symbolique = 'Y'; \
277: __constante++; } while(0)
278:
279: #define numberOfArguments(n) { \
280: __presence_validation = d_vrai; \
281: if ((*rpl_arguments).test_instruction == 'Y') \
282: { \
283: if (n < 0) \
284: systemError("Number of arguments must be positive or null"); \
285: (*rpl_arguments).nombre_arguments = n; \
286: __validation_instruction = d_vrai; \
287: } \
288: else \
289: { \
290: __taille_bloc = sizeof(t_8_bits) * 8; \
291: __indice_bloc = (31 - 1) / __taille_bloc; \
292: __indice_bit = (31 - 1) % __taille_bloc; \
293: __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
294: if (((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) != 0) \
295: { \
296: (*rpl_arguments).l_base_pile_last = \
297: sauvegarde_arguments(rpl_arguments, n); \
298: } \
299: } } while(0)
300:
301: /*
302: --------------------------------------------------------------------------------
303: Gestion des boucles
304: --------------------------------------------------------------------------------
305: */
306:
307: #define loop(b, e, s) for(b; e; s) {
308: #define endLoop }
309:
310: #define repeatWhile(c) while(c) {
311: #define endWhile }
312:
313: #define doUntil do {
314: #define repeatUntil(c) } while(!(c));
315:
316: #define select(s) switch(s) {
317: #define endSelect }
318: #define nonExclusiveCase(c) case c: {
319: #define endNonExclusiveCase }
320: #define exclusiveCase(c) case c: {
321: #define endExclusiveCase break; }
322: #define defaultCase default:
323: #define endDefaultCase break; }
324:
325: /*
326: --------------------------------------------------------------------------------
327: Gestion des erreurs
328: --------------------------------------------------------------------------------
329: */
330:
331: #define returnOnError(...) { \
332: if ((*rpl_arguments).erreur != 0) \
333: { \
334: __VA_ARGS__; \
335: return; \
336: } } while(0)
337:
338: #define systemError(message) { \
339: (*rpl_arguments).erreur = __LINE__; \
340: (*rpl_arguments).type_erreur = 'S'; \
341: (*rpl_arguments).message_erreur = (unsigned char *) message; \
342: return; } while(0)
343:
344: #define executionError(message) { \
345: (*rpl_arguments).erreur = __LINE__; \
346: (*rpl_arguments).type_erreur = 'E'; \
347: (*rpl_arguments).message_erreur = (unsigned char *) message; } while(0)
348:
349: #define onError(...) \
350: do { if (((*rpl_arguments).type_erreur == 'E') && \
351: ((*rpl_arguments).erreur != 0)) { __VA_ARGS__; \
352: (*rpl_arguments).erreur = 0; } } while(0)
353:
354: #define onExecution(...) \
355: do { if (((*rpl_arguments).type_erreur == 'E') && \
356: ((*rpl_arguments).erreur == 0)) { __VA_ARGS__; } } while(0)
357:
358: /*
359: --------------------------------------------------------------------------------
360: Gestion de la pile opérationnelle
361: --------------------------------------------------------------------------------
362: */
363:
364: #define pushOnStack(object) { \
365: if (((*rpl_arguments).l_base_pile = \
366: empilement_pile_operationnelle(rpl_arguments, object)) == NULL) \
367: systemError("Memory allocation error"); \
368: if ((*object).nombre_occurrences == 1) object = NULL; } while(0)
369:
370: #define pullFromStack(object, ...) { \
371: (*rpl_arguments).l_base_pile = \
372: depilement_pile_operationnelle(rpl_arguments, &object); \
373: if (object == NULL) \
374: { \
375: executionError("Too few arguments"); \
376: } \
377: else \
378: { \
379: if (strlen(#__VA_ARGS__) == 0) \
380: { \
381: systemError("Undefined type"); \
382: } \
383: else \
384: { \
385: __type = 0; \
386: if (strstr(#__VA_ARGS__, "integer") != NULL) \
387: if ((*object).type == INT) __type = 1; \
388: if (strstr(#__VA_ARGS__, "real") != NULL) \
389: if ((*object).type == REL) __type = 1; \
390: if (strstr(#__VA_ARGS__, "complex") != NULL) \
391: if ((*object).type == CPL) __type = 1; \
392: if (strstr(#__VA_ARGS__, "string") != NULL) \
393: if ((*object).type == CHN) __type = 1; \
394: if (strstr(#__VA_ARGS__, "list") != NULL) \
395: if ((*object).type == LST) __type = 1; \
396: if (strstr(#__VA_ARGS__, "unknown") != NULL) \
397: __type = 1; \
398: if (__type == 0) \
399: { \
400: executionError("Type not allowed"); \
401: } \
402: } \
403: } } while(0)
404:
405: /*
406: --------------------------------------------------------------------------------
407: Gestion des objets
408: --------------------------------------------------------------------------------
409: */
410:
411: #define then {
412: #define endIf }
413: #define elseIf } else if
414: #define orElse } else {
415:
416: // Constantes symboliques
417:
418: #define createSymbolicConstant(object, type, value) { \
419: if ((strcmp(#type, "integer") != 0) && (strcmp(#type, "real") != 0)) \
420: systemError("Type not allowed for symbolic constant"); \
421: __taille_bloc = sizeof(t_8_bits) * 8; \
422: __indice_bloc = (35 - 1) / __taille_bloc; \
423: __indice_bit = (35 - 1) % __taille_bloc; \
424: __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
425: if (((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) != 0) \
426: { \
427: createNameObject(object); \
428: { \
429: char *__constant_name; \
430: if ((__constant_name = malloc((strlen(__library_name) + \
431: strlen(__function_name) - 9) * sizeof(char))) == NULL) \
432: systemError("Memory allocation error"); \
433: sprintf(__constant_name, "%s$%s", __library_name, \
434: &(__function_name[11])); \
435: setName(object, __constant_name); \
436: free(__constant_name); \
437: } \
438: } \
439: else \
440: { \
441: if (strcmp(#type, "integer") == 0) \
442: { \
443: createIntegerObject(object); \
444: setInteger(object, value); \
445: } \
446: else if (strcmp(#type, "real") == 0) \
447: { \
448: createRealObject(object); \
449: setReal(object, value); \
450: } \
451: } \
452: __constante--; } while(0)
453:
454: #define createSymbolicComplexConstant(object, rp, ip) { \
455: __taille_bloc = sizeof(t_8_bits) * 8; \
456: __indice_bloc = (35 - 1) / __taille_bloc; \
457: __indice_bit = (35 - 1) % __taille_bloc; \
458: __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
459: if (((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) != 0) \
460: { \
461: createNameObject(object); \
462: { \
463: char *__constant_name; \
464: if ((__constant_name = malloc((strlen(__library_name) + \
465: strlen(__function_name) + 2) * sizeof(char))) == NULL) \
466: systemError("Memory allocation error"); \
467: sprintf(__constant_name, "%s$%s", __library_name, \
468: __function_name); \
469: setName(object, __constant_name); \
470: free(__constant_name); \
471: } \
472: } \
473: else \
474: { \
475: createComplexObject(object); \
476: setComplex(object, rp, im); \
477: } \
478: __constante--; } while(0)
479:
480: // Integer
481:
482: #define setInteger(object, value) { \
483: ifIsInteger(object) \
484: { \
485: if ((*object).nombre_occurrences > 1) \
486: { \
487: struct_objet *__tmp_object; \
488: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
489: systemError("Memory allocation error"); \
490: liberation(object); \
491: object = __tmp_object; \
492: } \
493: (*((integer8 *) (*object).objet)) = (integer8) value; \
494: } \
495: else executionError("Type mistmatch error"); } while(0)
496:
497: #define isInteger(object) \
498: ((*object).type == INT)
499:
500: #define ifIsInteger(object) if (isInteger(object))
501: #define elseIfIsInteger(object) } else ifIsInteger(object)
502:
503: #define getInteger(object, value) { \
504: value = 0; \
505: ifIsInteger(object) value = (*((integer8 *) (*object).objet)); \
506: else executionError("Type mismatch error"); } while(0)
507:
508: #define createIntegerObject(object) { \
509: if (object != NULL) \
510: systemError("Reallocated object"); \
511: if ((object = allocation(INT)) == NULL) \
512: systemError("Memory allocation error"); \
513: setInteger(object, 0); } while(0)
514:
515: // Real
516:
517: #define setReal(object, value) { \
518: ifIsReal(object) \
519: { \
520: if ((*object).nombre_occurrences > 1) \
521: { \
522: struct_objet *__tmp_object; \
523: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
524: systemError("Memory allocation error"); \
525: liberation(object); \
526: object = __tmp_object; \
527: } \
528: (*((real8 *) (*object).objet)) = (real8) value; \
529: } \
530: else executionError("Type mistmatch error"); } while(0)
531:
532: #define isReal(object) \
533: ((*object).type == REL)
534:
535: #define ifIsReal(object) if (isReal(object))
536: #define elseIfIsReal(object) } else ifIsReal(object)
537:
538: #define getReal(object, value) { \
539: value = 0; \
540: ifIsReal(object) value = (*((real8 *) (*object).objet)); \
541: else executionError("Type mismatch error"); } while(0)
542:
543: #define createRealObject(object) { \
544: if (object != NULL) \
545: systemError("Reallocated object"); \
546: if ((object = allocation(REL)) == NULL) \
547: systemError("Memory allocation error"); \
548: setReal(object, 0); } while(0)
549:
550: // Complex
551:
552: #define setComplex(object, rp, ip) { \
553: typeof(rp) __rp = rp; \
554: typeof(ip) __ip = ip; \
555: ifIsComplex(object) \
556: { \
557: if ((*object).nombre_occurrences > 1) \
558: { \
559: struct_objet *__tmp_object; \
560: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
561: systemError("Memory allocation error"); \
562: liberation(object); \
563: object = __tmp_object; \
564: } \
565: setRealPartOfComplex(object, __rp); \
566: setImaginaryPartOfComplex(object, __ip); \
567: } \
568: else executionError("Type mismatch error"); } while(0)
569:
570: #define setRealPartOfComplex(object, value) { \
571: if ((*object).nombre_occurrences > 1) \
572: { \
573: struct_objet *__tmp_object; \
574: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
575: systemError("Memory allocation error"); \
576: liberation(object); \
577: object = __tmp_object; \
578: } \
579: ifIsComplex(object) (*((complex16 *) (*object).objet)).partie_reelle = \
580: value; \
581: else executionError("Type mismatch error"); } while(0)
582:
583: #define setImaginaryPartOfComplex(object, value) { \
584: if ((*object).nombre_occurrences > 1) \
585: { \
586: struct_objet *__tmp_object; \
587: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
588: systemError("Memory allocation error"); \
589: liberation(object); \
590: object = __tmp_object; \
591: } \
592: (*((complex16 *) (*object).objet)).partie_imaginaire = value; \
593: else executionError("Type mismatch error"); } while(0)
594:
595: #define getRealPartOfComplex(object, value) \
596: value = (*((complex16 *) (*object).objet)).partie_reelle
597:
598: #define getImaginaryPartOfComplex(object, value) \
599: value = (*((complex16 *) (*object).objet)).partie_imaginaire
600:
601: #define isComplex(object) \
602: ((*object).type == CPL)
603:
604: #define ifIsComplex(object) if (isComplex(object))
605: #define elseIfIsComplex(object) } else ifIsComplex(object)
606:
607: #define getComplex(object, value) { \
608: value.partie_reelle = 0; \
609: value.partie_imaginaire = 0; \
610: ifIsComplex(object) value = (*((complex16 *) (*object).objet)); \
611: else systemError("Not a complex"); } while(0)
612:
613: #define createComplexObject(object) { \
614: if (object != NULL) \
615: systemError("Reallocated object"); \
616: if ((object = allocation(CPL)) == NULL) \
617: systemError("Memory allocation error"); \
618: setComplex(object, 0, 0); } while(0)
619:
620: // Generalized vectors
621:
622: #define createVectorObject(object, size, otype, structure, cat) { \
623: integer8 i; \
624: if (object != NULL) \
625: systemError("Reallocated object"); \
626: if ((object = allocation(cat)) == NULL) \
627: systemError("Memory allocation error"); \
628: (*((structure *) (*object).objet)).taille = size; \
629: if (((*((structure *) (*object).objet)).tableau = \
630: malloc(size * sizeof(otype))) == NULL) \
631: systemError("Memory allocation error"); \
632: if (cat != VCX) \
633: { \
634: if (cat == VIN) \
635: (*((structure *) (*object).objet)).type = 'I'; \
636: else \
637: (*((structure *) (*object).objet)).type = 'R'; \
638: for(i = 0; i < size; ((otype *) (*((structure *) (*object).objet)) \
639: .tableau)[i++] = (otype) 0); \
640: } \
641: else \
642: { \
643: (*((structure *) (*object).objet)).type = 'C'; \
644: for(i = 0; i < size; i++) \
645: { \
646: ((complex16 *) (*((structure *) (*object).objet)).tableau)[i] \
647: .partie_reelle = 0; \
648: ((complex16 *) (*((structure *) (*object).objet)).tableau)[i] \
649: .partie_imaginaire = 0; \
650: } \
651: } } while(0)
652:
653: // Integer vector
654:
655: #define setIntegerIntoVector(object, value, position) { \
656: typeof(position) __position = position; \
657: ifIsIntegerVector(object) \
658: { \
659: if ((*object).nombre_occurrences > 1) \
660: { \
661: struct_objet *__tmp_object; \
662: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
663: systemError("Memory allocation error"); \
664: liberation(object); \
665: object = __tmp_object; \
666: } \
667: __position--; \
668: if ((__position < 0) || (__position >= (*((struct_vecteur *) \
669: (*object).objet)).taille)) \
670: { executionError("Element out of range"); } \
671: else \
672: ((integer8 *) (*((struct_vecteur *) (*object).objet)).tableau) \
673: [__position] = (integer8) value; \
674: } \
675: else executionError("Type mistmatch error"); } while(0)
676:
677: #define isIntegerVector(object) \
678: ((*object).type == VIN)
679:
680: #define ifIsIntegerVector(object) if (isIntegerVector(object))
681: #define elseIfIsIntegerVector(object) } else ifIsIntegerVector(object)
682:
683: #define getIntegerFromVector(object, value, position) { \
684: typeof(position) __position = position; \
685: value = 0; \
686: ifIsIntegerVector(object) \
687: { \
688: __position--; \
689: if ((__position < 0) || (__position >= (*((struct_vecteur *) \
690: (*object).objet)).taille)) \
691: executionError("Element out of range"); \
692: else \
693: value = ((integer8 *) (*((struct_vecteur *) (*object).objet)) \
694: .tableau)[__position]; \
695: } \
696: else executionError("Type mismatch error"); } while(0)
697:
698: #define createIntegerVectorObject(object, size) \
699: createVectorObject(object, size, integer8, struct_vecteur, VIN)
700:
701: // Real vector
702:
703: #define setRealIntoVector(object, value, position) { \
704: typeof(position) __position = position; \
705: ifIsRealVector(object) \
706: { \
707: if ((*object).nombre_occurrences > 1) \
708: { \
709: struct_objet *__tmp_object; \
710: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
711: systemError("Memory allocation error"); \
712: liberation(object); \
713: object = __tmp_object; \
714: } \
715: __position--; \
716: if ((__position < 0) || (__position >= (*((struct_vecteur *) \
717: (*object).objet)).taille)) \
718: { executionError("Element out of range"); } \
719: else \
720: ((real8 *) (*((struct_vecteur *) (*object).objet)).tableau) \
721: [__position] = (real8) value; \
722: } \
723: else executionError("Type mistmatch error"); } while(0)
724:
725: #define isRealVector(object) \
726: ((*object).type == VRL)
727:
728: #define ifIsRealVector(object) if (isRealVector(object))
729: #define elseIfIsRealVector(object) } else ifIsRealVector(object)
730:
731: #define getRealFromVector(object, value, position) { \
732: typeof(position) __position = position; \
733: value = 0; \
734: ifIsRealVector(object) \
735: { \
736: __position--; \
737: if ((__position < 0) || (__position >= (*((struct_vecteur *) \
738: (*object).objet)).taille)) \
739: executionError("Element out of range"); \
740: value = ((real8 *) (*((struct_vecteur *) (*object).objet)).tableau) \
741: [__position]; \
742: } \
743: else executionError("Type mismatch error"); } while(0)
744:
745: #define createRealVectorObject(object, size) \
746: createVectorObject(object, size, real8, struct_vecteur, VRL)
747:
748: // A FIXER
749:
750: #define createComplexVectorObject
751:
752: #define createIntegerMatrixObject
753:
754: #define createRealMatrixObject
755:
756: #define createComplexMatrixObject
757:
758: // Binary integer
759:
760: #define setBinaryInteger(object, value) { \
761: ifIsBinaryInteger(object) \
762: { \
763: if ((*object).nombre_occurrences > 1) \
764: { \
765: struct_objet *__tmp_object; \
766: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
767: systemError("Memory allocation error"); \
768: liberation(object); \
769: object = __tmp_object; \
770: } \
771: (*((integer8 *) (*object).objet)) = (integer8) value; \
772: } \
773: else executionError("Type mistmatch error"); } while(0)
774:
775: #define isBinaryInteger(object) \
776: ((*object).type == BIN)
777:
778: #define ifIsBinaryInteger(object) if (isBinaryInteger(object))
779: #define elseIfIsBinaryInteger(object) } else ifIsBinaryInteger(object)
780:
781: #define getBinaryInteger(object, value) { \
782: value = 0; \
783: ifIsBinaryInteger(object) value = (*((integer8 *) (*object).objet)); \
784: else executionError("Type mismatch error"); } while(0)
785:
786: #define createBinaryIntegerObject(object) { \
787: if (object != NULL) \
788: systemError("Reallocated object"); \
789: if ((object = allocation(BIN)) == NULL) \
790: systemError("Memory allocation error"); \
791: setBinaryInteger(object, 0); } while(0)
792:
793: // Name
794:
795: #define isName(object) \
796: ((*object).type == NOM)
797:
798: #define ifIsName(object) if (isName(object))
799: #define elseIfIsName(object) } else if (isName(object))
800:
801: #define setName(object, value) { \
802: ifIsName(object) \
803: { \
804: if ((*object).nombre_occurrences > 1) \
805: { \
806: struct_objet *__tmp_object; \
807: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
808: systemError("Memory allocation error"); \
809: liberation(object); \
810: object = __tmp_object; \
811: } \
812: free((*((struct_nom *) (*object).objet)).nom); \
813: (*((struct_nom *) (*object).objet)).symbole = d_faux; \
814: if (((*((struct_nom *) (*object).objet)).nom = malloc( \
815: (strlen(value) + 1) * sizeof(unsigned char))) == NULL) \
816: systemError("Memory allocation error"); \
817: strcpy((char *) (*((struct_nom *) (*object).objet)).nom, \
818: (char *) value); \
819: } \
820: else executionError("Type mistmatch error"); } while(0)
821:
822: #define createNameObject(object) { \
823: if (object != NULL) \
824: systemError("Reallocated object"); \
825: if ((object = allocation(NOM)) == NULL) \
826: systemError("Memory allocation error"); \
827: (*((struct_nom *) (*object).objet)).symbole = d_faux; \
828: if (((*((struct_nom *) (*object).objet)).nom = malloc( \
829: sizeof(unsigned char))) == NULL) \
830: systemError("Memory allocation error"); \
831: strcpy((char *) (*((struct_nom *) (*object).objet)).nom, ""); } while(0)
832:
833: // String
834:
835: #define isString(object) \
836: ((*object).type == CHN)
837:
838: #define ifIsString(object) if (isString(object))
839: #define elseIfIsString(object) else if (isString(objet))
840:
841: #define setString(object, string) { \
842: ifIsString(object) \
843: { \
844: if ((*object).nombre_occurrences > 1) \
845: { \
846: struct_objet *__tmp_object; \
847: if ((__tmp_object = copie_objet(object, 'O')) == NULL) \
848: systemError("Memory allocation error"); \
849: liberation(object); \
850: object = __tmp_object; \
851: } \
852: free((unsigned char *) (*object).objet); \
853: if (((*object).objet = malloc((strlen(string) + 1) * \
854: sizeof(unsigned char))) == NULL) \
855: systemError("Memory allocation error"); \
856: strcpy((char *) (*object).objet, string); \
857: } \
858: else executionError("Type mistmatch error"); } while(0)
859:
860: #define getString(object, string) { \
861: string = NULL; \
862: ifIsString(object) string = (char *) (*object).objet; \
863: else executionError("Type mismatch error"); } while(0)
864:
865: #define createStringObject(object) { \
866: if (object != NULL) \
867: systemError("Reallocated object"); \
868: if ((object = allocation(CHN)) == NULL) \
869: systemError("Memory allocation error"); \
870: if (((*object).objet = malloc(sizeof(unsigned char))) == NULL) \
871: systemError("Memory allocation error"); \
872: strcpy((char *) (*object).objet, ""); } while(0)
873:
874: // List
875:
876: #define isList(object) \
877: ((*object).type == LST)
878:
879: #define ifIsList(object) if (isList(object))
880: #define elseIfIsList(object) else if (isList(object))
881:
882: #define createListObject(object) { \
883: if (object != NULL) \
884: systemError("Reallocated object"); \
885: if ((object = allocation(LST)) == NULL) \
886: systemError("Memory allocation error"); \
887: (*object).objet = NULL; } while(0)
888:
889: #define addObjectToList(list, object) { \
890: ifIsList(list) \
891: { \
892: struct_objet *__tmp_object; \
893: if ((__tmp_object = copie_objet(list, 'N')) == NULL) \
894: systemError("Memory allocation error"); \
895: liberation(list); \
896: list = __tmp_object; \
897: if ((*list).objet == NULL) \
898: { \
899: if (((*list).objet = malloc(sizeof(struct_liste_chainee))) \
900: == NULL) \
901: systemError("Memory allocation error"); \
902: (*((struct_liste_chainee *) (*list).objet)).suivant = NULL; \
903: (*((struct_liste_chainee *) (*list).objet)).donnee = object; \
904: } \
905: else \
906: { \
907: struct_liste_chainee *l_element_courant; \
908: l_element_courant = (*list).objet; \
909: while((*l_element_courant).suivant != NULL) \
910: l_element_courant = (*l_element_courant).suivant; \
911: if (((*l_element_courant).suivant = \
912: malloc(sizeof(struct_liste_chainee))) == NULL) \
913: systemError("Memory allocation error"); \
914: l_element_courant = (*l_element_courant).suivant; \
915: (*l_element_courant).suivant = NULL; \
916: (*l_element_courant).donnee = object; \
917: } \
918: object = NULL; \
919: } \
920: else executionError("Type mistmatch error"); } while(0)
921:
922: #define insertObjectIntoList(list, object) { \
923: ifIsList(list) \
924: { \
925: struct_objet *__tmp_object; \
926: if ((__tmp_object = copie_objet(list, 'N')) == NULL) \
927: systemError("Memory allocation error"); \
928: liberation(list); \
929: list = __tmp_object; \
930: if ((*list).objet == NULL) \
931: { \
932: if (((*list).objet = malloc(sizeof(struct_liste_chainee))) \
933: == NULL) \
934: systemError("Memory allocation error"); \
935: (*((struct_liste_chainee *) (*list).objet)).suivant = NULL; \
936: (*((struct_liste_chainee *) (*list).objet)).donnee = object; \
937: } \
938: else \
939: { \
940: struct_liste_chainee *l_element_courant; \
941: if ((l_element_courant = \
942: malloc(sizeof(struct_liste_chainee))) == NULL) \
943: systemError("Memory allocation error"); \
944: (*l_element_courant).donnee = object; \
945: (*l_element_courant).suivant = (*list).objet; \
946: (*list).objet = l_element_courant; \
947: } \
948: object = NULL; \
949: } \
950: else executionError("Type mistmatch error"); } while(0)
951:
952: #define removeObjectFromList(list, object) \
953: ifIsList(list) \
954: { \
955: if ((*object).objet == NULL) \
956: { \
957: struct_objet *__tmp_object; \
958: if ((__tmp_object = copie_objet(list, 'N')) == NULL) \
959: systemError("Memory allocation error"); \
960: liberation(object); \
961: object = __tmp_object; \
962: \
963: \
964: \
965: \
966: } \
967: } \
968: else executionError("Type mistmatch error"); } while(0)
969:
970: #define getObjectFromList(list, position, object)
971:
972: #define putObjectIntoList(list, position, object)
973:
974: #define getListFromList(list, position1, position2, object)
975:
976: #define listLength(list, length) { \
977: if (list == NULL) executionError("Nullified object"); \
978: if ((*list).type != LST) \
979: executionError("Type mistmatch error"); \
980: { \
981: struct_liste_chainee *l_element_courant; \
982: length = 0; \
983: l_element_courant = (*list).objet; \
984: while(l_element_courant != NULL) \
985: { \
986: l_element_courant = (*l_element_courant).suivant; \
987: length++; \
988: } \
989: } } while(0)
990:
991:
992: /*
993: --------------------------------------------------------------------------------
994: Destruction d'un objet
995: --------------------------------------------------------------------------------
996: */
997:
998: #define freeObject(object) \
999: { \
1000: if (object == NULL) \
1001: systemError("Nullified object"); \
1002: liberation(object); \
1003: object = NULL; \
1004: } while(0)
1005:
1006: /*
1007: --------------------------------------------------------------------------------
1008: Copie d'un objet
1009: --------------------------------------------------------------------------------
1010: */
1011:
1012: #define dupObject(object) \
1013: { if (copie_objet(object, 'P') != object) \
1014: systemError("Memory allocation error"); } while(0)
1015:
1016: /*
1017: --------------------------------------------------------------------------------
1018: Allocation mémoire
1019: --------------------------------------------------------------------------------
1020: */
1021:
1022: #define size(a) sizeof(a)
1023:
1024: #define allocate(a) ({ void *ptr; \
1025: if ((ptr = malloc(a)) == NULL) \
1026: systemError("Memory allocation error"); ptr; })
1027:
1028: #define deallocate(a) free(a)
1029:
1030: /*
1031: --------------------------------------------------------------------------------
1032: Exécution d'une fonction intrinsèque
1033: --------------------------------------------------------------------------------
1034: */
1035:
1036: #define intrinsic(function) { \
1037: int __status; \
1038: __status = wrapper_instruction_intrinseque(instruction_##function, \
1039: rpl_arguments); \
1040: if (__status == 1) executionError(#function); \
1041: if (__status == 2) systemError(#function); \
1042: } while(0)
1043:
1044: #endif
1045:
1046: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to rplexternals.h CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src