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