File:  [local] / rpl / src / rplexternals.h
Revision 1.6: download - view: text, annotated - select for diffs - revision graph
Wed Apr 7 13:45:10 2010 UTC (14 years ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_0_14, HEAD
En route pour la 4.0.14 !

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.0.14
    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( \
 1039:             instruction_##function, 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>