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

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

CVSweb interface <joel.bertrand@systella.fr>