File:  [local] / rpl / src / rplexternals.h
Revision 1.79: download - view: text, annotated - select for diffs - revision graph
Tue Jul 4 10:28:09 2017 UTC (6 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Ajout de l'option -m.

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

CVSweb interface <joel.bertrand@systella.fr>