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