File:  [local] / rpl / src / rplexternals.h
Revision 1.101: download - view: text, annotated - select for diffs - revision graph
Mon Nov 27 08:48:46 2023 UTC (5 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Rajout de fonctions pour gérer les vecteurs.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.35
    4:   Copyright (C) 1989-2023 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: // Si TYPE_DECLARATION est défini, toutes les structures internes du RPL/2
   33: // sont exposés pour travailler sur des nouveaux types de données.
   34: #   ifndef TYPE_DECLARATION
   35: #       define RPLARGS
   36: #       define struct_processus void
   37: #   endif
   38: 
   39: #   include "rpl.h"
   40: 
   41: /*
   42: ================================================================================
   43:   MACROS SPECIFIQUES
   44: ================================================================================
   45: */
   46: 
   47: #define __RPL__ struct_rpl_arguments *rpl_arguments; \
   48:     rpl_arguments = &__static_rpl_arguments; \
   49: 
   50: #define __CATCH_SYSTEM_ERROR__ \
   51:         do { if (((*rpl_arguments).erreur != 0) && \
   52:                 ((*rpl_arguments).type_erreur == 'S')) \
   53:             return 0; } while(0)
   54: #define leave do { return(0); } while(0)
   55: #define _allocation(a) librpl_allocation((*rpl_arguments).s_etat_processus, a)
   56: #define _copie_objet(a, b) librpl_copie_objet( \
   57:             (*rpl_arguments).s_etat_processus, a, b)
   58: #define _liberation(a) librpl_liberation((*rpl_arguments).s_etat_processus, a)
   59: 
   60: #ifdef __RPLC_MAIN
   61:     struct_rpl_arguments __static_rpl_arguments;
   62:     void *__static_library_descriptor;
   63: #   define global
   64: #   define initialize(a, b) a = b
   65: #   define declarePersistantObject(rpl_object) declareObject(rpl_object)
   66: #else
   67:     extern struct_rpl_arguments __static_rpl_arguments;
   68:     extern void *__static_library_descriptor;
   69: #   define global extern
   70: #   define initialize(a, b) a;
   71: #   define declarePersistantObject(rpl_object) extern struct_objet *rpl_object
   72: #endif
   73: 
   74: #define empty int
   75: 
   76: /*
   77: --------------------------------------------------------------------------------
   78:   Gestion des objets
   79: --------------------------------------------------------------------------------
   80: */
   81: 
   82: // new, dup, drop, disp, parse
   83: // __type_new(struct_rpl_arguments *rpl_arguments)
   84: #define declareTypeExtension(fct) \
   85:         int __type_##fct(struct_processus *s_etat_processus, void **arg) { \
   86:             char *rptr, *ptr, *iptr; \
   87:             rptr = (char *) ((*s_etat_processus).definitions_chainees + \
   88:                     (*s_etat_processus).position_courante); \
   89:             ptr = rptr; \
   90:             iptr = (char *) (*s_etat_processus).instruction_courante; \
   91:             if ((ptr != rptr) && (iptr)) goto __parse_error;
   92: #define parseError  { goto __parse_error; } while(0)
   93: #define typeError { return(0); } while(0)
   94: #define typeSystemError { (*s_etat_processus).erreur_systeme = \
   95:         d_es_execution_bibliotheque; return(0); } while(0)
   96: #define typeSuccess { return(1); } while(0)
   97: #define typeFound(a) { return(a); } while(0)
   98: #define endTypeExtension __parse_error: return(0); }
   99: #define sizeOfParse (rptr - ptr)
  100: #define searchType(...) { recherche_type(s_etat_processus); \
  101:             if (((*s_etat_processus).erreur_execution != d_ex) || \
  102:                     ((*s_etat_processus).erreur_systeme != d_es)) \
  103:                 { __VA_ARGS__; return(0); } } while(0)
  104: #define structObject struct_objet
  105: #define initializeObject(a, b)  do { \
  106:             (*a).descripteur_bibliotheque = (*b).descripteur_bibliotheque; \
  107:             (*a).extension_type = (*b).extension_type; } while(0)
  108: #define objectContainer(type, a) ((type *) ((*a).objet))
  109: #define objectOf(a) ((*a).objet)
  110: #define ifIsExternal(a, b) if (((*a).type == EXT) && ((*a).extension_type == b))
  111: #define elseIfIsExternal(a, b) } else if (((*a).type == EXT) && \
  112:             ((*a).extension_type == b))
  113: #define subType(a) ((*a).extension_type)
  114: #define integerFormat(a) formateur_nombre(s_etat_processus, a, 'I')
  115: #define procStatus(a) (*a).s_etat_processus
  116: 
  117: /*
  118: --------------------------------------------------------------------------------
  119:   Types
  120: --------------------------------------------------------------------------------
  121: */
  122: 
  123: #define declareObject(rpl_object) struct_objet *rpl_object = NULL
  124: #define declareInteger(integer) integer8 integer
  125: #define declareReal(real) real8 real
  126: #define declareComplex(complex) complex16 complex
  127: #define declareDaisyChain(daisyChain) struct_liste_chainee *daisyChain = NULL
  128: 
  129: #define getDaisyChainFromList(list, daisyChain) \
  130:     __CATCH_SYSTEM_ERROR__; \
  131:     do { \
  132:     typeof(list) __list = list; \
  133:     daisyChain = NULL; \
  134:     ifIsList(__list) { daisyChain = (*__list).objet; } \
  135:     else executionError("Type mistmatch error"); } while(0)
  136: 
  137: #define fetchElementFromDaisyChain(daisyChain) \
  138:     ({ __CATCH_SYSTEM_ERROR__; typeof(daisyChain) __daisyChain = daisyChain; \
  139:     if (__daisyChain == NULL) executionError("End of daisy chain"); \
  140:     (__daisyChain == NULL) ? NULL : (*__daisyChain).donnee; })
  141: 
  142: #define replaceElementIntoDaisyChain(daisyChain, element) \
  143:     __CATCH_SYSTEM_ERROR__; \
  144:     do { typeof(daisyChain) __daisyChain = daisyChain; \
  145:     if (__daisyChain == NULL) executionError("Nullified daisy chain"); \
  146:     freeObject((*__daisyChain).donnee); \
  147:     (*__daisyChain).donnee = element; } while(0)
  148: 
  149: #define nextElementOfDaisyChain(daisyChain) \
  150:     ({ __CATCH_SYSTEM_ERROR__; typeof(daisyChain) __daisyChain = daisyChain; \
  151:     if (__daisyChain == NULL) executionError("End of daisy chain"); \
  152:     (__daisyChain == NULL) ? NULL : (*__daisyChain).suivant; })
  153: 
  154: #define next        suivant
  155: #define data        donnee
  156: #define daisyChain  struct_liste_chainee
  157:     
  158: #define null NULL
  159: #define nullify(ptr) __CATCH_SYSTEM_ERROR__; do { ptr = NULL; } while(0)
  160: #define nullified(ptr) ((ptr) == NULL)
  161: 
  162: #define postIncr(x) (x++)
  163: #define preIncr(x) (++x)
  164: #define postDecr(x) (x--)
  165: #define preDecr(x) (--x)
  166: 
  167: #define eq ==
  168: #define ne !=
  169: #define ge >=
  170: #define gt >
  171: #define le <=
  172: #define lt <
  173: #define not !
  174: #define and &&
  175: #define or ||
  176: #define false 0
  177: #define true -1
  178: 
  179: #define setFalse(a) a = false
  180: #define setTrue(a) a = true
  181: 
  182: #define logical int
  183: #define string char *
  184: #define integer int
  185: 
  186: #define declareStructure typedef struct {
  187: #define declareUnion typedef union {
  188: #define as(name) } name;
  189: 
  190: #define target(a) (*(a))
  191: #define address(a) (&(a))
  192: 
  193: #define subroutine(name) int name()
  194: #define beginGroup { __CATCH_SYSTEM_ERROR__;
  195: #define endGroup __CATCH_SYSTEM_ERROR__; }
  196: #define beginMacro do beginGroup
  197: #define endMacro endGroup while(0)
  198: #define stopRequest ({ __CATCH_SYSTEM_ERROR__; \
  199:         test_arret((*rpl_arguments).s_etat_processus); })
  200: 
  201: /*
  202: --------------------------------------------------------------------------------
  203:   Signaux
  204: --------------------------------------------------------------------------------*/
  205: 
  206: #define blockSignals \
  207:     { __CATCH_SYSTEM_ERROR__; sigset_t set, oldset; sigfillset(&set); \
  208:     pthread_sigmask(SIG_BLOCK, &set, &oldset);
  209: #define unblockSignals \
  210:     pthread_sigmask(SIG_SETMASK, &oldset, NULL); __CATCH_SYSTEM_ERROR__; }
  211: 
  212: /*
  213: --------------------------------------------------------------------------------
  214:   Constructeurs
  215: --------------------------------------------------------------------------------
  216: */
  217: 
  218: #define DISABLE_SET_BUT_NOT_USED_WARNING(a) if (&a != ((&a) + 1));
  219: 
  220: #define HEADER \
  221:     int             __constante; \
  222:     logical1        __evaluation; \
  223:     logical1        __validation_instruction = d_faux; \
  224:     logical1        __presence_aide = d_faux; \
  225:     logical1        __presence_validation = d_faux; \
  226:     unsigned char   __indice_bit; \
  227:     unsigned char   __indice_bloc; \
  228:     unsigned char   __taille_bloc; \
  229:     unsigned char   __type; \
  230:     t_8_bits        __masque; \
  231:     void *s_etat_processus = (*rpl_arguments).s_etat_processus; \
  232:     DISABLE_SET_BUT_NOT_USED_WARNING(s_etat_processus); \
  233:     { \
  234:         (*rpl_arguments).instruction_valide = 'Y'; \
  235:         (*rpl_arguments).erreur = 0; \
  236:         __constante = 0; \
  237:         __evaluation = d_faux; \
  238:         DISABLE_SET_BUT_NOT_USED_WARNING(__evaluation); \
  239:         DISABLE_SET_BUT_NOT_USED_WARNING(__type); \
  240:         DISABLE_SET_BUT_NOT_USED_WARNING(__indice_bit); \
  241:         DISABLE_SET_BUT_NOT_USED_WARNING(__indice_bloc); \
  242:         DISABLE_SET_BUT_NOT_USED_WARNING(__taille_bloc); \
  243:         DISABLE_SET_BUT_NOT_USED_WARNING(__masque);
  244: 
  245: #define FUNCTION \
  246:     if (__validation_instruction == d_vrai) return 0; \
  247:     if (__presence_aide == d_faux) \
  248:     { \
  249:         systemError("Help string not defined"); \
  250:     } \
  251:     else if (__presence_validation == d_faux) \
  252:     { \
  253:         systemError("Number of arguments not defined"); \
  254:     } \
  255:     __indice_bit = 0; \
  256:     __indice_bloc = 0; \
  257:     __taille_bloc = 0; \
  258:     __type = 0; \
  259:     __masque = 0; \
  260:     {
  261: 
  262: #define END \
  263:         strcpy((char *) __function_name, ""); \
  264:         if (__constante != 0) \
  265:             systemError("Constant definition error"); \
  266:         __CATCH_SYSTEM_ERROR__; \
  267:     } } \
  268:     leave;
  269: 
  270: /*
  271: --------------------------------------------------------------------------------
  272:   Destruction d'un objet
  273: --------------------------------------------------------------------------------
  274: */
  275: 
  276: #define freeObject(rpl_object) \
  277:     __CATCH_SYSTEM_ERROR__; \
  278:     do { \
  279:         if (rpl_object == NULL) \
  280:             systemError("Nullified object"); \
  281:         _liberation(rpl_object); \
  282:         rpl_object = NULL; \
  283:     } while(0)
  284: 
  285: /*
  286: --------------------------------------------------------------------------------
  287:   Copie d'un objet
  288: --------------------------------------------------------------------------------
  289: */
  290: 
  291: #define dupObject(rpl_object) \
  292:     __CATCH_SYSTEM_ERROR__; \
  293:     do { if (_copie_objet(rpl_object, 'P') != rpl_object) \
  294:         systemError("Memory allocation error"); } while(0)
  295: 
  296: /*
  297: --------------------------------------------------------------------------------
  298:   Déclaration des fonctions internes
  299: --------------------------------------------------------------------------------
  300: */
  301: 
  302: #define CONCAT(a, b) __RPL_CONCAT(a, b)
  303: #define __RPL_CONCAT(a, b) a##b
  304: #define FIRST(...) FIRST_HELPER(__VA_ARGS__, throwaway)
  305: #define FIRST_HELPER(first, ...) first
  306: #define REST(...) REST_HELPER(NUM(__VA_ARGS__), __VA_ARGS__)
  307: #define REST_HELPER(qty, ...) REST_HELPER2(qty, __VA_ARGS__)
  308: #define REST_HELPER2(qty, ...) REST_HELPER_##qty(__VA_ARGS__)
  309: #define REST_HELPER_ONE(first)
  310: #define REST_HELPER_TWOORMORE(first, ...) , __VA_ARGS__
  311: #define NUM(...) \
  312:         SELECT_10TH(__VA_ARGS__, TWOORMORE, TWOORMORE, TWOORMORE, TWOORMORE,\
  313:         TWOORMORE, TWOORMORE, TWOORMORE, TWOORMORE, ONE, throwaway)
  314: #define SELECT_10TH(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, ...) a10
  315: 
  316: #define declareInternalFunction(type, ...) \
  317:     type CONCAT(__internal_, FIRST(__VA_ARGS__)) \
  318:             (struct_rpl_arguments *rpl_arguments REST(__VA_ARGS__)) { \
  319:     type __internal_return; __internal_return = 0; int __type; \
  320:     DISABLE_SET_BUT_NOT_USED_WARNING(__type);
  321: 
  322: #define endInternalFunction return(__internal_return); }
  323: 
  324: #define useInternalFunction(type, ...) \
  325:     type CONCAT(__internal_, FIRST(__VA_ARGS__)) \
  326:             (struct_rpl_arguments *rpl_arguments REST(__VA_ARGS__))
  327: 
  328: #define callInternalFunction(...) \
  329:     CONCAT(__internal_, FIRST(__VA_ARGS__))(rpl_arguments REST(__VA_ARGS__))
  330: 
  331: /*
  332: --------------------------------------------------------------------------------
  333:   Déclaration des fonctions C
  334: --------------------------------------------------------------------------------
  335: */
  336: 
  337: #define declareCFunction(type, name, ...) \
  338:         type name(__VA_ARGS__) { __RPL__ type __c_return;
  339: #define endCFunction return(__c_return); }
  340: 
  341: #define useCFunction(type, name, ...) type name(__VA_ARGS__)
  342: 
  343: /*
  344: --------------------------------------------------------------------------------
  345:   Déclaration des fonctions externes
  346: --------------------------------------------------------------------------------
  347: */
  348: 
  349: #define declareExternalFunction(name) \
  350:     int __external_##name(struct_rpl_arguments *rpl_arguments) { \
  351:     char __function_name[] = "__external_"#name; \
  352:     __static_rpl_arguments = (*rpl_arguments);
  353: 
  354: #define useExternalFunction(function) \
  355:     int __external_##function(struct_rpl_arguments *rpl_arguments)
  356: 
  357: #define libraryName(name) char __library_name[] = #name;
  358: 
  359: #define __onLoading int __runOnLoading(struct_rpl_arguments *rpl_arguments, \
  360:         void *descriptor)
  361: #define __onClosing int __runOnClosing(struct_rpl_arguments *rpl_arguments, \
  362:         void *descriptor)
  363: #define declareSubroutine(when) __##when { \
  364:     char __function_name[] = #when; \
  365:     __static_rpl_arguments = (*rpl_arguments); \
  366:     __static_library_descriptor = descriptor; \
  367:     HEADER \
  368:         declareHelpString(""); \
  369:         numberOfArguments(0); \
  370:     FUNCTION
  371: #define endSubroutine END }
  372: 
  373: #define notice(s, ...) __CATCH_SYSTEM_ERROR__; \
  374:         do { ufprintf(s, __VA_ARGS__); fflush(s); } while(0)
  375: #define logger(...) __CATCH_SYSTEM_ERROR__; \
  376:         do { syslog(LOG_NOTICE, __VA_ARGS__); } while(0) 
  377: 
  378: #define exportExternalFunctions(...) \
  379:     char **___external_symbols(struct_rpl_arguments *rpl_arguments, \
  380:             integer8 *nb_symbols, \
  381:             const char *version) { \
  382:         char arguments[] = #__VA_ARGS__; \
  383:         char **tableau; \
  384:         char *ptr1, *ptr2; \
  385:         int drapeau; \
  386:         unsigned long i; \
  387:         struct_processus *s_etat_processus; \
  388:         s_etat_processus = (*rpl_arguments).s_etat_processus; \
  389:         if (strcmp(version, _d_version_rpl) != 0) \
  390:         { \
  391:             notice(stdout, "Versions mismatch : library %s, expected %s\n", \
  392:                     _d_version_rpl, version); \
  393:             (*nb_symbols) = -1; return(NULL); \
  394:         } \
  395:         (*nb_symbols) = 0; ptr1 = arguments; drapeau = 0; \
  396:         while((*ptr1) != 0) \
  397:         { \
  398:             if (((*ptr1) != ',') && ((*ptr1) != ' ')) drapeau = -1; \
  399:             ptr1++; \
  400:         } \
  401:         if (drapeau == 0) return(NULL); \
  402:         ptr1 = arguments; (*nb_symbols) = 1; \
  403:         while((*ptr1) != 0) if ((*ptr1++) == ',') (*nb_symbols)++; \
  404:         if ((tableau = malloc((*nb_symbols) * sizeof(char *))) == NULL) \
  405:             return(NULL); \
  406:         ptr2 = arguments; i = 0; \
  407:         while(*ptr2 != 0) \
  408:         { \
  409:             while(((*ptr2) == ' ') || ((*ptr2) == ',')) ptr2++; \
  410:             ptr1 = ptr2; \
  411:             while(((*ptr2) != 0) && ((*ptr2) != ',') && ((*ptr2) != ' ')) \
  412:                     ptr2++; \
  413:             if ((tableau[i] = malloc((ptr2 + 2 + \
  414:                     strlen(__library_name) - ptr1) * \
  415:                     sizeof(unsigned char))) == NULL) \
  416:                 return(NULL); \
  417:             sprintf(tableau[i], "%s$", __library_name); \
  418:             strncat(&tableau[i][strlen(tableau[i])], ptr1, ptr2 - ptr1); \
  419:             i++; \
  420:             if ((*ptr2) != 0) \
  421:             { \
  422:                 while((*ptr2) == ' ') ptr2++; \
  423:                 if ((*ptr2) == ',') ptr2++; \
  424:             } \
  425:         } \
  426:         (*nb_symbols) = i; \
  427:         return(tableau); \
  428:     }
  429: 
  430: #define endExternalFunction leave; }
  431: 
  432: #define callExternalFunction(function) do { \
  433:     __CATCH_SYSTEM_ERROR__; \
  434:     __taille_bloc = sizeof(t_8_bits) * 8; \
  435:     __indice_bloc = (35 - 1) / __taille_bloc; \
  436:     __indice_bit = (35 - 1) % __taille_bloc; \
  437:     __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
  438:     __evaluation = ((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) \
  439:             ? d_vrai : d_faux; \
  440:     __masque = ~(((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1)); \
  441:     (*rpl_arguments).drapeaux_etat[__indice_bloc] &= __masque; \
  442:     __external_##function(rpl_arguments); \
  443:     if (__evaluation == d_vrai) \
  444:     { \
  445:         __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
  446:         (*rpl_arguments).drapeaux_etat[__indice_bloc] |= __masque; \
  447:     } \
  448:     else \
  449:     { \
  450:         __masque = ~(((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1)); \
  451:         (*rpl_arguments).drapeaux_etat[__indice_bloc] &= __masque; \
  452:     } } while(0)
  453: 
  454: /*
  455: --------------------------------------------------------------------------------
  456:   Macros spécifiques à l'en-tête
  457: --------------------------------------------------------------------------------
  458: */
  459: 
  460: #define declareHelpString(h) do { \
  461:     __presence_aide = d_vrai; \
  462:     if ((*rpl_arguments).affichage_arguments == 'Y') \
  463:     { \
  464:         uprintf("%s\n", h); \
  465:         return 0; \
  466:     } } while(0)
  467: 
  468: #define declareSymbolicConstant do { \
  469:     numberOfArguments(0); \
  470:     (*rpl_arguments).constante_symbolique = 'Y'; \
  471:     __constante++; } while(0)
  472: 
  473: #define numberOfArguments(n) do { \
  474:     __presence_validation = d_vrai; \
  475:     if ((*rpl_arguments).test_instruction == 'Y') \
  476:     { \
  477:         if (n < 0) \
  478:             systemError("Number of arguments must be positive or null"); \
  479:         (*rpl_arguments).nombre_arguments = n; \
  480:         __validation_instruction = d_vrai; \
  481:     } \
  482:     else \
  483:     { \
  484:         __taille_bloc = sizeof(t_8_bits) * 8; \
  485:         __indice_bloc = (31 - 1) / __taille_bloc; \
  486:         __indice_bit = (31 - 1) % __taille_bloc; \
  487:         __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
  488:         if (((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) != 0) \
  489:         { \
  490:             (*rpl_arguments).l_base_pile_last = \
  491:                     sauvegarde_arguments(rpl_arguments, n); \
  492:         } \
  493:     } } while(0)
  494: 
  495: /*
  496: --------------------------------------------------------------------------------
  497:   Gestion des boucles
  498: --------------------------------------------------------------------------------
  499: */
  500: 
  501: #define loop(b, e, s) for(b; e; s) {
  502: #define endLoop __CATCH_SYSTEM_ERROR__; }
  503: 
  504: #define repeatWhile(c) while(c) {
  505: #define endWhile __CATCH_SYSTEM_ERROR__; }
  506: 
  507: #define doUntil do {
  508: #define repeatUntil(c) __CATCH_SYSTEM_ERROR__; } while(!(c));
  509: 
  510: #define select(s) switch(s) {
  511: #define endSelect __CATCH_SYSTEM_ERROR__; }
  512: #define nonExclusiveCase(c) case c: {
  513: #define endNonExclusiveCase __CATCH_SYSTEM_ERROR__; }
  514: #define exclusiveCase(c) case c: {
  515: #define endExclusiveCase break; __CATCH_SYSTEM_ERROR__; }
  516: #define defaultCase default:
  517: #define endDefaultCase break; __CATCH_SYSTEM_ERROR__; }
  518: 
  519: /*
  520: --------------------------------------------------------------------------------
  521:   Gestion des erreurs
  522: --------------------------------------------------------------------------------
  523: */
  524: 
  525: #define returnOnError(...) do { \
  526:     if ((*rpl_arguments).erreur != 0) \
  527:     { \
  528:         __VA_ARGS__; \
  529:         return 0; \
  530:     } } while(0)
  531: 
  532: #define systemError(message) do { \
  533:     (*rpl_arguments).erreur = __LINE__; \
  534:     (*rpl_arguments).type_erreur = 'S'; \
  535:     (*rpl_arguments).message_erreur = (unsigned char *) message; \
  536:     return 0; } while(0)
  537: 
  538: #define executionError(message) do { \
  539:     (*rpl_arguments).erreur = __LINE__; \
  540:     (*rpl_arguments).type_erreur = 'E'; \
  541:     (*rpl_arguments).message_erreur = (unsigned char *) message; } while(0)
  542: 
  543: #define onSystemError(...) do { \
  544:     if (((*rpl_arguments).erreur != 0) && \
  545:             ((*rpl_arguments).type_erreur == 'S')) \
  546:     { \
  547:         blockSignals; \
  548:             kill(getpid(), SIGTERM); \
  549:         unblockSignals; \
  550:         __VA_ARGS__; \
  551:     } } while(0)
  552: 
  553: #define onError(...) \
  554:     __CATCH_SYSTEM_ERROR__; \
  555:     do { if (((*rpl_arguments).type_erreur == 'E') && \
  556:             ((*rpl_arguments).erreur != 0)) { __VA_ARGS__; \
  557:             (*rpl_arguments).erreur = 0; } } while(0)
  558: 
  559: #define onExecution(...) \
  560:     __CATCH_SYSTEM_ERROR__; \
  561:     do { if (((*rpl_arguments).type_erreur == 'E') && \
  562:             ((*rpl_arguments).erreur == 0)) { __VA_ARGS__; } } while(0)
  563: 
  564: /*
  565: --------------------------------------------------------------------------------
  566:   Gestion de la pile opérationnelle
  567: --------------------------------------------------------------------------------
  568: */
  569: 
  570: #define pushOnStack(rpl_object) do { \
  571:     __CATCH_SYSTEM_ERROR__; \
  572:     if (((*rpl_arguments).l_base_pile = \
  573:             empilement_pile_operationnelle(rpl_arguments, rpl_object)) \
  574:                     == NULL) \
  575:         systemError("Memory allocation error"); \
  576:     if ((*rpl_object).nombre_occurrences == 1) rpl_object = NULL; } while(0)
  577: 
  578: #define pullFromStack(rpl_object, ...) do { \
  579:     __CATCH_SYSTEM_ERROR__; \
  580:     (*rpl_arguments).l_base_pile = \
  581:             depilement_pile_operationnelle(rpl_arguments, &rpl_object); \
  582:     if (rpl_object == NULL) \
  583:     { \
  584:         executionError("Too few arguments"); \
  585:     } \
  586:     else \
  587:     { \
  588:         if (strlen(#__VA_ARGS__) == 0) \
  589:         { \
  590:             systemError("Undefined type"); \
  591:         } \
  592:         else \
  593:         { \
  594:             __type = 0; \
  595:             if (strstr(#__VA_ARGS__, "integerVector") != NULL) { \
  596:                 if ((*rpl_object).type == VIN) __type = 1; } \
  597:             else if (strstr(#__VA_ARGS__, "realVector") != NULL) { \
  598:                 if ((*rpl_object).type == VRL) __type = 1; } \
  599:             else if (strstr(#__VA_ARGS__, "complexVector") != NULL) { \
  600:                 if ((*rpl_object).type == VCX) __type = 1; } \
  601:             else if (strstr(#__VA_ARGS__, "integer") != NULL) { \
  602:                 if ((*rpl_object).type == INT) __type = 1; } \
  603:             else if (strstr(#__VA_ARGS__, "real") != NULL) { \
  604:                 if ((*rpl_object).type == REL) __type = 1; } \
  605:             else if (strstr(#__VA_ARGS__, "complex") != NULL) { \
  606:                 if ((*rpl_object).type == CPL) __type = 1; } \
  607:             else if (strstr(#__VA_ARGS__, "string") != NULL) { \
  608:                 if ((*rpl_object).type == CHN) __type = 1; } \
  609:             else if (strstr(#__VA_ARGS__, "list") != NULL) { \
  610:                 if ((*rpl_object).type == LST) __type = 1; } \
  611:             else if (strstr(#__VA_ARGS__, "external") != NULL) { \
  612:                 if ((*rpl_object).type == EXT) { \
  613:                     if ((*rpl_object).descripteur_bibliotheque == \
  614:                             __static_library_descriptor) __type = 1; } }\
  615:             else if (strstr(#__VA_ARGS__, "unknown") != NULL) { \
  616:                 __type = 1; } \
  617:             if (__type == 0) \
  618:             { \
  619:                 executionError("Type not allowed"); \
  620:             } \
  621:         } \
  622:     } } while(0)
  623: 
  624: #define objectSubtype(a) (*a).extension_type
  625: 
  626: /*
  627: --------------------------------------------------------------------------------
  628:   Gestion des objets
  629: --------------------------------------------------------------------------------
  630: */
  631: 
  632: #define then {
  633: #define endIf __CATCH_SYSTEM_ERROR__; }
  634: #define elseIf __CATCH_SYSTEM_ERROR__; } else if
  635: #define orElse __CATCH_SYSTEM_ERROR__; } else {
  636: 
  637: //  Constantes symboliques
  638: 
  639: #define createSymbolicConstant(rpl_object, type, value) do { \
  640:     struct_processus *s_etat_processus; \
  641:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
  642:     if ((strcmp(#type, "integer") != 0) && (strcmp(#type, "real") != 0)) \
  643:         systemError("Type not allowed for symbolic constant"); \
  644:     __taille_bloc = sizeof(t_8_bits) * 8; \
  645:     __indice_bloc = (35 - 1) / __taille_bloc; \
  646:     __indice_bit = (35 - 1) % __taille_bloc; \
  647:     __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
  648:     if (((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) != 0) \
  649:     { \
  650:         createNameObject(rpl_object); \
  651:         __CATCH_SYSTEM_ERROR__; \
  652:         { \
  653:             char *__constant_name; \
  654:             if ((__constant_name = malloc((strlen(__library_name) + \
  655:                     strlen(__function_name) - 9) * sizeof(char))) == NULL) \
  656:                 systemError("Memory allocation error"); \
  657:             sprintf(__constant_name, "%s$%s", __library_name, \
  658:                     &(__function_name[11])); \
  659:             setName(rpl_object, __constant_name); \
  660:             free(__constant_name); \
  661:         } \
  662:     } \
  663:     else \
  664:     { \
  665:         if (strcmp(#type, "integer") == 0) \
  666:         { \
  667:             createIntegerObject(rpl_object); \
  668:             __CATCH_SYSTEM_ERROR__; \
  669:             setInteger(rpl_object, value); \
  670:         } \
  671:         else if (strcmp(#type, "real") == 0) \
  672:         { \
  673:             createRealObject(rpl_object); \
  674:             __CATCH_SYSTEM_ERROR__; \
  675:             setReal(rpl_object, value); \
  676:         } \
  677:     } \
  678:     __CATCH_SYSTEM_ERROR__; \
  679:     __constante--; } while(0)
  680: 
  681: #define createSymbolicComplexConstant(rpl_object, rp, ip) do { \
  682:     struct_processus *s_etat_processus; \
  683:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
  684:     __taille_bloc = sizeof(t_8_bits) * 8; \
  685:     __indice_bloc = (35 - 1) / __taille_bloc; \
  686:     __indice_bit = (35 - 1) % __taille_bloc; \
  687:     __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
  688:     if (((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) != 0) \
  689:     { \
  690:         createNameObject(rpl_object); \
  691:         __CATCH_SYSTEM_ERROR__; \
  692:         { \
  693:             char *__constant_name; \
  694:             if ((__constant_name = malloc((strlen(__library_name) + \
  695:                     strlen(__function_name) + 2) * sizeof(char))) == NULL) \
  696:                 systemError("Memory allocation error"); \
  697:             sprintf(__constant_name, "%s$%s", __library_name, \
  698:                     __function_name); \
  699:             setName(rpl_object, __constant_name); \
  700:             free(__constant_name); \
  701:         } \
  702:     } \
  703:     else \
  704:     { \
  705:         createComplexObject(rpl_object); \
  706:         __CATCH_SYSTEM_ERROR__; \
  707:         setComplex(rpl_object, rp, im); \
  708:     } \
  709:     __CATCH_SYSTEM_ERROR__; \
  710:     __constante--; } while(0)
  711: 
  712: // Integer
  713: 
  714: #define setInteger(rpl_object, value) do { \
  715:     ifIsInteger(rpl_object) \
  716:     { \
  717:         if ((*rpl_object).nombre_occurrences > 1) \
  718:         { \
  719:             struct_objet *__tmp_rpl_object; \
  720:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  721:                 systemError("Memory allocation error"); \
  722:             _liberation(rpl_object); \
  723:             rpl_object = __tmp_rpl_object; \
  724:         } \
  725:         (*((integer8 *) (*rpl_object).objet)) = (integer8) value; \
  726:     } \
  727:     else executionError("Type mistmatch error"); } while(0)
  728: 
  729: #define isInteger(rpl_object) \
  730:     ((*rpl_object).type == INT)
  731: 
  732: #define ifIsInteger(rpl_object) if (isInteger(rpl_object))
  733: #define elseIfIsInteger(rpl_object) } else ifIsInteger(rpl_object)
  734: 
  735: #define getInteger(rpl_object, value) do { \
  736:     value = 0; \
  737:     ifIsInteger(rpl_object) value = (*((integer8 *) (*rpl_object).objet)); \
  738:     else executionError("Type mismatch error"); } while(0)
  739: 
  740: #define createIntegerObject(rpl_object) do { \
  741:     if (rpl_object != NULL) \
  742:         systemError("Reallocated object"); \
  743:     if ((rpl_object = _allocation(INT)) == NULL) \
  744:         systemError("Memory allocation error"); \
  745:     setInteger(rpl_object, 0); } while(0)
  746: 
  747: // Real
  748: 
  749: #define setReal(rpl_object, value) do { \
  750:     ifIsReal(rpl_object) \
  751:     { \
  752:         if ((*rpl_object).nombre_occurrences > 1) \
  753:         { \
  754:             struct_objet *__tmp_rpl_object; \
  755:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  756:                 systemError("Memory allocation error"); \
  757:             _liberation(rpl_object); \
  758:             rpl_object = __tmp_rpl_object; \
  759:         } \
  760:         (*((real8 *) (*rpl_object).objet)) = (real8) value; \
  761:     } \
  762:     else executionError("Type mistmatch error"); } while(0)
  763: 
  764: #define isReal(rpl_object) \
  765:     ((*rpl_object).type == REL)
  766: 
  767: #define ifIsReal(rpl_object) if (isReal(rpl_object))
  768: #define elseIfIsReal(rpl_object) } else ifIsReal(rpl_object)
  769: 
  770: #define getReal(rpl_object, value) do { \
  771:     value = 0; \
  772:     ifIsReal(rpl_object) value = (*((real8 *) (*rpl_object).objet)); \
  773:     else executionError("Type mismatch error"); } while(0)
  774: 
  775: #define createRealObject(rpl_object) do { \
  776:     if (rpl_object != NULL) \
  777:         systemError("Reallocated object"); \
  778:     if ((rpl_object = _allocation(REL)) == NULL) \
  779:         systemError("Memory allocation error"); \
  780:     setReal(rpl_object, 0); } while(0)
  781: 
  782: // Complex
  783: 
  784: #define setComplex(rpl_object, rp, ip) do { \
  785:     typeof(rp) __rp = rp; \
  786:     typeof(ip) __ip = ip; \
  787:     ifIsComplex(rpl_object) \
  788:     { \
  789:         if ((*rpl_object).nombre_occurrences > 1) \
  790:         { \
  791:             struct_objet *__tmp_rpl_object; \
  792:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  793:                 systemError("Memory allocation error"); \
  794:             _liberation(rpl_object); \
  795:             rpl_object = __tmp_rpl_object; \
  796:         } \
  797:         setRealPartOfComplex(rpl_object, __rp); \
  798:         setImaginaryPartOfComplex(rpl_object, __ip); \
  799:     } \
  800:     else executionError("Type mismatch error"); } while(0)
  801: 
  802: #define setRealPartOfComplex(rpl_object, value) do { \
  803:     if ((*rpl_object).nombre_occurrences > 1) \
  804:     { \
  805:         struct_objet *__tmp_rpl_object; \
  806:         if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  807:             systemError("Memory allocation error"); \
  808:         _liberation(rpl_object); \
  809:         rpl_object = __tmp_rpl_object; \
  810:     } \
  811:     ifIsComplex(rpl_object) (*((complex16 *) (*rpl_object).objet)) \
  812:             .partie_reelle = value; \
  813:     else executionError("Type mismatch error"); } while(0)
  814: 
  815: #define setImaginaryPartOfComplex(rpl_object, value) do { \
  816:     if ((*rpl_object).nombre_occurrences > 1) \
  817:     { \
  818:         struct_objet *__tmp_rpl_object; \
  819:         if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  820:             systemError("Memory allocation error"); \
  821:         _liberation(rpl_object); \
  822:         rpl_object = __tmp_rpl_object; \
  823:     } \
  824:     (*((complex16 *) (*rpl_object).objet)).partie_imaginaire = value; \
  825:     else executionError("Type mismatch error"); } while(0)
  826: 
  827: #define getRealPartOfComplex(rpl_object, value) \
  828:     value = (*((complex16 *) (*rpl_object).objet)).partie_reelle
  829: 
  830: #define getImaginaryPartOfComplex(rpl_object, value) \
  831:     value = (*((complex16 *) (*rpl_object).objet)).partie_imaginaire
  832: 
  833: #define isComplex(rpl_object) \
  834:     ((*rpl_object).type == CPL)
  835: 
  836: #define ifIsComplex(rpl_object) if (isComplex(rpl_object))
  837: #define elseIfIsComplex(rpl_object) } else ifIsComplex(rpl_object)
  838: 
  839: #define getComplex(rpl_object, value) do { \
  840:     value.partie_reelle = 0; \
  841:     value.partie_imaginaire = 0; \
  842:     ifIsComplex(rpl_object) value = (*((complex16 *) (*rpl_object).objet)); \
  843:     else systemError("Not a complex"); } while(0)
  844: 
  845: #define createComplexObject(rpl_object) do { \
  846:     if (rpl_object != NULL) \
  847:         systemError("Reallocated object"); \
  848:     if ((rpl_object = _allocation(CPL)) == NULL) \
  849:         systemError("Memory allocation error"); \
  850:     setComplex(rpl_object, 0, 0); } while(0)
  851: 
  852: // Generalized vectors
  853: 
  854: #define createVectorObject(rpl_object, size, otype, structure, cat) do { \
  855:     integer8 i; \
  856:     struct_processus *s_etat_processus; \
  857:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
  858:     if (rpl_object != NULL) \
  859:         systemError("Reallocated object"); \
  860:     if ((rpl_object = _allocation(cat)) == NULL) \
  861:         systemError("Memory allocation error"); \
  862:     (*((structure *) (*rpl_object).objet)).taille = size; \
  863:     if (((*((structure *) (*rpl_object).objet)).tableau = \
  864:             malloc(size * sizeof(otype))) == NULL) \
  865:         systemError("Memory allocation error"); \
  866:     if (cat != VCX) \
  867:     { \
  868:         if (cat == VIN) \
  869:             (*((structure *) (*rpl_object).objet)).type = 'I'; \
  870:         else \
  871:             (*((structure *) (*rpl_object).objet)).type = 'R'; \
  872:         for(i = 0; i < size; ((otype *) (*((structure *) (*rpl_object).objet)) \
  873:                 .tableau)[i++] = (otype) 0); \
  874:     } \
  875:     else \
  876:     { \
  877:         (*((structure *) (*rpl_object).objet)).type = 'C'; \
  878:         for(i = 0; i < size; i++) \
  879:         { \
  880:             ((complex16 *) (*((structure *) (*rpl_object).objet)).tableau)[i] \
  881:                     .partie_reelle = 0; \
  882:             ((complex16 *) (*((structure *) (*rpl_object).objet)).tableau)[i] \
  883:                     .partie_imaginaire = 0; \
  884:         } \
  885:     } } while(0)
  886: 
  887: #define vectorSize(rpl_object) \
  888:     ({ if ((*rpl_object).type == VIN) \
  889:             (*((integer8 *) (*rpl_object).objet)).taille; \
  890:     else if ((*rpl_object).type == VRL) \
  891:             (*((real8 *) (*rpl_object).objet)).taille; \
  892:     else if ((*rpl_object).type == VCX)) \
  893:             (*((complex16 *) (*rpl_object).objet)).taille; \
  894:     else { executionError("Type mistmatch error"); 0; } })
  895: 
  896: // Integer vector
  897: 
  898: #define setIntegerIntoVector(rpl_object, value, position) do { \
  899:     typeof(position) __position = position; \
  900:     ifIsIntegerVector(rpl_object) \
  901:     { \
  902:         if ((*rpl_object).nombre_occurrences > 1) \
  903:         { \
  904:             struct_objet *__tmp_rpl_object; \
  905:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  906:                 systemError("Memory allocation error"); \
  907:             _liberation(rpl_object); \
  908:             rpl_object = __tmp_rpl_object; \
  909:         } \
  910:         __position--; \
  911:         if ((__position < 0) || (__position >= (*((struct_vecteur *) \
  912:                 (*rpl_object).objet)).taille)) \
  913:             { executionError("Element out of range"); } \
  914:         else \
  915:             ((integer8 *) (*((struct_vecteur *) (*rpl_object).objet)).tableau) \
  916:                     [__position] = (integer8) value; \
  917:     } \
  918:     else executionError("Type mistmatch error"); } while(0)
  919: 
  920: #define isIntegerVector(rpl_object) \
  921:     ((*rpl_object).type == VIN)
  922: 
  923: #define ifIsIntegerVector(rpl_object) if (isIntegerVector(rpl_object))
  924: #define elseIfIsIntegerVector(rpl_object) } else ifIsIntegerVector(rpl_object)
  925: 
  926: #define getIntegerFromVector(rpl_object, value, position) do { \
  927:     typeof(position) __position = position; \
  928:     value = 0; \
  929:     ifIsIntegerVector(rpl_object) \
  930:     { \
  931:         __position--; \
  932:         if ((__position < 0) || (__position >= (*((struct_vecteur *) \
  933:                 (*rpl_object).objet)).taille)) \
  934:             executionError("Element out of range"); \
  935:         else \
  936:             value = ((integer8 *) (*((struct_vecteur *) (*rpl_object).objet)) \
  937:                 .tableau)[__position]; \
  938:     } \
  939:     else executionError("Type mismatch error"); } while(0)
  940: 
  941: #define createIntegerVectorObject(rpl_object, size) \
  942:     createVectorObject(rpl_object, size, integer8, struct_vecteur, VIN)
  943: 
  944: // Real vector
  945: 
  946: #define setRealIntoVector(rpl_object, value, position) do { \
  947:     typeof(position) __position = position; \
  948:     ifIsRealVector(rpl_object) \
  949:     { \
  950:         if ((*rpl_object).nombre_occurrences > 1) \
  951:         { \
  952:             struct_objet *__tmp_rpl_object; \
  953:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  954:                 systemError("Memory allocation error"); \
  955:             _liberation(rpl_object); \
  956:             rpl_object = __tmp_rpl_object; \
  957:         } \
  958:         __position--; \
  959:         if ((__position < 0) || (__position >= (*((struct_vecteur *) \
  960:                 (*rpl_object).objet)).taille)) \
  961:             { executionError("Element out of range"); } \
  962:         else \
  963:             ((real8 *) (*((struct_vecteur *) (*rpl_object).objet)).tableau) \
  964:                     [__position] = (real8) value; \
  965:     } \
  966:     else executionError("Type mistmatch error"); } while(0)
  967: 
  968: #define isRealVector(rpl_object) \
  969:     ((*rpl_object).type == VRL)
  970: 
  971: #define ifIsRealVector(rpl_object) if (isRealVector(rpl_object))
  972: #define elseIfIsRealVector(rpl_object) } else ifIsRealVector(rpl_object)
  973: 
  974: #define getRealFromVector(rpl_object, value, position) do { \
  975:     typeof(position) __position = position; \
  976:     value = 0; \
  977:     ifIsRealVector(rpl_object) \
  978:     { \
  979:         __position--; \
  980:         if ((__position < 0) || (__position >= (*((struct_vecteur *) \
  981:                 (*rpl_object).objet)).taille)) \
  982:             executionError("Element out of range"); \
  983:         value = ((real8 *) (*((struct_vecteur *) (*rpl_object).objet)) \
  984:                 .tableau)[__position]; \
  985:     } \
  986:     else executionError("Type mismatch error"); } while(0)
  987: 
  988: #define createRealVectorObject(rpl_object, size) \
  989:     createVectorObject(rpl_object, size, real8, struct_vecteur, VRL)
  990: 
  991: // A FIXER
  992: 
  993: #define createComplexVectorObject
  994: 
  995: #define createIntegerMatrixObject
  996: 
  997: #define createRealMatrixObject
  998: 
  999: #define createComplexMatrixObject
 1000: 
 1001: // Array
 1002: 
 1003: #define isArray(rpl_object) \
 1004:     ((*rpl_object).type == TBL)
 1005: 
 1006: #define ifIsArray(rpl_object) if (isArray(rpl_object))
 1007: #define elseIfIsArray(rpl_object) } else if (isArray(rpl_object))
 1008: 
 1009: #define createArray(rpl_object, size) do { \
 1010:     int __i; \
 1011:     if (rpl_object != NULL) systemError("Reallocated object"); \
 1012:     if ((rpl_object = _allocation(TBL)) == NULL) \
 1013:         systemError("Memory allocation error"); \
 1014:     (*((struct_tableau *) (*rpl_object).objet)).nombre_elements = size; \
 1015:     if (((*((struct_tableau *) (*rpl_object).objet)).elements = malloc( \
 1016:             size * sizeof(struct_objet *))) == NULL) \
 1017:         systemError("Memory allocation error"); \
 1018:     for(__i = 0; __i < size; __i++) { \
 1019:         nullify((*((struct_tableau *) (*rpl_object).objet)).elements[__i]); \
 1020:         createIntegerObject((*((struct_tableau *) (*rpl_object).objet)) \
 1021:                 .elements[__i]); } \
 1022:     } while(0)
 1023: 
 1024: #define setObjectIntoArray(rpl_array, pos, rpl_object) do { \
 1025:         typeof(pos) __position = pos; __position--; \
 1026:         ifIsArray(rpl_array) { \
 1027:             if ((__position < 0) || (__position >= (*((struct_tableau *) \
 1028:                     (*rpl_array).objet)).nombre_elements)) \
 1029:                 executionError("Element out of range"); \
 1030:             if ((*rpl_array).nombre_occurrences > 1) \
 1031:             { \
 1032:                 struct_objet *__tmp_rpl_object; \
 1033:                 if ((__tmp_rpl_object = _copie_objet(rpl_array, 'O')) == NULL) \
 1034:                     systemError("Memory allocation error"); \
 1035:                 _liberation(rpl_array); \
 1036:                 rpl_array = __tmp_rpl_object; \
 1037:             } \
 1038:             _liberation((*((struct_tableau *) (*rpl_array).objet)) \
 1039:                     .elements[__position]); \
 1040:             (*((struct_tableau *) (*rpl_array).objet)).elements[__position] = \
 1041:                     rpl_object; \
 1042:         } \
 1043:         else executionError("Type mistmatch error"); \
 1044:         nullify(rpl_object); \
 1045:     } while(0)
 1046: 
 1047: #define getObjectFromArray()
 1048: 
 1049: // Binary integer
 1050: 
 1051: #define setBinaryInteger(rpl_object, value) do { \
 1052:     ifIsBinaryInteger(rpl_object) \
 1053:     { \
 1054:         if ((*rpl_object).nombre_occurrences > 1) \
 1055:         { \
 1056:             struct_objet *__tmp_rpl_object; \
 1057:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
 1058:                 systemError("Memory allocation error"); \
 1059:             _liberation(rpl_object); \
 1060:             rpl_object = __tmp_rpl_object; \
 1061:         } \
 1062:         (*((integer8 *) (*rpl_object).objet)) = (integer8) value; \
 1063:     } \
 1064:     else executionError("Type mistmatch error"); } while(0)
 1065: 
 1066: #define isBinaryInteger(rpl_object) \
 1067:     ((*rpl_object).type == BIN)
 1068: 
 1069: #define ifIsBinaryInteger(rpl_object) if (isBinaryInteger(rpl_object))
 1070: #define elseIfIsBinaryInteger(rpl_object) } else ifIsBinaryInteger(rpl_object)
 1071: 
 1072: #define getBinaryInteger(rpl_object, value) do { \
 1073:     value = 0; \
 1074:     ifIsBinaryInteger(rpl_object) value = \
 1075:             (*((integer8 *) (*rpl_object).objet)); \
 1076:     else executionError("Type mismatch error"); } while(0)
 1077: 
 1078: #define createBinaryIntegerObject(rpl_object) do { \
 1079:     if (rpl_object != NULL) \
 1080:         systemError("Reallocated object"); \
 1081:     if ((rpl_object = _allocation(BIN)) == NULL) \
 1082:         systemError("Memory allocation error"); \
 1083:     setBinaryInteger(rpl_object, 0); } while(0)
 1084: 
 1085: // Name
 1086: 
 1087: #define isName(rpl_object) \
 1088:     ((*rpl_object).type == NOM)
 1089: 
 1090: #define ifIsName(rpl_object) if (isName(rpl_object))
 1091: #define elseIfIsName(rpl_object)  } else if (isName(rpl_object))
 1092: 
 1093: #define setName(rpl_object, value) do { \
 1094:     struct_processus *s_etat_processus; \
 1095:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1096:     ifIsName(rpl_object) \
 1097:     { \
 1098:         if ((*rpl_object).nombre_occurrences > 1) \
 1099:         { \
 1100:             struct_objet *__tmp_rpl_object; \
 1101:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
 1102:                 systemError("Memory allocation error"); \
 1103:             _liberation(rpl_object); \
 1104:             rpl_object = __tmp_rpl_object; \
 1105:         } \
 1106:         free((*((struct_nom *) (*rpl_object).objet)).nom); \
 1107:         (*((struct_nom *) (*rpl_object).objet)).symbole = d_faux; \
 1108:         if (((*((struct_nom *) (*rpl_object).objet)).nom = malloc( \
 1109:                 (strlen(value) + 1) * sizeof(unsigned char))) == NULL) \
 1110:             systemError("Memory allocation error"); \
 1111:         strcpy((char *) (*((struct_nom *) (*rpl_object).objet)).nom, \
 1112:                 (char *) value); \
 1113:     } \
 1114:     else executionError("Type mistmatch error"); } while(0)
 1115: 
 1116: #define setSymbolicName(rpl_object, value) do { \
 1117:     setName(rpl_object, value); \
 1118:     (*((struct_nom *) (*rpl_object).objet)).symbole = d_vrai; } while(0)
 1119: 
 1120: #define createNameObject(rpl_object) do { \
 1121:     struct_processus *s_etat_processus; \
 1122:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1123:     if (rpl_object != NULL) \
 1124:         systemError("Reallocated object"); \
 1125:     if ((rpl_object = _allocation(NOM)) == NULL) \
 1126:         systemError("Memory allocation error"); \
 1127:     (*((struct_nom *) (*rpl_object).objet)).symbole = d_faux; \
 1128:     if (((*((struct_nom *) (*rpl_object).objet)).nom = malloc( \
 1129:             sizeof(unsigned char))) == NULL) \
 1130:         systemError("Memory allocation error"); \
 1131:     strcpy((char *) (*((struct_nom *) (*rpl_object).objet)).nom, ""); } while(0)
 1132: 
 1133: // String
 1134: 
 1135: #define isString(rpl_object) \
 1136:     ((*rpl_object).type == CHN)
 1137: 
 1138: #define ifIsString(rpl_object) if (isString(rpl_object))
 1139: #define elseIfIsString(rpl_object) } else if (isString(rpl_object))
 1140: 
 1141: #define setString(rpl_object, string) do { \
 1142:     struct_processus *s_etat_processus; \
 1143:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1144:     ifIsString(rpl_object) \
 1145:     { \
 1146:         if (string == NULL) executionError("Nullified string"); else \
 1147:         { \
 1148:             if ((*rpl_object).nombre_occurrences > 1) \
 1149:             { \
 1150:                 struct_objet *__tmp_rpl_object; \
 1151:                 if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) \
 1152:                         == NULL) \
 1153:                     systemError("Memory allocation error"); \
 1154:                 _liberation(rpl_object); \
 1155:                 rpl_object = __tmp_rpl_object; \
 1156:             } \
 1157:             free((unsigned char *) (*rpl_object).objet); \
 1158:             if (((*rpl_object).objet = malloc((strlen(string) + 1) * \
 1159:                     sizeof(unsigned char))) == NULL) \
 1160:                 systemError("Memory allocation error"); \
 1161:             strcpy((char *) (*rpl_object).objet, string); \
 1162:         } \
 1163:     } \
 1164:     else executionError("Type mistmatch error"); } while(0)
 1165: 
 1166: #define getString(rpl_object, string) do { \
 1167:     string = NULL; \
 1168:     ifIsString(rpl_object) string = (char *) (*rpl_object).objet; \
 1169:     else executionError("Type mismatch error"); } while(0)
 1170: 
 1171: #define unEscString(s) ({ \
 1172:     unsigned char *__a; integer8 __l; \
 1173:     __a = formateur_flux((*rpl_arguments).s_etat_processus, \
 1174:             (unsigned char *) s, &__l); \
 1175:     if (nullified(__a)) systemError("Memory allocation error"); \
 1176:     (string) __a; \
 1177:     })
 1178: 
 1179: #define escString(rpl_object) ({ \
 1180:     unsigned char *__a; integer8 __l; \
 1181:     __a = analyse_flux((*rpl_arguments).s_etat_processus, \
 1182:             (unsigned char *) s, strlen(s)); \
 1183:     if (nullified(__a)) systemError("Memory allocation error"); \
 1184:     (string) __a; \
 1185:     })
 1186: 
 1187: #define createStringObject(rpl_object) do { \
 1188:     struct_processus *s_etat_processus; \
 1189:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1190:     if (rpl_object != NULL) \
 1191:         systemError("Reallocated object"); \
 1192:     if ((rpl_object = _allocation(CHN)) == NULL) \
 1193:         systemError("Memory allocation error"); \
 1194:     if (((*rpl_object).objet = malloc(sizeof(unsigned char))) == NULL) \
 1195:         systemError("Memory allocation error"); \
 1196:     strcpy((char *) (*rpl_object).objet, ""); } while(0)
 1197: 
 1198: // List
 1199: 
 1200: #define isList(rpl_object) \
 1201:     ((*rpl_object).type == LST)
 1202: 
 1203: #define ifIsList(rpl_object) if (isList(rpl_object))
 1204: #define elseIfIsList(rpl_object) else if (isList(rpl_object))
 1205: 
 1206: #define createListObject(rpl_object) do { \
 1207:     if (rpl_object != NULL) \
 1208:         systemError("Reallocated object"); \
 1209:     if ((rpl_object = _allocation(LST)) == NULL) \
 1210:         systemError("Memory allocation error"); \
 1211:     (*rpl_object).objet = NULL; } while(0)
 1212: 
 1213: #define addObjectToList(list, rpl_object) do { \
 1214:     struct_processus *s_etat_processus; \
 1215:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1216:     ifIsList(list) \
 1217:     { \
 1218:         struct_objet *__tmp_rpl_object; \
 1219:         if ((__tmp_rpl_object = _copie_objet(list, 'N')) == NULL) \
 1220:             systemError("Memory allocation error"); \
 1221:         _liberation(list); \
 1222:         list = __tmp_rpl_object; \
 1223:         if ((*list).objet == NULL) \
 1224:         { \
 1225:             if (((*list).objet = malloc(sizeof(struct_liste_chainee))) \
 1226:                     == NULL) \
 1227:                 systemError("Memory allocation error"); \
 1228:             (*((struct_liste_chainee *) (*list).objet)).suivant = NULL; \
 1229:             (*((struct_liste_chainee *) (*list).objet)).donnee = rpl_object; \
 1230:         } \
 1231:         else \
 1232:         { \
 1233:             struct_liste_chainee    *l_element_courant; \
 1234:             l_element_courant = (*list).objet; \
 1235:             while((*l_element_courant).suivant != NULL) \
 1236:                 l_element_courant = (*l_element_courant).suivant; \
 1237:             if (((*l_element_courant).suivant = \
 1238:                     malloc(sizeof(struct_liste_chainee))) == NULL) \
 1239:                 systemError("Memory allocation error"); \
 1240:             l_element_courant = (*l_element_courant).suivant; \
 1241:             (*l_element_courant).suivant = NULL; \
 1242:             (*l_element_courant).donnee = rpl_object; \
 1243:         } \
 1244:         rpl_object = NULL; \
 1245:     } \
 1246:     else executionError("Type mistmatch error"); } while(0)
 1247: 
 1248: #define insertObjectIntoList(list, rpl_object) do { \
 1249:     struct_processus *s_etat_processus; \
 1250:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1251:     ifIsList(list) \
 1252:     { \
 1253:         struct_objet *__tmp_rpl_object; \
 1254:         if ((__tmp_rpl_object = _copie_objet(list, 'N')) == NULL) \
 1255:             systemError("Memory allocation error"); \
 1256:         _liberation(list); \
 1257:         list = __tmp_rpl_object; \
 1258:         if ((*list).objet == NULL) \
 1259:         { \
 1260:             if (((*list).objet = malloc(sizeof(struct_liste_chainee))) \
 1261:                     == NULL) \
 1262:                 systemError("Memory allocation error"); \
 1263:             (*((struct_liste_chainee *) (*list).objet)).suivant = NULL; \
 1264:             (*((struct_liste_chainee *) (*list).objet)).donnee = rpl_object; \
 1265:         } \
 1266:         else \
 1267:         { \
 1268:             struct_liste_chainee    *l_element_courant; \
 1269:             if ((l_element_courant = \
 1270:                     malloc(sizeof(struct_liste_chainee))) == NULL) \
 1271:                 systemError("Memory allocation error"); \
 1272:             (*l_element_courant).donnee = rpl_object; \
 1273:             (*l_element_courant).suivant = (*list).objet; \
 1274:             (*list).objet = l_element_courant; \
 1275:         } \
 1276:         rpl_object = NULL; \
 1277:     } \
 1278:     else executionError("Type mistmatch error"); } while(0)
 1279: 
 1280: #define removeObjectFromList(list, rpl_object) do { \
 1281:     struct_processus *s_etat_processus; \
 1282:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1283:     ifIsList(list) \
 1284:     { \
 1285:         if ((*list).objet != NULL) \
 1286:         { \
 1287:             struct_liste_chainee    *__current; \
 1288:             struct_liste_chainee    *__previous; \
 1289:             __current = (*list).objet; \
 1290:             __previous = NULL; \
 1291:             if ((*__current).donnee == rpl_object) \
 1292:             { \
 1293:                 (*list).objet = (*__current).suivant; \
 1294:             } \
 1295:             else \
 1296:             { \
 1297:                 while(__current != NULL) \
 1298:                 { \
 1299:                     if ((*__current).donnee == rpl_object) \
 1300:                     { \
 1301:                         (*__previous).suivant = (*__current).suivant; \
 1302:                         break; \
 1303:                     } \
 1304:                     __previous = __current; \
 1305:                     __current = (*__current).suivant; \
 1306:                 } \
 1307:             } \
 1308:             _liberation((*__current).donnee); \
 1309:             free(__current); \
 1310:         } \
 1311:     } \
 1312:     else executionError("Type mistmatch error"); } while(0)
 1313: 
 1314: #define getObjectFromList(list, position, rpl_object)
 1315: 
 1316: #define putObjectIntoList(list, position, rpl_object)
 1317: 
 1318: #define getListFromList(list, position1, position2, rpl_object)
 1319: 
 1320: #define listLength(list, length) do { \
 1321:     if (list == NULL) executionError("Nullified object"); \
 1322:     if ((*list).type != LST) \
 1323:             executionError("Type mistmatch error"); \
 1324:     { \
 1325:         struct_liste_chainee        *l_element_courant; \
 1326:         length = 0; \
 1327:         l_element_courant = (*list).objet; \
 1328:         while(l_element_courant != NULL) \
 1329:         { \
 1330:             l_element_courant = (*l_element_courant).suivant; \
 1331:             length++; \
 1332:         } \
 1333:     } } while(0)
 1334: 
 1335: // NON
 1336: #define createObject(rpl_object) do { \
 1337:     if (rpl_object != NULL) \
 1338:         systemError("Reallocated object"); \
 1339:     if ((rpl_object = _allocation(NON)) == NULL) \
 1340:         systemError("Memory allocation error"); \
 1341:     (*rpl_object).objet = NULL; \
 1342:     } while(0)
 1343: 
 1344: // EXT
 1345: #define createExternalObject(rpl_object, subtype) do { \
 1346:     if (rpl_object != NULL) \
 1347:         systemError("Reallocated object"); \
 1348:     if ((rpl_object = _allocation(EXT)) == NULL) \
 1349:         systemError("Memory allocation error"); \
 1350:     (*rpl_object).objet = NULL; \
 1351:     (*rpl_object).extension_type = subtype; \
 1352:     (*rpl_object).descripteur_bibliotheque = __static_library_descriptor; \
 1353:     } while(0)
 1354: 
 1355: /*
 1356: --------------------------------------------------------------------------------
 1357:   Allocation mémoire
 1358: --------------------------------------------------------------------------------
 1359: */
 1360: 
 1361: #define size(a) sizeof(a)
 1362: 
 1363: #define allocate(a) ({ void *ptr; \
 1364:     struct_processus *s_etat_processus; \
 1365:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1366:     if ((ptr = malloc(a)) == NULL) \
 1367:         { systemError("Memory allocation error"); \
 1368:         __CATCH_SYSTEM_ERROR__; } ptr; }) \
 1369: 
 1370: #define reallocate(a, s) ({ void *ptr; \
 1371:     struct_processus *s_etat_processus; \
 1372:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1373:     if ((ptr = realloc(a, s)) == NULL) \
 1374:         { systemError("Memory allocation error"); \
 1375:         __CATCH_SYSTEM_ERROR__; } ptr; }) \
 1376: 
 1377: #define deallocate(a) do { \
 1378:     struct_processus *s_etat_processus; \
 1379:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1380:     free(a); } while(0)
 1381: 
 1382: /*
 1383: --------------------------------------------------------------------------------
 1384:   Récupération des interruptions et des signaux
 1385: --------------------------------------------------------------------------------
 1386: */
 1387: 
 1388: #define pollSignalsAndInterrupts() \
 1389:     __CATCH_SYSTEM_ERROR__; \
 1390:     do { scrutation_injection((*rpl_arguments).s_etat_processus); } while(0)
 1391: 
 1392: /*
 1393: --------------------------------------------------------------------------------
 1394:   Exécution d'une fonction intrinsèque
 1395: --------------------------------------------------------------------------------
 1396: */
 1397: 
 1398: #define intrinsic(function) do { \
 1399:     int __status; \
 1400:     __CATCH_SYSTEM_ERROR__; \
 1401:     __status = wrapper_instruction_intrinseque( \
 1402:             instruction_##function, rpl_arguments); \
 1403:     if (__status == 1) executionError(#function); \
 1404:     if (__status == 2) systemError(#function); \
 1405:     } while(0)
 1406: 
 1407: #endif
 1408: 
 1409: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>