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