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