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