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