Annotation of rpl/src/instructions_t1.c, 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: #include "rpl.conv.h"
! 24:
! 25:
! 26: /*
! 27: ================================================================================
! 28: Fonction 'type'
! 29: ================================================================================
! 30: Entrées : structure processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_type(struct_processus *s_etat_processus)
! 40: {
! 41: struct_objet *s_objet_argument;
! 42: struct_objet *s_objet_resultat;
! 43:
! 44: (*s_etat_processus).erreur_execution = d_ex;
! 45:
! 46: if ((*s_etat_processus).affichage_arguments == 'Y')
! 47: {
! 48: printf("\n TYPE ");
! 49:
! 50: if ((*s_etat_processus).langue == 'F')
! 51: {
! 52: printf("(type d'objet)\n\n");
! 53: }
! 54: else
! 55: {
! 56: printf("(object type)\n\n");
! 57: }
! 58:
! 59: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 60: " %s, %s, %s, %s, %s,\n"
! 61: " %s, %s, %s, %s, %s,\n"
! 62: " %s, %s, %s, %s\n",
! 63: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 64: d_TAB,
! 65: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB, d_SCK,
! 66: d_PRC);
! 67: printf("-> 1: %s\n", d_INT);
! 68:
! 69: return;
! 70: }
! 71: else if ((*s_etat_processus).test_instruction == 'Y')
! 72: {
! 73: (*s_etat_processus).nombre_arguments = -1;
! 74: return;
! 75: }
! 76:
! 77: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 78: {
! 79: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 80: {
! 81: return;
! 82: }
! 83: }
! 84:
! 85: if (depilement(s_etat_processus, &((*s_etat_processus)
! 86: .l_base_pile), &s_objet_argument) == d_erreur)
! 87: {
! 88: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 89: return;
! 90: }
! 91:
! 92: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 93: {
! 94: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 95: return;
! 96: }
! 97:
! 98: if (((*s_objet_argument).type == INT) ||
! 99: ((*s_objet_argument).type == REL))
! 100: {
! 101: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 102: }
! 103: else if ((*s_objet_argument).type == CPL)
! 104: {
! 105: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
! 106: }
! 107: else if ((*s_objet_argument).type == CHN)
! 108: {
! 109: (*((integer8 *) (*s_objet_resultat).objet)) = 2;
! 110: }
! 111: else if (((*s_objet_argument).type == VIN) ||
! 112: ((*s_objet_argument).type == VRL) ||
! 113: ((*s_objet_argument).type == MIN) ||
! 114: ((*s_objet_argument).type == MRL))
! 115: {
! 116: (*((integer8 *) (*s_objet_resultat).objet)) = 3;
! 117: }
! 118: else if (((*s_objet_argument).type == VCX) ||
! 119: ((*s_objet_argument).type == MCX))
! 120: {
! 121: (*((integer8 *) (*s_objet_resultat).objet)) = 4;
! 122: }
! 123: else if ((*s_objet_argument).type == LST)
! 124: {
! 125: (*((integer8 *) (*s_objet_resultat).objet)) = 5;
! 126: }
! 127: else if ((*s_objet_argument).type == ADR)
! 128: {
! 129: (*((integer8 *) (*s_objet_resultat).objet)) = 6;
! 130: }
! 131: else if ((*s_objet_argument).type == NOM)
! 132: {
! 133: (*((integer8 *) (*s_objet_resultat).objet)) = 7;
! 134: }
! 135: else if ((*s_objet_argument).type == RPN)
! 136: {
! 137: (*((integer8 *) (*s_objet_resultat).objet)) = 8;
! 138: }
! 139: else if ((*s_objet_argument).type == ALG)
! 140: {
! 141: (*((integer8 *) (*s_objet_resultat).objet)) = 9;
! 142: }
! 143: else if ((*s_objet_argument).type == BIN)
! 144: {
! 145: (*((integer8 *) (*s_objet_resultat).objet)) = 10;
! 146: }
! 147: else if ((*s_objet_argument).type == FCH)
! 148: {
! 149: (*((integer8 *) (*s_objet_resultat).objet)) = 11;
! 150: }
! 151: else if ((*s_objet_argument).type == SLB)
! 152: {
! 153: (*((integer8 *) (*s_objet_resultat).objet)) = 12;
! 154: }
! 155: else if ((*s_objet_argument).type == SCK)
! 156: {
! 157: (*((integer8 *) (*s_objet_resultat).objet)) = 13;
! 158: }
! 159: else if ((*s_objet_argument).type == PRC)
! 160: {
! 161: (*((integer8 *) (*s_objet_resultat).objet)) = 14;
! 162: }
! 163: else if ((*s_objet_argument).type == FCT)
! 164: {
! 165: (*((integer8 *) (*s_objet_resultat).objet)) = 15;
! 166: }
! 167: else if ((*s_objet_argument).type == TBL)
! 168: {
! 169: (*((integer8 *) (*s_objet_resultat).objet)) = 16;
! 170: }
! 171: else
! 172: {
! 173: /*
! 174: * Les autres types de données sont des types internes
! 175: */
! 176:
! 177: liberation(s_etat_processus, s_objet_argument);
! 178:
! 179: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 180: return;
! 181: }
! 182:
! 183: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 184: s_objet_resultat) == d_erreur)
! 185: {
! 186: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 187: return;
! 188: }
! 189:
! 190: liberation(s_etat_processus, s_objet_argument);
! 191:
! 192: return;
! 193: }
! 194:
! 195:
! 196: /*
! 197: ================================================================================
! 198: Fonction 'then'
! 199: ================================================================================
! 200: Entrées : structure processus
! 201: --------------------------------------------------------------------------------
! 202: Sorties :
! 203: --------------------------------------------------------------------------------
! 204: Effets de bord : néant
! 205: ================================================================================
! 206: */
! 207:
! 208: void
! 209: instruction_then(struct_processus *s_etat_processus)
! 210: {
! 211: logical1 condition;
! 212: logical1 drapeau_fin;
! 213: logical1 execution;
! 214:
! 215: struct_liste_chainee *s_registre;
! 216:
! 217: struct_objet *s_objet;
! 218:
! 219: unsigned char *instruction_majuscule;
! 220: unsigned char *tampon;
! 221:
! 222: unsigned long niveau;
! 223:
! 224: void (*fonction)();
! 225:
! 226: (*s_etat_processus).erreur_execution = d_ex;
! 227:
! 228: if ((*s_etat_processus).affichage_arguments == 'Y')
! 229: {
! 230: printf("\n THEN ");
! 231:
! 232: if ((*s_etat_processus).langue == 'F')
! 233: {
! 234: printf("(structure de contrôle)\n\n");
! 235: printf(" Utilisation :\n\n");
! 236: }
! 237: else
! 238: {
! 239: printf("(control statement)\n\n");
! 240: printf(" Usage:\n\n");
! 241: }
! 242:
! 243: printf(" IF(ERR)\n");
! 244: printf(" (expression test 1)\n");
! 245: printf(" THEN\n");
! 246: printf(" (expression 1)\n");
! 247: printf(" [ELSEIF\n");
! 248: printf(" (expression test 2)\n");
! 249: printf(" THEN\n");
! 250: printf(" (expression 2)]\n");
! 251: printf(" ...\n");
! 252: printf(" [ELSE\n");
! 253: printf(" (expression n)]\n");
! 254: printf(" END\n\n");
! 255:
! 256: printf(" SELECT (expression test)\n");
! 257: printf(" CASE (clause 1) THEN (expression 1) END\n");
! 258: printf(" CASE (clause 2) THEN (expression 2) END\n");
! 259: printf(" ...\n");
! 260: printf(" CASE (clause n) THEN (expression n) END\n");
! 261: printf(" DEFAULT\n");
! 262: printf(" (expression)\n");
! 263: printf(" END\n\n");
! 264:
! 265: printf(" SELECT (expression test)\n");
! 266: printf(" CASE (clause 1) THEN (expression 1) END\n");
! 267: printf(" (expression)\n");
! 268: printf(" CASE (clause 2) THEN (expression 2) END\n");
! 269: printf(" END\n");
! 270:
! 271: return;
! 272: }
! 273: else if ((*s_etat_processus).test_instruction == 'Y')
! 274: {
! 275: (*s_etat_processus).nombre_arguments = -1;
! 276: return;
! 277: }
! 278:
! 279: if (((*(*s_etat_processus).l_base_pile_systeme).clause != 'I') &&
! 280: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T') &&
! 281: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'R') &&
! 282: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'X') &&
! 283: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'C') &&
! 284: ((*(*s_etat_processus).l_base_pile_systeme).clause != 'K'))
! 285: {
! 286: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition;
! 287: return;
! 288: }
! 289:
! 290: /*
! 291: * Traitement des erreurs
! 292: */
! 293:
! 294: if (((*(*s_etat_processus).l_base_pile_systeme).clause == 'R') ||
! 295: ((*(*s_etat_processus).l_base_pile_systeme).clause == 'X'))
! 296: {
! 297: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
! 298: {
! 299: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 300: return;
! 301: }
! 302:
! 303: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'R')
! 304: {
! 305:
! 306: /*
! 307: * Erreur à traiter : on saute jusques au ELSE ou au END
! 308: * correspondant.
! 309: */
! 310:
! 311: (*((integer8 *) (*s_objet).objet)) = 0;
! 312: }
! 313: else
! 314: {
! 315: (*((integer8 *) (*s_objet).objet)) = -1;
! 316: }
! 317:
! 318: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 319: s_objet) == d_erreur)
! 320: {
! 321: return;
! 322: }
! 323:
! 324: (*s_etat_processus).arret_si_exception = (*(*s_etat_processus)
! 325: .l_base_pile_systeme).arret_si_exception;
! 326: }
! 327:
! 328: /*
! 329: * Traitement standard de l'instruction 'THEN'
! 330: */
! 331:
! 332: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 333: {
! 334: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 335: {
! 336: return;
! 337: }
! 338: }
! 339:
! 340: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 341: &s_objet) == d_erreur)
! 342: {
! 343: return;
! 344: }
! 345:
! 346: if (((*s_objet).type == INT) ||
! 347: ((*s_objet).type == REL))
! 348: {
! 349: if ((*s_objet).type == INT)
! 350: {
! 351: condition = ((*((integer8 *) (*s_objet).objet)) == 0)
! 352: ? d_faux : d_vrai;
! 353: }
! 354: else
! 355: {
! 356: condition = ((*((real8 *) (*s_objet).objet)) == 0)
! 357: ? d_faux : d_vrai;
! 358: }
! 359:
! 360: if (condition == d_vrai)
! 361: {
! 362:
! 363: /*
! 364: * condition == d_vrai : exécution de ce qui se trouve entre
! 365: * THEN et ELSE ou END.
! 366: */
! 367:
! 368: if (((*(*s_etat_processus).l_base_pile_systeme).clause !=
! 369: 'K') && ((*(*s_etat_processus).l_base_pile_systeme)
! 370: .clause != 'C'))
! 371: {
! 372: (*(*s_etat_processus).l_base_pile_systeme).clause = 'T';
! 373: }
! 374: else
! 375: {
! 376: (*(*s_etat_processus).l_base_pile_systeme).clause = 'Q';
! 377: }
! 378: }
! 379: else
! 380: {
! 381: /*
! 382: * condition == d_faux : saut à END ou exécution de ce qui se
! 383: * trouve entre ELSE et END
! 384: */
! 385:
! 386: if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T')
! 387: {
! 388: /*
! 389: * Traitement de ELSEIF
! 390: */
! 391:
! 392: if (((*(*s_etat_processus).l_base_pile_systeme).clause !=
! 393: 'K') && ((*(*s_etat_processus).l_base_pile_systeme)
! 394: .clause != 'C'))
! 395: {
! 396: (*(*s_etat_processus).l_base_pile_systeme).clause = 'E';
! 397: }
! 398: }
! 399:
! 400: niveau = 0;
! 401: drapeau_fin = d_faux;
! 402:
! 403: if ((*s_etat_processus).mode_execution_programme == 'Y')
! 404: {
! 405: tampon = (*s_etat_processus).instruction_courante;
! 406:
! 407: do
! 408: {
! 409: if (recherche_instruction_suivante(s_etat_processus)
! 410: == d_erreur)
! 411: {
! 412: liberation(s_etat_processus, s_objet);
! 413:
! 414: if ((*s_etat_processus).instruction_courante != NULL)
! 415: {
! 416: free((*s_etat_processus).instruction_courante);
! 417: }
! 418:
! 419: (*s_etat_processus).instruction_courante = tampon;
! 420: (*s_etat_processus).erreur_execution =
! 421: d_ex_erreur_traitement_condition;
! 422: return;
! 423: }
! 424:
! 425: if ((instruction_majuscule = conversion_majuscule(
! 426: (*s_etat_processus).instruction_courante)) == NULL)
! 427: {
! 428: liberation(s_etat_processus, s_objet);
! 429:
! 430: free((*s_etat_processus).instruction_courante);
! 431: (*s_etat_processus).instruction_courante = tampon;
! 432: (*s_etat_processus).erreur_systeme =
! 433: d_es_allocation_memoire;
! 434: return;
! 435: }
! 436:
! 437: if (niveau == 0)
! 438: {
! 439: if (((*(*s_etat_processus).l_base_pile_systeme)
! 440: .clause != 'K') && ((*(*s_etat_processus)
! 441: .l_base_pile_systeme) .clause != 'C'))
! 442: {
! 443:
! 444: /*
! 445: * Traitement de IF/THEN/ELSEIF/THEN/ELSE/END
! 446: */
! 447:
! 448: if ((strcmp(instruction_majuscule, "END") == 0) ||
! 449: (strcmp(instruction_majuscule, "ELSE")
! 450: == 0) || (strcmp(instruction_majuscule,
! 451: "ELSEIF") == 0))
! 452: {
! 453: (*s_etat_processus).position_courante
! 454: -= (strlen(instruction_majuscule) + 1);
! 455: drapeau_fin = d_vrai;
! 456: }
! 457: else
! 458: {
! 459: drapeau_fin = d_faux;
! 460: }
! 461: }
! 462: else
! 463: {
! 464: /*
! 465: * Traitement de CASE/THEN/END
! 466: */
! 467:
! 468: if (strcmp(instruction_majuscule, "ELSE") == 0)
! 469: {
! 470: liberation(s_etat_processus, s_objet);
! 471:
! 472: free((*s_etat_processus).instruction_courante);
! 473: free(instruction_majuscule);
! 474:
! 475: (*s_etat_processus).instruction_courante =
! 476: tampon;
! 477: (*s_etat_processus).erreur_execution =
! 478: d_ex_erreur_traitement_condition;
! 479: return;
! 480: }
! 481: else if (strcmp(instruction_majuscule, "END") == 0)
! 482: {
! 483: drapeau_fin = d_vrai;
! 484: }
! 485: else
! 486: {
! 487: drapeau_fin = d_faux;
! 488: }
! 489: }
! 490: }
! 491: else
! 492: {
! 493: drapeau_fin = d_faux;
! 494: }
! 495:
! 496: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
! 497: (strcmp(instruction_majuscule, "DO") == 0) ||
! 498: (strcmp(instruction_majuscule, "IF") == 0) ||
! 499: (strcmp(instruction_majuscule, "IFERR") == 0) ||
! 500: (strcmp(instruction_majuscule, "SELECT") == 0) ||
! 501: (strcmp(instruction_majuscule, "WHILE") == 0))
! 502: {
! 503: niveau++;
! 504: }
! 505: else if (strcmp(instruction_majuscule, "END") == 0)
! 506: {
! 507: niveau--;
! 508: }
! 509:
! 510: free(instruction_majuscule);
! 511: free((*s_etat_processus).instruction_courante);
! 512: } while(drapeau_fin == d_faux);
! 513:
! 514: (*s_etat_processus).instruction_courante = tampon;
! 515: }
! 516: else
! 517: {
! 518: /*
! 519: * Vérification du pointeur de prédiction de saut.
! 520: */
! 521:
! 522: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
! 523: .expression_courante).donnee).mutex)) != 0)
! 524: {
! 525: (*s_etat_processus).erreur_systeme = d_es_processus;
! 526: return;
! 527: }
! 528:
! 529: if ((*((struct_fonction *) (*(*(*s_etat_processus)
! 530: .expression_courante).donnee).objet)).prediction_saut
! 531: != NULL)
! 532: {
! 533: s_registre = (*s_etat_processus).expression_courante;
! 534:
! 535: (*s_etat_processus).expression_courante =
! 536: (struct_liste_chainee *)
! 537: (*((struct_fonction *) (*(*(*s_etat_processus)
! 538: .expression_courante).donnee).objet))
! 539: .prediction_saut;
! 540: fonction = (*((struct_fonction *)
! 541: (*(*(*s_etat_processus).expression_courante)
! 542: .donnee).objet)).fonction;
! 543: execution = (*((struct_fonction *)
! 544: (*(*s_registre).donnee).objet))
! 545: .prediction_execution;
! 546:
! 547: if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex))
! 548: != 0)
! 549: {
! 550: (*s_etat_processus).erreur_systeme = d_es_processus;
! 551: return;
! 552: }
! 553:
! 554: if (execution == d_vrai)
! 555: {
! 556: fonction(s_etat_processus);
! 557: }
! 558: }
! 559: else
! 560: {
! 561: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
! 562: .expression_courante).donnee).mutex)) != 0)
! 563: {
! 564: (*s_etat_processus).erreur_systeme = d_es_processus;
! 565: return;
! 566: }
! 567:
! 568: s_registre = (*s_etat_processus).expression_courante;
! 569: execution = d_faux;
! 570:
! 571: do
! 572: {
! 573: if (((*s_etat_processus).expression_courante =
! 574: (*(*s_etat_processus).expression_courante)
! 575: .suivant) == NULL)
! 576: {
! 577: liberation(s_etat_processus, s_objet);
! 578: (*s_etat_processus).erreur_execution =
! 579: d_ex_erreur_traitement_condition;
! 580: return;
! 581: }
! 582:
! 583: if ((*(*(*s_etat_processus).expression_courante)
! 584: .donnee).type == FCT)
! 585: {
! 586: fonction = (*((struct_fonction *)
! 587: (*(*(*s_etat_processus).expression_courante)
! 588: .donnee).objet)).fonction;
! 589:
! 590: if (niveau == 0)
! 591: {
! 592: if (((*(*s_etat_processus).l_base_pile_systeme)
! 593: .clause != 'K') &&
! 594: ((*(*s_etat_processus)
! 595: .l_base_pile_systeme) .clause != 'C'))
! 596: {
! 597:
! 598: /*
! 599: * Traitement de IF/THEN/ELSEIF/THEN/
! 600: * ELSE/END
! 601: */
! 602:
! 603: if ((fonction == instruction_end) ||
! 604: (fonction == instruction_else) ||
! 605: (fonction == instruction_elseif))
! 606: {
! 607: fonction(s_etat_processus);
! 608: execution = d_vrai;
! 609: drapeau_fin = d_vrai;
! 610: }
! 611: else
! 612: {
! 613: drapeau_fin = d_faux;
! 614: }
! 615: }
! 616: else
! 617: {
! 618: /*
! 619: * Traitement de CASE/THEN/END
! 620: */
! 621:
! 622: if (fonction == instruction_else)
! 623: {
! 624: liberation(s_etat_processus, s_objet);
! 625:
! 626: if ((drapeau_fin == d_faux) &&
! 627: ((*s_etat_processus)
! 628: .expression_courante != NULL))
! 629: {
! 630: (*s_etat_processus)
! 631: .expression_courante
! 632: = (*(*s_etat_processus)
! 633: .expression_courante)
! 634: .suivant;
! 635: }
! 636:
! 637: (*s_etat_processus).erreur_execution =
! 638: d_ex_erreur_traitement_condition;
! 639: return;
! 640: }
! 641: else if (fonction == instruction_end)
! 642: {
! 643: drapeau_fin = d_vrai;
! 644: }
! 645: else
! 646: {
! 647: drapeau_fin = d_faux;
! 648: }
! 649: }
! 650: }
! 651: else
! 652: {
! 653: drapeau_fin = d_faux;
! 654: }
! 655:
! 656: if ((fonction == instruction_case) ||
! 657: (fonction == instruction_do) ||
! 658: (fonction == instruction_if) ||
! 659: (fonction == instruction_iferr) ||
! 660: (fonction == instruction_select) ||
! 661: (fonction == instruction_while))
! 662: {
! 663: niveau++;
! 664: }
! 665: else if (fonction == instruction_end)
! 666: {
! 667: niveau--;
! 668: }
! 669: }
! 670: } while(drapeau_fin == d_faux);
! 671:
! 672: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
! 673: .expression_courante).donnee).mutex)) != 0)
! 674: {
! 675: (*s_etat_processus).erreur_systeme = d_es_processus;
! 676: return;
! 677: }
! 678:
! 679: (*((struct_fonction *) (*(*s_registre).donnee).objet))
! 680: .prediction_saut = (*s_etat_processus)
! 681: .expression_courante;
! 682: (*((struct_fonction *) (*(*s_registre).donnee).objet))
! 683: .prediction_execution = execution;
! 684:
! 685: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
! 686: .expression_courante).donnee).mutex)) != 0)
! 687: {
! 688: (*s_etat_processus).erreur_systeme = d_es_processus;
! 689: return;
! 690: }
! 691: }
! 692: }
! 693: }
! 694: }
! 695: else
! 696: {
! 697: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 698: return;
! 699: }
! 700:
! 701: liberation(s_etat_processus, s_objet);
! 702:
! 703: return;
! 704: }
! 705:
! 706:
! 707: /*
! 708: ================================================================================
! 709: Fonction 'tan'
! 710: ================================================================================
! 711: Entrées : pointeur sur une structure struct_processus
! 712: --------------------------------------------------------------------------------
! 713: Sorties :
! 714: --------------------------------------------------------------------------------
! 715: Effets de bord : néant
! 716: ================================================================================
! 717: */
! 718:
! 719: void
! 720: instruction_tan(struct_processus *s_etat_processus)
! 721: {
! 722: real8 angle;
! 723:
! 724: integer4 erreur;
! 725:
! 726: struct_liste_chainee *l_element_courant;
! 727: struct_liste_chainee *l_element_precedent;
! 728:
! 729: struct_objet *s_copie_argument;
! 730: struct_objet *s_objet_argument;
! 731: struct_objet *s_objet_resultat;
! 732:
! 733: (*s_etat_processus).erreur_execution = d_ex;
! 734:
! 735: if ((*s_etat_processus).affichage_arguments == 'Y')
! 736: {
! 737: printf("\n TAN ");
! 738:
! 739: if ((*s_etat_processus).langue == 'F')
! 740: {
! 741: printf("(tangente)\n\n");
! 742: }
! 743: else
! 744: {
! 745: printf("(tangent)\n\n");
! 746: }
! 747:
! 748: printf(" 1: %s, %s\n", d_INT, d_REL);
! 749: printf("-> 1: %s\n\n", d_REL);
! 750:
! 751: printf(" 1: %s\n", d_CPL);
! 752: printf("-> 1: %s\n\n", d_CPL);
! 753:
! 754: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 755: printf("-> 1: %s\n\n", d_ALG);
! 756:
! 757: printf(" 1: %s\n", d_RPN);
! 758: printf("-> 1: %s\n", d_RPN);
! 759:
! 760: return;
! 761: }
! 762: else if ((*s_etat_processus).test_instruction == 'Y')
! 763: {
! 764: (*s_etat_processus).nombre_arguments = 1;
! 765: return;
! 766: }
! 767:
! 768: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 769: {
! 770: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 771: {
! 772: return;
! 773: }
! 774: }
! 775:
! 776: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 777: &s_objet_argument) == d_erreur)
! 778: {
! 779: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 780: return;
! 781: }
! 782:
! 783: /*
! 784: --------------------------------------------------------------------------------
! 785: Tangente d'un entier ou d'un réel
! 786: --------------------------------------------------------------------------------
! 787: */
! 788:
! 789: if (((*s_objet_argument).type == INT) ||
! 790: ((*s_objet_argument).type == REL))
! 791: {
! 792: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 793: {
! 794: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 795: return;
! 796: }
! 797:
! 798: if ((*s_objet_argument).type == INT)
! 799: {
! 800: angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
! 801: }
! 802: else
! 803: {
! 804: angle = (*((real8 *) (*s_objet_argument).objet));
! 805: }
! 806:
! 807: if (test_cfsf(s_etat_processus, 60) == d_faux)
! 808: {
! 809: conversion_degres_vers_radians(&angle);
! 810: }
! 811:
! 812: if ((cos(angle) == 0) && (test_cfsf(s_etat_processus, 59) == d_vrai))
! 813: {
! 814: liberation(s_etat_processus, s_objet_argument);
! 815: liberation(s_etat_processus, s_objet_resultat);
! 816:
! 817: (*s_etat_processus).exception = d_ep_division_par_zero;
! 818: return;
! 819: }
! 820:
! 821: (*((real8 *) (*s_objet_resultat).objet)) = tan(angle);
! 822: }
! 823:
! 824: /*
! 825: --------------------------------------------------------------------------------
! 826: Tangente d'un complexe
! 827: --------------------------------------------------------------------------------
! 828: */
! 829:
! 830: else if ((*s_objet_argument).type == CPL)
! 831: {
! 832: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
! 833: {
! 834: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 835: return;
! 836: }
! 837:
! 838: f77tan_((struct_complexe16 *) (*s_objet_argument).objet,
! 839: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
! 840:
! 841: if (erreur != 0)
! 842: {
! 843: liberation(s_etat_processus, s_objet_argument);
! 844: liberation(s_etat_processus, s_objet_resultat);
! 845:
! 846: (*s_etat_processus).exception = d_ep_division_par_zero;
! 847: return;
! 848: }
! 849: }
! 850:
! 851: /*
! 852: --------------------------------------------------------------------------------
! 853: Tangente d'un nom
! 854: --------------------------------------------------------------------------------
! 855: */
! 856:
! 857: else if ((*s_objet_argument).type == NOM)
! 858: {
! 859: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 860: {
! 861: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 862: return;
! 863: }
! 864:
! 865: if (((*s_objet_resultat).objet =
! 866: allocation_maillon(s_etat_processus)) == NULL)
! 867: {
! 868: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 869: return;
! 870: }
! 871:
! 872: l_element_courant = (*s_objet_resultat).objet;
! 873:
! 874: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 875: == NULL)
! 876: {
! 877: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 878: return;
! 879: }
! 880:
! 881: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 882: .nombre_arguments = 0;
! 883: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 884: .fonction = instruction_vers_niveau_superieur;
! 885:
! 886: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 887: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 888: {
! 889: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 890: return;
! 891: }
! 892:
! 893: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 894: .nom_fonction, "<<");
! 895:
! 896: if (((*l_element_courant).suivant =
! 897: allocation_maillon(s_etat_processus)) == NULL)
! 898: {
! 899: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 900: return;
! 901: }
! 902:
! 903: l_element_courant = (*l_element_courant).suivant;
! 904: (*l_element_courant).donnee = s_objet_argument;
! 905:
! 906: if (((*l_element_courant).suivant =
! 907: allocation_maillon(s_etat_processus)) == NULL)
! 908: {
! 909: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 910: return;
! 911: }
! 912:
! 913: l_element_courant = (*l_element_courant).suivant;
! 914:
! 915: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 916: == NULL)
! 917: {
! 918: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 919: return;
! 920: }
! 921:
! 922: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 923: .nombre_arguments = 1;
! 924: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 925: .fonction = instruction_tan;
! 926:
! 927: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 928: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
! 929: {
! 930: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 931: return;
! 932: }
! 933:
! 934: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 935: .nom_fonction, "TAN");
! 936:
! 937: if (((*l_element_courant).suivant =
! 938: allocation_maillon(s_etat_processus)) == NULL)
! 939: {
! 940: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 941: return;
! 942: }
! 943:
! 944: l_element_courant = (*l_element_courant).suivant;
! 945:
! 946: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 947: == NULL)
! 948: {
! 949: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 950: return;
! 951: }
! 952:
! 953: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 954: .nombre_arguments = 0;
! 955: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 956: .fonction = instruction_vers_niveau_inferieur;
! 957:
! 958: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 959: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 960: {
! 961: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 962: return;
! 963: }
! 964:
! 965: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 966: .nom_fonction, ">>");
! 967:
! 968: (*l_element_courant).suivant = NULL;
! 969: s_objet_argument = NULL;
! 970: }
! 971:
! 972: /*
! 973: --------------------------------------------------------------------------------
! 974: Tangente d'une expression
! 975: --------------------------------------------------------------------------------
! 976: */
! 977:
! 978: else if (((*s_objet_argument).type == ALG) ||
! 979: ((*s_objet_argument).type == RPN))
! 980: {
! 981: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
! 982: 'N')) == NULL)
! 983: {
! 984: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 985: return;
! 986: }
! 987:
! 988: l_element_courant = (struct_liste_chainee *)
! 989: (*s_copie_argument).objet;
! 990: l_element_precedent = l_element_courant;
! 991:
! 992: while((*l_element_courant).suivant != NULL)
! 993: {
! 994: l_element_precedent = l_element_courant;
! 995: l_element_courant = (*l_element_courant).suivant;
! 996: }
! 997:
! 998: if (((*l_element_precedent).suivant =
! 999: allocation_maillon(s_etat_processus)) == NULL)
! 1000: {
! 1001: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1002: return;
! 1003: }
! 1004:
! 1005: if (((*(*l_element_precedent).suivant).donnee =
! 1006: allocation(s_etat_processus, FCT)) == NULL)
! 1007: {
! 1008: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1009: return;
! 1010: }
! 1011:
! 1012: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1013: .donnee).objet)).nombre_arguments = 1;
! 1014: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1015: .donnee).objet)).fonction = instruction_tan;
! 1016:
! 1017: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 1018: .suivant).donnee).objet)).nom_fonction =
! 1019: malloc(4 * sizeof(unsigned char))) == NULL)
! 1020: {
! 1021: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1022: return;
! 1023: }
! 1024:
! 1025: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 1026: .suivant).donnee).objet)).nom_fonction, "TAN");
! 1027:
! 1028: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1029:
! 1030: s_objet_resultat = s_copie_argument;
! 1031: }
! 1032:
! 1033: /*
! 1034: --------------------------------------------------------------------------------
! 1035: Réalisation impossible de la fonction tangente
! 1036: --------------------------------------------------------------------------------
! 1037: */
! 1038:
! 1039: else
! 1040: {
! 1041: liberation(s_etat_processus, s_objet_argument);
! 1042:
! 1043: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1044: return;
! 1045: }
! 1046:
! 1047: liberation(s_etat_processus, s_objet_argument);
! 1048:
! 1049: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1050: s_objet_resultat) == d_erreur)
! 1051: {
! 1052: return;
! 1053: }
! 1054:
! 1055: return;
! 1056: }
! 1057:
! 1058:
! 1059: /*
! 1060: ================================================================================
! 1061: Fonction 'tanh'
! 1062: ================================================================================
! 1063: Entrées : pointeur sur une structure struct_processus
! 1064: --------------------------------------------------------------------------------
! 1065: Sorties :
! 1066: --------------------------------------------------------------------------------
! 1067: Effets de bord : néant
! 1068: ================================================================================
! 1069: */
! 1070:
! 1071: void
! 1072: instruction_tanh(struct_processus *s_etat_processus)
! 1073: {
! 1074: real8 argument;
! 1075:
! 1076: integer4 erreur;
! 1077:
! 1078: struct_liste_chainee *l_element_courant;
! 1079: struct_liste_chainee *l_element_precedent;
! 1080:
! 1081: struct_objet *s_copie_argument;
! 1082: struct_objet *s_objet_argument;
! 1083: struct_objet *s_objet_resultat;
! 1084:
! 1085: (*s_etat_processus).erreur_execution = d_ex;
! 1086:
! 1087: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1088: {
! 1089: printf("\n TANH ");
! 1090:
! 1091: if ((*s_etat_processus).langue == 'F')
! 1092: {
! 1093: printf("(tangente hyperbolique)\n\n");
! 1094: }
! 1095: else
! 1096: {
! 1097: printf("(hyperbolic tangent)\n\n");
! 1098: }
! 1099:
! 1100: printf(" 1: %s, %s\n", d_INT, d_REL);
! 1101: printf("-> 1: %s\n\n", d_INT);
! 1102:
! 1103: printf(" 1: %s\n", d_CPL);
! 1104: printf("-> 1: %s\n\n", d_CPL);
! 1105:
! 1106: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 1107: printf("-> 1: %s\n\n", d_ALG);
! 1108:
! 1109: printf(" 1: %s\n", d_RPN);
! 1110: printf("-> 1: %s\n", d_RPN);
! 1111:
! 1112: return;
! 1113: }
! 1114: else if ((*s_etat_processus).test_instruction == 'Y')
! 1115: {
! 1116: (*s_etat_processus).nombre_arguments = 1;
! 1117: return;
! 1118: }
! 1119:
! 1120: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1121: {
! 1122: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1123: {
! 1124: return;
! 1125: }
! 1126: }
! 1127:
! 1128: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1129: &s_objet_argument) == d_erreur)
! 1130: {
! 1131: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1132: return;
! 1133: }
! 1134:
! 1135: /*
! 1136: --------------------------------------------------------------------------------
! 1137: Tangente hyperbolique d'un entier ou d'un réel
! 1138: --------------------------------------------------------------------------------
! 1139: */
! 1140:
! 1141: if (((*s_objet_argument).type == INT) ||
! 1142: ((*s_objet_argument).type == REL))
! 1143: {
! 1144: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 1145: {
! 1146: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1147: return;
! 1148: }
! 1149:
! 1150: if ((*s_objet_argument).type == INT)
! 1151: {
! 1152: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
! 1153: }
! 1154: else
! 1155: {
! 1156: argument = (*((real8 *) (*s_objet_argument).objet));
! 1157: }
! 1158:
! 1159: (*((real8 *) (*s_objet_resultat).objet)) = tanh(argument);
! 1160: }
! 1161:
! 1162: /*
! 1163: --------------------------------------------------------------------------------
! 1164: Tangente hyperbolique d'un complexe
! 1165: --------------------------------------------------------------------------------
! 1166: */
! 1167:
! 1168: else if ((*s_objet_argument).type == CPL)
! 1169: {
! 1170: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
! 1171: {
! 1172: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1173: return;
! 1174: }
! 1175:
! 1176: f77tanh_((struct_complexe16 *) (*s_objet_argument).objet,
! 1177: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
! 1178:
! 1179: if (erreur != 0)
! 1180: {
! 1181: liberation(s_etat_processus, s_objet_argument);
! 1182: liberation(s_etat_processus, s_objet_resultat);
! 1183:
! 1184: (*s_etat_processus).exception = d_ep_division_par_zero;
! 1185: return;
! 1186: }
! 1187: }
! 1188:
! 1189: /*
! 1190: --------------------------------------------------------------------------------
! 1191: Tangente hyperbolique d'un nom
! 1192: --------------------------------------------------------------------------------
! 1193: */
! 1194:
! 1195: else if ((*s_objet_argument).type == NOM)
! 1196: {
! 1197: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 1198: {
! 1199: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1200: return;
! 1201: }
! 1202:
! 1203: if (((*s_objet_resultat).objet =
! 1204: allocation_maillon(s_etat_processus)) == NULL)
! 1205: {
! 1206: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1207: return;
! 1208: }
! 1209:
! 1210: l_element_courant = (*s_objet_resultat).objet;
! 1211:
! 1212: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1213: == NULL)
! 1214: {
! 1215: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1216: return;
! 1217: }
! 1218:
! 1219: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1220: .nombre_arguments = 0;
! 1221: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1222: .fonction = instruction_vers_niveau_superieur;
! 1223:
! 1224: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1225: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1226: {
! 1227: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1228: return;
! 1229: }
! 1230:
! 1231: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1232: .nom_fonction, "<<");
! 1233:
! 1234: if (((*l_element_courant).suivant =
! 1235: allocation_maillon(s_etat_processus)) == NULL)
! 1236: {
! 1237: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1238: return;
! 1239: }
! 1240:
! 1241: l_element_courant = (*l_element_courant).suivant;
! 1242: (*l_element_courant).donnee = s_objet_argument;
! 1243:
! 1244: if (((*l_element_courant).suivant =
! 1245: allocation_maillon(s_etat_processus)) == NULL)
! 1246: {
! 1247: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1248: return;
! 1249: }
! 1250:
! 1251: l_element_courant = (*l_element_courant).suivant;
! 1252:
! 1253: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1254: == NULL)
! 1255: {
! 1256: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1257: return;
! 1258: }
! 1259:
! 1260: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1261: .nombre_arguments = 1;
! 1262: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1263: .fonction = instruction_tanh;
! 1264:
! 1265: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1266: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
! 1267: {
! 1268: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1269: return;
! 1270: }
! 1271:
! 1272: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1273: .nom_fonction, "TANH");
! 1274:
! 1275: if (((*l_element_courant).suivant =
! 1276: allocation_maillon(s_etat_processus)) == NULL)
! 1277: {
! 1278: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1279: return;
! 1280: }
! 1281:
! 1282: l_element_courant = (*l_element_courant).suivant;
! 1283:
! 1284: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1285: == NULL)
! 1286: {
! 1287: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1288: return;
! 1289: }
! 1290:
! 1291: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1292: .nombre_arguments = 0;
! 1293: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1294: .fonction = instruction_vers_niveau_inferieur;
! 1295:
! 1296: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1297: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1298: {
! 1299: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1300: return;
! 1301: }
! 1302:
! 1303: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1304: .nom_fonction, ">>");
! 1305:
! 1306: (*l_element_courant).suivant = NULL;
! 1307: s_objet_argument = NULL;
! 1308: }
! 1309:
! 1310: /*
! 1311: --------------------------------------------------------------------------------
! 1312: Tangente hyperbolique d'une expression
! 1313: --------------------------------------------------------------------------------
! 1314: */
! 1315:
! 1316: else if (((*s_objet_argument).type == ALG) ||
! 1317: ((*s_objet_argument).type == RPN))
! 1318: {
! 1319: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
! 1320: 'N')) == NULL)
! 1321: {
! 1322: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1323: return;
! 1324: }
! 1325:
! 1326: l_element_courant = (struct_liste_chainee *)
! 1327: (*s_copie_argument).objet;
! 1328: l_element_precedent = l_element_courant;
! 1329:
! 1330: while((*l_element_courant).suivant != NULL)
! 1331: {
! 1332: l_element_precedent = l_element_courant;
! 1333: l_element_courant = (*l_element_courant).suivant;
! 1334: }
! 1335:
! 1336: if (((*l_element_precedent).suivant =
! 1337: allocation_maillon(s_etat_processus)) == NULL)
! 1338: {
! 1339: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1340: return;
! 1341: }
! 1342:
! 1343: if (((*(*l_element_precedent).suivant).donnee =
! 1344: allocation(s_etat_processus, FCT)) == NULL)
! 1345: {
! 1346: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1347: return;
! 1348: }
! 1349:
! 1350: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1351: .donnee).objet)).nombre_arguments = 1;
! 1352: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1353: .donnee).objet)).fonction = instruction_tanh;
! 1354:
! 1355: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 1356: .suivant).donnee).objet)).nom_fonction =
! 1357: malloc(5 * sizeof(unsigned char))) == NULL)
! 1358: {
! 1359: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1360: return;
! 1361: }
! 1362:
! 1363: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 1364: .suivant).donnee).objet)).nom_fonction, "TANH");
! 1365:
! 1366: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1367:
! 1368: s_objet_resultat = s_copie_argument;
! 1369: }
! 1370:
! 1371: /*
! 1372: --------------------------------------------------------------------------------
! 1373: Réalisation impossible de la fonction tangente hyperbolique
! 1374: --------------------------------------------------------------------------------
! 1375: */
! 1376:
! 1377: else
! 1378: {
! 1379: liberation(s_etat_processus, s_objet_argument);
! 1380:
! 1381: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1382: return;
! 1383: }
! 1384:
! 1385: liberation(s_etat_processus, s_objet_argument);
! 1386:
! 1387: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1388: s_objet_resultat) == d_erreur)
! 1389: {
! 1390: return;
! 1391: }
! 1392:
! 1393: return;
! 1394: }
! 1395:
! 1396:
! 1397: /*
! 1398: ================================================================================
! 1399: Fonction 'true'
! 1400: ================================================================================
! 1401: Entrées : structure processus
! 1402: --------------------------------------------------------------------------------
! 1403: Sorties :
! 1404: --------------------------------------------------------------------------------
! 1405: Effets de bord : néant
! 1406: ================================================================================
! 1407: */
! 1408:
! 1409: void
! 1410: instruction_true(struct_processus *s_etat_processus)
! 1411: {
! 1412: struct_objet *s_objet;
! 1413:
! 1414: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1415: {
! 1416: printf("\n TRUE ");
! 1417:
! 1418: if ((*s_etat_processus).langue == 'F')
! 1419: {
! 1420: printf("(valeur vraie)\n\n");
! 1421: }
! 1422: else
! 1423: {
! 1424: printf("(true value)\n\n");
! 1425: }
! 1426:
! 1427: printf("-> 1: %s\n", d_INT);
! 1428:
! 1429: return;
! 1430: }
! 1431: else if ((*s_etat_processus).test_instruction == 'Y')
! 1432: {
! 1433: (*s_etat_processus).nombre_arguments = -1;
! 1434: return;
! 1435: }
! 1436:
! 1437: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
! 1438: {
! 1439: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1440: return;
! 1441: }
! 1442:
! 1443: (*((integer8 *) (*s_objet).objet)) = -1;
! 1444:
! 1445: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1446: s_objet) == d_erreur)
! 1447: {
! 1448: return;
! 1449: }
! 1450:
! 1451: return;
! 1452: }
! 1453:
! 1454: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_t1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src