Annotation of rpl/src/rplexternals.h, revision 1.51

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

CVSweb interface <joel.bertrand@systella.fr>