File:  [local] / rpl / src / rplexternals.h
Revision 1.97: download - view: text, annotated - select for diffs - revision graph
Fri Jan 10 11:15:51 2020 UTC (4 years, 3 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_32, HEAD
Modification du copyright.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.32
    4:   Copyright (C) 1989-2020 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__, "integer") != NULL) \
  596:                 if ((*rpl_object).type == INT) __type = 1; \
  597:             if (strstr(#__VA_ARGS__, "real") != NULL) \
  598:                 if ((*rpl_object).type == REL) __type = 1; \
  599:             if (strstr(#__VA_ARGS__, "complex") != NULL) \
  600:                 if ((*rpl_object).type == CPL) __type = 1; \
  601:             if (strstr(#__VA_ARGS__, "string") != NULL) \
  602:                 if ((*rpl_object).type == CHN) __type = 1; \
  603:             if (strstr(#__VA_ARGS__, "list") != NULL) \
  604:                 if ((*rpl_object).type == LST) __type = 1; \
  605:             if (strstr(#__VA_ARGS__, "external") != NULL) \
  606:                 if ((*rpl_object).type == EXT) { \
  607:                     if ((*rpl_object).descripteur_bibliotheque == \
  608:                             __static_library_descriptor) __type = 1; }\
  609:             if (strstr(#__VA_ARGS__, "unknown") != NULL) \
  610:                 __type = 1; \
  611:             if (__type == 0) \
  612:             { \
  613:                 executionError("Type not allowed"); \
  614:             } \
  615:         } \
  616:     } } while(0)
  617: 
  618: #define objectSubtype(a) (*a).extension_type
  619: 
  620: /*
  621: --------------------------------------------------------------------------------
  622:   Gestion des objets
  623: --------------------------------------------------------------------------------
  624: */
  625: 
  626: #define then {
  627: #define endIf __CATCH_SYSTEM_ERROR__; }
  628: #define elseIf __CATCH_SYSTEM_ERROR__; } else if
  629: #define orElse __CATCH_SYSTEM_ERROR__; } else {
  630: 
  631: //  Constantes symboliques
  632: 
  633: #define createSymbolicConstant(rpl_object, type, value) do { \
  634:     struct_processus *s_etat_processus; \
  635:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
  636:     if ((strcmp(#type, "integer") != 0) && (strcmp(#type, "real") != 0)) \
  637:         systemError("Type not allowed for symbolic constant"); \
  638:     __taille_bloc = sizeof(t_8_bits) * 8; \
  639:     __indice_bloc = (35 - 1) / __taille_bloc; \
  640:     __indice_bit = (35 - 1) % __taille_bloc; \
  641:     __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
  642:     if (((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) != 0) \
  643:     { \
  644:         createNameObject(rpl_object); \
  645:         __CATCH_SYSTEM_ERROR__; \
  646:         { \
  647:             char *__constant_name; \
  648:             if ((__constant_name = malloc((strlen(__library_name) + \
  649:                     strlen(__function_name) - 9) * sizeof(char))) == NULL) \
  650:                 systemError("Memory allocation error"); \
  651:             sprintf(__constant_name, "%s$%s", __library_name, \
  652:                     &(__function_name[11])); \
  653:             setName(rpl_object, __constant_name); \
  654:             free(__constant_name); \
  655:         } \
  656:     } \
  657:     else \
  658:     { \
  659:         if (strcmp(#type, "integer") == 0) \
  660:         { \
  661:             createIntegerObject(rpl_object); \
  662:             __CATCH_SYSTEM_ERROR__; \
  663:             setInteger(rpl_object, value); \
  664:         } \
  665:         else if (strcmp(#type, "real") == 0) \
  666:         { \
  667:             createRealObject(rpl_object); \
  668:             __CATCH_SYSTEM_ERROR__; \
  669:             setReal(rpl_object, value); \
  670:         } \
  671:     } \
  672:     __CATCH_SYSTEM_ERROR__; \
  673:     __constante--; } while(0)
  674: 
  675: #define createSymbolicComplexConstant(rpl_object, rp, ip) do { \
  676:     struct_processus *s_etat_processus; \
  677:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
  678:     __taille_bloc = sizeof(t_8_bits) * 8; \
  679:     __indice_bloc = (35 - 1) / __taille_bloc; \
  680:     __indice_bit = (35 - 1) % __taille_bloc; \
  681:     __masque = ((t_8_bits) 1) << (__taille_bloc - __indice_bit - 1); \
  682:     if (((*rpl_arguments).drapeaux_etat[__indice_bloc] & __masque) != 0) \
  683:     { \
  684:         createNameObject(rpl_object); \
  685:         __CATCH_SYSTEM_ERROR__; \
  686:         { \
  687:             char *__constant_name; \
  688:             if ((__constant_name = malloc((strlen(__library_name) + \
  689:                     strlen(__function_name) + 2) * sizeof(char))) == NULL) \
  690:                 systemError("Memory allocation error"); \
  691:             sprintf(__constant_name, "%s$%s", __library_name, \
  692:                     __function_name); \
  693:             setName(rpl_object, __constant_name); \
  694:             free(__constant_name); \
  695:         } \
  696:     } \
  697:     else \
  698:     { \
  699:         createComplexObject(rpl_object); \
  700:         __CATCH_SYSTEM_ERROR__; \
  701:         setComplex(rpl_object, rp, im); \
  702:     } \
  703:     __CATCH_SYSTEM_ERROR__; \
  704:     __constante--; } while(0)
  705: 
  706: // Integer
  707: 
  708: #define setInteger(rpl_object, value) do { \
  709:     ifIsInteger(rpl_object) \
  710:     { \
  711:         if ((*rpl_object).nombre_occurrences > 1) \
  712:         { \
  713:             struct_objet *__tmp_rpl_object; \
  714:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  715:                 systemError("Memory allocation error"); \
  716:             _liberation(rpl_object); \
  717:             rpl_object = __tmp_rpl_object; \
  718:         } \
  719:         (*((integer8 *) (*rpl_object).objet)) = (integer8) value; \
  720:     } \
  721:     else executionError("Type mistmatch error"); } while(0)
  722: 
  723: #define isInteger(rpl_object) \
  724:     ((*rpl_object).type == INT)
  725: 
  726: #define ifIsInteger(rpl_object) if (isInteger(rpl_object))
  727: #define elseIfIsInteger(rpl_object) } else ifIsInteger(rpl_object)
  728: 
  729: #define getInteger(rpl_object, value) do { \
  730:     value = 0; \
  731:     ifIsInteger(rpl_object) value = (*((integer8 *) (*rpl_object).objet)); \
  732:     else executionError("Type mismatch error"); } while(0)
  733: 
  734: #define createIntegerObject(rpl_object) do { \
  735:     if (rpl_object != NULL) \
  736:         systemError("Reallocated object"); \
  737:     if ((rpl_object = _allocation(INT)) == NULL) \
  738:         systemError("Memory allocation error"); \
  739:     setInteger(rpl_object, 0); } while(0)
  740: 
  741: // Real
  742: 
  743: #define setReal(rpl_object, value) do { \
  744:     ifIsReal(rpl_object) \
  745:     { \
  746:         if ((*rpl_object).nombre_occurrences > 1) \
  747:         { \
  748:             struct_objet *__tmp_rpl_object; \
  749:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  750:                 systemError("Memory allocation error"); \
  751:             _liberation(rpl_object); \
  752:             rpl_object = __tmp_rpl_object; \
  753:         } \
  754:         (*((real8 *) (*rpl_object).objet)) = (real8) value; \
  755:     } \
  756:     else executionError("Type mistmatch error"); } while(0)
  757: 
  758: #define isReal(rpl_object) \
  759:     ((*rpl_object).type == REL)
  760: 
  761: #define ifIsReal(rpl_object) if (isReal(rpl_object))
  762: #define elseIfIsReal(rpl_object) } else ifIsReal(rpl_object)
  763: 
  764: #define getReal(rpl_object, value) do { \
  765:     value = 0; \
  766:     ifIsReal(rpl_object) value = (*((real8 *) (*rpl_object).objet)); \
  767:     else executionError("Type mismatch error"); } while(0)
  768: 
  769: #define createRealObject(rpl_object) do { \
  770:     if (rpl_object != NULL) \
  771:         systemError("Reallocated object"); \
  772:     if ((rpl_object = _allocation(REL)) == NULL) \
  773:         systemError("Memory allocation error"); \
  774:     setReal(rpl_object, 0); } while(0)
  775: 
  776: // Complex
  777: 
  778: #define setComplex(rpl_object, rp, ip) do { \
  779:     typeof(rp) __rp = rp; \
  780:     typeof(ip) __ip = ip; \
  781:     ifIsComplex(rpl_object) \
  782:     { \
  783:         if ((*rpl_object).nombre_occurrences > 1) \
  784:         { \
  785:             struct_objet *__tmp_rpl_object; \
  786:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  787:                 systemError("Memory allocation error"); \
  788:             _liberation(rpl_object); \
  789:             rpl_object = __tmp_rpl_object; \
  790:         } \
  791:         setRealPartOfComplex(rpl_object, __rp); \
  792:         setImaginaryPartOfComplex(rpl_object, __ip); \
  793:     } \
  794:     else executionError("Type mismatch error"); } while(0)
  795: 
  796: #define setRealPartOfComplex(rpl_object, value) do { \
  797:     if ((*rpl_object).nombre_occurrences > 1) \
  798:     { \
  799:         struct_objet *__tmp_rpl_object; \
  800:         if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  801:             systemError("Memory allocation error"); \
  802:         _liberation(rpl_object); \
  803:         rpl_object = __tmp_rpl_object; \
  804:     } \
  805:     ifIsComplex(rpl_object) (*((complex16 *) (*rpl_object).objet)) \
  806:             .partie_reelle = value; \
  807:     else executionError("Type mismatch error"); } while(0)
  808: 
  809: #define setImaginaryPartOfComplex(rpl_object, value) do { \
  810:     if ((*rpl_object).nombre_occurrences > 1) \
  811:     { \
  812:         struct_objet *__tmp_rpl_object; \
  813:         if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  814:             systemError("Memory allocation error"); \
  815:         _liberation(rpl_object); \
  816:         rpl_object = __tmp_rpl_object; \
  817:     } \
  818:     (*((complex16 *) (*rpl_object).objet)).partie_imaginaire = value; \
  819:     else executionError("Type mismatch error"); } while(0)
  820: 
  821: #define getRealPartOfComplex(rpl_object, value) \
  822:     value = (*((complex16 *) (*rpl_object).objet)).partie_reelle
  823: 
  824: #define getImaginaryPartOfComplex(rpl_object, value) \
  825:     value = (*((complex16 *) (*rpl_object).objet)).partie_imaginaire
  826: 
  827: #define isComplex(rpl_object) \
  828:     ((*rpl_object).type == CPL)
  829: 
  830: #define ifIsComplex(rpl_object) if (isComplex(rpl_object))
  831: #define elseIfIsComplex(rpl_object) } else ifIsComplex(rpl_object)
  832: 
  833: #define getComplex(rpl_object, value) do { \
  834:     value.partie_reelle = 0; \
  835:     value.partie_imaginaire = 0; \
  836:     ifIsComplex(rpl_object) value = (*((complex16 *) (*rpl_object).objet)); \
  837:     else systemError("Not a complex"); } while(0)
  838: 
  839: #define createComplexObject(rpl_object) do { \
  840:     if (rpl_object != NULL) \
  841:         systemError("Reallocated object"); \
  842:     if ((rpl_object = _allocation(CPL)) == NULL) \
  843:         systemError("Memory allocation error"); \
  844:     setComplex(rpl_object, 0, 0); } while(0)
  845: 
  846: // Generalized vectors
  847: 
  848: #define createVectorObject(rpl_object, size, otype, structure, cat) do { \
  849:     integer8 i; \
  850:     struct_processus *s_etat_processus; \
  851:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
  852:     if (rpl_object != NULL) \
  853:         systemError("Reallocated object"); \
  854:     if ((rpl_object = _allocation(cat)) == NULL) \
  855:         systemError("Memory allocation error"); \
  856:     (*((structure *) (*rpl_object).objet)).taille = size; \
  857:     if (((*((structure *) (*rpl_object).objet)).tableau = \
  858:             malloc(size * sizeof(otype))) == NULL) \
  859:         systemError("Memory allocation error"); \
  860:     if (cat != VCX) \
  861:     { \
  862:         if (cat == VIN) \
  863:             (*((structure *) (*rpl_object).objet)).type = 'I'; \
  864:         else \
  865:             (*((structure *) (*rpl_object).objet)).type = 'R'; \
  866:         for(i = 0; i < size; ((otype *) (*((structure *) (*rpl_object).objet)) \
  867:                 .tableau)[i++] = (otype) 0); \
  868:     } \
  869:     else \
  870:     { \
  871:         (*((structure *) (*rpl_object).objet)).type = 'C'; \
  872:         for(i = 0; i < size; i++) \
  873:         { \
  874:             ((complex16 *) (*((structure *) (*rpl_object).objet)).tableau)[i] \
  875:                     .partie_reelle = 0; \
  876:             ((complex16 *) (*((structure *) (*rpl_object).objet)).tableau)[i] \
  877:                     .partie_imaginaire = 0; \
  878:         } \
  879:     } } while(0)
  880: 
  881: // Integer vector
  882: 
  883: #define setIntegerIntoVector(rpl_object, value, position) do { \
  884:     typeof(position) __position = position; \
  885:     ifIsIntegerVector(rpl_object) \
  886:     { \
  887:         if ((*rpl_object).nombre_occurrences > 1) \
  888:         { \
  889:             struct_objet *__tmp_rpl_object; \
  890:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  891:                 systemError("Memory allocation error"); \
  892:             _liberation(rpl_object); \
  893:             rpl_object = __tmp_rpl_object; \
  894:         } \
  895:         __position--; \
  896:         if ((__position < 0) || (__position >= (*((struct_vecteur *) \
  897:                 (*rpl_object).objet)).taille)) \
  898:             { executionError("Element out of range"); } \
  899:         else \
  900:             ((integer8 *) (*((struct_vecteur *) (*rpl_object).objet)).tableau) \
  901:                     [__position] = (integer8) value; \
  902:     } \
  903:     else executionError("Type mistmatch error"); } while(0)
  904: 
  905: #define isIntegerVector(rpl_object) \
  906:     ((*rpl_object).type == VIN)
  907: 
  908: #define ifIsIntegerVector(rpl_object) if (isIntegerVector(rpl_object))
  909: #define elseIfIsIntegerVector(rpl_object) } else ifIsIntegerVector(rpl_object)
  910: 
  911: #define getIntegerFromVector(rpl_object, value, position) do { \
  912:     typeof(position) __position = position; \
  913:     value = 0; \
  914:     ifIsIntegerVector(rpl_object) \
  915:     { \
  916:         __position--; \
  917:         if ((__position < 0) || (__position >= (*((struct_vecteur *) \
  918:                 (*rpl_object).objet)).taille)) \
  919:             executionError("Element out of range"); \
  920:         else \
  921:             value = ((integer8 *) (*((struct_vecteur *) (*rpl_object).objet)) \
  922:                 .tableau)[__position]; \
  923:     } \
  924:     else executionError("Type mismatch error"); } while(0)
  925: 
  926: #define createIntegerVectorObject(rpl_object, size) \
  927:     createVectorObject(rpl_object, size, integer8, struct_vecteur, VIN)
  928: 
  929: // Real vector
  930: 
  931: #define setRealIntoVector(rpl_object, value, position) do { \
  932:     typeof(position) __position = position; \
  933:     ifIsRealVector(rpl_object) \
  934:     { \
  935:         if ((*rpl_object).nombre_occurrences > 1) \
  936:         { \
  937:             struct_objet *__tmp_rpl_object; \
  938:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
  939:                 systemError("Memory allocation error"); \
  940:             _liberation(rpl_object); \
  941:             rpl_object = __tmp_rpl_object; \
  942:         } \
  943:         __position--; \
  944:         if ((__position < 0) || (__position >= (*((struct_vecteur *) \
  945:                 (*rpl_object).objet)).taille)) \
  946:             { executionError("Element out of range"); } \
  947:         else \
  948:             ((real8 *) (*((struct_vecteur *) (*rpl_object).objet)).tableau) \
  949:                     [__position] = (real8) value; \
  950:     } \
  951:     else executionError("Type mistmatch error"); } while(0)
  952: 
  953: #define isRealVector(rpl_object) \
  954:     ((*rpl_object).type == VRL)
  955: 
  956: #define ifIsRealVector(rpl_object) if (isRealVector(rpl_object))
  957: #define elseIfIsRealVector(rpl_object) } else ifIsRealVector(rpl_object)
  958: 
  959: #define getRealFromVector(rpl_object, value, position) do { \
  960:     typeof(position) __position = position; \
  961:     value = 0; \
  962:     ifIsRealVector(rpl_object) \
  963:     { \
  964:         __position--; \
  965:         if ((__position < 0) || (__position >= (*((struct_vecteur *) \
  966:                 (*rpl_object).objet)).taille)) \
  967:             executionError("Element out of range"); \
  968:         value = ((real8 *) (*((struct_vecteur *) (*rpl_object).objet)) \
  969:                 .tableau)[__position]; \
  970:     } \
  971:     else executionError("Type mismatch error"); } while(0)
  972: 
  973: #define createRealVectorObject(rpl_object, size) \
  974:     createVectorObject(rpl_object, size, real8, struct_vecteur, VRL)
  975: 
  976: // A FIXER
  977: 
  978: #define createComplexVectorObject
  979: 
  980: #define createIntegerMatrixObject
  981: 
  982: #define createRealMatrixObject
  983: 
  984: #define createComplexMatrixObject
  985: 
  986: // Array
  987: 
  988: #define isArray(rpl_object) \
  989:     ((*rpl_object).type == TBL)
  990: 
  991: #define ifIsArray(rpl_object) if (isArray(rpl_object))
  992: #define elseIfIsArray(rpl_object) } else if (isArray(rpl_object))
  993: 
  994: #define createArray(rpl_object, size) do { \
  995:     int __i; \
  996:     if (rpl_object != NULL) systemError("Reallocated object"); \
  997:     if ((rpl_object = _allocation(TBL)) == NULL) \
  998:         systemError("Memory allocation error"); \
  999:     (*((struct_tableau *) (*rpl_object).objet)).nombre_elements = size; \
 1000:     if (((*((struct_tableau *) (*rpl_object).objet)).elements = malloc( \
 1001:             size * sizeof(struct_objet *))) == NULL) \
 1002:         systemError("Memory allocation error"); \
 1003:     for(__i = 0; __i < size; __i++) { \
 1004:         nullify((*((struct_tableau *) (*rpl_object).objet)).elements[__i]); \
 1005:         createIntegerObject((*((struct_tableau *) (*rpl_object).objet)) \
 1006:                 .elements[__i]); } \
 1007:     } while(0)
 1008: 
 1009: #define setObjectIntoArray(rpl_array, pos, rpl_object) do { \
 1010:         typeof(pos) __position = pos; __position--; \
 1011:         ifIsArray(rpl_array) { \
 1012:             if ((__position < 0) || (__position >= (*((struct_tableau *) \
 1013:                     (*rpl_array).objet)).nombre_elements)) \
 1014:                 executionError("Element out of range"); \
 1015:             if ((*rpl_array).nombre_occurrences > 1) \
 1016:             { \
 1017:                 struct_objet *__tmp_rpl_object; \
 1018:                 if ((__tmp_rpl_object = _copie_objet(rpl_array, 'O')) == NULL) \
 1019:                     systemError("Memory allocation error"); \
 1020:                 _liberation(rpl_array); \
 1021:                 rpl_array = __tmp_rpl_object; \
 1022:             } \
 1023:             _liberation((*((struct_tableau *) (*rpl_array).objet)) \
 1024:                     .elements[__position]); \
 1025:             (*((struct_tableau *) (*rpl_array).objet)).elements[__position] = \
 1026:                     rpl_object; \
 1027:         } \
 1028:         else executionError("Type mistmatch error"); \
 1029:         nullify(rpl_object); \
 1030:     } while(0)
 1031: 
 1032: #define getObjectFromArray()
 1033: 
 1034: // Binary integer
 1035: 
 1036: #define setBinaryInteger(rpl_object, value) do { \
 1037:     ifIsBinaryInteger(rpl_object) \
 1038:     { \
 1039:         if ((*rpl_object).nombre_occurrences > 1) \
 1040:         { \
 1041:             struct_objet *__tmp_rpl_object; \
 1042:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
 1043:                 systemError("Memory allocation error"); \
 1044:             _liberation(rpl_object); \
 1045:             rpl_object = __tmp_rpl_object; \
 1046:         } \
 1047:         (*((integer8 *) (*rpl_object).objet)) = (integer8) value; \
 1048:     } \
 1049:     else executionError("Type mistmatch error"); } while(0)
 1050: 
 1051: #define isBinaryInteger(rpl_object) \
 1052:     ((*rpl_object).type == BIN)
 1053: 
 1054: #define ifIsBinaryInteger(rpl_object) if (isBinaryInteger(rpl_object))
 1055: #define elseIfIsBinaryInteger(rpl_object) } else ifIsBinaryInteger(rpl_object)
 1056: 
 1057: #define getBinaryInteger(rpl_object, value) do { \
 1058:     value = 0; \
 1059:     ifIsBinaryInteger(rpl_object) value = \
 1060:             (*((integer8 *) (*rpl_object).objet)); \
 1061:     else executionError("Type mismatch error"); } while(0)
 1062: 
 1063: #define createBinaryIntegerObject(rpl_object) do { \
 1064:     if (rpl_object != NULL) \
 1065:         systemError("Reallocated object"); \
 1066:     if ((rpl_object = _allocation(BIN)) == NULL) \
 1067:         systemError("Memory allocation error"); \
 1068:     setBinaryInteger(rpl_object, 0); } while(0)
 1069: 
 1070: // Name
 1071: 
 1072: #define isName(rpl_object) \
 1073:     ((*rpl_object).type == NOM)
 1074: 
 1075: #define ifIsName(rpl_object) if (isName(rpl_object))
 1076: #define elseIfIsName(rpl_object)  } else if (isName(rpl_object))
 1077: 
 1078: #define setName(rpl_object, value) do { \
 1079:     struct_processus *s_etat_processus; \
 1080:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1081:     ifIsName(rpl_object) \
 1082:     { \
 1083:         if ((*rpl_object).nombre_occurrences > 1) \
 1084:         { \
 1085:             struct_objet *__tmp_rpl_object; \
 1086:             if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) == NULL) \
 1087:                 systemError("Memory allocation error"); \
 1088:             _liberation(rpl_object); \
 1089:             rpl_object = __tmp_rpl_object; \
 1090:         } \
 1091:         free((*((struct_nom *) (*rpl_object).objet)).nom); \
 1092:         (*((struct_nom *) (*rpl_object).objet)).symbole = d_faux; \
 1093:         if (((*((struct_nom *) (*rpl_object).objet)).nom = malloc( \
 1094:                 (strlen(value) + 1) * sizeof(unsigned char))) == NULL) \
 1095:             systemError("Memory allocation error"); \
 1096:         strcpy((char *) (*((struct_nom *) (*rpl_object).objet)).nom, \
 1097:                 (char *) value); \
 1098:     } \
 1099:     else executionError("Type mistmatch error"); } while(0)
 1100: 
 1101: #define setSymbolicName(rpl_object, value) do { \
 1102:     setName(rpl_object, value); \
 1103:     (*((struct_nom *) (*rpl_object).objet)).symbole = d_vrai; } while(0)
 1104: 
 1105: #define createNameObject(rpl_object) do { \
 1106:     struct_processus *s_etat_processus; \
 1107:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1108:     if (rpl_object != NULL) \
 1109:         systemError("Reallocated object"); \
 1110:     if ((rpl_object = _allocation(NOM)) == NULL) \
 1111:         systemError("Memory allocation error"); \
 1112:     (*((struct_nom *) (*rpl_object).objet)).symbole = d_faux; \
 1113:     if (((*((struct_nom *) (*rpl_object).objet)).nom = malloc( \
 1114:             sizeof(unsigned char))) == NULL) \
 1115:         systemError("Memory allocation error"); \
 1116:     strcpy((char *) (*((struct_nom *) (*rpl_object).objet)).nom, ""); } while(0)
 1117: 
 1118: // String
 1119: 
 1120: #define isString(rpl_object) \
 1121:     ((*rpl_object).type == CHN)
 1122: 
 1123: #define ifIsString(rpl_object) if (isString(rpl_object))
 1124: #define elseIfIsString(rpl_object) } else if (isString(rpl_object))
 1125: 
 1126: #define setString(rpl_object, string) do { \
 1127:     struct_processus *s_etat_processus; \
 1128:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1129:     ifIsString(rpl_object) \
 1130:     { \
 1131:         if (string == NULL) executionError("Nullified string"); else \
 1132:         { \
 1133:             if ((*rpl_object).nombre_occurrences > 1) \
 1134:             { \
 1135:                 struct_objet *__tmp_rpl_object; \
 1136:                 if ((__tmp_rpl_object = _copie_objet(rpl_object, 'O')) \
 1137:                         == NULL) \
 1138:                     systemError("Memory allocation error"); \
 1139:                 _liberation(rpl_object); \
 1140:                 rpl_object = __tmp_rpl_object; \
 1141:             } \
 1142:             free((unsigned char *) (*rpl_object).objet); \
 1143:             if (((*rpl_object).objet = malloc((strlen(string) + 1) * \
 1144:                     sizeof(unsigned char))) == NULL) \
 1145:                 systemError("Memory allocation error"); \
 1146:             strcpy((char *) (*rpl_object).objet, string); \
 1147:         } \
 1148:     } \
 1149:     else executionError("Type mistmatch error"); } while(0)
 1150: 
 1151: #define getString(rpl_object, string) do { \
 1152:     string = NULL; \
 1153:     ifIsString(rpl_object) string = (char *) (*rpl_object).objet; \
 1154:     else executionError("Type mismatch error"); } while(0)
 1155: 
 1156: #define unEscString(s) ({ \
 1157:     unsigned char *__a; integer8 __l; \
 1158:     __a = formateur_flux((*rpl_arguments).s_etat_processus, \
 1159:             (unsigned char *) s, &__l); \
 1160:     if (nullified(__a)) systemError("Memory allocation error"); \
 1161:     (string) __a; \
 1162:     })
 1163: 
 1164: #define escString(rpl_object) ({ \
 1165:     unsigned char *__a; integer8 __l; \
 1166:     __a = analyse_flux((*rpl_arguments).s_etat_processus, \
 1167:             (unsigned char *) s, strlen(s)); \
 1168:     if (nullified(__a)) systemError("Memory allocation error"); \
 1169:     (string) __a; \
 1170:     })
 1171: 
 1172: #define createStringObject(rpl_object) do { \
 1173:     struct_processus *s_etat_processus; \
 1174:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1175:     if (rpl_object != NULL) \
 1176:         systemError("Reallocated object"); \
 1177:     if ((rpl_object = _allocation(CHN)) == NULL) \
 1178:         systemError("Memory allocation error"); \
 1179:     if (((*rpl_object).objet = malloc(sizeof(unsigned char))) == NULL) \
 1180:         systemError("Memory allocation error"); \
 1181:     strcpy((char *) (*rpl_object).objet, ""); } while(0)
 1182: 
 1183: // List
 1184: 
 1185: #define isList(rpl_object) \
 1186:     ((*rpl_object).type == LST)
 1187: 
 1188: #define ifIsList(rpl_object) if (isList(rpl_object))
 1189: #define elseIfIsList(rpl_object) else if (isList(rpl_object))
 1190: 
 1191: #define createListObject(rpl_object) do { \
 1192:     if (rpl_object != NULL) \
 1193:         systemError("Reallocated object"); \
 1194:     if ((rpl_object = _allocation(LST)) == NULL) \
 1195:         systemError("Memory allocation error"); \
 1196:     (*rpl_object).objet = NULL; } while(0)
 1197: 
 1198: #define addObjectToList(list, rpl_object) do { \
 1199:     struct_processus *s_etat_processus; \
 1200:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1201:     ifIsList(list) \
 1202:     { \
 1203:         struct_objet *__tmp_rpl_object; \
 1204:         if ((__tmp_rpl_object = _copie_objet(list, 'N')) == NULL) \
 1205:             systemError("Memory allocation error"); \
 1206:         _liberation(list); \
 1207:         list = __tmp_rpl_object; \
 1208:         if ((*list).objet == NULL) \
 1209:         { \
 1210:             if (((*list).objet = malloc(sizeof(struct_liste_chainee))) \
 1211:                     == NULL) \
 1212:                 systemError("Memory allocation error"); \
 1213:             (*((struct_liste_chainee *) (*list).objet)).suivant = NULL; \
 1214:             (*((struct_liste_chainee *) (*list).objet)).donnee = rpl_object; \
 1215:         } \
 1216:         else \
 1217:         { \
 1218:             struct_liste_chainee    *l_element_courant; \
 1219:             l_element_courant = (*list).objet; \
 1220:             while((*l_element_courant).suivant != NULL) \
 1221:                 l_element_courant = (*l_element_courant).suivant; \
 1222:             if (((*l_element_courant).suivant = \
 1223:                     malloc(sizeof(struct_liste_chainee))) == NULL) \
 1224:                 systemError("Memory allocation error"); \
 1225:             l_element_courant = (*l_element_courant).suivant; \
 1226:             (*l_element_courant).suivant = NULL; \
 1227:             (*l_element_courant).donnee = rpl_object; \
 1228:         } \
 1229:         rpl_object = NULL; \
 1230:     } \
 1231:     else executionError("Type mistmatch error"); } while(0)
 1232: 
 1233: #define insertObjectIntoList(list, rpl_object) do { \
 1234:     struct_processus *s_etat_processus; \
 1235:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1236:     ifIsList(list) \
 1237:     { \
 1238:         struct_objet *__tmp_rpl_object; \
 1239:         if ((__tmp_rpl_object = _copie_objet(list, 'N')) == NULL) \
 1240:             systemError("Memory allocation error"); \
 1241:         _liberation(list); \
 1242:         list = __tmp_rpl_object; \
 1243:         if ((*list).objet == NULL) \
 1244:         { \
 1245:             if (((*list).objet = malloc(sizeof(struct_liste_chainee))) \
 1246:                     == NULL) \
 1247:                 systemError("Memory allocation error"); \
 1248:             (*((struct_liste_chainee *) (*list).objet)).suivant = NULL; \
 1249:             (*((struct_liste_chainee *) (*list).objet)).donnee = rpl_object; \
 1250:         } \
 1251:         else \
 1252:         { \
 1253:             struct_liste_chainee    *l_element_courant; \
 1254:             if ((l_element_courant = \
 1255:                     malloc(sizeof(struct_liste_chainee))) == NULL) \
 1256:                 systemError("Memory allocation error"); \
 1257:             (*l_element_courant).donnee = rpl_object; \
 1258:             (*l_element_courant).suivant = (*list).objet; \
 1259:             (*list).objet = l_element_courant; \
 1260:         } \
 1261:         rpl_object = NULL; \
 1262:     } \
 1263:     else executionError("Type mistmatch error"); } while(0)
 1264: 
 1265: #define removeObjectFromList(list, rpl_object) do { \
 1266:     struct_processus *s_etat_processus; \
 1267:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1268:     ifIsList(list) \
 1269:     { \
 1270:         if ((*list).objet != NULL) \
 1271:         { \
 1272:             struct_liste_chainee    *__current; \
 1273:             struct_liste_chainee    *__previous; \
 1274:             __current = (*list).objet; \
 1275:             __previous = NULL; \
 1276:             if ((*__current).donnee == rpl_object) \
 1277:             { \
 1278:                 (*list).objet = (*__current).suivant; \
 1279:             } \
 1280:             else \
 1281:             { \
 1282:                 while(__current != NULL) \
 1283:                 { \
 1284:                     if ((*__current).donnee == rpl_object) \
 1285:                     { \
 1286:                         (*__previous).suivant = (*__current).suivant; \
 1287:                         break; \
 1288:                     } \
 1289:                     __previous = __current; \
 1290:                     __current = (*__current).suivant; \
 1291:                 } \
 1292:             } \
 1293:             _liberation((*__current).donnee); \
 1294:             free(__current); \
 1295:         } \
 1296:     } \
 1297:     else executionError("Type mistmatch error"); } while(0)
 1298: 
 1299: #define getObjectFromList(list, position, rpl_object)
 1300: 
 1301: #define putObjectIntoList(list, position, rpl_object)
 1302: 
 1303: #define getListFromList(list, position1, position2, rpl_object)
 1304: 
 1305: #define listLength(list, length) do { \
 1306:     if (list == NULL) executionError("Nullified object"); \
 1307:     if ((*list).type != LST) \
 1308:             executionError("Type mistmatch error"); \
 1309:     { \
 1310:         struct_liste_chainee        *l_element_courant; \
 1311:         length = 0; \
 1312:         l_element_courant = (*list).objet; \
 1313:         while(l_element_courant != NULL) \
 1314:         { \
 1315:             l_element_courant = (*l_element_courant).suivant; \
 1316:             length++; \
 1317:         } \
 1318:     } } while(0)
 1319: 
 1320: // NON
 1321: #define createObject(rpl_object) do { \
 1322:     if (rpl_object != NULL) \
 1323:         systemError("Reallocated object"); \
 1324:     if ((rpl_object = _allocation(NON)) == NULL) \
 1325:         systemError("Memory allocation error"); \
 1326:     (*rpl_object).objet = NULL; \
 1327:     } while(0)
 1328: 
 1329: // EXT
 1330: #define createExternalObject(rpl_object, subtype) do { \
 1331:     if (rpl_object != NULL) \
 1332:         systemError("Reallocated object"); \
 1333:     if ((rpl_object = _allocation(EXT)) == NULL) \
 1334:         systemError("Memory allocation error"); \
 1335:     (*rpl_object).objet = NULL; \
 1336:     (*rpl_object).extension_type = subtype; \
 1337:     (*rpl_object).descripteur_bibliotheque = __static_library_descriptor; \
 1338:     } while(0)
 1339: 
 1340: /*
 1341: --------------------------------------------------------------------------------
 1342:   Allocation mémoire
 1343: --------------------------------------------------------------------------------
 1344: */
 1345: 
 1346: #define size(a) sizeof(a)
 1347: 
 1348: #define allocate(a) ({ void *ptr; \
 1349:     struct_processus *s_etat_processus; \
 1350:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1351:     if ((ptr = malloc(a)) == NULL) \
 1352:         { systemError("Memory allocation error"); \
 1353:         __CATCH_SYSTEM_ERROR__; } ptr; }) \
 1354: 
 1355: #define reallocate(a, s) ({ void *ptr; \
 1356:     struct_processus *s_etat_processus; \
 1357:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1358:     if ((ptr = realloc(a, s)) == NULL) \
 1359:         { systemError("Memory allocation error"); \
 1360:         __CATCH_SYSTEM_ERROR__; } ptr; }) \
 1361: 
 1362: #define deallocate(a) do { \
 1363:     struct_processus *s_etat_processus; \
 1364:     s_etat_processus = (*rpl_arguments).s_etat_processus; \
 1365:     free(a); } while(0)
 1366: 
 1367: /*
 1368: --------------------------------------------------------------------------------
 1369:   Récupération des interruptions et des signaux
 1370: --------------------------------------------------------------------------------
 1371: */
 1372: 
 1373: #define pollSignalsAndInterrupts() \
 1374:     __CATCH_SYSTEM_ERROR__; \
 1375:     do { scrutation_injection((*rpl_arguments).s_etat_processus); } while(0)
 1376: 
 1377: /*
 1378: --------------------------------------------------------------------------------
 1379:   Exécution d'une fonction intrinsèque
 1380: --------------------------------------------------------------------------------
 1381: */
 1382: 
 1383: #define intrinsic(function) do { \
 1384:     int __status; \
 1385:     __CATCH_SYSTEM_ERROR__; \
 1386:     __status = wrapper_instruction_intrinseque( \
 1387:             instruction_##function, rpl_arguments); \
 1388:     if (__status == 1) executionError(#function); \
 1389:     if (__status == 2) systemError(#function); \
 1390:     } while(0)
 1391: 
 1392: #endif
 1393: 
 1394: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>