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