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