Annotation of rpl/src/instructions_a3.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 'array->'
! 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_array_fleche(struct_processus *s_etat_processus)
! 40: {
! 41: struct_liste_chainee *l_element_courant;
! 42:
! 43: struct_objet *s_objet_source;
! 44: struct_objet *s_objet_elementaire;
! 45:
! 46: unsigned long i;
! 47: unsigned long j;
! 48:
! 49: (*s_etat_processus).erreur_execution = d_ex;
! 50:
! 51: if ((*s_etat_processus).affichage_arguments == 'Y')
! 52: {
! 53: printf("\n ARRAY-> [ARRY->] ");
! 54:
! 55: if ((*s_etat_processus).langue == 'F')
! 56: {
! 57: printf("(éclatement de vecteur ou de matrice)\n\n");
! 58: }
! 59: else
! 60: {
! 61: printf("(vector or matrix split)\n\n");
! 62: }
! 63:
! 64: printf(" 1: %s\n", d_VIN);
! 65: printf("-> n: %s\n", d_INT);
! 66: printf(" ...\n");
! 67: printf(" 1: %s\n\n", d_INT);
! 68:
! 69: printf(" 1: %s\n", d_VRL);
! 70: printf("-> n: %s\n", d_REL);
! 71: printf(" ...\n");
! 72: printf(" 1: %s\n\n", d_REL);
! 73:
! 74: printf(" 1: %s\n", d_VCX);
! 75: printf("-> n: %s\n", d_CPL);
! 76: printf(" ...\n");
! 77: printf(" 1: %s\n\n", d_CPL);
! 78:
! 79: printf(" 1: %s\n", d_MIN);
! 80: printf("-> nm: %s\n", d_INT);
! 81: printf(" ...\n");
! 82: printf(" 1: %s\n\n", d_INT);
! 83:
! 84: printf(" 1: %s\n", d_MRL);
! 85: printf("-> nm: %s\n", d_REL);
! 86: printf(" ...\n");
! 87: printf(" 1: %s\n\n", d_REL);
! 88:
! 89: printf(" 1: %s\n", d_MCX);
! 90: printf("-> nm: %s\n", d_CPL);
! 91: printf(" ...\n");
! 92: printf(" 1: %s\n", d_CPL);
! 93:
! 94: return;
! 95: }
! 96: else if ((*s_etat_processus).test_instruction == 'Y')
! 97: {
! 98: (*s_etat_processus).nombre_arguments = -1;
! 99: return;
! 100: }
! 101:
! 102: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 103: {
! 104: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 105: {
! 106: return;
! 107: }
! 108: }
! 109:
! 110: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 111: &s_objet_source) == d_erreur)
! 112: {
! 113: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 114: return;
! 115: }
! 116:
! 117: /*
! 118: --------------------------------------------------------------------------------
! 119: Cas des vecteurs
! 120: --------------------------------------------------------------------------------
! 121: */
! 122:
! 123: if ((*s_objet_source).type == VIN)
! 124: {
! 125: /*
! 126: * Traitement d'un vecteur d'entiers
! 127: */
! 128:
! 129: for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
! 130: i++)
! 131: {
! 132: if ((s_objet_elementaire = allocation(s_etat_processus, INT))
! 133: == NULL)
! 134: {
! 135: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 136: return;
! 137: }
! 138:
! 139: (*((integer8 *) (*s_objet_elementaire).objet)) =
! 140: ((integer8 *) (*((struct_vecteur *)
! 141: (*s_objet_source).objet)).tableau)[i];
! 142:
! 143: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 144: s_objet_elementaire) == d_erreur)
! 145: {
! 146: return;
! 147: }
! 148: }
! 149:
! 150: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
! 151: == NULL)
! 152: {
! 153: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 154: return;
! 155: }
! 156:
! 157: if (((*s_objet_elementaire).objet =
! 158: allocation_maillon(s_etat_processus)) == NULL)
! 159: {
! 160: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 161: return;
! 162: }
! 163:
! 164: l_element_courant = (struct_liste_chainee *)
! 165: (*s_objet_elementaire).objet;
! 166:
! 167: (*l_element_courant).suivant = NULL;
! 168:
! 169: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
! 170: == NULL)
! 171: {
! 172: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 173: return;
! 174: }
! 175:
! 176: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
! 177: (*((struct_vecteur *) (*s_objet_source).objet)).taille;
! 178:
! 179: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 180: s_objet_elementaire) == d_erreur)
! 181: {
! 182: return;
! 183: }
! 184: }
! 185: else if ((*s_objet_source).type == VRL)
! 186: {
! 187: /*
! 188: * Traitement d'un vecteur de réels
! 189: */
! 190:
! 191: for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
! 192: i++)
! 193: {
! 194: if ((s_objet_elementaire = allocation(s_etat_processus, REL))
! 195: == NULL)
! 196: {
! 197: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 198: return;
! 199: }
! 200:
! 201: (*((real8 *) (*s_objet_elementaire).objet)) =
! 202: ((real8 *) (*((struct_vecteur *)
! 203: (*s_objet_source).objet)).tableau)[i];
! 204:
! 205: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 206: s_objet_elementaire) == d_erreur)
! 207: {
! 208: return;
! 209: }
! 210: }
! 211:
! 212: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
! 213: == NULL)
! 214: {
! 215: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 216: return;
! 217: }
! 218:
! 219: if (((*s_objet_elementaire).objet =
! 220: allocation_maillon(s_etat_processus)) == NULL)
! 221: {
! 222: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 223: return;
! 224: }
! 225:
! 226: l_element_courant = (struct_liste_chainee *)
! 227: (*s_objet_elementaire).objet;
! 228:
! 229: (*l_element_courant).suivant = NULL;
! 230:
! 231: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
! 232: == NULL)
! 233: {
! 234: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 235: return;
! 236: }
! 237:
! 238: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
! 239: (*((struct_vecteur *) (*s_objet_source).objet)).taille;
! 240:
! 241: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 242: s_objet_elementaire) == d_erreur)
! 243: {
! 244: return;
! 245: }
! 246: }
! 247: else if ((*s_objet_source).type == VCX)
! 248: {
! 249: /*
! 250: * Traitement d'un vecteur de complexes
! 251: */
! 252:
! 253: for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
! 254: i++)
! 255: {
! 256: if ((s_objet_elementaire = allocation(s_etat_processus, CPL))
! 257: == NULL)
! 258: {
! 259: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 260: return;
! 261: }
! 262:
! 263: (*((struct_complexe16 *) (*s_objet_elementaire).objet))
! 264: .partie_reelle = ((struct_complexe16 *)
! 265: (*((struct_vecteur *) (*s_objet_source).objet)).tableau)[i]
! 266: .partie_reelle;
! 267: (*((struct_complexe16 *) (*s_objet_elementaire).objet))
! 268: .partie_imaginaire = ((struct_complexe16 *)
! 269: (*((struct_vecteur *) (*s_objet_source).objet)).tableau)[i]
! 270: .partie_imaginaire;
! 271:
! 272: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 273: s_objet_elementaire) == d_erreur)
! 274: {
! 275: return;
! 276: }
! 277: }
! 278:
! 279: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
! 280: == NULL)
! 281: {
! 282: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 283: return;
! 284: }
! 285:
! 286: if (((*s_objet_elementaire).objet =
! 287: allocation_maillon(s_etat_processus)) == NULL)
! 288: {
! 289: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 290: return;
! 291: }
! 292:
! 293: l_element_courant = (struct_liste_chainee *)
! 294: (*s_objet_elementaire).objet;
! 295:
! 296: (*l_element_courant).suivant = NULL;
! 297:
! 298: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
! 299: == NULL)
! 300: {
! 301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 302: return;
! 303: }
! 304:
! 305: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
! 306: (*((struct_vecteur *) (*s_objet_source).objet)).taille;
! 307:
! 308: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 309: s_objet_elementaire) == d_erreur)
! 310: {
! 311: return;
! 312: }
! 313: }
! 314:
! 315: /*
! 316: --------------------------------------------------------------------------------
! 317: Cas des matrices
! 318: --------------------------------------------------------------------------------
! 319: */
! 320:
! 321: else if ((*s_objet_source).type == MIN)
! 322: {
! 323: /*
! 324: * Traitement d'une matrice d'entiers
! 325: */
! 326:
! 327: for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
! 328: .nombre_lignes; i++)
! 329: {
! 330: for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
! 331: .nombre_colonnes; j++)
! 332: {
! 333: if ((s_objet_elementaire = allocation(s_etat_processus, INT))
! 334: == NULL)
! 335: {
! 336: (*s_etat_processus).erreur_systeme =
! 337: d_es_allocation_memoire;
! 338: return;
! 339: }
! 340:
! 341: (*((integer8 *) (*s_objet_elementaire).objet)) =
! 342: ((integer8 **) (*((struct_matrice *)
! 343: (*s_objet_source).objet)).tableau)[i][j];
! 344:
! 345: if (empilement(s_etat_processus, &((*s_etat_processus)
! 346: .l_base_pile), s_objet_elementaire) == d_erreur)
! 347: {
! 348: return;
! 349: }
! 350: }
! 351: }
! 352:
! 353: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
! 354: == NULL)
! 355: {
! 356: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 357: return;
! 358: }
! 359:
! 360: if (((*s_objet_elementaire).objet =
! 361: allocation_maillon(s_etat_processus)) == NULL)
! 362: {
! 363: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 364: return;
! 365: }
! 366:
! 367: l_element_courant = (struct_liste_chainee *)
! 368: (*s_objet_elementaire).objet;
! 369:
! 370: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
! 371: == NULL)
! 372: {
! 373: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 374: return;
! 375: }
! 376:
! 377: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
! 378: (*((struct_matrice *) (*s_objet_source).objet))
! 379: .nombre_lignes;
! 380:
! 381: if (((*l_element_courant).suivant =
! 382: allocation_maillon(s_etat_processus)) == NULL)
! 383: {
! 384: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 385: return;
! 386: }
! 387:
! 388: l_element_courant = (*l_element_courant).suivant;
! 389: (*l_element_courant).suivant = NULL;
! 390:
! 391: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
! 392: == NULL)
! 393: {
! 394: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 395: return;
! 396: }
! 397:
! 398: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
! 399: (*((struct_matrice *) (*s_objet_source).objet))
! 400: .nombre_colonnes;
! 401:
! 402: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 403: s_objet_elementaire) == d_erreur)
! 404: {
! 405: return;
! 406: }
! 407: }
! 408: else if ((*s_objet_source).type == MRL)
! 409: {
! 410: /*
! 411: * Traitement d'une matrice de réels
! 412: */
! 413:
! 414: for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
! 415: .nombre_lignes; i++)
! 416: {
! 417: for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
! 418: .nombre_colonnes; j++)
! 419: {
! 420: if ((s_objet_elementaire = allocation(s_etat_processus, REL))
! 421: == NULL)
! 422: {
! 423: (*s_etat_processus).erreur_systeme =
! 424: d_es_allocation_memoire;
! 425: return;
! 426: }
! 427:
! 428: (*((real8 *) (*s_objet_elementaire).objet)) =
! 429: ((real8 **) (*((struct_matrice *)
! 430: (*s_objet_source).objet)).tableau)[i][j];
! 431:
! 432: if (empilement(s_etat_processus, &((*s_etat_processus)
! 433: .l_base_pile), s_objet_elementaire) == d_erreur)
! 434: {
! 435: return;
! 436: }
! 437: }
! 438: }
! 439:
! 440: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
! 441: == NULL)
! 442: {
! 443: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 444: return;
! 445: }
! 446:
! 447: if (((*s_objet_elementaire).objet =
! 448: allocation_maillon(s_etat_processus)) == NULL)
! 449: {
! 450: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 451: return;
! 452: }
! 453:
! 454: l_element_courant = (struct_liste_chainee *)
! 455: (*s_objet_elementaire).objet;
! 456:
! 457: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
! 458: == NULL)
! 459: {
! 460: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 461: return;
! 462: }
! 463:
! 464: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
! 465: (*((struct_matrice *) (*s_objet_source).objet))
! 466: .nombre_lignes;
! 467:
! 468: if (((*l_element_courant).suivant =
! 469: allocation_maillon(s_etat_processus)) == NULL)
! 470: {
! 471: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 472: return;
! 473: }
! 474:
! 475: l_element_courant = (*l_element_courant).suivant;
! 476: (*l_element_courant).suivant = NULL;
! 477:
! 478: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
! 479: == NULL)
! 480: {
! 481: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 482: return;
! 483: }
! 484:
! 485: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
! 486: (*((struct_matrice *) (*s_objet_source).objet))
! 487: .nombre_colonnes;
! 488:
! 489: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 490: s_objet_elementaire) == d_erreur)
! 491: {
! 492: return;
! 493: }
! 494: }
! 495: else if ((*s_objet_source).type == MCX)
! 496: {
! 497: /*
! 498: * Traitement d'une matrice de complexes
! 499: */
! 500:
! 501: for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
! 502: .nombre_lignes; i++)
! 503: {
! 504: for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
! 505: .nombre_colonnes; j++)
! 506: {
! 507: if ((s_objet_elementaire = allocation(s_etat_processus, CPL))
! 508: == NULL)
! 509: {
! 510: (*s_etat_processus).erreur_systeme =
! 511: d_es_allocation_memoire;
! 512: return;
! 513: }
! 514:
! 515: (*((struct_complexe16 *) (*s_objet_elementaire).objet))
! 516: .partie_reelle = ((struct_complexe16 **)
! 517: (*((struct_matrice *) (*s_objet_source).objet))
! 518: .tableau)[i][j].partie_reelle;
! 519: (*((struct_complexe16 *) (*s_objet_elementaire).objet))
! 520: .partie_imaginaire = ((struct_complexe16 **)
! 521: (*((struct_matrice *) (*s_objet_source).objet))
! 522: .tableau)[i][j].partie_imaginaire;
! 523:
! 524: if (empilement(s_etat_processus, &((*s_etat_processus)
! 525: .l_base_pile), s_objet_elementaire) == d_erreur)
! 526: {
! 527: return;
! 528: }
! 529: }
! 530: }
! 531:
! 532: if ((s_objet_elementaire = allocation(s_etat_processus, LST))
! 533: == NULL)
! 534: {
! 535: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 536: return;
! 537: }
! 538:
! 539: if (((*s_objet_elementaire).objet =
! 540: allocation_maillon(s_etat_processus)) == NULL)
! 541: {
! 542: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 543: return;
! 544: }
! 545:
! 546: l_element_courant = (struct_liste_chainee *)
! 547: (*s_objet_elementaire).objet;
! 548:
! 549: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
! 550: == NULL)
! 551: {
! 552: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 553: return;
! 554: }
! 555:
! 556: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
! 557: (*((struct_matrice *) (*s_objet_source).objet))
! 558: .nombre_lignes;
! 559:
! 560: if (((*l_element_courant).suivant =
! 561: allocation_maillon(s_etat_processus)) == NULL)
! 562: {
! 563: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 564: return;
! 565: }
! 566:
! 567: l_element_courant = (*l_element_courant).suivant;
! 568: (*l_element_courant).suivant = NULL;
! 569:
! 570: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
! 571: == NULL)
! 572: {
! 573: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 574: return;
! 575: }
! 576:
! 577: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
! 578: (*((struct_matrice *) (*s_objet_source).objet))
! 579: .nombre_colonnes;
! 580:
! 581: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 582: s_objet_elementaire) == d_erreur)
! 583: {
! 584: return;
! 585: }
! 586: }
! 587:
! 588: /*
! 589: --------------------------------------------------------------------------------
! 590: Réalisation impossible de la fonction ARRAY->
! 591: --------------------------------------------------------------------------------
! 592: */
! 593:
! 594: else
! 595: {
! 596: liberation(s_etat_processus, s_objet_source);
! 597:
! 598: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 599: return;
! 600: }
! 601:
! 602: liberation(s_etat_processus, s_objet_source);
! 603:
! 604: return;
! 605: }
! 606:
! 607:
! 608: /*
! 609: ================================================================================
! 610: Fonction 'alog'
! 611: ================================================================================
! 612: Entrées : pointeur sur une struct_processus
! 613: --------------------------------------------------------------------------------
! 614: Sorties :
! 615: --------------------------------------------------------------------------------
! 616: Effets de bord : néant
! 617: ================================================================================
! 618: */
! 619:
! 620: void
! 621: instruction_alog(struct_processus *s_etat_processus)
! 622: {
! 623: integer8 base;
! 624: integer8 tampon;
! 625:
! 626: struct_liste_chainee *l_element_courant;
! 627: struct_liste_chainee *l_element_precedent;
! 628:
! 629: struct_objet *s_copie_argument;
! 630: struct_objet *s_objet_argument;
! 631: struct_objet *s_objet_resultat;
! 632:
! 633: (*s_etat_processus).erreur_execution = d_ex;
! 634:
! 635: if ((*s_etat_processus).affichage_arguments == 'Y')
! 636: {
! 637: printf("\n ALOG ");
! 638:
! 639: if ((*s_etat_processus).langue == 'F')
! 640: {
! 641: printf("(antilogarithme base 10)\n\n");
! 642: }
! 643: else
! 644: {
! 645: printf("(10-based antilogarithm)\n\n");
! 646: }
! 647:
! 648: printf(" 1: %s\n", d_INT);
! 649: printf("-> 1: %s, %s\n\n", d_INT, d_REL);
! 650:
! 651: printf(" 1: %s\n", d_REL);
! 652: printf("-> 1: %s\n", d_REL);
! 653:
! 654: printf(" 1: %s\n", d_CPL);
! 655: printf("-> 1: %s\n", d_CPL);
! 656:
! 657: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 658: printf("-> 1: %s\n\n", d_ALG);
! 659:
! 660: printf(" 1: %s\n", d_RPN);
! 661: printf("-> 1: %s\n", d_RPN);
! 662:
! 663: return;
! 664: }
! 665: else if ((*s_etat_processus).test_instruction == 'Y')
! 666: {
! 667: (*s_etat_processus).nombre_arguments = 1;
! 668: return;
! 669: }
! 670:
! 671: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 672: {
! 673: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 674: {
! 675: return;
! 676: }
! 677: }
! 678:
! 679: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 680: &s_objet_argument) == d_erreur)
! 681: {
! 682: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 683: return;
! 684: }
! 685:
! 686: /*
! 687: --------------------------------------------------------------------------------
! 688: Alog d'un entier
! 689: --------------------------------------------------------------------------------
! 690: */
! 691:
! 692: if ((*s_objet_argument).type == INT)
! 693: {
! 694: base = 10;
! 695:
! 696: if (depassement_puissance(&base, (integer8 *) (*s_objet_argument).objet,
! 697: &tampon) == d_absence_erreur)
! 698: {
! 699: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 700: == NULL)
! 701: {
! 702: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 703: return;
! 704: }
! 705:
! 706: (*((integer8 *) (*s_objet_resultat).objet)) = tampon;
! 707: }
! 708: else
! 709: {
! 710: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 711: == NULL)
! 712: {
! 713: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 714: return;
! 715: }
! 716:
! 717: (*((real8 *) (*s_objet_resultat).objet)) =
! 718: pow((real8) 10, (real8) (*((integer8 *)
! 719: (*s_objet_argument).objet)));
! 720: }
! 721: }
! 722:
! 723: /*
! 724: --------------------------------------------------------------------------------
! 725: Alog d'un réel
! 726: --------------------------------------------------------------------------------
! 727: */
! 728:
! 729: else if ((*s_objet_argument).type == REL)
! 730: {
! 731: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 732: == NULL)
! 733: {
! 734: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 735: return;
! 736: }
! 737:
! 738: (*((real8 *) (*s_objet_resultat).objet)) =
! 739: pow((real8) 10, ((*((real8 *) (*s_objet_argument).objet))));
! 740: }
! 741:
! 742: /*
! 743: --------------------------------------------------------------------------------
! 744: Alog d'un complexe
! 745: --------------------------------------------------------------------------------
! 746: */
! 747:
! 748: else if ((*s_objet_argument).type == CPL)
! 749: {
! 750: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 751: == NULL)
! 752: {
! 753: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 754: return;
! 755: }
! 756:
! 757: f77alogc_(&((*((struct_complexe16 *) (*s_objet_argument).objet))),
! 758: (struct_complexe16 *) (*s_objet_resultat).objet);
! 759: }
! 760:
! 761: /*
! 762: --------------------------------------------------------------------------------
! 763: Alog d'un nom
! 764: --------------------------------------------------------------------------------
! 765: */
! 766:
! 767: else if ((*s_objet_argument).type == NOM)
! 768: {
! 769: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 770: == NULL)
! 771: {
! 772: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 773: return;
! 774: }
! 775:
! 776: if (((*s_objet_resultat).objet =
! 777: allocation_maillon(s_etat_processus)) == NULL)
! 778: {
! 779: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 780: return;
! 781: }
! 782:
! 783: l_element_courant = (*s_objet_resultat).objet;
! 784:
! 785: if (((*l_element_courant).donnee =
! 786: allocation(s_etat_processus, FCT)) == NULL)
! 787: {
! 788: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 789: return;
! 790: }
! 791:
! 792: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 793: .nombre_arguments = 0;
! 794: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 795: .fonction = instruction_alog;
! 796:
! 797: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 798: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 799: {
! 800: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 801: return;
! 802: }
! 803:
! 804: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 805: .nom_fonction, "<<");
! 806:
! 807: if (((*l_element_courant).suivant =
! 808: allocation_maillon(s_etat_processus)) == NULL)
! 809: {
! 810: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 811: return;
! 812: }
! 813:
! 814: l_element_courant = (*l_element_courant).suivant;
! 815: (*l_element_courant).donnee = s_objet_argument;
! 816:
! 817: if (((*l_element_courant).suivant =
! 818: allocation_maillon(s_etat_processus)) == NULL)
! 819: {
! 820: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 821: return;
! 822: }
! 823:
! 824: l_element_courant = (*l_element_courant).suivant;
! 825:
! 826: if (((*l_element_courant).donnee =
! 827: allocation(s_etat_processus, FCT)) == NULL)
! 828: {
! 829: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 830: return;
! 831: }
! 832:
! 833: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 834: .nombre_arguments = 1;
! 835: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 836: .fonction = instruction_alog;
! 837:
! 838: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 839: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
! 840: {
! 841: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 842: return;
! 843: }
! 844:
! 845: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 846: .nom_fonction, "ALOG");
! 847:
! 848: if (((*l_element_courant).suivant =
! 849: allocation_maillon(s_etat_processus)) == NULL)
! 850: {
! 851: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 852: return;
! 853: }
! 854:
! 855: l_element_courant = (*l_element_courant).suivant;
! 856:
! 857: if (((*l_element_courant).donnee =
! 858: allocation(s_etat_processus, FCT)) == NULL)
! 859: {
! 860: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 861: return;
! 862: }
! 863:
! 864: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 865: .nombre_arguments = 0;
! 866: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 867: .fonction = instruction_vers_niveau_inferieur;
! 868:
! 869: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 870: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 871: {
! 872: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 873: return;
! 874: }
! 875:
! 876: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 877: .nom_fonction, ">>");
! 878:
! 879: (*l_element_courant).suivant = NULL;
! 880: s_objet_argument = NULL;
! 881: }
! 882:
! 883: /*
! 884: --------------------------------------------------------------------------------
! 885: Alog d'une expression
! 886: --------------------------------------------------------------------------------
! 887: */
! 888:
! 889: else if (((*s_objet_argument).type == ALG) ||
! 890: ((*s_objet_argument).type == RPN))
! 891: {
! 892: if ((s_copie_argument = copie_objet(s_etat_processus,
! 893: s_objet_argument, 'N')) == NULL)
! 894: {
! 895: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 896: return;
! 897: }
! 898:
! 899: l_element_courant = (struct_liste_chainee *)
! 900: (*s_copie_argument).objet;
! 901: l_element_precedent = l_element_courant;
! 902:
! 903: while((*l_element_courant).suivant != NULL)
! 904: {
! 905: l_element_precedent = l_element_courant;
! 906: l_element_courant = (*l_element_courant).suivant;
! 907: }
! 908:
! 909: if (((*l_element_precedent).suivant =
! 910: allocation_maillon(s_etat_processus)) == NULL)
! 911: {
! 912: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 913: return;
! 914: }
! 915:
! 916: if (((*(*l_element_precedent).suivant).donnee =
! 917: allocation(s_etat_processus, FCT)) == NULL)
! 918: {
! 919: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 920: return;
! 921: }
! 922:
! 923: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 924: .donnee).objet)).nombre_arguments = 1;
! 925: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 926: .donnee).objet)).fonction = instruction_alog;
! 927:
! 928: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 929: .suivant).donnee).objet)).nom_fonction =
! 930: malloc(5 * sizeof(unsigned char))) == NULL)
! 931: {
! 932: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 933: return;
! 934: }
! 935:
! 936: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 937: .suivant).donnee).objet)).nom_fonction, "ALOG");
! 938:
! 939: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 940:
! 941: s_objet_resultat = s_copie_argument;
! 942: }
! 943:
! 944: /*
! 945: --------------------------------------------------------------------------------
! 946: Fonction alog impossible à réaliser
! 947: --------------------------------------------------------------------------------
! 948: */
! 949:
! 950: else
! 951: {
! 952: liberation(s_etat_processus, s_objet_argument);
! 953:
! 954: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 955: return;
! 956: }
! 957:
! 958: liberation(s_etat_processus, s_objet_argument);
! 959:
! 960: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 961: s_objet_resultat) == d_erreur)
! 962: {
! 963: return;
! 964: }
! 965:
! 966: return;
! 967: }
! 968:
! 969: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_a3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src