Annotation of rpl/src/instructions_e2.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 'egvl'
! 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_egvl(struct_processus *s_etat_processus)
! 40: {
! 41: struct_objet *s_objet_argument;
! 42: struct_objet *s_objet_resultat;
! 43:
! 44: (*s_etat_processus).erreur_execution = d_ex;
! 45:
! 46: if ((*s_etat_processus).affichage_arguments == 'Y')
! 47: {
! 48: printf("\n EGVL ");
! 49:
! 50: if ((*s_etat_processus).langue == 'F')
! 51: {
! 52: printf("(valeurs propres)\n\n");
! 53: }
! 54: else
! 55: {
! 56: printf("(eigenvalues)\n\n");
! 57: }
! 58:
! 59: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 60: printf("-> 1: %s\n", d_VCX);
! 61:
! 62: return;
! 63: }
! 64: else if ((*s_etat_processus).test_instruction == 'Y')
! 65: {
! 66: (*s_etat_processus).nombre_arguments = -1;
! 67: return;
! 68: }
! 69:
! 70: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 71: {
! 72: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 73: {
! 74: return;
! 75: }
! 76: }
! 77:
! 78: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 79: &s_objet_argument) == d_erreur)
! 80: {
! 81: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 82: return;
! 83: }
! 84:
! 85: /*
! 86: --------------------------------------------------------------------------------
! 87: L'argument est une matrice carrée
! 88: --------------------------------------------------------------------------------
! 89: */
! 90:
! 91: if (((*s_objet_argument).type == MIN) ||
! 92: ((*s_objet_argument).type == MRL) ||
! 93: ((*s_objet_argument).type == MCX))
! 94: {
! 95: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
! 96: (*((struct_matrice *) (*s_objet_argument).objet))
! 97: .nombre_colonnes)
! 98: {
! 99: liberation(s_etat_processus, s_objet_argument);
! 100:
! 101: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 102: return;
! 103: }
! 104:
! 105: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
! 106: == NULL)
! 107: {
! 108: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 109: return;
! 110: }
! 111:
! 112: valeurs_propres(s_etat_processus,
! 113: (struct_matrice *) (*s_objet_argument).objet,
! 114: (struct_vecteur *) (*s_objet_resultat).objet,
! 115: NULL, NULL);
! 116:
! 117: if ((*s_etat_processus).erreur_systeme != d_es)
! 118: {
! 119: return;
! 120: }
! 121:
! 122: if (((*s_etat_processus).exception != d_ep) ||
! 123: ((*s_etat_processus).erreur_execution != d_ex))
! 124: {
! 125: liberation(s_etat_processus, s_objet_argument);
! 126: liberation(s_etat_processus, s_objet_resultat);
! 127: return;
! 128: }
! 129: }
! 130:
! 131: /*
! 132: --------------------------------------------------------------------------------
! 133: Type incompatible
! 134: --------------------------------------------------------------------------------
! 135: */
! 136:
! 137: else
! 138: {
! 139: liberation(s_etat_processus, s_objet_argument);
! 140:
! 141: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 142: return;
! 143: }
! 144:
! 145: liberation(s_etat_processus, s_objet_argument);
! 146:
! 147: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 148: s_objet_resultat) == d_erreur)
! 149: {
! 150: return;
! 151: }
! 152:
! 153: return;
! 154: }
! 155:
! 156:
! 157: /*
! 158: ================================================================================
! 159: Fonction 'egv'
! 160: ================================================================================
! 161: Entrées : pointeur sur une structure struct_processus
! 162: --------------------------------------------------------------------------------
! 163: Sorties :
! 164: --------------------------------------------------------------------------------
! 165: Effets de bord : néant
! 166: ================================================================================
! 167: */
! 168:
! 169: void
! 170: instruction_egv(struct_processus *s_etat_processus)
! 171: {
! 172: struct_objet *s_objet_argument;
! 173: struct_objet *s_objet_resultat_1;
! 174: struct_objet *s_objet_resultat_2;
! 175: struct_objet *s_objet_resultat_3;
! 176:
! 177: (*s_etat_processus).erreur_execution = d_ex;
! 178:
! 179: if ((*s_etat_processus).affichage_arguments == 'Y')
! 180: {
! 181: printf("\n EGV ");
! 182:
! 183: if ((*s_etat_processus).langue == 'F')
! 184: {
! 185: printf("(valeurs et vecteurs propres)\n\n");
! 186: }
! 187: else
! 188: {
! 189: printf("(eigenvalues and eigenvectors)\n\n");
! 190: }
! 191:
! 192: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 193: printf("-> 3: %s\n", d_MCX);
! 194: printf(" 2: %s\n", d_MCX);
! 195: printf(" 1: %s\n", d_VCX);
! 196:
! 197: return;
! 198: }
! 199: else if ((*s_etat_processus).test_instruction == 'Y')
! 200: {
! 201: (*s_etat_processus).nombre_arguments = -1;
! 202: return;
! 203: }
! 204:
! 205: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 206: {
! 207: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 208: {
! 209: return;
! 210: }
! 211: }
! 212:
! 213: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 214: &s_objet_argument) == d_erreur)
! 215: {
! 216: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 217: return;
! 218: }
! 219:
! 220: /*
! 221: --------------------------------------------------------------------------------
! 222: L'argument est une matrice carrée
! 223: --------------------------------------------------------------------------------
! 224: */
! 225:
! 226: if (((*s_objet_argument).type == MIN) ||
! 227: ((*s_objet_argument).type == MRL) ||
! 228: ((*s_objet_argument).type == MCX))
! 229: {
! 230: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
! 231: (*((struct_matrice *) (*s_objet_argument).objet))
! 232: .nombre_colonnes)
! 233: {
! 234: liberation(s_etat_processus, s_objet_argument);
! 235:
! 236: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 237: return;
! 238: }
! 239:
! 240: if ((s_objet_resultat_1 = allocation(s_etat_processus, VCX))
! 241: == NULL)
! 242: {
! 243: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 244: return;
! 245: }
! 246:
! 247: if ((s_objet_resultat_2 = allocation(s_etat_processus, MCX))
! 248: == NULL)
! 249: {
! 250: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 251: return;
! 252: }
! 253:
! 254: if ((s_objet_resultat_3 = allocation(s_etat_processus, MCX))
! 255: == NULL)
! 256: {
! 257: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 258: return;
! 259: }
! 260:
! 261: valeurs_propres(s_etat_processus,
! 262: (struct_matrice *) (*s_objet_argument).objet,
! 263: (struct_vecteur *) (*s_objet_resultat_1).objet,
! 264: (struct_matrice *) (*s_objet_resultat_3).objet,
! 265: (struct_matrice *) (*s_objet_resultat_2).objet);
! 266:
! 267: if ((*s_etat_processus).erreur_systeme != d_es)
! 268: {
! 269: return;
! 270: }
! 271:
! 272: if (((*s_etat_processus).exception != d_ep) ||
! 273: ((*s_etat_processus).erreur_execution != d_ex))
! 274: {
! 275: liberation(s_etat_processus, s_objet_argument);
! 276: liberation(s_etat_processus, s_objet_resultat_1);
! 277: liberation(s_etat_processus, s_objet_resultat_2);
! 278: liberation(s_etat_processus, s_objet_resultat_3);
! 279: return;
! 280: }
! 281: }
! 282:
! 283: /*
! 284: --------------------------------------------------------------------------------
! 285: Type incompatible
! 286: --------------------------------------------------------------------------------
! 287: */
! 288:
! 289: else
! 290: {
! 291: liberation(s_etat_processus, s_objet_argument);
! 292:
! 293: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 294: return;
! 295: }
! 296:
! 297: liberation(s_etat_processus, s_objet_argument);
! 298:
! 299: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 300: s_objet_resultat_3) == d_erreur)
! 301: {
! 302: return;
! 303: }
! 304:
! 305: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 306: s_objet_resultat_2) == d_erreur)
! 307: {
! 308: return;
! 309: }
! 310:
! 311: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 312: s_objet_resultat_1) == d_erreur)
! 313: {
! 314: return;
! 315: }
! 316:
! 317: return;
! 318: }
! 319:
! 320:
! 321: /*
! 322: ================================================================================
! 323: Fonction 'erase' (detruit la queue d'impression)
! 324: ================================================================================
! 325: Entrées : structure processus
! 326: --------------------------------------------------------------------------------
! 327: Sorties :
! 328: --------------------------------------------------------------------------------
! 329: Effets de bord : néant
! 330: ================================================================================
! 331: */
! 332:
! 333: void
! 334: instruction_erase(struct_processus *s_etat_processus)
! 335: {
! 336: (*s_etat_processus).erreur_execution = d_ex;
! 337:
! 338: if ((*s_etat_processus).affichage_arguments == 'Y')
! 339: {
! 340: printf("\n ERASE ");
! 341:
! 342: if ((*s_etat_processus).langue == 'F')
! 343: {
! 344: printf("(efface la file d'impression)\n\n");
! 345: printf(" Aucun argument\n");
! 346: }
! 347: else
! 348: {
! 349: printf("(erase the printer queue)\n\n");
! 350: printf(" No argument\n");
! 351: }
! 352:
! 353: return;
! 354: }
! 355: else if ((*s_etat_processus).test_instruction == 'Y')
! 356: {
! 357: (*s_etat_processus).nombre_arguments = -1;
! 358: return;
! 359: }
! 360:
! 361: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 362: {
! 363: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 364: {
! 365: return;
! 366: }
! 367: }
! 368:
! 369: if ((*s_etat_processus).nom_fichier_impression != NULL)
! 370: {
! 371: if (destruction_fichier((*s_etat_processus).nom_fichier_impression)
! 372: == d_erreur)
! 373: {
! 374: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 375: return;
! 376: }
! 377:
! 378: free((*s_etat_processus).nom_fichier_impression);
! 379: (*s_etat_processus).nom_fichier_impression = NULL;
! 380: }
! 381:
! 382: return;
! 383: }
! 384:
! 385:
! 386: /*
! 387: ================================================================================
! 388: Fonction 'epsilon' (renvoie la le plus petit réel e tel x + e != x)
! 389: ================================================================================
! 390: Entrées : structure processus
! 391: --------------------------------------------------------------------------------
! 392: Sorties :
! 393: --------------------------------------------------------------------------------
! 394: Effets de bord : néant
! 395: ================================================================================
! 396: */
! 397:
! 398: void
! 399: instruction_epsilon(struct_processus *s_etat_processus)
! 400: {
! 401: struct_objet *s_copie;
! 402: struct_objet *s_objet;
! 403:
! 404: (*s_etat_processus).erreur_execution = d_ex;
! 405:
! 406: if ((*s_etat_processus).affichage_arguments == 'Y')
! 407: {
! 408: printf("\n EPSILON ");
! 409:
! 410: if ((*s_etat_processus).langue == 'F')
! 411: {
! 412: printf("(epsilon machine)\n\n");
! 413: }
! 414: else
! 415: {
! 416: printf("(computer epsilon)\n\n");
! 417: }
! 418:
! 419: printf(" 1: %s\n", d_INT);
! 420: printf("-> 1: %s\n\n", d_INT);
! 421:
! 422: printf(" 1: %s\n", d_CPL);
! 423: printf("-> 1: %s\n\n", d_CPL);
! 424:
! 425: printf(" 1: %s\n", d_REL);
! 426: printf("-> 1: %s\n", d_REL);
! 427:
! 428: return;
! 429: }
! 430: else if ((*s_etat_processus).test_instruction == 'Y')
! 431: {
! 432: (*s_etat_processus).nombre_arguments = 1;
! 433: return;
! 434: }
! 435:
! 436: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 437: {
! 438: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 439: {
! 440: return;
! 441: }
! 442: }
! 443:
! 444: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 445: &s_objet) == d_erreur)
! 446: {
! 447: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 448: return;
! 449: }
! 450:
! 451: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
! 452: {
! 453: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 454: return;
! 455: }
! 456:
! 457: liberation(s_etat_processus, s_objet);
! 458: s_objet = s_copie;
! 459:
! 460: /*
! 461: * L'argument est un entier et la routine renvoie 1.
! 462: */
! 463:
! 464: if ((*s_objet).type == INT)
! 465: {
! 466: (*((integer8 *) (*s_objet).objet)) = 1;
! 467: }
! 468:
! 469: /*
! 470: * L'argument est un réel
! 471: */
! 472:
! 473: else if ((*s_objet).type == REL)
! 474: {
! 475: if ((*((real8 *) (*s_objet).objet)) == 0)
! 476: {
! 477: (*((real8 *) (*s_objet).objet)) = nextafter((double) 0, (double) 1);
! 478: }
! 479: else
! 480: {
! 481: (*((real8 *) (*s_objet).objet)) = nextafter(-abs(*((real8 *)
! 482: (*s_objet).objet)), 0) + abs(*((real8 *) (*s_objet).objet));
! 483: }
! 484: }
! 485:
! 486: /*
! 487: * L'argument est un complexe
! 488: */
! 489:
! 490: else if ((*s_objet).type == CPL)
! 491: {
! 492: (*((complex16 *) (*s_objet).objet)).partie_reelle =
! 493: nextafter(-abs((*((complex16 *) (*s_objet).objet))
! 494: .partie_reelle), 0) + abs((*((complex16 *) (*s_objet).objet))
! 495: .partie_reelle);
! 496: (*((complex16 *) (*s_objet).objet)).partie_imaginaire =
! 497: nextafter(-abs((*((complex16 *) (*s_objet).objet))
! 498: .partie_imaginaire), 0) + abs((*((complex16 *)
! 499: (*s_objet).objet)).partie_imaginaire);
! 500: }
! 501: else
! 502: {
! 503: liberation(s_etat_processus, s_objet);
! 504:
! 505: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 506: return;
! 507: }
! 508:
! 509: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 510: s_objet) == d_erreur)
! 511: {
! 512: return;
! 513: }
! 514:
! 515: return;
! 516: }
! 517:
! 518:
! 519: /*
! 520: ================================================================================
! 521: Fonction 'errn' (detruit la queue d'impression)
! 522: ================================================================================
! 523: Entrées : structure processus
! 524: --------------------------------------------------------------------------------
! 525: Sorties :
! 526: --------------------------------------------------------------------------------
! 527: Effets de bord : néant
! 528: ================================================================================
! 529: */
! 530:
! 531: void
! 532: instruction_errn(struct_processus *s_etat_processus)
! 533: {
! 534: struct_objet *s_objet_resultat;
! 535:
! 536: (*s_etat_processus).erreur_execution = d_ex;
! 537:
! 538: if ((*s_etat_processus).affichage_arguments == 'Y')
! 539: {
! 540: printf("\n ERRN ");
! 541:
! 542: if ((*s_etat_processus).langue == 'F')
! 543: {
! 544: printf("(numéro de la dernière erreur)\n\n");
! 545: }
! 546: else
! 547: {
! 548: printf("(last error number)\n\n");
! 549: }
! 550:
! 551: printf("-> 1: %s\n", d_INT);
! 552:
! 553: return;
! 554: }
! 555: else if ((*s_etat_processus).test_instruction == 'Y')
! 556: {
! 557: (*s_etat_processus).nombre_arguments = -1;
! 558: return;
! 559: }
! 560:
! 561: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 562: {
! 563: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 564: {
! 565: return;
! 566: }
! 567: }
! 568:
! 569: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 570: {
! 571: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 572: return;
! 573: }
! 574:
! 575: if ((*s_etat_processus).derniere_exception != d_ep)
! 576: {
! 577: (*((integer8 *) (*s_objet_resultat).objet)) =
! 578: 1000 + ((*s_etat_processus).derniere_exception - d_ep);
! 579: }
! 580: else if ((*s_etat_processus).derniere_erreur_execution != d_ex)
! 581: {
! 582: (*((integer8 *) (*s_objet_resultat).objet)) =
! 583: 0 + ((*s_etat_processus).derniere_erreur_execution - d_ex);
! 584: }
! 585: else if ((*s_etat_processus).derniere_erreur_systeme != d_es)
! 586: {
! 587: /*
! 588: * On ne doit jamais passer par ici !
! 589: */
! 590:
! 591: (*((integer8 *) (*s_objet_resultat).objet)) =
! 592: 2000 + ((*s_etat_processus).derniere_erreur_systeme - d_es);
! 593: }
! 594: else
! 595: {
! 596: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 597: }
! 598:
! 599: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 600: s_objet_resultat) == d_erreur)
! 601: {
! 602: return;
! 603: }
! 604:
! 605: return;
! 606: }
! 607:
! 608:
! 609: /*
! 610: ================================================================================
! 611: Fonction 'errm'
! 612: ================================================================================
! 613: Entrées : structure processus
! 614: --------------------------------------------------------------------------------
! 615: Sorties :
! 616: --------------------------------------------------------------------------------
! 617: Effets de bord : néant
! 618: ================================================================================
! 619: */
! 620:
! 621: void
! 622: instruction_errm(struct_processus *s_etat_processus)
! 623: {
! 624: struct_objet *s_objet_resultat;
! 625:
! 626: unsigned int registre_erreur_execution;
! 627: unsigned int registre_erreur_systeme;
! 628: unsigned int registre_exception;
! 629:
! 630: (*s_etat_processus).erreur_execution = d_ex;
! 631:
! 632: if ((*s_etat_processus).affichage_arguments == 'Y')
! 633: {
! 634: printf("\n ERRM ");
! 635:
! 636: if ((*s_etat_processus).langue == 'F')
! 637: {
! 638: printf("(dernier message d'erreur)\n\n");
! 639: }
! 640: else
! 641: {
! 642: printf("(last error message)\n\n");
! 643: }
! 644:
! 645: printf("-> 1: %s\n", d_CHN);
! 646:
! 647: return;
! 648: }
! 649: else if ((*s_etat_processus).test_instruction == 'Y')
! 650: {
! 651: (*s_etat_processus).nombre_arguments = -1;
! 652: return;
! 653: }
! 654:
! 655: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 656: {
! 657: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 658: {
! 659: return;
! 660: }
! 661: }
! 662:
! 663: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
! 664: {
! 665: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 666: return;
! 667: }
! 668:
! 669: registre_exception = (*s_etat_processus).exception;
! 670: registre_erreur_execution = (*s_etat_processus).erreur_execution;
! 671: registre_erreur_systeme = (*s_etat_processus).erreur_systeme;
! 672:
! 673: (*s_etat_processus).exception =
! 674: (*s_etat_processus).derniere_exception;
! 675: (*s_etat_processus).erreur_execution =
! 676: (*s_etat_processus).derniere_erreur_execution;
! 677: (*s_etat_processus).erreur_systeme =
! 678: (*s_etat_processus).derniere_erreur_systeme;
! 679:
! 680: if (((*s_objet_resultat).objet =
! 681: messages(s_etat_processus)) == NULL)
! 682: {
! 683: (*s_etat_processus).exception =
! 684: registre_exception;
! 685: (*s_etat_processus).erreur_execution =
! 686: registre_erreur_execution;
! 687: (*s_etat_processus).erreur_systeme =
! 688: registre_erreur_systeme;
! 689:
! 690: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 691: return;
! 692: }
! 693:
! 694: (*s_etat_processus).exception = registre_exception;
! 695: (*s_etat_processus).erreur_execution = registre_erreur_execution;
! 696: (*s_etat_processus).erreur_systeme = registre_erreur_systeme;
! 697:
! 698: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 699: s_objet_resultat) == d_erreur)
! 700: {
! 701: return;
! 702: }
! 703:
! 704: return;
! 705: }
! 706:
! 707:
! 708: /*
! 709: ================================================================================
! 710: Fonction 'edit'
! 711: ================================================================================
! 712: Entrées : structure processus
! 713: --------------------------------------------------------------------------------
! 714: Sorties :
! 715: --------------------------------------------------------------------------------
! 716: Effets de bord : néant
! 717: ================================================================================
! 718: */
! 719:
! 720: void
! 721: instruction_edit(struct_processus *s_etat_processus)
! 722: {
! 723: # ifdef VIM_SUPPORT
! 724: # include "vim.conv.h"
! 725:
! 726: file *fichier;
! 727:
! 728: logical1 drapeau;
! 729: logical1 drapeau49;
! 730: logical1 drapeau50;
! 731:
! 732: struct_liste_chainee *registre_pile_last;
! 733:
! 734: struct_objet *s_copie;
! 735: struct_objet *s_objet;
! 736: struct_objet *s_objet_nom;
! 737:
! 738: unsigned char *chaine;
! 739: unsigned char *commande;
! 740: unsigned char *nom_fichier;
! 741:
! 742: (*s_etat_processus).erreur_execution = d_ex;
! 743:
! 744: if ((*s_etat_processus).affichage_arguments == 'Y')
! 745: {
! 746: printf("\n EDIT ");
! 747:
! 748: if ((*s_etat_processus).langue == 'F')
! 749: {
! 750: printf("(édition d'un objet)\n\n");
! 751: }
! 752: else
! 753: {
! 754: printf("(edit object)\n\n");
! 755: }
! 756:
! 757: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 758: " %s, %s, %s, %s, %s,\n"
! 759: " %s, %s, %s, %s, %s\n",
! 760: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 761: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
! 762: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
! 763: " %s, %s, %s, %s, %s,\n"
! 764: " %s, %s, %s, %s, %s\n",
! 765: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 766: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
! 767: printf(" ...\n");
! 768: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 769: " %s, %s, %s, %s, %s,\n"
! 770: " %s, %s, %s, %s, %s\n",
! 771: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 772: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
! 773: return;
! 774: }
! 775: else if ((*s_etat_processus).test_instruction == 'Y')
! 776: {
! 777: (*s_etat_processus).nombre_arguments = -1;
! 778: return;
! 779: }
! 780:
! 781: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 782: {
! 783: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 784: {
! 785: return;
! 786: }
! 787: }
! 788:
! 789: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 790: &s_objet) == d_erreur)
! 791: {
! 792: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 793: return;
! 794: }
! 795:
! 796: if (((*s_objet).type != INT) &&
! 797: ((*s_objet).type != REL) &&
! 798: ((*s_objet).type != CPL) &&
! 799: ((*s_objet).type != VIN) &&
! 800: ((*s_objet).type != VRL) &&
! 801: ((*s_objet).type != VCX) &&
! 802: ((*s_objet).type != MIN) &&
! 803: ((*s_objet).type != MRL) &&
! 804: ((*s_objet).type != MCX) &&
! 805: ((*s_objet).type != TBL) &&
! 806: ((*s_objet).type != BIN) &&
! 807: ((*s_objet).type != NOM) &&
! 808: ((*s_objet).type != CHN) &&
! 809: ((*s_objet).type != LST) &&
! 810: ((*s_objet).type != ALG) &&
! 811: ((*s_objet).type != RPN))
! 812: {
! 813: liberation(s_etat_processus, s_objet);
! 814:
! 815: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 816: return;
! 817: }
! 818:
! 819: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
! 820: {
! 821: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 822: return;
! 823: }
! 824:
! 825: liberation(s_etat_processus, s_objet);
! 826: s_objet = s_copie;
! 827:
! 828: // Création d'un fichier temporaire à éditer
! 829:
! 830: if ((nom_fichier = creation_nom_fichier(s_etat_processus,
! 831: (*s_etat_processus).chemin_fichiers_temporaires)) == NULL)
! 832: {
! 833: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 834: return;
! 835: }
! 836:
! 837: drapeau49 = test_cfsf(s_etat_processus, 49);
! 838: drapeau50 = test_cfsf(s_etat_processus, 50);
! 839:
! 840: cf(s_etat_processus, 49);
! 841: cf(s_etat_processus, 50);
! 842:
! 843: // Ecriture de l'objet dans le fichier en mode STD et multiligne
! 844:
! 845: if ((fichier = fopen(nom_fichier, "w+")) == NULL)
! 846: {
! 847: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 848: return;
! 849: }
! 850:
! 851: if ((chaine = formateur(s_etat_processus, 0, s_objet)) == NULL)
! 852: {
! 853: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 854: return;
! 855: }
! 856:
! 857: if ((*s_objet).type == CHN)
! 858: {
! 859: if (fprintf(fichier, "\"%s\"\n", chaine) != (int) (strlen(chaine) + 3))
! 860: {
! 861: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 862: return;
! 863: }
! 864: }
! 865: else
! 866: {
! 867: if (fprintf(fichier, "%s\n", chaine) != (int) (strlen(chaine) + 1))
! 868: {
! 869: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 870: return;
! 871: }
! 872: }
! 873:
! 874: free(chaine);
! 875:
! 876: if (fclose(fichier) != 0)
! 877: {
! 878: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 879: return;
! 880: }
! 881:
! 882: do
! 883: {
! 884: if ((commande = malloc((strlen(ds_vim_commande) + strlen(nom_fichier)
! 885: - 1) * sizeof(unsigned char))) == NULL)
! 886: {
! 887: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 888: return;
! 889: }
! 890:
! 891: sprintf(commande, ds_vim_commande, nom_fichier);
! 892:
! 893: if (system(commande) != 0)
! 894: {
! 895: free(commande);
! 896:
! 897: (*s_etat_processus).erreur_systeme = d_es_processus;
! 898: return;
! 899: }
! 900:
! 901: free(commande);
! 902:
! 903: if ((s_objet_nom = allocation(s_etat_processus, CHN)) == NULL)
! 904: {
! 905: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 906: return;
! 907: }
! 908:
! 909: if (((*s_objet_nom).objet = malloc((strlen(nom_fichier) + 1)
! 910: * sizeof(unsigned char))) == NULL)
! 911: {
! 912: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 913: return;
! 914: }
! 915:
! 916: strcpy((unsigned char *) (*s_objet_nom).objet, nom_fichier);
! 917:
! 918: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 919: s_objet_nom) == d_erreur)
! 920: {
! 921: return;
! 922: }
! 923:
! 924: registre_pile_last = (*s_etat_processus).l_base_pile_last;
! 925: (*s_etat_processus).l_base_pile_last = NULL;
! 926:
! 927: instruction_recall(s_etat_processus);
! 928:
! 929: // Destruction du fichier temporaire
! 930:
! 931: if (destruction_fichier(nom_fichier) == d_erreur)
! 932: {
! 933: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 934: return;
! 935: }
! 936:
! 937: free(nom_fichier);
! 938:
! 939: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 940: ((*s_etat_processus).erreur_execution != d_ex) ||
! 941: ((*s_etat_processus).exception != d_ep))
! 942: {
! 943: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 944: {
! 945: return;
! 946: }
! 947:
! 948: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 949: liberation(s_etat_processus, s_objet);
! 950:
! 951: return;
! 952: }
! 953:
! 954: if ((*s_etat_processus).erreur_systeme != d_es)
! 955: {
! 956: return;
! 957: }
! 958:
! 959: if ((*s_etat_processus).erreur_execution == d_ex_fichier_vide)
! 960: {
! 961: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 962: s_objet) == d_erreur)
! 963: {
! 964: return;
! 965: }
! 966:
! 967: (*s_etat_processus).erreur_execution = d_ex;
! 968: drapeau = d_faux;
! 969: }
! 970: else
! 971: {
! 972: drapeau = d_vrai;
! 973: }
! 974: } while((*s_etat_processus).erreur_execution != d_ex);
! 975:
! 976: if (drapeau == d_vrai)
! 977: {
! 978: liberation(s_etat_processus, s_objet);
! 979: }
! 980:
! 981: if (drapeau49 == d_vrai)
! 982: {
! 983: sf(s_etat_processus, 49);
! 984: }
! 985: else
! 986: {
! 987: cf(s_etat_processus, 49);
! 988: }
! 989:
! 990: if (drapeau50 == d_vrai)
! 991: {
! 992: sf(s_etat_processus, 50);
! 993: }
! 994: else
! 995: {
! 996: cf(s_etat_processus, 50);
! 997: }
! 998:
! 999: # endif
! 1000:
! 1001: return;
! 1002: }
! 1003:
! 1004:
! 1005: /*
! 1006: ================================================================================
! 1007: Fonction 'externals'
! 1008: ================================================================================
! 1009: Entrées : structure processus
! 1010: --------------------------------------------------------------------------------
! 1011: Sorties :
! 1012: --------------------------------------------------------------------------------
! 1013: Effets de bord : néant
! 1014: ================================================================================
! 1015: */
! 1016:
! 1017: void
! 1018: instruction_externals(struct_processus *s_etat_processus)
! 1019: {
! 1020: logical1 ambiguite;
! 1021:
! 1022: unsigned long i;
! 1023:
! 1024: struct_liste_chainee *l_element_courant;
! 1025:
! 1026: struct_objet *s_objet;
! 1027:
! 1028: (*s_etat_processus).erreur_execution = d_ex;
! 1029:
! 1030: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1031: {
! 1032: printf("\n EXTERNALS ");
! 1033:
! 1034: if ((*s_etat_processus).langue == 'F')
! 1035: {
! 1036: printf("(liste des définitions externes)\n\n");
! 1037: }
! 1038: else
! 1039: {
! 1040: printf("(list of external definitions)\n\n");
! 1041: }
! 1042:
! 1043: printf("-> 1: %s\n", d_LST);
! 1044: return;
! 1045: }
! 1046: else if ((*s_etat_processus).test_instruction == 'Y')
! 1047: {
! 1048: (*s_etat_processus).nombre_arguments = -1;
! 1049: return;
! 1050: }
! 1051:
! 1052: if ((s_objet = allocation(s_etat_processus, LST)) == NULL)
! 1053: {
! 1054: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1055: return;
! 1056: }
! 1057:
! 1058: (*s_objet).objet = NULL;
! 1059:
! 1060: /*
! 1061: * { "fonction" } si la fonction n'est pas ambiguë
! 1062: * { "bibliotheque$fonction" } sinon.
! 1063: */
! 1064:
! 1065: l_element_courant = NULL;
! 1066:
! 1067: for(i = 0; i < (*s_etat_processus).nombre_instructions_externes; i++)
! 1068: {
! 1069: if (l_element_courant == NULL)
! 1070: {
! 1071: if (((*s_objet).objet = allocation_maillon(s_etat_processus))
! 1072: == NULL)
! 1073: {
! 1074: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1075: return;
! 1076: }
! 1077:
! 1078: l_element_courant = (*s_objet).objet;
! 1079: }
! 1080: else
! 1081: {
! 1082: if (((*l_element_courant).suivant =
! 1083: allocation_maillon(s_etat_processus)) == NULL)
! 1084: {
! 1085: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1086: return;
! 1087: }
! 1088:
! 1089: l_element_courant = (*l_element_courant).suivant;
! 1090: }
! 1091:
! 1092: (*l_element_courant).suivant = NULL;
! 1093:
! 1094: if (((*l_element_courant).donnee = allocation(s_etat_processus, CHN))
! 1095: == NULL)
! 1096: {
! 1097: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1098: return;
! 1099: }
! 1100:
! 1101: ambiguite = d_faux;
! 1102:
! 1103: if (i > 0)
! 1104: {
! 1105: if (strcmp((*s_etat_processus).s_instructions_externes[i].nom,
! 1106: (*s_etat_processus).s_instructions_externes[i - 1].nom)
! 1107: == 0)
! 1108: {
! 1109: ambiguite = d_vrai;
! 1110: }
! 1111: }
! 1112:
! 1113: if (((i + 1) < (*s_etat_processus).nombre_instructions_externes) &&
! 1114: (ambiguite == d_faux))
! 1115: {
! 1116: if (strcmp((*s_etat_processus).s_instructions_externes[i].nom,
! 1117: (*s_etat_processus).s_instructions_externes[i + 1].nom)
! 1118: == 0)
! 1119: {
! 1120: ambiguite = d_vrai;
! 1121: }
! 1122: }
! 1123:
! 1124: if (ambiguite == d_faux)
! 1125: {
! 1126: if (((*(*l_element_courant).donnee).objet = malloc((strlen(
! 1127: (*s_etat_processus).s_instructions_externes[i].nom) + 1)
! 1128: * sizeof(unsigned char))) == NULL)
! 1129: {
! 1130: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1131: return;
! 1132: }
! 1133:
! 1134: strcpy((unsigned char *) (*(*l_element_courant).donnee).objet,
! 1135: (*s_etat_processus).s_instructions_externes[i].nom);
! 1136: }
! 1137: else
! 1138: {
! 1139: if (((*(*l_element_courant).donnee).objet = malloc((strlen(
! 1140: (*s_etat_processus).s_instructions_externes[i].nom) +
! 1141: strlen((*s_etat_processus).s_instructions_externes[i]
! 1142: .nom_bibliotheque) + 2) * sizeof(unsigned char))) == NULL)
! 1143: {
! 1144: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1145: return;
! 1146: }
! 1147:
! 1148: sprintf((unsigned char *) (*(*l_element_courant).donnee).objet,
! 1149: "%s$%s", (*s_etat_processus).s_instructions_externes[i]
! 1150: .nom_bibliotheque, (*s_etat_processus)
! 1151: .s_instructions_externes[i].nom);
! 1152: }
! 1153: }
! 1154:
! 1155: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1156: s_objet) == d_erreur)
! 1157: {
! 1158: return;
! 1159: }
! 1160:
! 1161: return;
! 1162: }
! 1163:
! 1164:
! 1165: /*
! 1166: ================================================================================
! 1167: Fonction 'exit'
! 1168: ================================================================================
! 1169: Entrées : structure processus
! 1170: --------------------------------------------------------------------------------
! 1171: Sorties :
! 1172: --------------------------------------------------------------------------------
! 1173: Effets de bord : néant
! 1174: ================================================================================
! 1175: */
! 1176:
! 1177: void
! 1178: instruction_exit(struct_processus *s_etat_processus)
! 1179: {
! 1180: logical1 drapeau_boucle_definie;
! 1181: logical1 drapeau_presence_fin_boucle;
! 1182: logical1 erreur;
! 1183: logical1 presence_boucle;
! 1184: logical1 presence_compteur;
! 1185:
! 1186: struct_liste_pile_systeme *l_element_pile_systeme;
! 1187:
! 1188: unsigned char *instruction_majuscule;
! 1189: unsigned char *tampon;
! 1190:
! 1191: unsigned long niveau;
! 1192:
! 1193: void (*fonction)();
! 1194:
! 1195: (*s_etat_processus).erreur_execution = d_ex;
! 1196:
! 1197: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1198: {
! 1199: printf("\n EXIT ");
! 1200:
! 1201: if ((*s_etat_processus).langue == 'F')
! 1202: {
! 1203: printf("(structure de contrôle)\n\n");
! 1204: printf(" Utilisation :\n\n");
! 1205: }
! 1206: else
! 1207: {
! 1208: printf("(control statement)\n\n");
! 1209: printf(" Usage:\n\n");
! 1210: }
! 1211:
! 1212: printf(" START/FOR\n");
! 1213: printf(" (expression 1)\n");
! 1214: printf(" EXIT\n");
! 1215: printf(" (expression 2)\n");
! 1216: printf(" NEXT/STEP\n\n");
! 1217:
! 1218: printf(" DO\n");
! 1219: printf(" (expression 1)\n");
! 1220: printf(" EXIT\n");
! 1221: printf(" (expression 2)\n");
! 1222: printf(" UNTIL\n");
! 1223: printf(" (expression test 1)\n");
! 1224: printf(" [EXIT\n");
! 1225: printf(" (expression test 2)]\n");
! 1226: printf(" END\n\n");
! 1227:
! 1228: printf(" WHILE\n");
! 1229: printf(" (expression test 1)\n");
! 1230: printf(" [EXIT\n");
! 1231: printf(" (expression test 2)]\n");
! 1232: printf(" REPEAT\n");
! 1233: printf(" (expression 1)\n");
! 1234: printf(" EXIT\n");
! 1235: printf(" (expression 2)\n");
! 1236: printf(" END\n");
! 1237:
! 1238: return;
! 1239: }
! 1240: else if ((*s_etat_processus).test_instruction == 'Y')
! 1241: {
! 1242: (*s_etat_processus).nombre_arguments = -1;
! 1243: return;
! 1244: }
! 1245:
! 1246: /*
! 1247: * Test de la présence de l'instruction EXIT dans une boucle
! 1248: */
! 1249:
! 1250: l_element_pile_systeme = (*s_etat_processus).l_base_pile_systeme;
! 1251: presence_boucle = d_faux;
! 1252: drapeau_boucle_definie = d_faux;
! 1253:
! 1254: while((l_element_pile_systeme != NULL) && (presence_boucle == d_faux))
! 1255: {
! 1256: if (((*l_element_pile_systeme).type_cloture == 'S') ||
! 1257: ((*l_element_pile_systeme).type_cloture == 'F'))
! 1258: {
! 1259: presence_boucle = d_vrai;
! 1260: drapeau_boucle_definie = d_vrai;
! 1261: }
! 1262: else if (((*l_element_pile_systeme).type_cloture == 'D') ||
! 1263: ((*l_element_pile_systeme).type_cloture == 'W'))
! 1264: {
! 1265: presence_boucle = d_vrai;
! 1266: drapeau_boucle_definie = d_faux;
! 1267: }
! 1268:
! 1269: l_element_pile_systeme = (*l_element_pile_systeme).suivant;
! 1270: }
! 1271:
! 1272: if (presence_boucle == d_faux)
! 1273: {
! 1274: (*s_etat_processus).erreur_execution = d_ex_exit_hors_boucle;
! 1275: return;
! 1276: }
! 1277:
! 1278: if ((*s_etat_processus).mode_execution_programme == 'Y')
! 1279: {
! 1280: drapeau_presence_fin_boucle = d_vrai;
! 1281: tampon = (*s_etat_processus).instruction_courante;
! 1282: niveau = 1;
! 1283:
! 1284: instruction_majuscule = conversion_majuscule("");
! 1285:
! 1286: if (drapeau_boucle_definie == d_vrai)
! 1287: {
! 1288: while(!(((strcmp(instruction_majuscule, "NEXT") == 0) ||
! 1289: (strcmp(instruction_majuscule, "STEP") == 0)) &&
! 1290: (niveau == 0)))
! 1291: {
! 1292: free(instruction_majuscule);
! 1293:
! 1294: erreur = recherche_instruction_suivante(s_etat_processus);
! 1295:
! 1296: if (erreur == d_erreur)
! 1297: {
! 1298: return;
! 1299: }
! 1300:
! 1301: if (recherche_variable(s_etat_processus,
! 1302: (*s_etat_processus).instruction_courante) == d_vrai)
! 1303: {
! 1304: instruction_majuscule = conversion_majuscule("");
! 1305:
! 1306: if ((*s_etat_processus).s_liste_variables
! 1307: [(*s_etat_processus).position_variable_courante]
! 1308: .objet == NULL)
! 1309: {
! 1310: if (pthread_mutex_lock(&((*(*s_etat_processus)
! 1311: .s_liste_variables_partagees).mutex)) != 0)
! 1312: {
! 1313: (*s_etat_processus).erreur_systeme =
! 1314: d_es_processus;
! 1315: return;
! 1316: }
! 1317:
! 1318: if (recherche_variable_partagee(s_etat_processus,
! 1319: (*s_etat_processus).s_liste_variables
! 1320: [(*s_etat_processus).position_variable_courante]
! 1321: .nom, (*s_etat_processus).s_liste_variables
! 1322: [(*s_etat_processus).position_variable_courante]
! 1323: .variable_partagee,
! 1324: (*s_etat_processus).s_liste_variables
! 1325: [(*s_etat_processus).position_variable_courante]
! 1326: .origine) == d_vrai)
! 1327: {
! 1328: if ((*((*s_etat_processus).s_liste_variables
! 1329: [(*s_etat_processus)
! 1330: .position_variable_courante]).objet).type
! 1331: == ADR)
! 1332: {
! 1333: empilement_pile_systeme(s_etat_processus);
! 1334:
! 1335: if ((*s_etat_processus).erreur_systeme != d_es)
! 1336: {
! 1337: if (pthread_mutex_unlock(
! 1338: &((*(*s_etat_processus)
! 1339: .s_liste_variables_partagees)
! 1340: .mutex)) != 0)
! 1341: {
! 1342: (*s_etat_processus).erreur_systeme =
! 1343: d_es_processus;
! 1344: return;
! 1345: }
! 1346:
! 1347: return;
! 1348: }
! 1349:
! 1350: (*(*s_etat_processus).l_base_pile_systeme)
! 1351: .adresse_retour =
! 1352: (*s_etat_processus).position_courante;
! 1353:
! 1354: (*(*s_etat_processus).l_base_pile_systeme)
! 1355: .retour_definition = 'Y';
! 1356: (*(*s_etat_processus).l_base_pile_systeme)
! 1357: .niveau_courant =
! 1358: (*s_etat_processus).niveau_courant;
! 1359:
! 1360: (*s_etat_processus).position_courante =
! 1361: (*((unsigned long *)
! 1362: ((*((*s_etat_processus)
! 1363: .s_liste_variables[(*s_etat_processus)
! 1364: .position_variable_courante].objet))
! 1365: .objet)));
! 1366:
! 1367: (*s_etat_processus)
! 1368: .autorisation_empilement_programme
! 1369: = 'N';
! 1370: }
! 1371: }
! 1372: else
! 1373: {
! 1374: (*s_etat_processus).erreur_systeme = d_es;
! 1375: }
! 1376:
! 1377: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 1378: .s_liste_variables_partagees).mutex)) != 0)
! 1379: {
! 1380: (*s_etat_processus).erreur_systeme =
! 1381: d_es_processus;
! 1382: return;
! 1383: }
! 1384: }
! 1385: else
! 1386: {
! 1387: if ((*((*s_etat_processus).s_liste_variables
! 1388: [(*s_etat_processus)
! 1389: .position_variable_courante]).objet).type
! 1390: == ADR)
! 1391: {
! 1392: empilement_pile_systeme(s_etat_processus);
! 1393:
! 1394: if ((*s_etat_processus).erreur_systeme != d_es)
! 1395: {
! 1396: return;
! 1397: }
! 1398:
! 1399: (*(*s_etat_processus).l_base_pile_systeme)
! 1400: .adresse_retour =
! 1401: (*s_etat_processus).position_courante;
! 1402:
! 1403: (*(*s_etat_processus).l_base_pile_systeme)
! 1404: .retour_definition = 'Y';
! 1405: (*(*s_etat_processus).l_base_pile_systeme)
! 1406: .niveau_courant =
! 1407: (*s_etat_processus).niveau_courant;
! 1408:
! 1409: (*s_etat_processus).position_courante =
! 1410: (*((unsigned long *) ((*((*s_etat_processus)
! 1411: .s_liste_variables[(*s_etat_processus)
! 1412: .position_variable_courante].objet))
! 1413: .objet)));
! 1414:
! 1415: (*s_etat_processus)
! 1416: .autorisation_empilement_programme
! 1417: = 'N';
! 1418: }
! 1419: }
! 1420: }
! 1421: else
! 1422: {
! 1423: (*s_etat_processus).erreur_systeme = d_es;
! 1424: instruction_majuscule = conversion_majuscule(
! 1425: (*s_etat_processus).instruction_courante);
! 1426:
! 1427: if (instruction_majuscule == NULL)
! 1428: {
! 1429: return;
! 1430: }
! 1431:
! 1432: /*
! 1433: * Traitement de la pile système par les
! 1434: * différentes instructions.
! 1435: */
! 1436:
! 1437: if ((strcmp(instruction_majuscule, "IF") == 0) ||
! 1438: (strcmp(instruction_majuscule, "IFERR") == 0) ||
! 1439: (strcmp(instruction_majuscule, "DO") == 0) ||
! 1440: (strcmp(instruction_majuscule, "WHILE") == 0) ||
! 1441: (strcmp(instruction_majuscule, "FOR") == 0) ||
! 1442: (strcmp(instruction_majuscule, "START") == 0) ||
! 1443: (strcmp(instruction_majuscule, "SELECT") == 0)
! 1444: || (strcmp(instruction_majuscule, "CASE") == 0)
! 1445: || (strcmp(instruction_majuscule, "<<") == 0))
! 1446: {
! 1447: if (strcmp(instruction_majuscule, "<<") == 0)
! 1448: {
! 1449: analyse(s_etat_processus, NULL);
! 1450: }
! 1451: else
! 1452: {
! 1453: if ((strcmp(instruction_majuscule, "FOR") == 0) ||
! 1454: (strcmp(instruction_majuscule, "START")
! 1455: == 0))
! 1456: {
! 1457: niveau++;
! 1458: }
! 1459:
! 1460: empilement_pile_systeme(s_etat_processus);
! 1461:
! 1462: if ((*s_etat_processus).erreur_systeme != d_es)
! 1463: {
! 1464: return;
! 1465: }
! 1466: }
! 1467: }
! 1468: else if ((strcmp(instruction_majuscule, "END") == 0) ||
! 1469: (strcmp(instruction_majuscule, "NEXT") == 0) ||
! 1470: (strcmp(instruction_majuscule, "STEP") == 0) ||
! 1471: (strcmp(instruction_majuscule, ">>") == 0))
! 1472: {
! 1473: if (strcmp(instruction_majuscule, ">>") == 0)
! 1474: {
! 1475: analyse(s_etat_processus, NULL);
! 1476:
! 1477: if ((*s_etat_processus).retour_routine_evaluation
! 1478: == 'Y')
! 1479: {
! 1480: drapeau_presence_fin_boucle = d_faux;
! 1481: free((*s_etat_processus).instruction_courante);
! 1482:
! 1483: break;
! 1484: }
! 1485: }
! 1486: else
! 1487: {
! 1488: if ((strcmp(instruction_majuscule, "NEXT") == 0) ||
! 1489: (strcmp(instruction_majuscule, "STEP")
! 1490: == 0))
! 1491: {
! 1492: niveau--;
! 1493:
! 1494: if (niveau != 0)
! 1495: {
! 1496: depilement_pile_systeme(s_etat_processus);
! 1497: }
! 1498: }
! 1499: else
! 1500: {
! 1501: depilement_pile_systeme(s_etat_processus);
! 1502: }
! 1503:
! 1504: if ((*s_etat_processus).erreur_systeme != d_es)
! 1505: {
! 1506: return;
! 1507: }
! 1508: }
! 1509: }
! 1510: }
! 1511:
! 1512: free((*s_etat_processus).instruction_courante);
! 1513: }
! 1514: }
! 1515: else
! 1516: {
! 1517: while(!((strcmp(instruction_majuscule, "END") == 0) &&
! 1518: (niveau == 0)))
! 1519: {
! 1520: free(instruction_majuscule);
! 1521:
! 1522: erreur = recherche_instruction_suivante(s_etat_processus);
! 1523:
! 1524: if (erreur == d_erreur)
! 1525: {
! 1526: return;
! 1527: }
! 1528:
! 1529: if (recherche_variable(s_etat_processus,
! 1530: (*s_etat_processus).instruction_courante) == d_vrai)
! 1531: {
! 1532: instruction_majuscule = conversion_majuscule("");
! 1533:
! 1534: if ((*s_etat_processus).s_liste_variables
! 1535: [(*s_etat_processus).position_variable_courante]
! 1536: .objet == NULL)
! 1537: {
! 1538: if (pthread_mutex_lock(&((*(*s_etat_processus)
! 1539: .s_liste_variables_partagees).mutex)) != 0)
! 1540: {
! 1541: (*s_etat_processus).erreur_systeme =
! 1542: d_es_processus;
! 1543: return;
! 1544: }
! 1545:
! 1546: if (recherche_variable_partagee(s_etat_processus,
! 1547: (*s_etat_processus).s_liste_variables
! 1548: [(*s_etat_processus).position_variable_courante]
! 1549: .nom, (*s_etat_processus).s_liste_variables
! 1550: [(*s_etat_processus).position_variable_courante]
! 1551: .variable_partagee,
! 1552: (*s_etat_processus).s_liste_variables
! 1553: [(*s_etat_processus).position_variable_courante]
! 1554: .origine) == d_vrai)
! 1555: {
! 1556: if ((*((*s_etat_processus).s_liste_variables
! 1557: [(*s_etat_processus)
! 1558: .position_variable_courante]).objet).type
! 1559: == ADR)
! 1560: {
! 1561: empilement_pile_systeme(s_etat_processus);
! 1562:
! 1563: if ((*s_etat_processus).erreur_systeme != d_es)
! 1564: {
! 1565: if (pthread_mutex_unlock(
! 1566: &((*(*s_etat_processus)
! 1567: .s_liste_variables_partagees)
! 1568: .mutex)) != 0)
! 1569: {
! 1570: (*s_etat_processus).erreur_systeme =
! 1571: d_es_processus;
! 1572: return;
! 1573: }
! 1574:
! 1575: return;
! 1576: }
! 1577:
! 1578: (*(*s_etat_processus).l_base_pile_systeme)
! 1579: .adresse_retour =
! 1580: (*s_etat_processus).position_courante;
! 1581:
! 1582: (*(*s_etat_processus).l_base_pile_systeme)
! 1583: .retour_definition = 'Y';
! 1584: (*(*s_etat_processus).l_base_pile_systeme)
! 1585: .niveau_courant =
! 1586: (*s_etat_processus).niveau_courant;
! 1587:
! 1588: (*s_etat_processus).position_courante =
! 1589: (*((unsigned long *)
! 1590: ((*((*s_etat_processus)
! 1591: .s_liste_variables[(*s_etat_processus)
! 1592: .position_variable_courante].objet))
! 1593: .objet)));
! 1594:
! 1595: (*s_etat_processus)
! 1596: .autorisation_empilement_programme
! 1597: = 'N';
! 1598: }
! 1599: }
! 1600: else
! 1601: {
! 1602: (*s_etat_processus).erreur_systeme = d_es;
! 1603: }
! 1604:
! 1605: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 1606: .s_liste_variables_partagees).mutex)) != 0)
! 1607: {
! 1608: (*s_etat_processus).erreur_systeme =
! 1609: d_es_processus;
! 1610: return;
! 1611: }
! 1612: }
! 1613: else
! 1614: {
! 1615: if ((*((*s_etat_processus).s_liste_variables
! 1616: [(*s_etat_processus)
! 1617: .position_variable_courante]).objet).type
! 1618: == ADR)
! 1619: {
! 1620: empilement_pile_systeme(s_etat_processus);
! 1621:
! 1622: if ((*s_etat_processus).erreur_systeme != d_es)
! 1623: {
! 1624: return;
! 1625: }
! 1626:
! 1627: (*(*s_etat_processus).l_base_pile_systeme)
! 1628: .adresse_retour =
! 1629: (*s_etat_processus).position_courante;
! 1630:
! 1631: (*(*s_etat_processus).l_base_pile_systeme)
! 1632: .retour_definition = 'Y';
! 1633: (*(*s_etat_processus).l_base_pile_systeme)
! 1634: .niveau_courant =
! 1635: (*s_etat_processus).niveau_courant;
! 1636:
! 1637: (*s_etat_processus).position_courante =
! 1638: (*((unsigned long *) ((*((*s_etat_processus)
! 1639: .s_liste_variables[(*s_etat_processus)
! 1640: .position_variable_courante].objet))
! 1641: .objet)));
! 1642:
! 1643: (*s_etat_processus)
! 1644: .autorisation_empilement_programme
! 1645: = 'N';
! 1646: }
! 1647: }
! 1648: }
! 1649: else
! 1650: {
! 1651: (*s_etat_processus).erreur_systeme = d_es;
! 1652: instruction_majuscule = conversion_majuscule(
! 1653: (*s_etat_processus).instruction_courante);
! 1654:
! 1655: if (instruction_majuscule == NULL)
! 1656: {
! 1657: return;
! 1658: }
! 1659:
! 1660: /*
! 1661: * Traitement de la pile système par les
! 1662: * différentes instructions.
! 1663: */
! 1664:
! 1665: if ((strcmp(instruction_majuscule, "IF") == 0) ||
! 1666: (strcmp(instruction_majuscule, "IFERR") == 0) ||
! 1667: (strcmp(instruction_majuscule, "DO") == 0) ||
! 1668: (strcmp(instruction_majuscule, "WHILE") == 0) ||
! 1669: (strcmp(instruction_majuscule, "FOR") == 0) ||
! 1670: (strcmp(instruction_majuscule, "START") == 0) ||
! 1671: (strcmp(instruction_majuscule, "SELECT") == 0)
! 1672: || (strcmp(instruction_majuscule, "CASE") == 0)
! 1673: || (strcmp(instruction_majuscule, "<<") == 0))
! 1674: {
! 1675: if (strcmp(instruction_majuscule, "<<") == 0)
! 1676: {
! 1677: analyse(s_etat_processus, NULL);
! 1678: }
! 1679: else
! 1680: {
! 1681: if ((strcmp(instruction_majuscule, "DO") == 0) ||
! 1682: (strcmp(instruction_majuscule, "WHILE")
! 1683: == 0))
! 1684: {
! 1685: niveau++;
! 1686: }
! 1687:
! 1688: empilement_pile_systeme(s_etat_processus);
! 1689:
! 1690: if ((*s_etat_processus).erreur_systeme != d_es)
! 1691: {
! 1692: return;
! 1693: }
! 1694: }
! 1695: }
! 1696: else if ((strcmp(instruction_majuscule, "END") == 0) ||
! 1697: (strcmp(instruction_majuscule, "NEXT") == 0) ||
! 1698: (strcmp(instruction_majuscule, "STEP") == 0) ||
! 1699: (strcmp(instruction_majuscule, ">>") == 0))
! 1700: {
! 1701: if (strcmp(instruction_majuscule, ">>") == 0)
! 1702: {
! 1703: analyse(s_etat_processus, NULL);
! 1704:
! 1705: if ((*s_etat_processus).retour_routine_evaluation
! 1706: == 'Y')
! 1707: {
! 1708: drapeau_presence_fin_boucle = d_faux;
! 1709: free((*s_etat_processus).instruction_courante);
! 1710:
! 1711: break;
! 1712: }
! 1713: }
! 1714: else
! 1715: {
! 1716: if (strcmp(instruction_majuscule, "END") == 0)
! 1717: {
! 1718: if (((*(*s_etat_processus).l_base_pile_systeme)
! 1719: .type_cloture == 'D') ||
! 1720: ((*(*s_etat_processus)
! 1721: .l_base_pile_systeme).type_cloture
! 1722: == 'W'))
! 1723: {
! 1724: niveau--;
! 1725: }
! 1726:
! 1727: depilement_pile_systeme(s_etat_processus);
! 1728: }
! 1729: else
! 1730: {
! 1731: depilement_pile_systeme(s_etat_processus);
! 1732: }
! 1733:
! 1734: if ((*s_etat_processus).erreur_systeme != d_es)
! 1735: {
! 1736: return;
! 1737: }
! 1738: }
! 1739: }
! 1740: }
! 1741:
! 1742: free((*s_etat_processus).instruction_courante);
! 1743: }
! 1744: }
! 1745:
! 1746: if (drapeau_presence_fin_boucle == d_faux)
! 1747: {
! 1748: (*s_etat_processus).traitement_cycle_exit = 'E';
! 1749: }
! 1750: else
! 1751: {
! 1752: (*s_etat_processus).traitement_cycle_exit = 'N';
! 1753: }
! 1754:
! 1755: free(instruction_majuscule);
! 1756: (*s_etat_processus).instruction_courante = tampon;
! 1757: }
! 1758: else
! 1759: {
! 1760: /* EXIT apparaissant dans l'évaluation d'une expression */
! 1761:
! 1762: drapeau_presence_fin_boucle = d_faux;
! 1763: instruction_majuscule = NULL;
! 1764: niveau = 1;
! 1765:
! 1766: if (drapeau_boucle_definie == d_vrai)
! 1767: {
! 1768: while((*s_etat_processus).expression_courante != NULL)
! 1769: {
! 1770: while((*(*(*s_etat_processus).expression_courante)
! 1771: .donnee).type != FCT)
! 1772: {
! 1773: if ((*s_etat_processus).expression_courante == NULL)
! 1774: {
! 1775: (*s_etat_processus).erreur_execution =
! 1776: d_ex_erreur_traitement_boucle;
! 1777: return;
! 1778: }
! 1779:
! 1780: (*s_etat_processus).expression_courante =
! 1781: (*(*s_etat_processus).expression_courante).suivant;
! 1782: }
! 1783:
! 1784: fonction = (*((struct_fonction *) (*(*(*s_etat_processus)
! 1785: .expression_courante).donnee).objet)).fonction;
! 1786:
! 1787: if ((fonction == instruction_if) ||
! 1788: (fonction == instruction_iferr) ||
! 1789: (fonction == instruction_do) ||
! 1790: (fonction == instruction_while) ||
! 1791: (fonction == instruction_for) ||
! 1792: (fonction == instruction_start) ||
! 1793: (fonction == instruction_select) ||
! 1794: (fonction == instruction_case) ||
! 1795: (fonction == instruction_vers_niveau_superieur))
! 1796: {
! 1797: if (fonction == instruction_vers_niveau_superieur)
! 1798: {
! 1799: analyse(s_etat_processus,
! 1800: instruction_vers_niveau_superieur);
! 1801: }
! 1802: else
! 1803: {
! 1804: if ((fonction == instruction_for) ||
! 1805: (fonction == instruction_start))
! 1806: {
! 1807: niveau++;
! 1808: }
! 1809:
! 1810: empilement_pile_systeme(s_etat_processus);
! 1811:
! 1812: if ((*s_etat_processus).erreur_systeme != d_es)
! 1813: {
! 1814: return;
! 1815: }
! 1816: }
! 1817: }
! 1818: else if ((fonction == instruction_end) ||
! 1819: (fonction == instruction_next) ||
! 1820: (fonction == instruction_step) ||
! 1821: (fonction == instruction_vers_niveau_inferieur))
! 1822: {
! 1823: if (fonction == instruction_vers_niveau_inferieur)
! 1824: {
! 1825: tampon = (*s_etat_processus).instruction_courante;
! 1826: (*s_etat_processus).instruction_courante =
! 1827: instruction_majuscule;
! 1828:
! 1829: analyse(s_etat_processus,
! 1830: instruction_vers_niveau_inferieur);
! 1831:
! 1832: (*s_etat_processus).instruction_courante = tampon;
! 1833: }
! 1834: else
! 1835: {
! 1836: if ((fonction == instruction_next) ||
! 1837: (fonction == instruction_step))
! 1838: {
! 1839: niveau--;
! 1840:
! 1841: if (niveau != 0)
! 1842: {
! 1843: depilement_pile_systeme(s_etat_processus);
! 1844: }
! 1845: else
! 1846: {
! 1847: drapeau_presence_fin_boucle = d_vrai;
! 1848: break;
! 1849: }
! 1850: }
! 1851: else
! 1852: {
! 1853: depilement_pile_systeme(s_etat_processus);
! 1854: }
! 1855:
! 1856: if ((*s_etat_processus).erreur_systeme != d_es)
! 1857: {
! 1858: return;
! 1859: }
! 1860: }
! 1861: }
! 1862:
! 1863: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
! 1864: .expression_courante).suivant;
! 1865: }
! 1866: }
! 1867: else
! 1868: {
! 1869: while((*s_etat_processus).expression_courante != NULL)
! 1870: {
! 1871: while((*(*(*s_etat_processus).expression_courante)
! 1872: .donnee).type != FCT)
! 1873: {
! 1874: if ((*s_etat_processus).expression_courante == NULL)
! 1875: {
! 1876: (*s_etat_processus).erreur_execution =
! 1877: d_ex_erreur_traitement_boucle;
! 1878: return;
! 1879: }
! 1880:
! 1881: (*s_etat_processus).expression_courante =
! 1882: (*(*s_etat_processus).expression_courante).suivant;
! 1883: }
! 1884:
! 1885: fonction = (*((struct_fonction *) (*(*(*s_etat_processus)
! 1886: .expression_courante).donnee).objet)).fonction;
! 1887:
! 1888: if ((fonction == instruction_if) ||
! 1889: (fonction == instruction_iferr) ||
! 1890: (fonction == instruction_do) ||
! 1891: (fonction == instruction_while) ||
! 1892: (fonction == instruction_for) ||
! 1893: (fonction == instruction_start) ||
! 1894: (fonction == instruction_select) ||
! 1895: (fonction == instruction_case) ||
! 1896: (fonction == instruction_vers_niveau_superieur))
! 1897: {
! 1898: if (fonction == instruction_vers_niveau_superieur)
! 1899: {
! 1900: analyse(s_etat_processus,
! 1901: instruction_vers_niveau_superieur);
! 1902: }
! 1903: else
! 1904: {
! 1905: if ((fonction == instruction_do) ||
! 1906: (fonction == instruction_while))
! 1907: {
! 1908: niveau++;
! 1909: }
! 1910:
! 1911: empilement_pile_systeme(s_etat_processus);
! 1912:
! 1913: if ((*s_etat_processus).erreur_systeme != d_es)
! 1914: {
! 1915: return;
! 1916: }
! 1917: }
! 1918: }
! 1919: else if ((fonction == instruction_end) ||
! 1920: (fonction == instruction_next) ||
! 1921: (fonction == instruction_step) ||
! 1922: (fonction == instruction_vers_niveau_inferieur))
! 1923: {
! 1924: if (fonction == instruction_vers_niveau_inferieur)
! 1925: {
! 1926: analyse(s_etat_processus,
! 1927: instruction_vers_niveau_inferieur);
! 1928: }
! 1929: else
! 1930: {
! 1931: if (fonction == instruction_end)
! 1932: {
! 1933: if (((*(*s_etat_processus).l_base_pile_systeme)
! 1934: .type_cloture == 'D') ||
! 1935: ((*(*s_etat_processus).l_base_pile_systeme)
! 1936: .type_cloture == 'W'))
! 1937: {
! 1938: niveau--;
! 1939: }
! 1940:
! 1941: depilement_pile_systeme(s_etat_processus);
! 1942:
! 1943: if (niveau == 0)
! 1944: {
! 1945: drapeau_presence_fin_boucle = d_vrai;
! 1946: break;
! 1947: }
! 1948: }
! 1949: else
! 1950: {
! 1951: depilement_pile_systeme(s_etat_processus);
! 1952: }
! 1953:
! 1954: if ((*s_etat_processus).erreur_systeme != d_es)
! 1955: {
! 1956: return;
! 1957: }
! 1958: }
! 1959: }
! 1960:
! 1961: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
! 1962: .expression_courante).suivant;
! 1963: }
! 1964: }
! 1965:
! 1966: if (drapeau_presence_fin_boucle == d_faux)
! 1967: {
! 1968: (*s_etat_processus).traitement_cycle_exit = 'E';
! 1969: }
! 1970: else
! 1971: {
! 1972: (*s_etat_processus).traitement_cycle_exit = 'N';
! 1973: }
! 1974: }
! 1975:
! 1976: if ((drapeau_boucle_definie == d_vrai) &&
! 1977: (drapeau_presence_fin_boucle == d_vrai))
! 1978: {
! 1979: presence_compteur = ((*(*s_etat_processus).l_base_pile_systeme)
! 1980: .type_cloture == 'F') ? d_vrai : d_faux;
! 1981:
! 1982: if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'S')
! 1983: && (presence_compteur == d_faux))
! 1984: {
! 1985: (*s_etat_processus).erreur_execution =
! 1986: d_ex_erreur_traitement_boucle;
! 1987: return;
! 1988: }
! 1989:
! 1990: depilement_pile_systeme(s_etat_processus);
! 1991:
! 1992: if ((*s_etat_processus).erreur_systeme != d_es)
! 1993: {
! 1994: return;
! 1995: }
! 1996:
! 1997: if (presence_compteur == d_vrai)
! 1998: {
! 1999: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
! 2000: (*s_etat_processus).niveau_courant--;
! 2001:
! 2002: if (retrait_variable_par_niveau(s_etat_processus) == d_erreur)
! 2003: {
! 2004: return;
! 2005: }
! 2006: }
! 2007: }
! 2008:
! 2009: return;
! 2010: }
! 2011:
! 2012: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_e2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src