Annotation of rpl/src/instructions_a1.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 'abort'
! 29: ================================================================================
! 30: Entrées : pointeur sur une structure struct_processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_abort(struct_processus *s_etat_processus)
! 40: {
! 41: struct timespec attente;
! 42:
! 43: (*s_etat_processus).erreur_execution = d_ex;
! 44:
! 45: if ((*s_etat_processus).affichage_arguments == 'Y')
! 46: {
! 47: printf("\n ABORT ");
! 48:
! 49: if ((*s_etat_processus).langue == 'F')
! 50: {
! 51: printf("(abandon du programme)\n\n");
! 52: printf(" Aucun argument\n");
! 53: }
! 54: else
! 55: {
! 56: printf("(program abort)\n\n");
! 57: printf(" No argument\n");
! 58: }
! 59:
! 60: return;
! 61: }
! 62: else if ((*s_etat_processus).test_instruction == 'Y')
! 63: {
! 64: (*s_etat_processus).nombre_arguments = -1;
! 65: return;
! 66: }
! 67:
! 68: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 69: {
! 70: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 71: {
! 72: return;
! 73: }
! 74: }
! 75:
! 76: kill((*s_etat_processus).pid_processus_pere, SIGABORT);
! 77: (*s_etat_processus).requete_arret = 'Y';
! 78:
! 79: attente.tv_sec = 0;
! 80: attente.tv_nsec = GRANULARITE_us * 1000;
! 81:
! 82: while((*s_etat_processus).var_volatile_requete_arret == 0)
! 83: {
! 84: nanosleep(&attente, NULL);
! 85: INCR_GRANULARITE(attente.tv_nsec);
! 86: }
! 87:
! 88: if ((*s_etat_processus).traitement_instruction_halt == d_vrai)
! 89: {
! 90: (*s_etat_processus).execution_pas_suivant = d_vrai;
! 91: }
! 92:
! 93: return;
! 94: }
! 95:
! 96:
! 97: /*
! 98: ================================================================================
! 99: Fonction 'and'
! 100: ================================================================================
! 101: Entrées : pointeur sur une structure struct_processus
! 102: --------------------------------------------------------------------------------
! 103: Sorties :
! 104: --------------------------------------------------------------------------------
! 105: Effets de bord : néant
! 106: ================================================================================
! 107: */
! 108:
! 109: void
! 110: instruction_and(struct_processus *s_etat_processus)
! 111: {
! 112: struct_liste_chainee *l_element_courant;
! 113: struct_liste_chainee *l_element_precedent;
! 114:
! 115: struct_objet *s_copie_argument_1;
! 116: struct_objet *s_copie_argument_2;
! 117: struct_objet *s_objet_argument_1;
! 118: struct_objet *s_objet_argument_2;
! 119: struct_objet *s_objet_resultat;
! 120:
! 121: unsigned long nombre_elements;
! 122:
! 123: (*s_etat_processus).erreur_execution = d_ex;
! 124:
! 125: if ((*s_etat_processus).affichage_arguments == 'Y')
! 126: {
! 127: printf("\n AND ");
! 128:
! 129: if ((*s_etat_processus).langue == 'F')
! 130: {
! 131: printf("(opérateur et)\n\n");
! 132: }
! 133: else
! 134: {
! 135: printf("(and operator)\n\n");
! 136: }
! 137:
! 138: printf(" 2: %s, %s\n", d_INT, d_REL);
! 139: printf(" 1: %s, %s\n", d_INT, d_REL);
! 140: printf("-> 1: %s\n\n", d_INT);
! 141:
! 142: printf(" 2: %s\n", d_BIN);
! 143: printf(" 1: %s\n", d_BIN);
! 144: printf("-> 1: %s\n\n", d_BIN);
! 145:
! 146: printf(" 2: %s\n", d_NOM);
! 147: printf(" 1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
! 148: printf("-> 1: %s\n\n", d_ALG);
! 149:
! 150: printf(" 2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
! 151: printf(" 1: %s\n", d_NOM);
! 152: printf("-> 1: %s\n\n", d_ALG);
! 153:
! 154: printf(" 2: %s\n", d_ALG);
! 155: printf(" 1: %s\n", d_ALG);
! 156: printf("-> 1: %s\n\n", d_ALG);
! 157:
! 158: printf(" 2: %s\n", d_RPN);
! 159: printf(" 1: %s\n", d_RPN);
! 160: printf("-> 1: %s\n", d_RPN);
! 161:
! 162: return;
! 163: }
! 164: else if ((*s_etat_processus).test_instruction == 'Y')
! 165: {
! 166: (*s_etat_processus).nombre_arguments = 0;
! 167: return;
! 168: }
! 169:
! 170: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 171: {
! 172: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 173: {
! 174: return;
! 175: }
! 176: }
! 177:
! 178: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 179: &s_objet_argument_1) == d_erreur)
! 180: {
! 181: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 182: return;
! 183: }
! 184:
! 185: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 186: &s_objet_argument_2) == d_erreur)
! 187: {
! 188: liberation(s_etat_processus, s_objet_argument_1);
! 189:
! 190: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 191: return;
! 192: }
! 193:
! 194: /*
! 195: --------------------------------------------------------------------------------
! 196: AND logique
! 197: --------------------------------------------------------------------------------
! 198: */
! 199:
! 200: if (((((*s_objet_argument_1).type == INT) ||
! 201: ((*s_objet_argument_1).type == REL)) &&
! 202: (((*s_objet_argument_2).type == INT) ||
! 203: ((*s_objet_argument_2).type == REL))))
! 204: {
! 205: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 206: {
! 207: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 208: return;
! 209: }
! 210:
! 211: if ((*s_objet_argument_1).type == INT)
! 212: {
! 213: if ((*s_objet_argument_2).type == INT)
! 214: {
! 215: if (((*((integer8 *) (*s_objet_argument_1).objet)) != 0) &&
! 216: ((*((integer8 *) (*s_objet_argument_2).objet)) != 0))
! 217: {
! 218: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
! 219: }
! 220: else
! 221: {
! 222: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 223: }
! 224: }
! 225: else
! 226: {
! 227: if (((*((integer8 *) (*s_objet_argument_1).objet)) != 0) &&
! 228: ((*((real8 *) (*s_objet_argument_2).objet)) != 0))
! 229: {
! 230: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
! 231: }
! 232: else
! 233: {
! 234: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 235: }
! 236: }
! 237: }
! 238: else
! 239: {
! 240: if ((*s_objet_argument_2).type == INT)
! 241: {
! 242: if (((*((real8 *) (*s_objet_argument_1).objet)) != 0) &&
! 243: ((*((integer8 *) (*s_objet_argument_2).objet)) != 0))
! 244: {
! 245: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
! 246: }
! 247: else
! 248: {
! 249: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 250: }
! 251: }
! 252: else
! 253: {
! 254: if (((*((real8 *) (*s_objet_argument_1).objet)) != 0) &&
! 255: ((*((real8 *) (*s_objet_argument_2).objet)) != 0))
! 256: {
! 257: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
! 258: }
! 259: else
! 260: {
! 261: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 262: }
! 263: }
! 264: }
! 265: }
! 266:
! 267: /*
! 268: --------------------------------------------------------------------------------
! 269: AND binaire
! 270: --------------------------------------------------------------------------------
! 271: */
! 272:
! 273: else if (((*s_objet_argument_1).type == BIN) &&
! 274: ((*s_objet_argument_2).type == BIN))
! 275: {
! 276: if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL)
! 277: {
! 278: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 279: return;
! 280: }
! 281:
! 282: (*((logical8 *) (*s_objet_resultat).objet)) =
! 283: (*((logical8 *) (*s_objet_argument_1).objet)) &
! 284: (*((logical8 *) (*s_objet_argument_2).objet));
! 285: }
! 286:
! 287: /*
! 288: --------------------------------------------------------------------------------
! 289: AND entre des arguments complexes
! 290: --------------------------------------------------------------------------------
! 291: */
! 292:
! 293: /*
! 294: * Nom ou valeur numérique / Nom ou valeur numérique
! 295: */
! 296:
! 297: else if ((((*s_objet_argument_1).type == NOM) &&
! 298: (((*s_objet_argument_2).type == NOM) ||
! 299: ((*s_objet_argument_2).type == INT) ||
! 300: ((*s_objet_argument_2).type == REL))) ||
! 301: (((*s_objet_argument_2).type == NOM) &&
! 302: (((*s_objet_argument_1).type == INT) ||
! 303: ((*s_objet_argument_1).type == REL))))
! 304: {
! 305: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 306: {
! 307: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 308: return;
! 309: }
! 310:
! 311: if (((*s_objet_resultat).objet = allocation_maillon(s_etat_processus))
! 312: == NULL)
! 313: {
! 314: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 315: return;
! 316: }
! 317:
! 318: l_element_courant = (*s_objet_resultat).objet;
! 319:
! 320: if (((*l_element_courant).donnee =
! 321: allocation(s_etat_processus, FCT)) == NULL)
! 322: {
! 323: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 324: return;
! 325: }
! 326:
! 327: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 328: .nombre_arguments = 0;
! 329: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 330: .fonction = instruction_vers_niveau_superieur;
! 331:
! 332: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 333: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 334: {
! 335: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 336: return;
! 337: }
! 338:
! 339: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 340: .nom_fonction, "<<");
! 341:
! 342: if (((*l_element_courant).suivant =
! 343: allocation_maillon(s_etat_processus)) == NULL)
! 344: {
! 345: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 346: return;
! 347: }
! 348:
! 349: l_element_courant = (*l_element_courant).suivant;
! 350: (*l_element_courant).donnee = s_objet_argument_2;
! 351:
! 352: if (((*l_element_courant).suivant =
! 353: allocation_maillon(s_etat_processus)) == NULL)
! 354: {
! 355: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 356: return;
! 357: }
! 358:
! 359: l_element_courant = (*l_element_courant).suivant;
! 360: (*l_element_courant).donnee = s_objet_argument_1;
! 361:
! 362: if (((*l_element_courant).suivant =
! 363: allocation_maillon(s_etat_processus)) == NULL)
! 364: {
! 365: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 366: return;
! 367: }
! 368:
! 369: l_element_courant = (*l_element_courant).suivant;
! 370:
! 371: if (((*l_element_courant).donnee =
! 372: allocation(s_etat_processus, FCT)) == NULL)
! 373: {
! 374: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 375: return;
! 376: }
! 377:
! 378: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 379: .nombre_arguments = 0;
! 380: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 381: .fonction = instruction_and;
! 382:
! 383: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 384: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
! 385: {
! 386: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 387: return;
! 388: }
! 389:
! 390: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 391: .nom_fonction, "AND");
! 392:
! 393: if (((*l_element_courant).suivant =
! 394: allocation_maillon(s_etat_processus)) == NULL)
! 395: {
! 396: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 397: return;
! 398: }
! 399:
! 400: l_element_courant = (*l_element_courant).suivant;
! 401:
! 402: if (((*l_element_courant).donnee =
! 403: allocation(s_etat_processus, FCT)) == NULL)
! 404: {
! 405: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 406: return;
! 407: }
! 408:
! 409: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 410: .nombre_arguments = 0;
! 411: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 412: .fonction = instruction_vers_niveau_inferieur;
! 413:
! 414: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 415: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 416: {
! 417: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 418: return;
! 419: }
! 420:
! 421: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 422: .nom_fonction, ">>");
! 423:
! 424: (*l_element_courant).suivant = NULL;
! 425:
! 426: s_objet_argument_1 = NULL;
! 427: s_objet_argument_2 = NULL;
! 428: }
! 429:
! 430: /*
! 431: * Nom ou valeur numérique / Expression
! 432: */
! 433:
! 434: else if ((((*s_objet_argument_1).type == ALG) ||
! 435: ((*s_objet_argument_1).type == RPN)) &&
! 436: (((*s_objet_argument_2).type == NOM) ||
! 437: ((*s_objet_argument_2).type == INT) ||
! 438: ((*s_objet_argument_2).type == REL)))
! 439: {
! 440: nombre_elements = 0;
! 441: l_element_courant = (struct_liste_chainee *)
! 442: (*s_objet_argument_1).objet;
! 443:
! 444: while(l_element_courant != NULL)
! 445: {
! 446: nombre_elements++;
! 447: l_element_courant = (*l_element_courant).suivant;
! 448: }
! 449:
! 450: if (nombre_elements == 2)
! 451: {
! 452: liberation(s_etat_processus, s_objet_argument_1);
! 453: liberation(s_etat_processus, s_objet_argument_2);
! 454:
! 455: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 456: return;
! 457: }
! 458:
! 459: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 460: s_objet_argument_1, 'N')) == NULL)
! 461: {
! 462: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 463: return;
! 464: }
! 465:
! 466: l_element_courant = (struct_liste_chainee *)
! 467: (*s_objet_resultat).objet;
! 468: l_element_precedent = l_element_courant;
! 469: l_element_courant = (*l_element_courant).suivant;
! 470:
! 471: if (((*l_element_precedent).suivant =
! 472: allocation_maillon(s_etat_processus)) == NULL)
! 473: {
! 474: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 475: return;
! 476: }
! 477:
! 478: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
! 479: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 480:
! 481: while((*l_element_courant).suivant != NULL)
! 482: {
! 483: l_element_precedent = l_element_courant;
! 484: l_element_courant = (*l_element_courant).suivant;
! 485: }
! 486:
! 487: if (((*l_element_precedent).suivant =
! 488: allocation_maillon(s_etat_processus)) == NULL)
! 489: {
! 490: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 491: return;
! 492: }
! 493:
! 494: if (((*(*l_element_precedent).suivant).donnee =
! 495: allocation(s_etat_processus, FCT)) == NULL)
! 496: {
! 497: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 498: return;
! 499: }
! 500:
! 501: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 502: .donnee).objet)).nombre_arguments = 0;
! 503: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 504: .donnee).objet)).fonction = instruction_and;
! 505:
! 506: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 507: .suivant).donnee).objet)).nom_fonction =
! 508: malloc(4 * sizeof(unsigned char))) == NULL)
! 509: {
! 510: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 511: return;
! 512: }
! 513:
! 514: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 515: .suivant).donnee).objet)).nom_fonction, "AND");
! 516:
! 517: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 518:
! 519: s_objet_argument_2 = NULL;
! 520: }
! 521:
! 522: /*
! 523: * Expression / Nom ou valeur numérique
! 524: */
! 525:
! 526: else if ((((*s_objet_argument_1).type == NOM) ||
! 527: ((*s_objet_argument_1).type == INT) ||
! 528: ((*s_objet_argument_1).type == REL)) &&
! 529: (((*s_objet_argument_2).type == ALG) ||
! 530: ((*s_objet_argument_2).type == RPN)))
! 531: {
! 532: nombre_elements = 0;
! 533: l_element_courant = (struct_liste_chainee *)
! 534: (*s_objet_argument_2).objet;
! 535:
! 536: while(l_element_courant != NULL)
! 537: {
! 538: nombre_elements++;
! 539: l_element_courant = (*l_element_courant).suivant;
! 540: }
! 541:
! 542: if (nombre_elements == 2)
! 543: {
! 544: liberation(s_etat_processus, s_objet_argument_1);
! 545: liberation(s_etat_processus, s_objet_argument_2);
! 546:
! 547: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 548: return;
! 549: }
! 550:
! 551: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 552: s_objet_argument_2, 'N')) == NULL)
! 553: {
! 554: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 555: return;
! 556: }
! 557:
! 558: l_element_courant = (struct_liste_chainee *)
! 559: (*s_objet_resultat).objet;
! 560: l_element_precedent = l_element_courant;
! 561:
! 562: while((*l_element_courant).suivant != NULL)
! 563: {
! 564: l_element_precedent = l_element_courant;
! 565: l_element_courant = (*l_element_courant).suivant;
! 566: }
! 567:
! 568: if (((*l_element_precedent).suivant =
! 569: allocation_maillon(s_etat_processus)) == NULL)
! 570: {
! 571: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 572: return;
! 573: }
! 574:
! 575: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
! 576: l_element_precedent = (*l_element_precedent).suivant;
! 577:
! 578: if (((*l_element_precedent).suivant =
! 579: allocation_maillon(s_etat_processus)) == NULL)
! 580: {
! 581: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 582: return;
! 583: }
! 584:
! 585: if (((*(*l_element_precedent).suivant).donnee =
! 586: allocation(s_etat_processus, FCT)) == NULL)
! 587: {
! 588: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 589: return;
! 590: }
! 591:
! 592: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 593: .donnee).objet)).nombre_arguments = 0;
! 594: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 595: .donnee).objet)).fonction = instruction_and;
! 596:
! 597: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 598: .suivant).donnee).objet)).nom_fonction =
! 599: malloc(4 * sizeof(unsigned char))) == NULL)
! 600: {
! 601: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 602: return;
! 603: }
! 604:
! 605: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 606: .suivant).donnee).objet)).nom_fonction, "AND");
! 607:
! 608: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 609:
! 610: s_objet_argument_1 = NULL;
! 611: }
! 612:
! 613: /*
! 614: * Expression / Expression
! 615: */
! 616:
! 617: else if ((((*s_objet_argument_1).type == ALG) &&
! 618: ((*s_objet_argument_2).type == ALG)) ||
! 619: (((*s_objet_argument_1).type == RPN) &&
! 620: ((*s_objet_argument_2).type == RPN)))
! 621: {
! 622: nombre_elements = 0;
! 623: l_element_courant = (struct_liste_chainee *)
! 624: (*s_objet_argument_1).objet;
! 625:
! 626: while(l_element_courant != NULL)
! 627: {
! 628: nombre_elements++;
! 629: l_element_courant = (*l_element_courant).suivant;
! 630: }
! 631:
! 632: if (nombre_elements == 2)
! 633: {
! 634: liberation(s_etat_processus, s_objet_argument_1);
! 635: liberation(s_etat_processus, s_objet_argument_2);
! 636:
! 637: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 638: return;
! 639: }
! 640:
! 641: nombre_elements = 0;
! 642: l_element_courant = (struct_liste_chainee *)
! 643: (*s_objet_argument_2).objet;
! 644:
! 645: while(l_element_courant != NULL)
! 646: {
! 647: nombre_elements++;
! 648: l_element_courant = (*l_element_courant).suivant;
! 649: }
! 650:
! 651: if (nombre_elements == 2)
! 652: {
! 653: liberation(s_etat_processus, s_objet_argument_1);
! 654: liberation(s_etat_processus, s_objet_argument_2);
! 655:
! 656: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 657: return;
! 658: }
! 659:
! 660: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
! 661: s_objet_argument_1, 'N')) == NULL)
! 662: {
! 663: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 664: return;
! 665: }
! 666:
! 667: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
! 668: s_objet_argument_2, 'N')) == NULL)
! 669: {
! 670: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 671: return;
! 672: }
! 673:
! 674: l_element_courant = (struct_liste_chainee *)
! 675: (*s_copie_argument_1).objet;
! 676: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
! 677: (*s_copie_argument_1).objet)).suivant;
! 678:
! 679: liberation(s_etat_processus, (*l_element_courant).donnee);
! 680: liberation_maillon(s_etat_processus, l_element_courant);
! 681:
! 682: l_element_courant = (struct_liste_chainee *)
! 683: (*s_copie_argument_2).objet;
! 684: l_element_precedent = l_element_courant;
! 685: s_objet_resultat = s_copie_argument_2;
! 686:
! 687: while((*l_element_courant).suivant != NULL)
! 688: {
! 689: l_element_precedent = l_element_courant;
! 690: l_element_courant = (*l_element_courant).suivant;
! 691: }
! 692:
! 693: liberation(s_etat_processus, (*l_element_courant).donnee);
! 694: liberation_maillon(s_etat_processus, l_element_courant);
! 695:
! 696: (*l_element_precedent).suivant = (struct_liste_chainee *)
! 697: (*s_copie_argument_1).objet;
! 698: (*s_copie_argument_1).objet = NULL;
! 699: free(s_copie_argument_1);
! 700:
! 701: l_element_courant = (*l_element_precedent).suivant;
! 702: while((*l_element_courant).suivant != NULL)
! 703: {
! 704: l_element_precedent = l_element_courant;
! 705: l_element_courant = (*l_element_courant).suivant;
! 706: }
! 707:
! 708: if (((*l_element_precedent).suivant =
! 709: allocation_maillon(s_etat_processus)) == NULL)
! 710: {
! 711: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 712: return;
! 713: }
! 714:
! 715: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 716: l_element_courant = (*l_element_precedent).suivant;
! 717:
! 718: if (((*l_element_courant).donnee =
! 719: allocation(s_etat_processus, FCT)) == NULL)
! 720: {
! 721: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 722: return;
! 723: }
! 724:
! 725: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 726: .nombre_arguments = 0;
! 727: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 728: .fonction = instruction_and;
! 729:
! 730: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 731: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
! 732: {
! 733: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 734: return;
! 735: }
! 736:
! 737: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 738: .nom_fonction, "AND");
! 739: }
! 740:
! 741: /*
! 742: --------------------------------------------------------------------------------
! 743: AND impossible
! 744: --------------------------------------------------------------------------------
! 745: */
! 746:
! 747: else
! 748: {
! 749: liberation(s_etat_processus, s_objet_argument_1);
! 750: liberation(s_etat_processus, s_objet_argument_2);
! 751:
! 752: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 753: return;
! 754: }
! 755:
! 756: liberation(s_etat_processus, s_objet_argument_1);
! 757: liberation(s_etat_processus, s_objet_argument_2);
! 758:
! 759: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 760: s_objet_resultat) == d_erreur)
! 761: {
! 762: return;
! 763: }
! 764:
! 765: return;
! 766: }
! 767:
! 768:
! 769: /*
! 770: ================================================================================
! 771: Fonction 'abs'
! 772: ================================================================================
! 773: Entrées :
! 774: --------------------------------------------------------------------------------
! 775: Sorties :
! 776: --------------------------------------------------------------------------------
! 777: Effets de bord : néant
! 778: ================================================================================
! 779: */
! 780:
! 781: void
! 782: instruction_abs(struct_processus *s_etat_processus)
! 783: {
! 784: logical1 erreur_memoire;
! 785:
! 786: real8 tampon_flottant;
! 787:
! 788: struct_liste_chainee *l_element_courant;
! 789: struct_liste_chainee *l_element_precedent;
! 790:
! 791: struct_objet *s_copie_argument;
! 792: struct_objet *s_objet_argument;
! 793: struct_objet *s_objet_resultat;
! 794:
! 795: unsigned long i;
! 796: unsigned long j;
! 797: unsigned long k;
! 798: unsigned long nombre_elements;
! 799:
! 800: void *accumulateur;
! 801:
! 802: (*s_etat_processus).erreur_execution = d_ex;
! 803:
! 804: if ((*s_etat_processus).affichage_arguments == 'Y')
! 805: {
! 806: printf("\n ABS ");
! 807:
! 808: if ((*s_etat_processus).langue == 'F')
! 809: {
! 810: printf("(norme)\n\n");
! 811: }
! 812: else
! 813: {
! 814: printf("(norm)\n\n");
! 815: }
! 816:
! 817: printf(" 1: %s\n", d_INT);
! 818: printf("-> 1: %s\n\n", d_INT);
! 819:
! 820: printf(" 1: %s, %s\n", d_REL, d_CPL);
! 821: printf("-> 1: %s\n\n", d_REL);
! 822:
! 823: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 824: printf("-> 1: %s\n\n", d_REL);
! 825:
! 826: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 827: printf("-> 1: %s\n\n", d_REL);
! 828:
! 829: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 830: printf("-> 1: %s\n\n", d_ALG);
! 831:
! 832: printf(" 1: %s\n", d_RPN);
! 833: printf("-> 1: %s\n", d_RPN);
! 834:
! 835: return;
! 836: }
! 837: else if ((*s_etat_processus).test_instruction == 'Y')
! 838: {
! 839: (*s_etat_processus).nombre_arguments = 1;
! 840: return;
! 841: }
! 842:
! 843: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 844: {
! 845: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 846: {
! 847: return;
! 848: }
! 849: }
! 850:
! 851: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 852: &s_objet_argument) == d_erreur)
! 853: {
! 854: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 855: return;
! 856: }
! 857:
! 858: /*
! 859: --------------------------------------------------------------------------------
! 860: Valeur absolue d'un entier
! 861: --------------------------------------------------------------------------------
! 862: */
! 863:
! 864: if ((*s_objet_argument).type == INT)
! 865: {
! 866: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 867: {
! 868: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 869: return;
! 870: }
! 871:
! 872: (*((integer8 *) (*s_objet_resultat).objet)) = abs((*((integer8 *)
! 873: (*s_objet_argument).objet)));
! 874: }
! 875:
! 876: /*
! 877: --------------------------------------------------------------------------------
! 878: Valeur absolue d'un réel
! 879: --------------------------------------------------------------------------------
! 880: */
! 881:
! 882: else if ((*s_objet_argument).type == REL)
! 883: {
! 884: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 885: {
! 886: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 887: return;
! 888: }
! 889:
! 890: (*((real8 *) (*s_objet_resultat).objet)) = fabs(*((real8 *)
! 891: (*s_objet_argument).objet));
! 892: }
! 893:
! 894: /*
! 895: --------------------------------------------------------------------------------
! 896: Valeur absolue d'un complexe
! 897: --------------------------------------------------------------------------------
! 898: */
! 899:
! 900: else if ((*s_objet_argument).type == CPL)
! 901: {
! 902: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 903: {
! 904: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 905: return;
! 906: }
! 907:
! 908: (*s_objet_resultat).type = REL;
! 909: f77absc_(((struct_complexe16 *) (*s_objet_argument).objet),
! 910: ((real8 *) (*s_objet_resultat).objet));
! 911: }
! 912:
! 913: /*
! 914: --------------------------------------------------------------------------------
! 915: Norme de Frobenius d'un tableau
! 916: --------------------------------------------------------------------------------
! 917: */
! 918:
! 919: /*
! 920: * Vecteur d'entiers
! 921: */
! 922:
! 923: else if ((*s_objet_argument).type == VIN)
! 924: {
! 925: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 926: {
! 927: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 928: return;
! 929: }
! 930:
! 931: if ((accumulateur = malloc((*(((struct_vecteur *)
! 932: (*s_objet_argument).objet))).taille * sizeof(real8))) == NULL)
! 933: {
! 934: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 935: return;
! 936: }
! 937:
! 938: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
! 939: .taille; i++)
! 940: {
! 941: ((real8 *) accumulateur)[i] = (real8) (((integer8 *)
! 942: (*((struct_vecteur *) (*s_objet_argument).objet))
! 943: .tableau)[i] * ((integer8 *) (*((struct_vecteur *)
! 944: (*s_objet_argument).objet)).tableau)[i]);
! 945: }
! 946:
! 947: (*((real8 *) (*s_objet_resultat).objet)) =
! 948: sqrt(sommation_vecteur_reel(accumulateur,
! 949: &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille),
! 950: &erreur_memoire));
! 951:
! 952: if (erreur_memoire == d_vrai)
! 953: {
! 954: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 955: return;
! 956: }
! 957:
! 958: free(accumulateur);
! 959: }
! 960:
! 961: /*
! 962: * Vecteur de réels
! 963: */
! 964:
! 965: else if ((*s_objet_argument).type == VRL)
! 966: {
! 967: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 968: {
! 969: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 970: return;
! 971: }
! 972:
! 973: if ((accumulateur = malloc((*(((struct_vecteur *)
! 974: (*s_objet_argument).objet))).taille * sizeof(real8))) == NULL)
! 975: {
! 976: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 977: return;
! 978: }
! 979:
! 980: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
! 981: .taille; i++)
! 982: {
! 983: ((real8 *) accumulateur)[i] = ((real8 *) (*((struct_vecteur *)
! 984: (*s_objet_argument).objet)).tableau)[i] *
! 985: ((real8 *) (*((struct_vecteur *)
! 986: (*s_objet_argument).objet)).tableau)[i];
! 987: }
! 988:
! 989: (*((real8 *) (*s_objet_resultat).objet)) =
! 990: sqrt(sommation_vecteur_reel(accumulateur,
! 991: &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille),
! 992: &erreur_memoire));
! 993:
! 994: if (erreur_memoire == d_vrai)
! 995: {
! 996: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 997: return;
! 998: }
! 999:
! 1000: free(accumulateur);
! 1001: }
! 1002:
! 1003: /*
! 1004: * Vecteur de complexes
! 1005: */
! 1006:
! 1007: else if ((*s_objet_argument).type == VCX)
! 1008: {
! 1009: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 1010: {
! 1011: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1012: return;
! 1013: }
! 1014:
! 1015: if ((accumulateur = malloc((*(((struct_vecteur *)
! 1016: (*s_objet_argument).objet))).taille * sizeof(real8))) == NULL)
! 1017: {
! 1018: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1019: return;
! 1020: }
! 1021:
! 1022: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
! 1023: .taille; i++)
! 1024: {
! 1025: f77absc_(&(((struct_complexe16 *) (*((struct_vecteur *)
! 1026: (*s_objet_argument).objet)).tableau)[i]), &tampon_flottant);
! 1027: ((real8 *) accumulateur)[i] = (tampon_flottant * tampon_flottant);
! 1028: }
! 1029:
! 1030: (*((real8 *) (*s_objet_resultat).objet)) =
! 1031: sqrt(sommation_vecteur_reel(accumulateur,
! 1032: &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille),
! 1033: &erreur_memoire));
! 1034:
! 1035: if (erreur_memoire == d_vrai)
! 1036: {
! 1037: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1038: return;
! 1039: }
! 1040:
! 1041: free(accumulateur);
! 1042: }
! 1043:
! 1044: /*
! 1045: * Matrice d'entiers
! 1046: */
! 1047:
! 1048: else if ((*s_objet_argument).type == MIN)
! 1049: {
! 1050: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 1051: {
! 1052: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1053: return;
! 1054: }
! 1055:
! 1056: if ((accumulateur = malloc((nombre_elements =
! 1057: (*(((struct_matrice *) (*s_objet_argument).objet)))
! 1058: .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument)
! 1059: .objet))).nombre_colonnes) * sizeof(real8))) == NULL)
! 1060: {
! 1061: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1062: return;
! 1063: }
! 1064:
! 1065: for(k = 0, i = 0; i < (*(((struct_matrice *)
! 1066: (*s_objet_argument).objet))).nombre_lignes; i++)
! 1067: {
! 1068: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
! 1069: .nombre_colonnes; j++)
! 1070: {
! 1071: ((real8 *) accumulateur)[k++] =
! 1072: ((integer8 **) (*((struct_matrice *)
! 1073: (*s_objet_argument).objet)).tableau)[i][j] *
! 1074: ((integer8 **) (*((struct_matrice *)
! 1075: (*s_objet_argument).objet)).tableau)[i][j];
! 1076: }
! 1077: }
! 1078:
! 1079: (*((real8 *) (*s_objet_resultat).objet)) =
! 1080: sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements,
! 1081: &erreur_memoire));
! 1082:
! 1083: if (erreur_memoire == d_vrai)
! 1084: {
! 1085: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1086: return;
! 1087: }
! 1088:
! 1089: free(accumulateur);
! 1090: }
! 1091:
! 1092: /*
! 1093: * Matrice de réels
! 1094: */
! 1095:
! 1096: else if ((*s_objet_argument).type == MRL)
! 1097: {
! 1098: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 1099: {
! 1100: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1101: return;
! 1102: }
! 1103:
! 1104: if ((accumulateur = malloc((nombre_elements =
! 1105: (*(((struct_matrice *) (*s_objet_argument).objet)))
! 1106: .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument)
! 1107: .objet))).nombre_colonnes) * sizeof(real8))) == NULL)
! 1108: {
! 1109: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1110: return;
! 1111: }
! 1112:
! 1113: for(k = 0, i = 0; i < (*(((struct_matrice *)
! 1114: (*s_objet_argument).objet))).nombre_lignes; i++)
! 1115: {
! 1116: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
! 1117: .nombre_colonnes; j++)
! 1118: {
! 1119: ((real8 *) accumulateur)[k++] =
! 1120: ((real8 **) (*((struct_matrice *)
! 1121: (*s_objet_argument).objet)).tableau)[i][j] *
! 1122: ((real8 **) (*((struct_matrice *)
! 1123: (*s_objet_argument).objet)).tableau)[i][j];
! 1124: }
! 1125: }
! 1126:
! 1127: (*((real8 *) (*s_objet_resultat).objet)) =
! 1128: sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements,
! 1129: &erreur_memoire));
! 1130:
! 1131: if (erreur_memoire == d_vrai)
! 1132: {
! 1133: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1134: return;
! 1135: }
! 1136:
! 1137: free(accumulateur);
! 1138: }
! 1139:
! 1140: /*
! 1141: * Matrice de complexes
! 1142: */
! 1143:
! 1144: else if ((*s_objet_argument).type == MCX)
! 1145: {
! 1146: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 1147: {
! 1148: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1149: return;
! 1150: }
! 1151:
! 1152: if ((accumulateur = malloc((nombre_elements =
! 1153: (*(((struct_matrice *) (*s_objet_argument).objet)))
! 1154: .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument)
! 1155: .objet))).nombre_colonnes) * sizeof(real8))) == NULL)
! 1156: {
! 1157: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1158: return;
! 1159: }
! 1160:
! 1161: for(k = 0, i = 0; i < (*(((struct_matrice *)
! 1162: (*s_objet_argument).objet))).nombre_lignes; i++)
! 1163: {
! 1164: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
! 1165: .nombre_colonnes; j++)
! 1166: {
! 1167: f77absc_(&(((struct_complexe16 **) (*((struct_matrice *)
! 1168: (*s_objet_argument).objet)).tableau)[i][j]),
! 1169: &tampon_flottant);
! 1170: ((real8 *) accumulateur)[k++] =
! 1171: (tampon_flottant * tampon_flottant);
! 1172: }
! 1173: }
! 1174:
! 1175: (*((real8 *) (*s_objet_resultat).objet)) =
! 1176: sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements,
! 1177: &erreur_memoire));
! 1178:
! 1179: if (erreur_memoire == d_vrai)
! 1180: {
! 1181: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1182: return;
! 1183: }
! 1184:
! 1185: free(accumulateur);
! 1186: }
! 1187:
! 1188: /*
! 1189: --------------------------------------------------------------------------------
! 1190: Valeur absolue d'un nom
! 1191: --------------------------------------------------------------------------------
! 1192: */
! 1193:
! 1194: else if ((*s_objet_argument).type == NOM)
! 1195: {
! 1196: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 1197: {
! 1198: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1199: return;
! 1200: }
! 1201:
! 1202: if (((*s_objet_resultat).objet =
! 1203: allocation_maillon(s_etat_processus)) == NULL)
! 1204: {
! 1205: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1206: return;
! 1207: }
! 1208:
! 1209: l_element_courant = (*s_objet_resultat).objet;
! 1210:
! 1211: if (((*l_element_courant).donnee =
! 1212: allocation(s_etat_processus, FCT)) == NULL)
! 1213: {
! 1214: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1215: return;
! 1216: }
! 1217:
! 1218: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1219: .nombre_arguments = 0;
! 1220: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1221: .fonction = instruction_vers_niveau_superieur;
! 1222:
! 1223: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1224: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1225: {
! 1226: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1227: return;
! 1228: }
! 1229:
! 1230: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1231: .nom_fonction, "<<");
! 1232:
! 1233: if (((*l_element_courant).suivant =
! 1234: allocation_maillon(s_etat_processus)) == NULL)
! 1235: {
! 1236: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1237: return;
! 1238: }
! 1239:
! 1240: l_element_courant = (*l_element_courant).suivant;
! 1241: (*l_element_courant).donnee = s_objet_argument;
! 1242:
! 1243: if (((*l_element_courant).suivant =
! 1244: allocation_maillon(s_etat_processus)) == NULL)
! 1245: {
! 1246: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1247: return;
! 1248: }
! 1249:
! 1250: l_element_courant = (*l_element_courant).suivant;
! 1251:
! 1252: if (((*l_element_courant).donnee =
! 1253: allocation(s_etat_processus, FCT)) == NULL)
! 1254: {
! 1255: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1256: return;
! 1257: }
! 1258:
! 1259: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1260: .nombre_arguments = 1;
! 1261: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1262: .fonction = instruction_abs;
! 1263:
! 1264: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1265: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
! 1266: {
! 1267: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1268: return;
! 1269: }
! 1270:
! 1271: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1272: .nom_fonction, "ABS");
! 1273:
! 1274: if (((*l_element_courant).suivant =
! 1275: allocation_maillon(s_etat_processus)) == NULL)
! 1276: {
! 1277: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1278: return;
! 1279: }
! 1280:
! 1281: l_element_courant = (*l_element_courant).suivant;
! 1282:
! 1283: if (((*l_element_courant).donnee =
! 1284: allocation(s_etat_processus, FCT)) == NULL)
! 1285: {
! 1286: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1287: return;
! 1288: }
! 1289:
! 1290: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1291: .nombre_arguments = 0;
! 1292: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1293: .fonction = instruction_vers_niveau_inferieur;
! 1294:
! 1295: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1296: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1297: {
! 1298: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1299: return;
! 1300: }
! 1301:
! 1302: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1303: .nom_fonction, ">>");
! 1304:
! 1305: (*l_element_courant).suivant = NULL;
! 1306: s_objet_argument = NULL;
! 1307: }
! 1308:
! 1309: /*
! 1310: --------------------------------------------------------------------------------
! 1311: Valeur absolue d'une expression
! 1312: --------------------------------------------------------------------------------
! 1313: */
! 1314:
! 1315: else if (((*s_objet_argument).type == ALG) ||
! 1316: ((*s_objet_argument).type == RPN))
! 1317: {
! 1318: if ((s_copie_argument = copie_objet(s_etat_processus,
! 1319: s_objet_argument, 'N')) == NULL)
! 1320: {
! 1321: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1322: return;
! 1323: }
! 1324:
! 1325: l_element_courant = (struct_liste_chainee *)
! 1326: (*s_copie_argument).objet;
! 1327: l_element_precedent = l_element_courant;
! 1328:
! 1329: while((*l_element_courant).suivant != NULL)
! 1330: {
! 1331: l_element_precedent = l_element_courant;
! 1332: l_element_courant = (*l_element_courant).suivant;
! 1333: }
! 1334:
! 1335: if (((*l_element_precedent).suivant =
! 1336: allocation_maillon(s_etat_processus)) == NULL)
! 1337: {
! 1338: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1339: return;
! 1340: }
! 1341:
! 1342: if (((*(*l_element_precedent).suivant).donnee =
! 1343: allocation(s_etat_processus, FCT)) == NULL)
! 1344: {
! 1345: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1346: return;
! 1347: }
! 1348:
! 1349: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1350: .donnee).objet)).nombre_arguments = 1;
! 1351: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1352: .donnee).objet)).fonction = instruction_abs;
! 1353:
! 1354: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 1355: .suivant).donnee).objet)).nom_fonction =
! 1356: malloc(4 * sizeof(unsigned char))) == NULL)
! 1357: {
! 1358: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1359: return;
! 1360: }
! 1361:
! 1362: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 1363: .suivant).donnee).objet)).nom_fonction, "ABS");
! 1364:
! 1365: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1366:
! 1367: s_objet_resultat = s_copie_argument;
! 1368: }
! 1369:
! 1370: /*
! 1371: --------------------------------------------------------------------------------
! 1372: Valeur absolue impossible à réaliser
! 1373: --------------------------------------------------------------------------------
! 1374: */
! 1375:
! 1376: else
! 1377: {
! 1378: liberation(s_etat_processus, s_objet_argument);
! 1379:
! 1380: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1381: return;
! 1382: }
! 1383:
! 1384: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1385: s_objet_resultat) == d_erreur)
! 1386: {
! 1387: return;
! 1388: }
! 1389:
! 1390: liberation(s_etat_processus, s_objet_argument);
! 1391:
! 1392: return;
! 1393: }
! 1394:
! 1395:
! 1396: /*
! 1397: ================================================================================
! 1398: Fonction 'arg'
! 1399: ================================================================================
! 1400: Entrées : structure processus
! 1401: --------------------------------------------------------------------------------
! 1402: Sorties :
! 1403: --------------------------------------------------------------------------------
! 1404: Effets de bord : néant
! 1405: ================================================================================
! 1406: */
! 1407:
! 1408: void
! 1409: instruction_arg(struct_processus *s_etat_processus)
! 1410: {
! 1411: struct_liste_chainee *l_element_courant;
! 1412: struct_liste_chainee *l_element_precedent;
! 1413:
! 1414: struct_objet *s_copie_argument;
! 1415: struct_objet *s_objet_argument;
! 1416: struct_objet *s_objet_resultat;
! 1417:
! 1418: (*s_etat_processus).erreur_execution = d_ex;
! 1419:
! 1420: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1421: {
! 1422: printf("\n ARG ");
! 1423:
! 1424: if ((*s_etat_processus).langue == 'F')
! 1425: {
! 1426: printf("(argument)\n\n");
! 1427: }
! 1428: else
! 1429: {
! 1430: printf("(argument)\n\n");
! 1431: }
! 1432:
! 1433: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 1434: printf("-> 1: %s\n\n", d_REL);
! 1435:
! 1436: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 1437: printf("-> 1: %s\n\n", d_ALG);
! 1438:
! 1439: printf(" 1: %s\n", d_RPN);
! 1440: printf("-> 1: %s\n", d_RPN);
! 1441:
! 1442: return;
! 1443: }
! 1444: else if ((*s_etat_processus).test_instruction == 'Y')
! 1445: {
! 1446: (*s_etat_processus).nombre_arguments = 1;
! 1447: return;
! 1448: }
! 1449:
! 1450: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1451: {
! 1452: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1453: {
! 1454: return;
! 1455: }
! 1456: }
! 1457:
! 1458: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1459: &s_objet_argument) == d_erreur)
! 1460: {
! 1461: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1462: return;
! 1463: }
! 1464:
! 1465: /*
! 1466: --------------------------------------------------------------------------------
! 1467: Argument d'un entier ou d'un réel
! 1468: --------------------------------------------------------------------------------
! 1469: */
! 1470:
! 1471: if (((*s_objet_argument).type == INT) ||
! 1472: ((*s_objet_argument).type == REL))
! 1473: {
! 1474: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 1475: == NULL)
! 1476: {
! 1477: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1478: return;
! 1479: }
! 1480:
! 1481: if ((*s_objet_argument).type == INT)
! 1482: {
! 1483: if ((*((integer8 *) (*s_objet_argument).objet)) >= 0)
! 1484: {
! 1485: (*((real8 *) (*s_objet_resultat).objet)) = 0;
! 1486: }
! 1487: else
! 1488: {
! 1489: (*((real8 *) (*s_objet_resultat).objet)) =
! 1490: 4 * atan((real8) 1);
! 1491: }
! 1492: }
! 1493: else
! 1494: {
! 1495: if ((*((real8 *) (*s_objet_argument).objet)) >= 0)
! 1496: {
! 1497: (*((real8 *) (*s_objet_resultat).objet)) = 0;
! 1498: }
! 1499: else
! 1500: {
! 1501: (*((real8 *) (*s_objet_resultat).objet)) =
! 1502: 4 * atan((real8) 1);
! 1503:
! 1504: if (test_cfsf(s_etat_processus, 60) == d_faux)
! 1505: {
! 1506: conversion_radians_vers_degres(&(*((real8 *)
! 1507: (*s_objet_resultat).objet)));
! 1508: }
! 1509: }
! 1510: }
! 1511: }
! 1512:
! 1513: /*
! 1514: --------------------------------------------------------------------------------
! 1515: Argument d'un complexe
! 1516: --------------------------------------------------------------------------------
! 1517: */
! 1518:
! 1519: else if ((*s_objet_argument).type == CPL)
! 1520: {
! 1521: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 1522: == NULL)
! 1523: {
! 1524: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1525: return;
! 1526: }
! 1527:
! 1528: (*((real8 *) (*s_objet_resultat).objet)) =
! 1529: atan2((*((struct_complexe16 *) (*s_objet_argument).objet))
! 1530: .partie_imaginaire, (*((struct_complexe16 *)
! 1531: (*s_objet_argument).objet)).partie_reelle);
! 1532:
! 1533: if (test_cfsf(s_etat_processus, 60) == d_faux)
! 1534: {
! 1535: conversion_radians_vers_degres(&(*((real8 *)
! 1536: (*s_objet_resultat).objet)));
! 1537: }
! 1538: }
! 1539:
! 1540: /*
! 1541: --------------------------------------------------------------------------------
! 1542: Argument d'un nom
! 1543: --------------------------------------------------------------------------------
! 1544: */
! 1545:
! 1546: else if ((*s_objet_argument).type == NOM)
! 1547: {
! 1548: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 1549: == NULL)
! 1550: {
! 1551: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1552: return;
! 1553: }
! 1554:
! 1555: if (((*s_objet_resultat).objet =
! 1556: allocation_maillon(s_etat_processus)) == NULL)
! 1557: {
! 1558: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1559: return;
! 1560: }
! 1561:
! 1562: l_element_courant = (*s_objet_resultat).objet;
! 1563:
! 1564: if (((*l_element_courant).donnee =
! 1565: allocation(s_etat_processus, FCT)) == NULL)
! 1566: {
! 1567: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1568: return;
! 1569: }
! 1570:
! 1571: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1572: .nombre_arguments = 0;
! 1573: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1574: .fonction = instruction_vers_niveau_superieur;
! 1575:
! 1576: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1577: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1578: {
! 1579: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1580: return;
! 1581: }
! 1582:
! 1583: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1584: .nom_fonction, "<<");
! 1585:
! 1586: if (((*l_element_courant).suivant =
! 1587: allocation_maillon(s_etat_processus)) == NULL)
! 1588: {
! 1589: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1590: return;
! 1591: }
! 1592:
! 1593: l_element_courant = (*l_element_courant).suivant;
! 1594: (*l_element_courant).donnee = s_objet_argument;
! 1595:
! 1596: if (((*l_element_courant).suivant =
! 1597: allocation_maillon(s_etat_processus)) == NULL)
! 1598: {
! 1599: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1600: return;
! 1601: }
! 1602:
! 1603: l_element_courant = (*l_element_courant).suivant;
! 1604:
! 1605: if (((*l_element_courant).donnee =
! 1606: allocation(s_etat_processus, FCT)) == NULL)
! 1607: {
! 1608: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1609: return;
! 1610: }
! 1611:
! 1612: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1613: .nombre_arguments = 1;
! 1614: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1615: .fonction = instruction_arg;
! 1616:
! 1617: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1618: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
! 1619: {
! 1620: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1621: return;
! 1622: }
! 1623:
! 1624: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1625: .nom_fonction, "ARG");
! 1626:
! 1627: if (((*l_element_courant).suivant =
! 1628: allocation_maillon(s_etat_processus)) == NULL)
! 1629: {
! 1630: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1631: return;
! 1632: }
! 1633:
! 1634: l_element_courant = (*l_element_courant).suivant;
! 1635:
! 1636: if (((*l_element_courant).donnee =
! 1637: allocation(s_etat_processus, FCT)) == NULL)
! 1638: {
! 1639: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1640: return;
! 1641: }
! 1642:
! 1643: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1644: .nombre_arguments = 0;
! 1645: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1646: .fonction = instruction_vers_niveau_inferieur;
! 1647:
! 1648: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1649: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1650: {
! 1651: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1652: return;
! 1653: }
! 1654:
! 1655: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1656: .nom_fonction, ">>");
! 1657:
! 1658: (*l_element_courant).suivant = NULL;
! 1659: s_objet_argument = NULL;
! 1660: }
! 1661:
! 1662: /*
! 1663: --------------------------------------------------------------------------------
! 1664: Argument d'une expression
! 1665: --------------------------------------------------------------------------------
! 1666: */
! 1667:
! 1668: else if (((*s_objet_argument).type == ALG) ||
! 1669: ((*s_objet_argument).type == RPN))
! 1670: {
! 1671: if ((s_copie_argument = copie_objet(s_etat_processus,
! 1672: s_objet_argument, 'N')) == NULL)
! 1673: {
! 1674: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1675: return;
! 1676: }
! 1677:
! 1678: l_element_courant = (struct_liste_chainee *)
! 1679: (*s_copie_argument).objet;
! 1680: l_element_precedent = l_element_courant;
! 1681:
! 1682: while((*l_element_courant).suivant != NULL)
! 1683: {
! 1684: l_element_precedent = l_element_courant;
! 1685: l_element_courant = (*l_element_courant).suivant;
! 1686: }
! 1687:
! 1688: if (((*l_element_precedent).suivant =
! 1689: allocation_maillon(s_etat_processus)) == NULL)
! 1690: {
! 1691: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1692: return;
! 1693: }
! 1694:
! 1695: if (((*(*l_element_precedent).suivant).donnee =
! 1696: allocation(s_etat_processus, FCT)) == NULL)
! 1697: {
! 1698: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1699: return;
! 1700: }
! 1701:
! 1702: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1703: .donnee).objet)).nombre_arguments = 1;
! 1704: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1705: .donnee).objet)).fonction = instruction_arg;
! 1706:
! 1707: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 1708: .suivant).donnee).objet)).nom_fonction =
! 1709: malloc(4 * sizeof(unsigned char))) == NULL)
! 1710: {
! 1711: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1712: return;
! 1713: }
! 1714:
! 1715: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 1716: .suivant).donnee).objet)).nom_fonction, "ARG");
! 1717:
! 1718: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1719:
! 1720: s_objet_resultat = s_copie_argument;
! 1721: }
! 1722:
! 1723: /*
! 1724: --------------------------------------------------------------------------------
! 1725: Réalisation impossible de la fonction argument
! 1726: --------------------------------------------------------------------------------
! 1727: */
! 1728:
! 1729: else
! 1730: {
! 1731: liberation(s_etat_processus, s_objet_argument);
! 1732:
! 1733: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1734: return;
! 1735: }
! 1736:
! 1737: liberation(s_etat_processus, s_objet_argument);
! 1738:
! 1739: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1740: s_objet_resultat) == d_erreur)
! 1741: {
! 1742: return;
! 1743: }
! 1744:
! 1745: return;
! 1746: }
! 1747:
! 1748:
! 1749: /*
! 1750: ================================================================================
! 1751: Fonction 'asin'
! 1752: ================================================================================
! 1753: Entrées : pointeur sur une structure struct_processus
! 1754: --------------------------------------------------------------------------------
! 1755: Sorties :
! 1756: --------------------------------------------------------------------------------
! 1757: Effets de bord : néant
! 1758: ================================================================================
! 1759: */
! 1760:
! 1761: void
! 1762: instruction_asin(struct_processus *s_etat_processus)
! 1763: {
! 1764: real8 argument;
! 1765:
! 1766: struct_complexe16 registre;
! 1767:
! 1768: struct_liste_chainee *l_element_courant;
! 1769: struct_liste_chainee *l_element_precedent;
! 1770:
! 1771: struct_objet *s_copie_argument;
! 1772: struct_objet *s_objet_argument;
! 1773: struct_objet *s_objet_resultat;
! 1774:
! 1775: (*s_etat_processus).erreur_execution = d_ex;
! 1776:
! 1777: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1778: {
! 1779: printf("\n ASIN ");
! 1780:
! 1781: if ((*s_etat_processus).langue == 'F')
! 1782: {
! 1783: printf("(arcsinus)\n\n");
! 1784: }
! 1785: else
! 1786: {
! 1787: printf("(arcsine)\n\n");
! 1788: }
! 1789:
! 1790: printf(" 1: %s, %s\n", d_INT, d_REL);
! 1791: printf("-> 1: %s, %s\n\n", d_REL, d_CPL);
! 1792:
! 1793: printf(" 1: %s\n", d_CPL);
! 1794: printf("-> 1: %s\n\n", d_CPL);
! 1795:
! 1796: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 1797: printf("-> 1: %s\n\n", d_ALG);
! 1798:
! 1799: printf(" 1: %s\n", d_RPN);
! 1800: printf("-> 1: %s\n", d_RPN);
! 1801:
! 1802: return;
! 1803: }
! 1804: else if ((*s_etat_processus).test_instruction == 'Y')
! 1805: {
! 1806: (*s_etat_processus).nombre_arguments = 1;
! 1807: return;
! 1808: }
! 1809:
! 1810: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1811: {
! 1812: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1813: {
! 1814: return;
! 1815: }
! 1816: }
! 1817:
! 1818: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1819: &s_objet_argument) == d_erreur)
! 1820: {
! 1821: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1822: return;
! 1823: }
! 1824:
! 1825: /*
! 1826: --------------------------------------------------------------------------------
! 1827: Arcsinus d'un entier ou d'un réel
! 1828: --------------------------------------------------------------------------------
! 1829: */
! 1830:
! 1831: if (((*s_objet_argument).type == INT) ||
! 1832: ((*s_objet_argument).type == REL))
! 1833: {
! 1834: if ((*s_objet_argument).type == INT)
! 1835: {
! 1836: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
! 1837: }
! 1838: else
! 1839: {
! 1840: argument = (*((real8 *) (*s_objet_argument).objet));
! 1841: }
! 1842:
! 1843: if ((argument >= -1) && (argument <= 1))
! 1844: {
! 1845: /*
! 1846: * Résultat réel
! 1847: */
! 1848:
! 1849: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 1850: == NULL)
! 1851: {
! 1852: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1853: return;
! 1854: }
! 1855:
! 1856: (*((real8 *) (*s_objet_resultat).objet)) = asin(argument);
! 1857:
! 1858: if (test_cfsf(s_etat_processus, 60) == d_faux)
! 1859: {
! 1860: conversion_radians_vers_degres((real8 *)
! 1861: (*s_objet_resultat).objet);
! 1862: }
! 1863: }
! 1864: else
! 1865: {
! 1866: /*
! 1867: * Résultat complexe
! 1868: */
! 1869:
! 1870: registre.partie_reelle = argument;
! 1871: registre.partie_imaginaire = 0;
! 1872:
! 1873: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 1874: == NULL)
! 1875: {
! 1876: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1877: return;
! 1878: }
! 1879:
! 1880: f77asin_(®istre, (struct_complexe16 *)
! 1881: (*s_objet_resultat).objet);
! 1882: }
! 1883: }
! 1884:
! 1885: /*
! 1886: --------------------------------------------------------------------------------
! 1887: Arcsinus d'un complexe
! 1888: --------------------------------------------------------------------------------
! 1889: */
! 1890:
! 1891: else if ((*s_objet_argument).type == CPL)
! 1892: {
! 1893: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 1894: == NULL)
! 1895: {
! 1896: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1897: return;
! 1898: }
! 1899:
! 1900: f77asin_((struct_complexe16 *) (*s_objet_argument).objet,
! 1901: (struct_complexe16 *) (*s_objet_resultat).objet);
! 1902: }
! 1903:
! 1904: /*
! 1905: --------------------------------------------------------------------------------
! 1906: Arcsinus d'un nom
! 1907: --------------------------------------------------------------------------------
! 1908: */
! 1909:
! 1910: else if ((*s_objet_argument).type == NOM)
! 1911: {
! 1912: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 1913: == NULL)
! 1914: {
! 1915: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1916: return;
! 1917: }
! 1918:
! 1919: if (((*s_objet_resultat).objet =
! 1920: allocation_maillon(s_etat_processus)) == NULL)
! 1921: {
! 1922: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1923: return;
! 1924: }
! 1925:
! 1926: l_element_courant = (*s_objet_resultat).objet;
! 1927:
! 1928: if (((*l_element_courant).donnee =
! 1929: allocation(s_etat_processus, FCT)) == NULL)
! 1930: {
! 1931: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1932: return;
! 1933: }
! 1934:
! 1935: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1936: .nombre_arguments = 0;
! 1937: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1938: .fonction = instruction_vers_niveau_superieur;
! 1939:
! 1940: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1941: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1942: {
! 1943: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1944: return;
! 1945: }
! 1946:
! 1947: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1948: .nom_fonction, "<<");
! 1949:
! 1950: if (((*l_element_courant).suivant =
! 1951: allocation_maillon(s_etat_processus)) == NULL)
! 1952: {
! 1953: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1954: return;
! 1955: }
! 1956:
! 1957: l_element_courant = (*l_element_courant).suivant;
! 1958: (*l_element_courant).donnee = s_objet_argument;
! 1959:
! 1960: if (((*l_element_courant).suivant =
! 1961: allocation_maillon(s_etat_processus)) == NULL)
! 1962: {
! 1963: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1964: return;
! 1965: }
! 1966:
! 1967: l_element_courant = (*l_element_courant).suivant;
! 1968:
! 1969: if (((*l_element_courant).donnee =
! 1970: allocation(s_etat_processus, FCT)) == NULL)
! 1971: {
! 1972: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1973: return;
! 1974: }
! 1975:
! 1976: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1977: .nombre_arguments = 1;
! 1978: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1979: .fonction = instruction_asin;
! 1980:
! 1981: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1982: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
! 1983: {
! 1984: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1985: return;
! 1986: }
! 1987:
! 1988: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1989: .nom_fonction, "ASIN");
! 1990:
! 1991: if (((*l_element_courant).suivant =
! 1992: allocation_maillon(s_etat_processus)) == NULL)
! 1993: {
! 1994: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1995: return;
! 1996: }
! 1997:
! 1998: l_element_courant = (*l_element_courant).suivant;
! 1999:
! 2000: if (((*l_element_courant).donnee =
! 2001: allocation(s_etat_processus, FCT)) == NULL)
! 2002: {
! 2003: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2004: return;
! 2005: }
! 2006:
! 2007: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2008: .nombre_arguments = 0;
! 2009: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2010: .fonction = instruction_vers_niveau_inferieur;
! 2011:
! 2012: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2013: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2014: {
! 2015: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2016: return;
! 2017: }
! 2018:
! 2019: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2020: .nom_fonction, ">>");
! 2021:
! 2022: (*l_element_courant).suivant = NULL;
! 2023: s_objet_argument = NULL;
! 2024: }
! 2025:
! 2026: /*
! 2027: --------------------------------------------------------------------------------
! 2028: Arcsinus d'une expression
! 2029: --------------------------------------------------------------------------------
! 2030: */
! 2031:
! 2032: else if (((*s_objet_argument).type == ALG) ||
! 2033: ((*s_objet_argument).type == RPN))
! 2034: {
! 2035: if ((s_copie_argument = copie_objet(s_etat_processus,
! 2036: s_objet_argument, 'N')) == NULL)
! 2037: {
! 2038: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2039: return;
! 2040: }
! 2041:
! 2042: l_element_courant = (struct_liste_chainee *)
! 2043: (*s_copie_argument).objet;
! 2044: l_element_precedent = l_element_courant;
! 2045:
! 2046: while((*l_element_courant).suivant != NULL)
! 2047: {
! 2048: l_element_precedent = l_element_courant;
! 2049: l_element_courant = (*l_element_courant).suivant;
! 2050: }
! 2051:
! 2052: if (((*l_element_precedent).suivant =
! 2053: allocation_maillon(s_etat_processus)) == NULL)
! 2054: {
! 2055: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2056: return;
! 2057: }
! 2058:
! 2059: if (((*(*l_element_precedent).suivant).donnee =
! 2060: allocation(s_etat_processus, FCT)) == NULL)
! 2061: {
! 2062: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2063: return;
! 2064: }
! 2065:
! 2066: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2067: .donnee).objet)).nombre_arguments = 1;
! 2068: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2069: .donnee).objet)).fonction = instruction_asin;
! 2070:
! 2071: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 2072: .suivant).donnee).objet)).nom_fonction =
! 2073: malloc(5 * sizeof(unsigned char))) == NULL)
! 2074: {
! 2075: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2076: return;
! 2077: }
! 2078:
! 2079: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 2080: .suivant).donnee).objet)).nom_fonction, "ASIN");
! 2081:
! 2082: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 2083:
! 2084: s_objet_resultat = s_copie_argument;
! 2085: }
! 2086:
! 2087: /*
! 2088: --------------------------------------------------------------------------------
! 2089: Réalisation impossible de la fonction arcsinus
! 2090: --------------------------------------------------------------------------------
! 2091: */
! 2092:
! 2093: else
! 2094: {
! 2095: liberation(s_etat_processus, s_objet_argument);
! 2096:
! 2097: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 2098: return;
! 2099: }
! 2100:
! 2101: liberation(s_etat_processus, s_objet_argument);
! 2102:
! 2103: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2104: s_objet_resultat) == d_erreur)
! 2105: {
! 2106: return;
! 2107: }
! 2108:
! 2109: return;
! 2110: }
! 2111:
! 2112:
! 2113: /*
! 2114: ================================================================================
! 2115: Fonction 'acos'
! 2116: ================================================================================
! 2117: Entrées : pointeur sur une structure struct_processus
! 2118: --------------------------------------------------------------------------------
! 2119: Sorties :
! 2120: --------------------------------------------------------------------------------
! 2121: Effets de bord : néant
! 2122: ================================================================================
! 2123: */
! 2124:
! 2125: void
! 2126: instruction_acos(struct_processus *s_etat_processus)
! 2127: {
! 2128: real8 argument;
! 2129:
! 2130: struct_complexe16 registre;
! 2131:
! 2132: struct_liste_chainee *l_element_courant;
! 2133: struct_liste_chainee *l_element_precedent;
! 2134:
! 2135: struct_objet *s_copie_argument;
! 2136: struct_objet *s_objet_argument;
! 2137: struct_objet *s_objet_resultat;
! 2138:
! 2139: (*s_etat_processus).erreur_execution = d_ex;
! 2140:
! 2141: if ((*s_etat_processus).affichage_arguments == 'Y')
! 2142: {
! 2143: printf("\n ACOS ");
! 2144:
! 2145: if ((*s_etat_processus).langue == 'F')
! 2146: {
! 2147: printf("(arccosinus)\n\n");
! 2148: }
! 2149: else
! 2150: {
! 2151: printf("(arccosine)\n\n");
! 2152: }
! 2153:
! 2154: printf(" 1: %s, %s\n", d_INT, d_REL);
! 2155: printf("-> 1: %s, %s\n\n", d_REL, d_CPL);
! 2156:
! 2157: printf(" 1: %s\n", d_CPL);
! 2158: printf("-> 1: %s\n\n", d_CPL);
! 2159:
! 2160: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 2161: printf("-> 1: %s\n\n", d_ALG);
! 2162:
! 2163: printf(" 1: %s\n", d_RPN);
! 2164: printf("-> 1: %s\n", d_RPN);
! 2165:
! 2166: return;
! 2167: }
! 2168: else if ((*s_etat_processus).test_instruction == 'Y')
! 2169: {
! 2170: (*s_etat_processus).nombre_arguments = 1;
! 2171: return;
! 2172: }
! 2173:
! 2174: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 2175: {
! 2176: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 2177: {
! 2178: return;
! 2179: }
! 2180: }
! 2181:
! 2182: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2183: &s_objet_argument) == d_erreur)
! 2184: {
! 2185: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 2186: return;
! 2187: }
! 2188:
! 2189: /*
! 2190: --------------------------------------------------------------------------------
! 2191: Arccossinus d'un entier ou d'un réel
! 2192: --------------------------------------------------------------------------------
! 2193: */
! 2194:
! 2195: if (((*s_objet_argument).type == INT) ||
! 2196: ((*s_objet_argument).type == REL))
! 2197: {
! 2198: if ((*s_objet_argument).type == INT)
! 2199: {
! 2200: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
! 2201: }
! 2202: else
! 2203: {
! 2204: argument = (*((real8 *) (*s_objet_argument).objet));
! 2205: }
! 2206:
! 2207: if ((argument >= -1) && (argument <= 1))
! 2208: {
! 2209: /*
! 2210: * Résultat réel
! 2211: */
! 2212:
! 2213: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 2214: == NULL)
! 2215: {
! 2216: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2217: return;
! 2218: }
! 2219:
! 2220: (*((real8 *) (*s_objet_resultat).objet)) = acos(argument);
! 2221:
! 2222: if (test_cfsf(s_etat_processus, 60) == d_faux)
! 2223: {
! 2224: conversion_radians_vers_degres((real8 *)
! 2225: (*s_objet_resultat).objet);
! 2226: }
! 2227: }
! 2228: else
! 2229: {
! 2230: /*
! 2231: * Résultat complexe
! 2232: */
! 2233:
! 2234: registre.partie_reelle = argument;
! 2235: registre.partie_imaginaire = 0;
! 2236:
! 2237: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 2238: == NULL)
! 2239: {
! 2240: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2241: return;
! 2242: }
! 2243:
! 2244: f77acos_(®istre, (struct_complexe16 *)
! 2245: (*s_objet_resultat).objet);
! 2246: }
! 2247: }
! 2248:
! 2249: /*
! 2250: --------------------------------------------------------------------------------
! 2251: Arccossinus d'un complexe
! 2252: --------------------------------------------------------------------------------
! 2253: */
! 2254:
! 2255: else if ((*s_objet_argument).type == CPL)
! 2256: {
! 2257: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 2258: == NULL)
! 2259: {
! 2260: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2261: return;
! 2262: }
! 2263:
! 2264: f77acos_((struct_complexe16 *) (*s_objet_argument).objet,
! 2265: (struct_complexe16 *) (*s_objet_resultat).objet);
! 2266: }
! 2267:
! 2268: /*
! 2269: --------------------------------------------------------------------------------
! 2270: Arccossinus d'un nom
! 2271: --------------------------------------------------------------------------------
! 2272: */
! 2273:
! 2274: else if ((*s_objet_argument).type == NOM)
! 2275: {
! 2276: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 2277: == NULL)
! 2278: {
! 2279: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2280: return;
! 2281: }
! 2282:
! 2283: if (((*s_objet_resultat).objet =
! 2284: allocation_maillon(s_etat_processus)) == NULL)
! 2285: {
! 2286: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2287: return;
! 2288: }
! 2289:
! 2290: l_element_courant = (*s_objet_resultat).objet;
! 2291:
! 2292: if (((*l_element_courant).donnee =
! 2293: allocation(s_etat_processus, FCT)) == NULL)
! 2294: {
! 2295: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2296: return;
! 2297: }
! 2298:
! 2299: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2300: .nombre_arguments = 0;
! 2301: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2302: .fonction = instruction_vers_niveau_superieur;
! 2303:
! 2304: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2305: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2306: {
! 2307: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2308: return;
! 2309: }
! 2310:
! 2311: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2312: .nom_fonction, "<<");
! 2313:
! 2314: if (((*l_element_courant).suivant =
! 2315: allocation_maillon(s_etat_processus)) == NULL)
! 2316: {
! 2317: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2318: return;
! 2319: }
! 2320:
! 2321: l_element_courant = (*l_element_courant).suivant;
! 2322: (*l_element_courant).donnee = s_objet_argument;
! 2323:
! 2324: if (((*l_element_courant).suivant =
! 2325: allocation_maillon(s_etat_processus)) == NULL)
! 2326: {
! 2327: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2328: return;
! 2329: }
! 2330:
! 2331: l_element_courant = (*l_element_courant).suivant;
! 2332:
! 2333: if (((*l_element_courant).donnee =
! 2334: allocation(s_etat_processus, FCT)) == NULL)
! 2335: {
! 2336: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2337: return;
! 2338: }
! 2339:
! 2340: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2341: .nombre_arguments = 1;
! 2342: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2343: .fonction = instruction_acos;
! 2344:
! 2345: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2346: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
! 2347: {
! 2348: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2349: return;
! 2350: }
! 2351:
! 2352: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2353: .nom_fonction, "ACOS");
! 2354:
! 2355: if (((*l_element_courant).suivant =
! 2356: allocation_maillon(s_etat_processus)) == NULL)
! 2357: {
! 2358: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2359: return;
! 2360: }
! 2361:
! 2362: l_element_courant = (*l_element_courant).suivant;
! 2363:
! 2364: if (((*l_element_courant).donnee =
! 2365: allocation(s_etat_processus, FCT)) == NULL)
! 2366: {
! 2367: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2368: return;
! 2369: }
! 2370:
! 2371: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2372: .nombre_arguments = 0;
! 2373: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2374: .fonction = instruction_vers_niveau_inferieur;
! 2375:
! 2376: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2377: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2378: {
! 2379: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2380: return;
! 2381: }
! 2382:
! 2383: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2384: .nom_fonction, ">>");
! 2385:
! 2386: (*l_element_courant).suivant = NULL;
! 2387: s_objet_argument = NULL;
! 2388: }
! 2389:
! 2390: /*
! 2391: --------------------------------------------------------------------------------
! 2392: Arccossinus d'une expression
! 2393: --------------------------------------------------------------------------------
! 2394: */
! 2395:
! 2396: else if (((*s_objet_argument).type == ALG) ||
! 2397: ((*s_objet_argument).type == RPN))
! 2398: {
! 2399: if ((s_copie_argument = copie_objet(s_etat_processus,
! 2400: s_objet_argument, 'N')) == NULL)
! 2401: {
! 2402: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2403: return;
! 2404: }
! 2405:
! 2406: l_element_courant = (struct_liste_chainee *)
! 2407: (*s_copie_argument).objet;
! 2408: l_element_precedent = l_element_courant;
! 2409:
! 2410: while((*l_element_courant).suivant != NULL)
! 2411: {
! 2412: l_element_precedent = l_element_courant;
! 2413: l_element_courant = (*l_element_courant).suivant;
! 2414: }
! 2415:
! 2416: if (((*l_element_precedent).suivant =
! 2417: allocation_maillon(s_etat_processus)) == NULL)
! 2418: {
! 2419: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2420: return;
! 2421: }
! 2422:
! 2423: if (((*(*l_element_precedent).suivant).donnee =
! 2424: allocation(s_etat_processus, FCT)) == NULL)
! 2425: {
! 2426: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2427: return;
! 2428: }
! 2429:
! 2430: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2431: .donnee).objet)).nombre_arguments = 1;
! 2432: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2433: .donnee).objet)).fonction = instruction_acos;
! 2434:
! 2435: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 2436: .suivant).donnee).objet)).nom_fonction =
! 2437: malloc(5 * sizeof(unsigned char))) == NULL)
! 2438: {
! 2439: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2440: return;
! 2441: }
! 2442:
! 2443: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 2444: .suivant).donnee).objet)).nom_fonction, "ACOS");
! 2445:
! 2446: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 2447:
! 2448: s_objet_resultat = s_copie_argument;
! 2449: }
! 2450:
! 2451: /*
! 2452: --------------------------------------------------------------------------------
! 2453: Réalisation impossible de la fonction arccosinus
! 2454: --------------------------------------------------------------------------------
! 2455: */
! 2456:
! 2457: else
! 2458: {
! 2459: liberation(s_etat_processus, s_objet_argument);
! 2460:
! 2461: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 2462: return;
! 2463: }
! 2464:
! 2465: liberation(s_etat_processus, s_objet_argument);
! 2466:
! 2467: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2468: s_objet_resultat) == d_erreur)
! 2469: {
! 2470: return;
! 2471: }
! 2472:
! 2473: return;
! 2474: }
! 2475:
! 2476:
! 2477: /*
! 2478: ================================================================================
! 2479: Fonction 'atan'
! 2480: ================================================================================
! 2481: Entrées : pointeur sur une structure struct_processus
! 2482: --------------------------------------------------------------------------------
! 2483: Sorties :
! 2484: --------------------------------------------------------------------------------
! 2485: Effets de bord : néant
! 2486: ================================================================================
! 2487: */
! 2488:
! 2489: void
! 2490: instruction_atan(struct_processus *s_etat_processus)
! 2491: {
! 2492: real8 argument;
! 2493:
! 2494: integer4 erreur;
! 2495:
! 2496: struct_liste_chainee *l_element_courant;
! 2497: struct_liste_chainee *l_element_precedent;
! 2498:
! 2499: struct_objet *s_copie_argument;
! 2500: struct_objet *s_objet_argument;
! 2501: struct_objet *s_objet_resultat;
! 2502:
! 2503: (*s_etat_processus).erreur_execution = d_ex;
! 2504:
! 2505: if ((*s_etat_processus).affichage_arguments == 'Y')
! 2506: {
! 2507: printf("\n ATAN ");
! 2508:
! 2509: if ((*s_etat_processus).langue == 'F')
! 2510: {
! 2511: printf("(arctangente)\n\n");
! 2512: }
! 2513: else
! 2514: {
! 2515: printf("(arctangent)\n\n");
! 2516: }
! 2517:
! 2518: printf(" 1: %s, %s\n", d_INT, d_REL);
! 2519: printf("-> 1: %s, %s\n\n", d_REL, d_CPL);
! 2520:
! 2521: printf(" 1: %s\n", d_CPL);
! 2522: printf("-> 1: %s\n\n", d_CPL);
! 2523:
! 2524: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 2525: printf("-> 1: %s\n\n", d_ALG);
! 2526:
! 2527: printf(" 1: %s\n", d_RPN);
! 2528: printf("-> 1: %s\n", d_RPN);
! 2529:
! 2530: return;
! 2531: }
! 2532: else if ((*s_etat_processus).test_instruction == 'Y')
! 2533: {
! 2534: (*s_etat_processus).nombre_arguments = 1;
! 2535: return;
! 2536: }
! 2537:
! 2538: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 2539: {
! 2540: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 2541: {
! 2542: return;
! 2543: }
! 2544: }
! 2545:
! 2546: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2547: &s_objet_argument) == d_erreur)
! 2548: {
! 2549: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 2550: return;
! 2551: }
! 2552:
! 2553: /*
! 2554: --------------------------------------------------------------------------------
! 2555: Arctangente d'un entier ou d'un réel
! 2556: --------------------------------------------------------------------------------
! 2557: */
! 2558:
! 2559: if (((*s_objet_argument).type == INT) ||
! 2560: ((*s_objet_argument).type == REL))
! 2561: {
! 2562: if ((*s_objet_argument).type == INT)
! 2563: {
! 2564: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
! 2565: }
! 2566: else
! 2567: {
! 2568: argument = (*((real8 *) (*s_objet_argument).objet));
! 2569: }
! 2570:
! 2571: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 2572: == NULL)
! 2573: {
! 2574: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2575: return;
! 2576: }
! 2577:
! 2578: (*((real8 *) (*s_objet_resultat).objet)) = atan(argument);
! 2579:
! 2580: if (test_cfsf(s_etat_processus, 60) == d_faux)
! 2581: {
! 2582: conversion_radians_vers_degres((real8 *)
! 2583: (*s_objet_resultat).objet);
! 2584: }
! 2585: }
! 2586:
! 2587: /*
! 2588: --------------------------------------------------------------------------------
! 2589: Arctangente d'un complexe
! 2590: --------------------------------------------------------------------------------
! 2591: */
! 2592:
! 2593: else if ((*s_objet_argument).type == CPL)
! 2594: {
! 2595: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 2596: == NULL)
! 2597: {
! 2598: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2599: return;
! 2600: }
! 2601:
! 2602: f77atan_((struct_complexe16 *) (*s_objet_argument).objet,
! 2603: (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
! 2604:
! 2605: if (erreur != 0)
! 2606: {
! 2607: liberation(s_etat_processus, s_objet_argument);
! 2608: liberation(s_etat_processus, s_objet_resultat);
! 2609:
! 2610: free(s_objet_resultat);
! 2611:
! 2612: (*s_etat_processus).exception = d_ep_division_par_zero;
! 2613: return;
! 2614: }
! 2615: }
! 2616:
! 2617: /*
! 2618: --------------------------------------------------------------------------------
! 2619: Arctangente d'un nom
! 2620: --------------------------------------------------------------------------------
! 2621: */
! 2622:
! 2623: else if ((*s_objet_argument).type == NOM)
! 2624: {
! 2625: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 2626: == NULL)
! 2627: {
! 2628: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2629: return;
! 2630: }
! 2631:
! 2632: if (((*s_objet_resultat).objet =
! 2633: allocation_maillon(s_etat_processus)) == NULL)
! 2634: {
! 2635: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2636: return;
! 2637: }
! 2638:
! 2639: l_element_courant = (*s_objet_resultat).objet;
! 2640:
! 2641: if (((*l_element_courant).donnee =
! 2642: allocation(s_etat_processus, FCT)) == NULL)
! 2643: {
! 2644: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2645: return;
! 2646: }
! 2647:
! 2648: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2649: .nombre_arguments = 0;
! 2650: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2651: .fonction = instruction_vers_niveau_superieur;
! 2652:
! 2653: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2654: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2655: {
! 2656: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2657: return;
! 2658: }
! 2659:
! 2660: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2661: .nom_fonction, "<<");
! 2662:
! 2663: if (((*l_element_courant).suivant =
! 2664: allocation_maillon(s_etat_processus)) == NULL)
! 2665: {
! 2666: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2667: return;
! 2668: }
! 2669:
! 2670: l_element_courant = (*l_element_courant).suivant;
! 2671: (*l_element_courant).donnee = s_objet_argument;
! 2672:
! 2673: if (((*l_element_courant).suivant =
! 2674: allocation_maillon(s_etat_processus)) == NULL)
! 2675: {
! 2676: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2677: return;
! 2678: }
! 2679:
! 2680: l_element_courant = (*l_element_courant).suivant;
! 2681:
! 2682: if (((*l_element_courant).donnee =
! 2683: allocation(s_etat_processus, FCT)) == NULL)
! 2684: {
! 2685: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2686: return;
! 2687: }
! 2688:
! 2689: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2690: .nombre_arguments = 1;
! 2691: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2692: .fonction = instruction_atan;
! 2693:
! 2694: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2695: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
! 2696: {
! 2697: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2698: return;
! 2699: }
! 2700:
! 2701: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2702: .nom_fonction, "ATAN");
! 2703:
! 2704: if (((*l_element_courant).suivant =
! 2705: allocation_maillon(s_etat_processus)) == NULL)
! 2706: {
! 2707: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2708: return;
! 2709: }
! 2710:
! 2711: l_element_courant = (*l_element_courant).suivant;
! 2712:
! 2713: if (((*l_element_courant).donnee =
! 2714: allocation(s_etat_processus, FCT)) == NULL)
! 2715: {
! 2716: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2717: return;
! 2718: }
! 2719:
! 2720: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2721: .nombre_arguments = 0;
! 2722: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2723: .fonction = instruction_vers_niveau_inferieur;
! 2724:
! 2725: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2726: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2727: {
! 2728: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2729: return;
! 2730: }
! 2731:
! 2732: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2733: .nom_fonction, ">>");
! 2734:
! 2735: (*l_element_courant).suivant = NULL;
! 2736: s_objet_argument = NULL;
! 2737: }
! 2738:
! 2739: /*
! 2740: --------------------------------------------------------------------------------
! 2741: Arctangente d'une expression
! 2742: --------------------------------------------------------------------------------
! 2743: */
! 2744:
! 2745: else if (((*s_objet_argument).type == ALG) ||
! 2746: ((*s_objet_argument).type == RPN))
! 2747: {
! 2748: if ((s_copie_argument = copie_objet(s_etat_processus,
! 2749: s_objet_argument, 'N')) == NULL)
! 2750: {
! 2751: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2752: return;
! 2753: }
! 2754:
! 2755: l_element_courant = (struct_liste_chainee *)
! 2756: (*s_copie_argument).objet;
! 2757: l_element_precedent = l_element_courant;
! 2758:
! 2759: while((*l_element_courant).suivant != NULL)
! 2760: {
! 2761: l_element_precedent = l_element_courant;
! 2762: l_element_courant = (*l_element_courant).suivant;
! 2763: }
! 2764:
! 2765: if (((*l_element_precedent).suivant =
! 2766: allocation_maillon(s_etat_processus)) == NULL)
! 2767: {
! 2768: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2769: return;
! 2770: }
! 2771:
! 2772: if (((*(*l_element_precedent).suivant).donnee =
! 2773: allocation(s_etat_processus, FCT)) == NULL)
! 2774: {
! 2775: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2776: return;
! 2777: }
! 2778:
! 2779: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2780: .donnee).objet)).nombre_arguments = 1;
! 2781: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2782: .donnee).objet)).fonction = instruction_atan;
! 2783:
! 2784: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 2785: .suivant).donnee).objet)).nom_fonction =
! 2786: malloc(5 * sizeof(unsigned char))) == NULL)
! 2787: {
! 2788: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2789: return;
! 2790: }
! 2791:
! 2792: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 2793: .suivant).donnee).objet)).nom_fonction, "ATAN");
! 2794:
! 2795: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 2796:
! 2797: s_objet_resultat = s_copie_argument;
! 2798: }
! 2799:
! 2800: /*
! 2801: --------------------------------------------------------------------------------
! 2802: Réalisation impossible de la fonction arctangente
! 2803: --------------------------------------------------------------------------------
! 2804: */
! 2805:
! 2806: else
! 2807: {
! 2808: liberation(s_etat_processus, s_objet_argument);
! 2809:
! 2810: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 2811: return;
! 2812: }
! 2813:
! 2814: liberation(s_etat_processus, s_objet_argument);
! 2815:
! 2816: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2817: s_objet_resultat) == d_erreur)
! 2818: {
! 2819: return;
! 2820: }
! 2821:
! 2822: return;
! 2823: }
! 2824:
! 2825: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>