Annotation of rpl/src/instructions_s1.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 'swap'
! 29: ================================================================================
! 30: Entrées : structure processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_swap(struct_processus *s_etat_processus)
! 40: {
! 41: struct_liste_chainee *l_liste;
! 42:
! 43: (*s_etat_processus).erreur_execution = d_ex;
! 44:
! 45: if ((*s_etat_processus).affichage_arguments == 'Y')
! 46: {
! 47: printf("\n SWAP ");
! 48:
! 49: if ((*s_etat_processus).langue == 'F')
! 50: {
! 51: printf("(inversion de deux objets)\n\n");
! 52: }
! 53: else
! 54: {
! 55: printf("(swap two objects)\n\n");
! 56: }
! 57:
! 58: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 59: " %s, %s, %s, %s, %s,\n"
! 60: " %s, %s, %s, %s, %s,\n"
! 61: " %s, %s, %s, %s, %s,\n"
! 62: " %s\n",
! 63: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 64: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 65: d_SLB, d_PRC, d_MTX, d_SQL);
! 66: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 67: " %s, %s, %s, %s, %s,\n"
! 68: " %s, %s, %s, %s, %s,\n"
! 69: " %s, %s, %s, %s, %s,\n"
! 70: " %s\n",
! 71: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 72: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 73: d_SLB, d_PRC, d_MTX, d_SQL);
! 74: printf("-> 2: %s, %s, %s, %s, %s, %s,\n"
! 75: " %s, %s, %s, %s, %s,\n"
! 76: " %s, %s, %s, %s, %s,\n"
! 77: " %s, %s, %s, %s, %s,\n"
! 78: " %s\n",
! 79: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 80: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 81: d_SLB, d_PRC, d_MTX, d_SQL);
! 82: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 83: " %s, %s, %s, %s, %s,\n"
! 84: " %s, %s, %s, %s, %s,\n"
! 85: " %s, %s, %s, %s, %s,\n"
! 86: " %s\n",
! 87: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 88: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 89: d_SLB, d_PRC, d_MTX, d_SQL);
! 90:
! 91: return;
! 92: }
! 93: else if ((*s_etat_processus).test_instruction == 'Y')
! 94: {
! 95: (*s_etat_processus).nombre_arguments = -1;
! 96: return;
! 97: }
! 98:
! 99: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 100: {
! 101: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 102: {
! 103: return;
! 104: }
! 105: }
! 106:
! 107: if ((*s_etat_processus).hauteur_pile_operationnelle < 2)
! 108: {
! 109: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 110: return;
! 111: }
! 112:
! 113: l_liste = (*s_etat_processus).l_base_pile;
! 114: (*s_etat_processus).l_base_pile = (*l_liste).suivant;
! 115: (*l_liste).suivant = (*(*s_etat_processus).l_base_pile).suivant;
! 116: (*(*s_etat_processus).l_base_pile).suivant = l_liste;
! 117:
! 118: return;
! 119: }
! 120:
! 121:
! 122: /*
! 123: ================================================================================
! 124: Fonction 'sq'
! 125: ================================================================================
! 126: Entrées : pointeur sur une struct_processus
! 127: --------------------------------------------------------------------------------
! 128: Sorties :
! 129: --------------------------------------------------------------------------------
! 130: Effets de bord : néant
! 131: ================================================================================
! 132: */
! 133:
! 134: void
! 135: instruction_sq(struct_processus *s_etat_processus)
! 136: {
! 137: integer8 a;
! 138: integer8 r;
! 139:
! 140: logical1 depassement;
! 141: logical1 erreur_memoire;
! 142:
! 143: struct_liste_chainee *l_element_courant;
! 144: struct_liste_chainee *l_element_precedent;
! 145:
! 146: struct_objet *s_copie_argument;
! 147: struct_objet *s_objet_argument;
! 148: struct_objet *s_objet_resultat;
! 149:
! 150: unsigned long i;
! 151: unsigned long j;
! 152: unsigned long k;
! 153:
! 154: void *accumulateur;
! 155:
! 156: (*s_etat_processus).erreur_execution = d_ex;
! 157:
! 158: if ((*s_etat_processus).affichage_arguments == 'Y')
! 159: {
! 160: printf("\n SQ ");
! 161:
! 162: if ((*s_etat_processus).langue == 'F')
! 163: {
! 164: printf("(élevation au carré)\n\n");
! 165: }
! 166: else
! 167: {
! 168: printf("(square)\n\n");
! 169: }
! 170:
! 171: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 172: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
! 173:
! 174: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 175: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
! 176:
! 177: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 178: printf("-> 1: %s\n\n", d_ALG);
! 179:
! 180: printf(" 1: %s\n", d_RPN);
! 181: printf("-> 1: %s\n", d_RPN);
! 182:
! 183: return;
! 184: }
! 185: else if ((*s_etat_processus).test_instruction == 'Y')
! 186: {
! 187: (*s_etat_processus).nombre_arguments = 1;
! 188: return;
! 189: }
! 190:
! 191: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 192: {
! 193: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 194: {
! 195: return;
! 196: }
! 197: }
! 198:
! 199: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 200: &s_objet_argument) == d_erreur)
! 201: {
! 202: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 203: return;
! 204: }
! 205:
! 206: /*
! 207: --------------------------------------------------------------------------------
! 208: Carré d'un entier
! 209: --------------------------------------------------------------------------------
! 210: */
! 211:
! 212: if ((*s_objet_argument).type == INT)
! 213: {
! 214: a = (*((integer8 *) (*s_objet_argument).objet));
! 215:
! 216: if (depassement_multiplication(&a, &a, &r) == d_absence_erreur)
! 217: {
! 218: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 219: == NULL)
! 220: {
! 221: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 222: return;
! 223: }
! 224:
! 225: (*((integer8 *) (*s_objet_resultat).objet)) = r;
! 226: }
! 227: else
! 228: {
! 229: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 230: == NULL)
! 231: {
! 232: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 233: return;
! 234: }
! 235:
! 236: (*((real8 *) (*s_objet_resultat).objet)) =
! 237: ((double) (*((integer8 *) (*s_objet_argument).objet))) *
! 238: ((double) (*((integer8 *) (*s_objet_argument).objet)));
! 239: }
! 240: }
! 241:
! 242: /*
! 243: --------------------------------------------------------------------------------
! 244: Carré d'un réel
! 245: --------------------------------------------------------------------------------
! 246: */
! 247:
! 248: else if ((*s_objet_argument).type == REL)
! 249: {
! 250: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 251: {
! 252: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 253: return;
! 254: }
! 255:
! 256: (*((real8 *) (*s_objet_resultat).objet)) =
! 257: (*((real8 *) (*s_objet_argument).objet)) *
! 258: (*((real8 *) (*s_objet_argument).objet));
! 259: }
! 260:
! 261: /*
! 262: --------------------------------------------------------------------------------
! 263: Carré d'un complexe
! 264: --------------------------------------------------------------------------------
! 265: */
! 266:
! 267: else if ((*s_objet_argument).type == CPL)
! 268: {
! 269: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
! 270: {
! 271: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 272: return;
! 273: }
! 274:
! 275: f77multiplicationcc_(&((*((struct_complexe16 *)
! 276: (*s_objet_argument).objet))), &((*((struct_complexe16 *)
! 277: (*s_objet_argument).objet))), &((*((struct_complexe16 *)
! 278: (*s_objet_resultat).objet))));
! 279: }
! 280:
! 281: /*
! 282: --------------------------------------------------------------------------------
! 283: Carré d'une matrice entière
! 284: --------------------------------------------------------------------------------
! 285: */
! 286:
! 287: else if ((*s_objet_argument).type == MIN)
! 288: {
! 289: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
! 290: (*((struct_matrice *) (*s_objet_argument).objet))
! 291: .nombre_colonnes)
! 292: {
! 293: liberation(s_etat_processus, s_objet_argument);
! 294:
! 295: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 296: return;
! 297: }
! 298:
! 299: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
! 300: {
! 301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 302: return;
! 303: }
! 304:
! 305: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 306: (*(((struct_matrice *) (*s_objet_argument)
! 307: .objet))).nombre_lignes;
! 308: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 309: (*(((struct_matrice *) (*s_objet_argument)
! 310: .objet))).nombre_colonnes;
! 311:
! 312: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 313: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 314: .objet))).nombre_lignes * sizeof(integer8 *))) == NULL)
! 315: {
! 316: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 317: return;
! 318: }
! 319:
! 320: depassement = d_faux;
! 321:
! 322: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
! 323: .objet))).nombre_lignes; i++)
! 324: {
! 325: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
! 326: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 327: .objet))).nombre_colonnes * sizeof(integer8))) == NULL)
! 328: {
! 329: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 330: return;
! 331: }
! 332:
! 333: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
! 334: .objet))).nombre_colonnes; j++)
! 335: {
! 336: ((integer8 **) (*((struct_matrice *)
! 337: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
! 338:
! 339: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
! 340: .objet))).nombre_colonnes; k++)
! 341: {
! 342: if (depassement_multiplication(&(((integer8 **)
! 343: (*((struct_matrice *) (*s_objet_argument).objet))
! 344: .tableau)[i][k]), &(((integer8 **)
! 345: (*((struct_matrice *) (*s_objet_argument).objet))
! 346: .tableau)[k][j]), &a) == d_erreur)
! 347: {
! 348: depassement = d_vrai;
! 349: }
! 350:
! 351: if (depassement_addition(&(((integer8 **)
! 352: (*((struct_matrice *) (*s_objet_resultat).objet))
! 353: .tableau)[i][j]), &a, &r) == d_erreur)
! 354: {
! 355: depassement = d_vrai;
! 356: }
! 357:
! 358: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 359: .objet)).tableau)[i][j] = r;
! 360: }
! 361: }
! 362: }
! 363:
! 364: if (depassement == d_vrai)
! 365: {
! 366: (*s_objet_resultat).type = MRL;
! 367: (*((struct_matrice *) (*s_objet_resultat).objet)).type = 'R';
! 368:
! 369: if ((accumulateur = malloc((*(((struct_matrice *)
! 370: (*s_objet_argument).objet))).nombre_colonnes *
! 371: sizeof(real8))) == NULL)
! 372: {
! 373: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 374: return;
! 375: }
! 376:
! 377: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
! 378: .objet))).nombre_lignes; i++)
! 379: {
! 380: free(((integer8 **) (*((struct_matrice *)
! 381: (*s_objet_resultat).objet)).tableau)[i]);
! 382:
! 383: if (((*((struct_matrice *) (*s_objet_resultat).objet))
! 384: .tableau[i] = malloc((*(((struct_matrice *)
! 385: (*s_objet_resultat).objet))).nombre_colonnes *
! 386: sizeof(real8))) == NULL)
! 387: {
! 388: (*s_etat_processus).erreur_systeme =
! 389: d_es_allocation_memoire;
! 390: return;
! 391: }
! 392:
! 393: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
! 394: .objet))).nombre_colonnes; j++)
! 395: {
! 396: ((real8 **) (*((struct_matrice *)
! 397: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
! 398:
! 399: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
! 400: .objet))).nombre_colonnes; k++)
! 401: {
! 402: ((real8 *) accumulateur)[k] = ((real8)
! 403: (((integer8 **) (*((struct_matrice *)
! 404: (*s_objet_argument).objet)).tableau)[i][k]) *
! 405: ((real8) ((integer8 **) (*((struct_matrice *)
! 406: (*s_objet_argument).objet)).tableau)[k][j]));
! 407: }
! 408:
! 409: ((real8 **) (*((struct_matrice *)
! 410: (*s_objet_resultat).objet)).tableau)[i][j] =
! 411: sommation_vecteur_reel(accumulateur,
! 412: &((*(((struct_matrice *) (*s_objet_argument)
! 413: .objet))).nombre_colonnes), &erreur_memoire);
! 414:
! 415: if (erreur_memoire == d_vrai)
! 416: {
! 417: (*s_etat_processus).erreur_systeme =
! 418: d_es_allocation_memoire;
! 419: return;
! 420: }
! 421: }
! 422: }
! 423:
! 424: free(accumulateur);
! 425: }
! 426: }
! 427:
! 428: /*
! 429: --------------------------------------------------------------------------------
! 430: Carré d'une matrice réelle
! 431: --------------------------------------------------------------------------------
! 432: */
! 433:
! 434: else if ((*s_objet_argument).type == MRL)
! 435: {
! 436: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
! 437: (*((struct_matrice *) (*s_objet_argument).objet))
! 438: .nombre_colonnes)
! 439: {
! 440: liberation(s_etat_processus, s_objet_argument);
! 441:
! 442: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 443: return;
! 444: }
! 445:
! 446: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
! 447: {
! 448: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 449: return;
! 450: }
! 451:
! 452: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 453: (*(((struct_matrice *) (*s_objet_argument)
! 454: .objet))).nombre_lignes;
! 455: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 456: (*(((struct_matrice *) (*s_objet_argument)
! 457: .objet))).nombre_colonnes;
! 458:
! 459: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 460: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 461: .objet))).nombre_lignes * sizeof(real8 *))) == NULL)
! 462: {
! 463: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 464: return;
! 465: }
! 466:
! 467: if ((accumulateur = malloc((*(((struct_matrice *)
! 468: (*s_objet_argument).objet))).nombre_colonnes * sizeof(real8)))
! 469: == NULL)
! 470: {
! 471: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 472: return;
! 473: }
! 474:
! 475: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
! 476: .objet))).nombre_lignes; i++)
! 477: {
! 478: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
! 479: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 480: .objet))).nombre_colonnes * sizeof(real8))) == NULL)
! 481: {
! 482: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 483: return;
! 484: }
! 485:
! 486: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
! 487: .objet))).nombre_colonnes; j++)
! 488: {
! 489: ((real8 **) (*((struct_matrice *)
! 490: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
! 491:
! 492: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
! 493: .objet))).nombre_colonnes; k++)
! 494: {
! 495: ((real8 *) accumulateur)[k] =
! 496: (((real8 **) (*((struct_matrice *)
! 497: (*s_objet_argument).objet)).tableau)[i][k] *
! 498: ((real8 **) (*((struct_matrice *)
! 499: (*s_objet_argument).objet)).tableau)[k][j]);
! 500: }
! 501:
! 502: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
! 503: .tableau)[i][j] = sommation_vecteur_reel(
! 504: accumulateur, &((*(((struct_matrice *)
! 505: (*s_objet_argument).objet))).nombre_colonnes),
! 506: &erreur_memoire);
! 507:
! 508: if (erreur_memoire == d_vrai)
! 509: {
! 510: (*s_etat_processus).erreur_systeme =
! 511: d_es_allocation_memoire;
! 512: return;
! 513: }
! 514: }
! 515: }
! 516:
! 517: free(accumulateur);
! 518: }
! 519:
! 520: /*
! 521: --------------------------------------------------------------------------------
! 522: Carré d'une matrice complexe
! 523: --------------------------------------------------------------------------------
! 524: */
! 525:
! 526: else if ((*s_objet_argument).type == MCX)
! 527: {
! 528: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
! 529: (*((struct_matrice *) (*s_objet_argument).objet))
! 530: .nombre_colonnes)
! 531: {
! 532: liberation(s_etat_processus, s_objet_argument);
! 533:
! 534: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 535: return;
! 536: }
! 537:
! 538: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 539: {
! 540: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 541: return;
! 542: }
! 543:
! 544: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 545: (*(((struct_matrice *) (*s_objet_argument)
! 546: .objet))).nombre_lignes;
! 547: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 548: (*(((struct_matrice *) (*s_objet_argument)
! 549: .objet))).nombre_colonnes;
! 550:
! 551: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 552: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 553: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
! 554: {
! 555: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 556: return;
! 557: }
! 558:
! 559: if ((accumulateur = malloc((*(((struct_matrice *)
! 560: (*s_objet_argument).objet))).nombre_colonnes *
! 561: sizeof(complex16))) == NULL)
! 562: {
! 563: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 564: return;
! 565: }
! 566:
! 567: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
! 568: .objet))).nombre_lignes; i++)
! 569: {
! 570: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
! 571: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 572: .objet))).nombre_colonnes * sizeof(struct_complexe16)))
! 573: == NULL)
! 574: {
! 575: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 576: return;
! 577: }
! 578:
! 579: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
! 580: .objet))).nombre_colonnes; j++)
! 581: {
! 582: ((struct_complexe16 **) (*((struct_matrice *)
! 583: (*s_objet_resultat).objet)).tableau)[i][j]
! 584: .partie_reelle = 0;
! 585: ((struct_complexe16 **) (*((struct_matrice *)
! 586: (*s_objet_resultat).objet)).tableau)[i][j]
! 587: .partie_imaginaire = 0;
! 588:
! 589: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
! 590: .objet))).nombre_colonnes; k++)
! 591: {
! 592: f77multiplicationcc_(&(((struct_complexe16 **)
! 593: (*((struct_matrice *) (*s_objet_argument).objet))
! 594: .tableau)[i][k]), &(((struct_complexe16 **)
! 595: (*((struct_matrice *) (*s_objet_argument).objet))
! 596: .tableau)[k][j]), &(((complex16 *)
! 597: accumulateur)[k]));
! 598: }
! 599:
! 600: ((complex16 **) (*((struct_matrice *)
! 601: (*s_objet_resultat).objet)).tableau)[i][j] =
! 602: sommation_vecteur_complexe(accumulateur,
! 603: &((*(((struct_matrice *)
! 604: (*s_objet_argument).objet))).nombre_colonnes),
! 605: &erreur_memoire);
! 606:
! 607: if (erreur_memoire == d_vrai)
! 608: {
! 609: (*s_etat_processus).erreur_systeme =
! 610: d_es_allocation_memoire;
! 611: return;
! 612: }
! 613: }
! 614: }
! 615:
! 616: free(accumulateur);
! 617: }
! 618:
! 619: /*
! 620: --------------------------------------------------------------------------------
! 621: Carré d'un nom
! 622: --------------------------------------------------------------------------------
! 623: */
! 624: else if ((*s_objet_argument).type == NOM)
! 625: {
! 626: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 627: {
! 628: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 629: return;
! 630: }
! 631:
! 632: if (((*s_objet_resultat).objet =
! 633: allocation_maillon(s_etat_processus)) == NULL)
! 634: {
! 635: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 636: return;
! 637: }
! 638:
! 639: l_element_courant = (*s_objet_resultat).objet;
! 640:
! 641: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 642: == NULL)
! 643: {
! 644: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 645: return;
! 646: }
! 647:
! 648: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 649: .nombre_arguments = 0;
! 650: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 651: .fonction = instruction_vers_niveau_superieur;
! 652:
! 653: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 654: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 655: {
! 656: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 657: return;
! 658: }
! 659:
! 660: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 661: .nom_fonction, "<<");
! 662:
! 663: if (((*l_element_courant).suivant =
! 664: allocation_maillon(s_etat_processus)) == NULL)
! 665: {
! 666: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 667: return;
! 668: }
! 669:
! 670: l_element_courant = (*l_element_courant).suivant;
! 671: (*l_element_courant).donnee = s_objet_argument;
! 672:
! 673: if (((*l_element_courant).suivant =
! 674: allocation_maillon(s_etat_processus)) == NULL)
! 675: {
! 676: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 677: return;
! 678: }
! 679:
! 680: l_element_courant = (*l_element_courant).suivant;
! 681:
! 682: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 683: == NULL)
! 684: {
! 685: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 686: return;
! 687: }
! 688:
! 689: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 690: .nombre_arguments = 1;
! 691: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 692: .fonction = instruction_sq;
! 693:
! 694: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 695: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 696: {
! 697: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 698: return;
! 699: }
! 700:
! 701: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 702: .nom_fonction, "SQ");
! 703:
! 704: if (((*l_element_courant).suivant =
! 705: allocation_maillon(s_etat_processus)) == NULL)
! 706: {
! 707: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 708: return;
! 709: }
! 710:
! 711: l_element_courant = (*l_element_courant).suivant;
! 712:
! 713: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 714: == NULL)
! 715: {
! 716: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 717: return;
! 718: }
! 719:
! 720: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 721: .nombre_arguments = 0;
! 722: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 723: .fonction = instruction_vers_niveau_inferieur;
! 724:
! 725: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 726: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 727: {
! 728: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 729: return;
! 730: }
! 731:
! 732: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 733: .nom_fonction, ">>");
! 734:
! 735: (*l_element_courant).suivant = NULL;
! 736: s_objet_argument = NULL;
! 737: }
! 738:
! 739: /*
! 740: --------------------------------------------------------------------------------
! 741: Carré d'une expression
! 742: --------------------------------------------------------------------------------
! 743: */
! 744:
! 745: else if (((*s_objet_argument).type == ALG) ||
! 746: ((*s_objet_argument).type == RPN))
! 747: {
! 748: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
! 749: 'N')) == NULL)
! 750: {
! 751: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 752: return;
! 753: }
! 754:
! 755: l_element_courant = (struct_liste_chainee *)
! 756: (*s_copie_argument).objet;
! 757: l_element_precedent = l_element_courant;
! 758:
! 759: while((*l_element_courant).suivant != NULL)
! 760: {
! 761: l_element_precedent = l_element_courant;
! 762: l_element_courant = (*l_element_courant).suivant;
! 763: }
! 764:
! 765: if (((*l_element_precedent).suivant =
! 766: allocation_maillon(s_etat_processus)) == NULL)
! 767: {
! 768: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 769: return;
! 770: }
! 771:
! 772: if (((*(*l_element_precedent).suivant).donnee =
! 773: allocation(s_etat_processus, FCT)) == NULL)
! 774: {
! 775: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 776: return;
! 777: }
! 778:
! 779: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 780: .donnee).objet)).nombre_arguments = 1;
! 781: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 782: .donnee).objet)).fonction = instruction_sq;
! 783:
! 784: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 785: .suivant).donnee).objet)).nom_fonction =
! 786: malloc(3 * sizeof(unsigned char))) == NULL)
! 787: {
! 788: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 789: return;
! 790: }
! 791:
! 792: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 793: .suivant).donnee).objet)).nom_fonction, "SQ");
! 794:
! 795: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 796:
! 797: s_objet_resultat = s_copie_argument;
! 798: }
! 799:
! 800: /*
! 801: --------------------------------------------------------------------------------
! 802: Carré impossible
! 803: --------------------------------------------------------------------------------
! 804: */
! 805:
! 806: else
! 807: {
! 808: liberation(s_etat_processus, s_objet_argument);
! 809:
! 810: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 811: return;
! 812: }
! 813:
! 814: liberation(s_etat_processus, s_objet_argument);
! 815:
! 816: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 817: s_objet_resultat) == d_erreur)
! 818: {
! 819: return;
! 820: }
! 821:
! 822: return;
! 823: }
! 824:
! 825:
! 826: /*
! 827: ================================================================================
! 828: Fonction 'sqrt'
! 829: ================================================================================
! 830: Entrées : pointeur sur une struct_processus
! 831: --------------------------------------------------------------------------------
! 832: Sorties :
! 833: --------------------------------------------------------------------------------
! 834: Effets de bord : néant
! 835: ================================================================================
! 836: */
! 837:
! 838: void
! 839: instruction_sqrt(struct_processus *s_etat_processus)
! 840: {
! 841: struct_liste_chainee *l_element_courant;
! 842: struct_liste_chainee *l_element_precedent;
! 843:
! 844: struct_objet *s_copie_argument;
! 845: struct_objet *s_objet_argument;
! 846: struct_objet *s_objet_resultat;
! 847:
! 848: (*s_etat_processus).erreur_execution = d_ex;
! 849:
! 850: if ((*s_etat_processus).affichage_arguments == 'Y')
! 851: {
! 852: printf("\n SQRT ");
! 853:
! 854: if ((*s_etat_processus).langue == 'F')
! 855: {
! 856: printf("(racine carrée)\n\n");
! 857: }
! 858: else
! 859: {
! 860: printf("(square root)\n\n");
! 861: }
! 862:
! 863: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 864: printf("-> 1: %s, %s\n\n", d_REL, d_CPL);
! 865:
! 866: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 867: printf("-> 1: %s\n\n", d_ALG);
! 868:
! 869: printf(" 1: %s\n", d_RPN);
! 870: printf("-> 1: %s\n", d_RPN);
! 871:
! 872: return;
! 873: }
! 874: else if ((*s_etat_processus).test_instruction == 'Y')
! 875: {
! 876: (*s_etat_processus).nombre_arguments = 1;
! 877: return;
! 878: }
! 879:
! 880: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 881: {
! 882: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 883: {
! 884: return;
! 885: }
! 886: }
! 887:
! 888: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 889: &s_objet_argument) == d_erreur)
! 890: {
! 891: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 892: return;
! 893: }
! 894:
! 895: /*
! 896: --------------------------------------------------------------------------------
! 897: Racine carrée d'un entier
! 898: --------------------------------------------------------------------------------
! 899: */
! 900:
! 901: if ((*s_objet_argument).type == INT)
! 902: {
! 903: if ((*((integer8 *) (*s_objet_argument).objet)) >= 0)
! 904: {
! 905: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 906: == NULL)
! 907: {
! 908: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 909: return;
! 910: }
! 911:
! 912: f77racinecarreeip_(&((*((integer8 *) (*s_objet_argument).objet))),
! 913: &((*((real8 *) (*s_objet_resultat).objet))));
! 914: }
! 915: else
! 916: {
! 917: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 918: == NULL)
! 919: {
! 920: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 921: return;
! 922: }
! 923:
! 924: f77racinecarreein_(&((*((integer8 *) (*s_objet_argument).objet))),
! 925: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
! 926: }
! 927: }
! 928:
! 929: /*
! 930: --------------------------------------------------------------------------------
! 931: Racine carré d'un réel
! 932: --------------------------------------------------------------------------------
! 933: */
! 934:
! 935: else if ((*s_objet_argument).type == REL)
! 936: {
! 937: if ((*((real8 *) (*s_objet_argument).objet)) >= 0)
! 938: {
! 939: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 940: == NULL)
! 941: {
! 942: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 943: return;
! 944: }
! 945:
! 946: f77racinecarreerp_(&((*((real8 *) (*s_objet_argument).objet))),
! 947: &((*((real8 *) (*s_objet_resultat).objet))));
! 948: }
! 949: else
! 950: {
! 951: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 952: == NULL)
! 953: {
! 954: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 955: return;
! 956: }
! 957:
! 958: f77racinecarreern_(&((*((real8 *) (*s_objet_argument).objet))),
! 959: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
! 960: }
! 961: }
! 962:
! 963: /*
! 964: --------------------------------------------------------------------------------
! 965: Racine carrée d'un complexe
! 966: --------------------------------------------------------------------------------
! 967: */
! 968:
! 969: else if ((*s_objet_argument).type == CPL)
! 970: {
! 971: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
! 972: {
! 973: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 974: return;
! 975: }
! 976:
! 977: f77racinecarreec_(&((*((struct_complexe16 *) (*s_objet_argument)
! 978: .objet))), &((*((struct_complexe16 *) (*s_objet_resultat)
! 979: .objet))));
! 980: }
! 981:
! 982: /*
! 983: --------------------------------------------------------------------------------
! 984: Racine carrée d'un nom
! 985: --------------------------------------------------------------------------------
! 986: */
! 987:
! 988: else if ((*s_objet_argument).type == NOM)
! 989: {
! 990: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 991: {
! 992: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 993: return;
! 994: }
! 995:
! 996: if (((*s_objet_resultat).objet =
! 997: allocation_maillon(s_etat_processus)) == NULL)
! 998: {
! 999: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1000: return;
! 1001: }
! 1002:
! 1003: l_element_courant = (*s_objet_resultat).objet;
! 1004:
! 1005: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1006: == NULL)
! 1007: {
! 1008: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1009: return;
! 1010: }
! 1011:
! 1012: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1013: .nombre_arguments = 0;
! 1014: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1015: .fonction = instruction_vers_niveau_superieur;
! 1016:
! 1017: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1018: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1019: {
! 1020: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1021: return;
! 1022: }
! 1023:
! 1024: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1025: .nom_fonction, "<<");
! 1026:
! 1027: if (((*l_element_courant).suivant =
! 1028: allocation_maillon(s_etat_processus)) == NULL)
! 1029: {
! 1030: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1031: return;
! 1032: }
! 1033:
! 1034: l_element_courant = (*l_element_courant).suivant;
! 1035: (*l_element_courant).donnee = s_objet_argument;
! 1036:
! 1037: if (((*l_element_courant).suivant =
! 1038: allocation_maillon(s_etat_processus)) == NULL)
! 1039: {
! 1040: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1041: return;
! 1042: }
! 1043:
! 1044: l_element_courant = (*l_element_courant).suivant;
! 1045:
! 1046: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1047: == NULL)
! 1048: {
! 1049: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1050: return;
! 1051: }
! 1052:
! 1053: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1054: .nombre_arguments = 1;
! 1055: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1056: .fonction = instruction_sqrt;
! 1057:
! 1058: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1059: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
! 1060: {
! 1061: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1062: return;
! 1063: }
! 1064:
! 1065: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1066: .nom_fonction, "SQRT");
! 1067:
! 1068: if (((*l_element_courant).suivant =
! 1069: allocation_maillon(s_etat_processus)) == NULL)
! 1070: {
! 1071: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1072: return;
! 1073: }
! 1074:
! 1075: l_element_courant = (*l_element_courant).suivant;
! 1076:
! 1077: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1078: == NULL)
! 1079: {
! 1080: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1081: return;
! 1082: }
! 1083:
! 1084: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1085: .nombre_arguments = 0;
! 1086: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1087: .fonction = instruction_vers_niveau_inferieur;
! 1088:
! 1089: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1090: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1091: {
! 1092: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1093: return;
! 1094: }
! 1095:
! 1096: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1097: .nom_fonction, ">>");
! 1098:
! 1099: (*l_element_courant).suivant = NULL;
! 1100: s_objet_argument = NULL;
! 1101: }
! 1102:
! 1103: /*
! 1104: --------------------------------------------------------------------------------
! 1105: Racine carrée d'une expression
! 1106: --------------------------------------------------------------------------------
! 1107: */
! 1108:
! 1109: else if (((*s_objet_argument).type == ALG) ||
! 1110: ((*s_objet_argument).type == RPN))
! 1111: {
! 1112: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
! 1113: 'N')) == NULL)
! 1114: {
! 1115: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1116: return;
! 1117: }
! 1118:
! 1119: l_element_courant = (struct_liste_chainee *)
! 1120: (*s_copie_argument).objet;
! 1121: l_element_precedent = l_element_courant;
! 1122:
! 1123: while((*l_element_courant).suivant != NULL)
! 1124: {
! 1125: l_element_precedent = l_element_courant;
! 1126: l_element_courant = (*l_element_courant).suivant;
! 1127: }
! 1128:
! 1129: if (((*l_element_precedent).suivant =
! 1130: allocation_maillon(s_etat_processus)) == NULL)
! 1131: {
! 1132: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1133: return;
! 1134: }
! 1135:
! 1136: if (((*(*l_element_precedent).suivant).donnee =
! 1137: allocation(s_etat_processus, FCT)) == NULL)
! 1138: {
! 1139: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1140: return;
! 1141: }
! 1142:
! 1143: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1144: .donnee).objet)).nombre_arguments = 1;
! 1145: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1146: .donnee).objet)).fonction = instruction_sqrt;
! 1147:
! 1148: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 1149: .suivant).donnee).objet)).nom_fonction =
! 1150: malloc(5 * sizeof(unsigned char))) == NULL)
! 1151: {
! 1152: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1153: return;
! 1154: }
! 1155:
! 1156: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 1157: .suivant).donnee).objet)).nom_fonction, "SQRT");
! 1158:
! 1159: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1160:
! 1161: s_objet_resultat = s_copie_argument;
! 1162: }
! 1163:
! 1164: /*
! 1165: --------------------------------------------------------------------------------
! 1166: Racine carrée impossible
! 1167: --------------------------------------------------------------------------------
! 1168: */
! 1169:
! 1170: else
! 1171: {
! 1172: liberation(s_etat_processus, s_objet_argument);
! 1173:
! 1174: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1175: return;
! 1176: }
! 1177:
! 1178: liberation(s_etat_processus, s_objet_argument);
! 1179:
! 1180: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1181: s_objet_resultat) == d_erreur)
! 1182: {
! 1183: return;
! 1184: }
! 1185:
! 1186: return;
! 1187: }
! 1188:
! 1189:
! 1190: /*
! 1191: ================================================================================
! 1192: Fonction 'same'
! 1193: ================================================================================
! 1194: Entrées : pointeur sur une structure struct_processus
! 1195: --------------------------------------------------------------------------------
! 1196: Sorties :
! 1197: --------------------------------------------------------------------------------
! 1198: Effets de bord : néant
! 1199: ================================================================================
! 1200: */
! 1201:
! 1202: void
! 1203: instruction_same(struct_processus *s_etat_processus)
! 1204: {
! 1205: struct_liste_chainee *l_element_courant;
! 1206: struct_liste_chainee *l_element_courant_1;
! 1207: struct_liste_chainee *l_element_courant_2;
! 1208: struct_liste_chainee *l_element_precedent;
! 1209:
! 1210: struct_objet *s_copie_argument_1;
! 1211: struct_objet *s_copie_argument_2;
! 1212: struct_objet *s_objet_argument_1;
! 1213: struct_objet *s_objet_argument_2;
! 1214: struct_objet *s_objet_resultat;
! 1215: struct_objet *s_objet_resultat_intermediaire;
! 1216:
! 1217: logical1 difference;
! 1218:
! 1219: unsigned long i;
! 1220: unsigned long j;
! 1221: unsigned long nombre_elements;
! 1222:
! 1223: (*s_etat_processus).erreur_execution = d_ex;
! 1224:
! 1225: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1226: {
! 1227: printf("\n SAME ");
! 1228:
! 1229: if ((*s_etat_processus).langue == 'F')
! 1230: {
! 1231: printf("(opérateur égalité)\n\n");
! 1232: }
! 1233: else
! 1234: {
! 1235: printf("(equality operator)\n\n");
! 1236: }
! 1237:
! 1238: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 1239: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 1240: printf("-> 1: %s\n\n", d_INT);
! 1241:
! 1242: printf(" 2: %s\n", d_BIN);
! 1243: printf(" 1: %s\n", d_BIN);
! 1244: printf("-> 1: %s\n\n", d_INT);
! 1245:
! 1246: printf(" 2: %s\n", d_LST);
! 1247: printf(" 1: %s\n", d_LST);
! 1248: printf("-> 1: %s\n\n", d_INT);
! 1249:
! 1250: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 1251: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 1252: printf("-> 1: %s\n\n", d_INT);
! 1253:
! 1254: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1255: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1256: printf("-> 1: %s\n\n", d_INT);
! 1257:
! 1258: printf(" 2: %s\n", d_TAB);
! 1259: printf(" 1: %s\n", d_TAB);
! 1260: printf("-> 1: %s\n\n", d_INT);
! 1261:
! 1262: printf(" 2: %s\n", d_NOM);
! 1263: printf(" 1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
! 1264: printf("-> 1: %s\n\n", d_ALG);
! 1265:
! 1266: printf(" 2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
! 1267: printf(" 1: %s\n", d_NOM);
! 1268: printf("-> 1: %s\n\n", d_ALG);
! 1269:
! 1270: printf(" 2: %s\n", d_ALG);
! 1271: printf(" 1: %s\n", d_ALG);
! 1272: printf("-> 1: %s\n\n", d_ALG);
! 1273:
! 1274: printf(" 2: %s\n", d_RPN);
! 1275: printf(" 1: %s\n", d_RPN);
! 1276: printf("-> 1: %s\n", d_RPN);
! 1277:
! 1278: return;
! 1279: }
! 1280: else if ((*s_etat_processus).test_instruction == 'Y')
! 1281: {
! 1282: (*s_etat_processus).nombre_arguments = -1;
! 1283: return;
! 1284: }
! 1285:
! 1286: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1287: {
! 1288: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 1289: {
! 1290: return;
! 1291: }
! 1292: }
! 1293:
! 1294: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1295: &s_objet_argument_1) == d_erreur)
! 1296: {
! 1297: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1298: return;
! 1299: }
! 1300:
! 1301: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1302: &s_objet_argument_2) == d_erreur)
! 1303: {
! 1304: liberation(s_etat_processus, s_objet_argument_1);
! 1305:
! 1306: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1307: return;
! 1308: }
! 1309:
! 1310: /*
! 1311: --------------------------------------------------------------------------------
! 1312: SAME sur des valeurs numériques
! 1313: --------------------------------------------------------------------------------
! 1314: */
! 1315:
! 1316: if ((((*s_objet_argument_1).type == INT) ||
! 1317: ((*s_objet_argument_1).type == REL)) &&
! 1318: (((*s_objet_argument_2).type == INT) ||
! 1319: ((*s_objet_argument_2).type == REL)))
! 1320: {
! 1321: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1322: {
! 1323: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1324: return;
! 1325: }
! 1326:
! 1327: if ((*s_objet_argument_1).type == INT)
! 1328: {
! 1329: if ((*s_objet_argument_2).type == INT)
! 1330: {
! 1331: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1332: ((*((integer8 *) (*s_objet_argument_1).objet)) ==
! 1333: (*((integer8 *) (*s_objet_argument_2).objet)))
! 1334: ? -1 : 0;
! 1335: }
! 1336: else
! 1337: {
! 1338: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1339: ((*((integer8 *) (*s_objet_argument_1).objet)) ==
! 1340: (*((real8 *) (*s_objet_argument_2).objet)))
! 1341: ? -1 : 0;
! 1342: }
! 1343: }
! 1344: else
! 1345: {
! 1346: if ((*s_objet_argument_2).type == INT)
! 1347: {
! 1348: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1349: ((*((real8 *) (*s_objet_argument_1).objet)) ==
! 1350: (*((integer8 *) (*s_objet_argument_2).objet)))
! 1351: ? -1 : 0;
! 1352: }
! 1353: else
! 1354: {
! 1355: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1356: ((*((real8 *) (*s_objet_argument_1).objet)) ==
! 1357: (*((real8 *) (*s_objet_argument_2).objet)))
! 1358: ? -1 : 0;
! 1359: }
! 1360: }
! 1361: }
! 1362:
! 1363: /*
! 1364: --------------------------------------------------------------------------------
! 1365: SAME Processus
! 1366: --------------------------------------------------------------------------------
! 1367: */
! 1368:
! 1369: else if (((*s_objet_argument_1).type == PRC) &&
! 1370: ((*s_objet_argument_2).type == PRC))
! 1371: {
! 1372: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1373: {
! 1374: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1375: return;
! 1376: }
! 1377:
! 1378: if ((*(*((struct_processus_fils *) (*s_objet_argument_1).objet)).thread)
! 1379: .processus_detache != (*(*((struct_processus_fils *)
! 1380: (*s_objet_argument_2).objet)).thread).processus_detache)
! 1381: {
! 1382: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1383: }
! 1384: else
! 1385: {
! 1386: if ((*(*((struct_processus_fils *) (*s_objet_argument_1).objet))
! 1387: .thread).processus_detache == d_vrai)
! 1388: {
! 1389: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1390: ((*(*((struct_processus_fils *) (*s_objet_argument_1)
! 1391: .objet)).thread).pid ==
! 1392: (*(*((struct_processus_fils *) (*s_objet_argument_2)
! 1393: .objet)).thread).pid) ? -1 : 0;
! 1394: }
! 1395: else
! 1396: {
! 1397: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1398: ((pthread_equal((*(*((struct_processus_fils *)
! 1399: (*s_objet_argument_1).objet)).thread).tid,
! 1400: (*(*((struct_processus_fils *) (*s_objet_argument_2)
! 1401: .objet)).thread).tid) != 0) &&
! 1402: ((*(*((struct_processus_fils *)
! 1403: (*s_objet_argument_1).objet)).thread).pid ==
! 1404: (*(*((struct_processus_fils *) (*s_objet_argument_2)
! 1405: .objet)).thread).pid)) ? -1 : 0;
! 1406: }
! 1407: }
! 1408: }
! 1409:
! 1410: /*
! 1411: --------------------------------------------------------------------------------
! 1412: SAME complexe
! 1413: --------------------------------------------------------------------------------
! 1414: */
! 1415:
! 1416: else if (((*s_objet_argument_1).type == CPL) &&
! 1417: ((*s_objet_argument_2).type == CPL))
! 1418: {
! 1419: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1420: {
! 1421: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1422: return;
! 1423: }
! 1424:
! 1425: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1426: (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
! 1427: .partie_reelle == (*((struct_complexe16 *) (*s_objet_argument_2)
! 1428: .objet)).partie_reelle) && ((*((struct_complexe16 *)
! 1429: (*s_objet_argument_1).objet)).partie_imaginaire ==
! 1430: ((*((struct_complexe16 *) (*s_objet_argument_1).objet))
! 1431: .partie_imaginaire))) ? -1 : 0;
! 1432: }
! 1433:
! 1434: /*
! 1435: --------------------------------------------------------------------------------
! 1436: SAME binaire
! 1437: --------------------------------------------------------------------------------
! 1438: */
! 1439:
! 1440: else if (((*s_objet_argument_1).type == BIN) &&
! 1441: ((*s_objet_argument_2).type == BIN))
! 1442: {
! 1443: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1444: {
! 1445: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1446: return;
! 1447: }
! 1448:
! 1449: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1450: ((*((logical8 *) (*s_objet_argument_1).objet)) ==
! 1451: (*((logical8 *) (*s_objet_argument_2).objet)))
! 1452: ? -1 : 0;
! 1453: }
! 1454:
! 1455: /*
! 1456: --------------------------------------------------------------------------------
! 1457: SAME portant sur des chaînes de caractères
! 1458: --------------------------------------------------------------------------------
! 1459: */
! 1460:
! 1461: else if (((*s_objet_argument_1).type == CHN) &&
! 1462: ((*s_objet_argument_2).type == CHN))
! 1463: {
! 1464: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1465: {
! 1466: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1467: return;
! 1468: }
! 1469:
! 1470: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1471: (strcmp((unsigned char *) (*s_objet_argument_1).objet,
! 1472: (unsigned char *) (*s_objet_argument_2).objet) == 0) ? -1 : 0;
! 1473: }
! 1474:
! 1475: /*
! 1476: --------------------------------------------------------------------------------
! 1477: SAME portant sur des listes ou (instruction "SAME") des expressions
! 1478: --------------------------------------------------------------------------------
! 1479: */
! 1480:
! 1481: else if (((*s_objet_argument_1).type == FCT) &&
! 1482: ((*s_objet_argument_2).type == FCT))
! 1483: {
! 1484: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1485: {
! 1486: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1487: return;
! 1488: }
! 1489:
! 1490: if ((strcmp((*((struct_fonction *) (*s_objet_argument_1).objet))
! 1491: .nom_fonction, (*((struct_fonction *) (*s_objet_argument_2)
! 1492: .objet)).nom_fonction) == 0) &&
! 1493: ((*((struct_fonction *) (*s_objet_argument_1).objet))
! 1494: .nombre_arguments == (*((struct_fonction *)
! 1495: (*s_objet_argument_2).objet)).nombre_arguments))
! 1496: {
! 1497: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
! 1498: }
! 1499: else
! 1500: {
! 1501: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1502: }
! 1503: }
! 1504:
! 1505: /*
! 1506: * Il y a de la récursivité dans l'air...
! 1507: */
! 1508:
! 1509: else if ((((*s_objet_argument_1).type == LST) &&
! 1510: ((*s_objet_argument_2).type == LST)) ||
! 1511: (((((*s_objet_argument_1).type == ALG) &&
! 1512: ((*s_objet_argument_2).type == ALG)) ||
! 1513: (((*s_objet_argument_1).type == RPN) &&
! 1514: ((*s_objet_argument_2).type == RPN))) &&
! 1515: (strcmp((*s_etat_processus).instruction_courante, "==") != 0)))
! 1516: {
! 1517: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1518: {
! 1519: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1520: return;
! 1521: }
! 1522:
! 1523: l_element_courant_1 = (struct_liste_chainee *)
! 1524: (*s_objet_argument_1).objet;
! 1525: l_element_courant_2 = (struct_liste_chainee *)
! 1526: (*s_objet_argument_2).objet;
! 1527:
! 1528: difference = d_faux;
! 1529:
! 1530: while((l_element_courant_1 != NULL) && (l_element_courant_2 != NULL)
! 1531: && (difference == d_faux))
! 1532: {
! 1533: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
! 1534: (*l_element_courant_1).donnee, 'P')) == NULL)
! 1535: {
! 1536: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1537: return;
! 1538: }
! 1539:
! 1540: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1541: s_copie_argument_1) == d_erreur)
! 1542: {
! 1543: return;
! 1544: }
! 1545:
! 1546: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
! 1547: (*l_element_courant_2).donnee, 'P')) == NULL)
! 1548: {
! 1549: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1550: return;
! 1551: }
! 1552:
! 1553: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1554: s_copie_argument_2) == d_erreur)
! 1555: {
! 1556: return;
! 1557: }
! 1558:
! 1559: instruction_same(s_etat_processus);
! 1560:
! 1561: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1562: &s_objet_resultat_intermediaire) == d_erreur)
! 1563: {
! 1564: liberation(s_etat_processus, s_objet_argument_1);
! 1565: liberation(s_etat_processus, s_objet_argument_2);
! 1566: liberation(s_etat_processus, s_objet_resultat);
! 1567:
! 1568: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1569: return;
! 1570: }
! 1571:
! 1572: if ((*s_objet_resultat_intermediaire).type != INT)
! 1573: {
! 1574: liberation(s_etat_processus, s_objet_argument_1);
! 1575: liberation(s_etat_processus, s_objet_argument_2);
! 1576: liberation(s_etat_processus, s_objet_resultat);
! 1577:
! 1578: (*s_etat_processus).erreur_execution =
! 1579: d_ex_erreur_type_argument;
! 1580:
! 1581: return;
! 1582: }
! 1583:
! 1584: difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
! 1585: .objet)) == 0) ? d_vrai : d_faux;
! 1586:
! 1587: liberation(s_etat_processus, s_objet_resultat_intermediaire);
! 1588:
! 1589: l_element_courant_1 = (*l_element_courant_1).suivant;
! 1590: l_element_courant_2 = (*l_element_courant_2).suivant;
! 1591: }
! 1592:
! 1593: if ((difference == d_vrai) || ((l_element_courant_1 != NULL) &&
! 1594: (l_element_courant_2 == NULL)) ||
! 1595: ((l_element_courant_1 == NULL) &&
! 1596: (l_element_courant_2 != NULL)))
! 1597: {
! 1598: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1599: }
! 1600: else
! 1601: {
! 1602: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
! 1603: }
! 1604: }
! 1605:
! 1606: /*
! 1607: --------------------------------------------------------------------------------
! 1608: SAME portant sur des tables des expressions
! 1609: --------------------------------------------------------------------------------
! 1610: */
! 1611: /*
! 1612: * Il y a de la récursivité dans l'air...
! 1613: */
! 1614:
! 1615: else if (((*s_objet_argument_1).type == TBL) &&
! 1616: ((*s_objet_argument_2).type == TBL) &&
! 1617: (strcmp((*s_etat_processus).instruction_courante, "==") != 0))
! 1618: {
! 1619: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1620: {
! 1621: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1622: return;
! 1623: }
! 1624:
! 1625: if ((*((struct_tableau *) (*s_objet_argument_1).objet)).nombre_elements
! 1626: != (*((struct_tableau *) (*s_objet_argument_2).objet))
! 1627: .nombre_elements)
! 1628: {
! 1629: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1630: }
! 1631: else
! 1632: {
! 1633: difference = d_faux;
! 1634:
! 1635: for(i = 0; i < (*((struct_tableau *) (*s_objet_argument_1).objet))
! 1636: .nombre_elements; i++)
! 1637: {
! 1638: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
! 1639: (*((struct_tableau *)
! 1640: (*s_objet_argument_1).objet)).elements[i],
! 1641: 'P')) == NULL)
! 1642: {
! 1643: (*s_etat_processus).erreur_systeme =
! 1644: d_es_allocation_memoire;
! 1645: return;
! 1646: }
! 1647:
! 1648: if (empilement(s_etat_processus, &((*s_etat_processus)
! 1649: .l_base_pile), s_copie_argument_1) == d_erreur)
! 1650: {
! 1651: return;
! 1652: }
! 1653:
! 1654: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
! 1655: (*((struct_tableau *)
! 1656: (*s_objet_argument_2).objet)).elements[i],
! 1657: 'P')) == NULL)
! 1658: {
! 1659: (*s_etat_processus).erreur_systeme =
! 1660: d_es_allocation_memoire;
! 1661: return;
! 1662: }
! 1663:
! 1664: if (empilement(s_etat_processus, &((*s_etat_processus)
! 1665: .l_base_pile), s_copie_argument_2) == d_erreur)
! 1666: {
! 1667: return;
! 1668: }
! 1669:
! 1670: instruction_same(s_etat_processus);
! 1671:
! 1672: if (depilement(s_etat_processus, &((*s_etat_processus)
! 1673: .l_base_pile), &s_objet_resultat_intermediaire)
! 1674: == d_erreur)
! 1675: {
! 1676: liberation(s_etat_processus, s_objet_argument_1);
! 1677: liberation(s_etat_processus, s_objet_argument_2);
! 1678: liberation(s_etat_processus, s_objet_resultat);
! 1679:
! 1680: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1681: return;
! 1682: }
! 1683:
! 1684: if ((*s_objet_resultat_intermediaire).type != INT)
! 1685: {
! 1686: liberation(s_etat_processus, s_objet_argument_1);
! 1687: liberation(s_etat_processus, s_objet_argument_2);
! 1688: liberation(s_etat_processus, s_objet_resultat);
! 1689:
! 1690: (*s_etat_processus).erreur_execution =
! 1691: d_ex_erreur_type_argument;
! 1692: return;
! 1693: }
! 1694:
! 1695: difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
! 1696: .objet)) == 0) ? d_vrai : d_faux;
! 1697:
! 1698: liberation(s_etat_processus, s_objet_resultat_intermediaire);
! 1699: }
! 1700:
! 1701: if (difference == d_vrai)
! 1702: {
! 1703: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1704: }
! 1705: else
! 1706: {
! 1707: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
! 1708: }
! 1709: }
! 1710: }
! 1711:
! 1712:
! 1713: /*
! 1714: --------------------------------------------------------------------------------
! 1715: SAME portant sur des vecteurs
! 1716: --------------------------------------------------------------------------------
! 1717: */
! 1718: /*
! 1719: * Vecteurs d'entiers
! 1720: */
! 1721:
! 1722: else if (((*s_objet_argument_1).type == VIN) &&
! 1723: ((*s_objet_argument_2).type == VIN))
! 1724: {
! 1725: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1726: {
! 1727: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1728: return;
! 1729: }
! 1730:
! 1731: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
! 1732: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
! 1733: {
! 1734: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1735: }
! 1736: else
! 1737: {
! 1738: difference = d_faux;
! 1739:
! 1740: for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
! 1741: .taille) && (difference == d_faux); i++)
! 1742: {
! 1743: difference = (((integer8 *) (*((struct_vecteur *)
! 1744: (*s_objet_argument_1).objet)).tableau)[i] ==
! 1745: ((integer8 *) (*((struct_vecteur *)
! 1746: (*s_objet_argument_2).objet)).tableau)[i])
! 1747: ? d_faux : d_vrai;
! 1748: }
! 1749:
! 1750: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
! 1751: d_faux) ? -1 : 0;
! 1752: }
! 1753: }
! 1754:
! 1755: /*
! 1756: * Vecteurs de réels
! 1757: */
! 1758:
! 1759: else if (((*s_objet_argument_1).type == VRL) &&
! 1760: ((*s_objet_argument_2).type == VRL))
! 1761: {
! 1762: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1763: {
! 1764: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1765: return;
! 1766: }
! 1767:
! 1768: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
! 1769: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
! 1770: {
! 1771: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1772: }
! 1773: else
! 1774: {
! 1775: difference = d_faux;
! 1776:
! 1777: for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
! 1778: .taille) && (difference == d_faux); i++)
! 1779: {
! 1780: difference = (((real8 *) (*((struct_vecteur *)
! 1781: (*s_objet_argument_1).objet)).tableau)[i] ==
! 1782: ((real8 *) (*((struct_vecteur *)
! 1783: (*s_objet_argument_2).objet)).tableau)[i])
! 1784: ? d_faux : d_vrai;
! 1785: }
! 1786:
! 1787: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
! 1788: d_faux) ? -1 : 0;
! 1789: }
! 1790: }
! 1791:
! 1792: /*
! 1793: * Vecteurs de complexes
! 1794: */
! 1795:
! 1796: else if (((*s_objet_argument_1).type == VCX) &&
! 1797: ((*s_objet_argument_2).type == VCX))
! 1798: {
! 1799: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1800: {
! 1801: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1802: return;
! 1803: }
! 1804:
! 1805: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
! 1806: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
! 1807: {
! 1808: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1809: }
! 1810: else
! 1811: {
! 1812: difference = d_faux;
! 1813:
! 1814: for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
! 1815: .taille) && (difference == d_faux); i++)
! 1816: {
! 1817: difference = ((((struct_complexe16 *) (*((struct_vecteur *)
! 1818: (*s_objet_argument_1).objet)).tableau)[i].partie_reelle
! 1819: == ((struct_complexe16 *) (*((struct_vecteur *)
! 1820: (*s_objet_argument_2).objet)).tableau)[i].partie_reelle)
! 1821: && (((struct_complexe16 *) (*((struct_vecteur *)
! 1822: (*s_objet_argument_1).objet)).tableau)[i]
! 1823: .partie_imaginaire == ((struct_complexe16 *)
! 1824: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 1825: .tableau)[i].partie_imaginaire)) ? d_faux : d_vrai;
! 1826: }
! 1827:
! 1828: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
! 1829: d_faux) ? -1 : 0;
! 1830: }
! 1831: }
! 1832:
! 1833: /*
! 1834: --------------------------------------------------------------------------------
! 1835: SAME portant sur des matrices
! 1836: --------------------------------------------------------------------------------
! 1837: */
! 1838: /*
! 1839: * Matrice d'entiers
! 1840: */
! 1841:
! 1842: else if (((*s_objet_argument_1).type == MIN) &&
! 1843: ((*s_objet_argument_2).type == MIN))
! 1844: {
! 1845: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1846: {
! 1847: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1848: return;
! 1849: }
! 1850:
! 1851: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
! 1852: != (*((struct_matrice *) (*s_objet_argument_2).objet))
! 1853: .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
! 1854: .objet)).nombre_colonnes != (*((struct_matrice *)
! 1855: (*s_objet_argument_2).objet)).nombre_colonnes))
! 1856: {
! 1857: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1858: }
! 1859: else
! 1860: {
! 1861: difference = d_faux;
! 1862:
! 1863: for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
! 1864: .nombre_lignes) && (difference == d_faux); i++)
! 1865: {
! 1866: for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
! 1867: .objet)).nombre_colonnes) && (difference == d_faux);
! 1868: j++)
! 1869: {
! 1870: difference = (((integer8 **) (*((struct_matrice *)
! 1871: (*s_objet_argument_1).objet)).tableau)[i][j] ==
! 1872: ((integer8 **) (*((struct_matrice *)
! 1873: (*s_objet_argument_2).objet)).tableau)[i][j])
! 1874: ? d_faux : d_vrai;
! 1875: }
! 1876: }
! 1877:
! 1878: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
! 1879: d_faux) ? -1 : 0;
! 1880: }
! 1881: }
! 1882:
! 1883: /*
! 1884: * Matrice de réels
! 1885: */
! 1886:
! 1887: else if (((*s_objet_argument_1).type == MRL) &&
! 1888: ((*s_objet_argument_2).type == MRL))
! 1889: {
! 1890: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1891: {
! 1892: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1893: return;
! 1894: }
! 1895:
! 1896: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
! 1897: != (*((struct_matrice *) (*s_objet_argument_2).objet))
! 1898: .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
! 1899: .objet)).nombre_colonnes != (*((struct_matrice *)
! 1900: (*s_objet_argument_2).objet)).nombre_colonnes))
! 1901: {
! 1902: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1903: }
! 1904: else
! 1905: {
! 1906: difference = d_faux;
! 1907:
! 1908: for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
! 1909: .nombre_lignes) && (difference == d_faux); i++)
! 1910: {
! 1911: for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
! 1912: .objet)).nombre_colonnes) && (difference == d_faux);
! 1913: j++)
! 1914: {
! 1915: difference = (((real8 **) (*((struct_matrice *)
! 1916: (*s_objet_argument_1).objet)).tableau)[i][j] ==
! 1917: ((real8 **) (*((struct_matrice *)
! 1918: (*s_objet_argument_2).objet)).tableau)[i][j])
! 1919: ? d_faux : d_vrai;
! 1920: }
! 1921: }
! 1922:
! 1923: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
! 1924: d_faux) ? -1 : 0;
! 1925: }
! 1926: }
! 1927:
! 1928: /*
! 1929: * Matrice de complexes
! 1930: */
! 1931:
! 1932: else if (((*s_objet_argument_1).type == MCX) &&
! 1933: ((*s_objet_argument_2).type == MCX))
! 1934: {
! 1935: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1936: {
! 1937: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1938: return;
! 1939: }
! 1940:
! 1941: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
! 1942: != (*((struct_matrice *) (*s_objet_argument_2).objet))
! 1943: .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
! 1944: .objet)).nombre_colonnes != (*((struct_matrice *)
! 1945: (*s_objet_argument_2).objet)).nombre_colonnes))
! 1946: {
! 1947: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1948: }
! 1949: else
! 1950: {
! 1951: difference = d_faux;
! 1952:
! 1953: for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
! 1954: .nombre_lignes) && (difference == d_faux); i++)
! 1955: {
! 1956: for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
! 1957: .objet)).nombre_colonnes) && (difference == d_faux);
! 1958: j++)
! 1959: {
! 1960: difference = ((((struct_complexe16 **) (*((struct_matrice *)
! 1961: (*s_objet_argument_1).objet)).tableau)[i][j]
! 1962: .partie_reelle == ((struct_complexe16 **)
! 1963: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 1964: .tableau)[i][j].partie_reelle) &&
! 1965: (((struct_complexe16 **) (*((struct_matrice *)
! 1966: (*s_objet_argument_1).objet)).tableau)[i][j]
! 1967: .partie_imaginaire == ((struct_complexe16 **)
! 1968: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 1969: .tableau)[i][j].partie_imaginaire))
! 1970: ? d_faux : d_vrai;
! 1971: }
! 1972: }
! 1973:
! 1974: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
! 1975: d_faux) ? -1 : 0;
! 1976: }
! 1977: }
! 1978:
! 1979: /*
! 1980: --------------------------------------------------------------------------------
! 1981: SAME portant sur des noms (instruction "SAME")
! 1982: --------------------------------------------------------------------------------
! 1983: */
! 1984:
! 1985: else if (((*s_objet_argument_1).type == NOM) &&
! 1986: ((*s_objet_argument_2).type == NOM) &&
! 1987: (strcmp((*s_etat_processus).instruction_courante, "==") != 0))
! 1988: {
! 1989: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 1990: {
! 1991: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1992: return;
! 1993: }
! 1994:
! 1995: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1996: (strcmp((*((struct_nom *) (*s_objet_argument_1).objet)).nom,
! 1997: (*((struct_nom *) (*s_objet_argument_2).objet)).nom) == 0)
! 1998: ? -1 : 0;
! 1999: }
! 2000:
! 2001: /*
! 2002: --------------------------------------------------------------------------------
! 2003: SAME entre des arguments complexes (instruction '==')
! 2004: --------------------------------------------------------------------------------
! 2005: */
! 2006:
! 2007: /*
! 2008: * Nom ou valeur numérique / Nom ou valeur numérique
! 2009: */
! 2010:
! 2011: else if (((((*s_objet_argument_1).type == NOM) &&
! 2012: (((*s_objet_argument_2).type == NOM) ||
! 2013: ((*s_objet_argument_2).type == INT) ||
! 2014: ((*s_objet_argument_2).type == REL))) ||
! 2015: (((*s_objet_argument_2).type == NOM) &&
! 2016: (((*s_objet_argument_1).type == INT) ||
! 2017: ((*s_objet_argument_1).type == REL)))) &&
! 2018: (strcmp((*s_etat_processus).instruction_courante, "==") == 0))
! 2019: {
! 2020: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 2021: {
! 2022: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2023: return;
! 2024: }
! 2025:
! 2026: if (((*s_objet_resultat).objet =
! 2027: allocation_maillon(s_etat_processus)) == NULL)
! 2028: {
! 2029: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2030: return;
! 2031: }
! 2032:
! 2033: l_element_courant = (*s_objet_resultat).objet;
! 2034:
! 2035: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 2036: == NULL)
! 2037: {
! 2038: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2039: return;
! 2040: }
! 2041:
! 2042: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2043: .nombre_arguments = 0;
! 2044: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2045: .fonction = instruction_vers_niveau_superieur;
! 2046:
! 2047: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2048: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2049: {
! 2050: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2051: return;
! 2052: }
! 2053:
! 2054: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2055: .nom_fonction, "<<");
! 2056:
! 2057: if (((*l_element_courant).suivant =
! 2058: allocation_maillon(s_etat_processus)) == NULL)
! 2059: {
! 2060: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2061: return;
! 2062: }
! 2063:
! 2064: l_element_courant = (*l_element_courant).suivant;
! 2065: (*l_element_courant).donnee = s_objet_argument_2;
! 2066:
! 2067: if (((*l_element_courant).suivant =
! 2068: allocation_maillon(s_etat_processus)) == NULL)
! 2069: {
! 2070: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2071: return;
! 2072: }
! 2073:
! 2074: l_element_courant = (*l_element_courant).suivant;
! 2075: (*l_element_courant).donnee = s_objet_argument_1;
! 2076:
! 2077: if (((*l_element_courant).suivant =
! 2078: allocation_maillon(s_etat_processus)) == NULL)
! 2079: {
! 2080: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2081: return;
! 2082: }
! 2083:
! 2084: l_element_courant = (*l_element_courant).suivant;
! 2085:
! 2086: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 2087: == NULL)
! 2088: {
! 2089: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2090: return;
! 2091: }
! 2092:
! 2093: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2094: .nombre_arguments = 0;
! 2095: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2096: .fonction = instruction_same;
! 2097:
! 2098: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2099: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2100: {
! 2101: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2102: return;
! 2103: }
! 2104:
! 2105: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2106: .nom_fonction, "==");
! 2107:
! 2108: if (((*l_element_courant).suivant =
! 2109: allocation_maillon(s_etat_processus)) == NULL)
! 2110: {
! 2111: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2112: return;
! 2113: }
! 2114:
! 2115: l_element_courant = (*l_element_courant).suivant;
! 2116:
! 2117: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 2118: == NULL)
! 2119: {
! 2120: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2121: return;
! 2122: }
! 2123:
! 2124: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2125: .nombre_arguments = 0;
! 2126: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2127: .fonction = instruction_vers_niveau_inferieur;
! 2128:
! 2129: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2130: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2131: {
! 2132: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2133: return;
! 2134: }
! 2135:
! 2136: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2137: .nom_fonction, ">>");
! 2138:
! 2139: (*l_element_courant).suivant = NULL;
! 2140:
! 2141: s_objet_argument_1 = NULL;
! 2142: s_objet_argument_2 = NULL;
! 2143: }
! 2144:
! 2145: /*
! 2146: * Nom ou valeur numérique / Expression
! 2147: */
! 2148:
! 2149: else if (((((*s_objet_argument_1).type == ALG) ||
! 2150: ((*s_objet_argument_1).type == RPN)) &&
! 2151: (strcmp((*s_etat_processus).instruction_courante, "==") == 0)) &&
! 2152: (((*s_objet_argument_2).type == NOM) ||
! 2153: ((*s_objet_argument_2).type == INT) ||
! 2154: ((*s_objet_argument_2).type == REL)))
! 2155: {
! 2156: nombre_elements = 0;
! 2157: l_element_courant = (struct_liste_chainee *)
! 2158: (*s_objet_argument_1).objet;
! 2159:
! 2160: while(l_element_courant != NULL)
! 2161: {
! 2162: nombre_elements++;
! 2163: l_element_courant = (*l_element_courant).suivant;
! 2164: }
! 2165:
! 2166: if (nombre_elements == 2)
! 2167: {
! 2168: liberation(s_etat_processus, s_objet_argument_1);
! 2169: liberation(s_etat_processus, s_objet_argument_2);
! 2170:
! 2171: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 2172: return;
! 2173: }
! 2174:
! 2175: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 2176: s_objet_argument_1, 'N')) == NULL)
! 2177: {
! 2178: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2179: return;
! 2180: }
! 2181:
! 2182: l_element_courant = (struct_liste_chainee *)
! 2183: (*s_objet_resultat).objet;
! 2184: l_element_precedent = l_element_courant;
! 2185: l_element_courant = (*l_element_courant).suivant;
! 2186:
! 2187: if (((*l_element_precedent).suivant =
! 2188: allocation_maillon(s_etat_processus)) == NULL)
! 2189: {
! 2190: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2191: return;
! 2192: }
! 2193:
! 2194: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
! 2195: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 2196:
! 2197: while((*l_element_courant).suivant != NULL)
! 2198: {
! 2199: l_element_precedent = l_element_courant;
! 2200: l_element_courant = (*l_element_courant).suivant;
! 2201: }
! 2202:
! 2203: if (((*l_element_precedent).suivant =
! 2204: allocation_maillon(s_etat_processus)) == NULL)
! 2205: {
! 2206: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2207: return;
! 2208: }
! 2209:
! 2210: if (((*(*l_element_precedent).suivant).donnee =
! 2211: allocation(s_etat_processus, FCT)) == NULL)
! 2212: {
! 2213: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2214: return;
! 2215: }
! 2216:
! 2217: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2218: .donnee).objet)).nombre_arguments = 0;
! 2219: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2220: .donnee).objet)).fonction = instruction_same;
! 2221:
! 2222: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 2223: .suivant).donnee).objet)).nom_fonction =
! 2224: malloc((strlen((*s_etat_processus).instruction_courante) + 1) *
! 2225: sizeof(unsigned char))) == NULL)
! 2226: {
! 2227: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2228: return;
! 2229: }
! 2230:
! 2231: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 2232: .suivant).donnee).objet)).nom_fonction,
! 2233: (*s_etat_processus).instruction_courante);
! 2234:
! 2235: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 2236:
! 2237: s_objet_argument_2 = NULL;
! 2238: }
! 2239:
! 2240: /*
! 2241: * Expression / Nom ou valeur numérique
! 2242: */
! 2243:
! 2244: else if ((((*s_objet_argument_1).type == NOM) ||
! 2245: ((*s_objet_argument_1).type == INT) ||
! 2246: ((*s_objet_argument_1).type == REL)) &&
! 2247: ((((*s_objet_argument_2).type == ALG) ||
! 2248: ((*s_objet_argument_2).type == RPN)) &&
! 2249: (strcmp((*s_etat_processus).instruction_courante, "==") == 0)))
! 2250: {
! 2251: nombre_elements = 0;
! 2252: l_element_courant = (struct_liste_chainee *)
! 2253: (*s_objet_argument_2).objet;
! 2254:
! 2255: while(l_element_courant != NULL)
! 2256: {
! 2257: nombre_elements++;
! 2258: l_element_courant = (*l_element_courant).suivant;
! 2259: }
! 2260:
! 2261: if (nombre_elements == 2)
! 2262: {
! 2263: liberation(s_etat_processus, s_objet_argument_1);
! 2264: liberation(s_etat_processus, s_objet_argument_2);
! 2265:
! 2266: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 2267: return;
! 2268: }
! 2269:
! 2270: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 2271: s_objet_argument_2, 'N')) == NULL)
! 2272: {
! 2273: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2274: return;
! 2275: }
! 2276:
! 2277: l_element_courant = (struct_liste_chainee *)
! 2278: (*s_objet_resultat).objet;
! 2279: l_element_precedent = l_element_courant;
! 2280:
! 2281: while((*l_element_courant).suivant != NULL)
! 2282: {
! 2283: l_element_precedent = l_element_courant;
! 2284: l_element_courant = (*l_element_courant).suivant;
! 2285: }
! 2286:
! 2287: if (((*l_element_precedent).suivant =
! 2288: allocation_maillon(s_etat_processus)) == NULL)
! 2289: {
! 2290: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2291: return;
! 2292: }
! 2293:
! 2294: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
! 2295: l_element_precedent = (*l_element_precedent).suivant;
! 2296:
! 2297: if (((*l_element_precedent).suivant =
! 2298: allocation_maillon(s_etat_processus)) == NULL)
! 2299: {
! 2300: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2301: return;
! 2302: }
! 2303:
! 2304: if (((*(*l_element_precedent).suivant).donnee =
! 2305: allocation(s_etat_processus, FCT)) == NULL)
! 2306: {
! 2307: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2308: return;
! 2309: }
! 2310:
! 2311: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2312: .donnee).objet)).nombre_arguments = 0;
! 2313: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2314: .donnee).objet)).fonction = instruction_same;
! 2315:
! 2316: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 2317: .suivant).donnee).objet)).nom_fonction =
! 2318: malloc((strlen((*s_etat_processus).instruction_courante) + 1) *
! 2319: sizeof(unsigned char))) == NULL)
! 2320: {
! 2321: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2322: return;
! 2323: }
! 2324:
! 2325: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 2326: .suivant).donnee).objet)).nom_fonction,
! 2327: (*s_etat_processus).instruction_courante);
! 2328:
! 2329: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 2330:
! 2331: s_objet_argument_1 = NULL;
! 2332: }
! 2333:
! 2334: /*
! 2335: * Expression / Expression
! 2336: */
! 2337:
! 2338: else if ((((*s_objet_argument_1).type == ALG) &&
! 2339: ((*s_objet_argument_2).type == ALG) &&
! 2340: (strcmp((*s_etat_processus).instruction_courante, "==") == 0)) ||
! 2341: (((*s_objet_argument_1).type == RPN) &&
! 2342: ((*s_objet_argument_2).type == RPN)))
! 2343: {
! 2344: nombre_elements = 0;
! 2345: l_element_courant = (struct_liste_chainee *)
! 2346: (*s_objet_argument_1).objet;
! 2347:
! 2348: while(l_element_courant != NULL)
! 2349: {
! 2350: nombre_elements++;
! 2351: l_element_courant = (*l_element_courant).suivant;
! 2352: }
! 2353:
! 2354: if (nombre_elements == 2)
! 2355: {
! 2356: liberation(s_etat_processus, s_objet_argument_1);
! 2357: liberation(s_etat_processus, s_objet_argument_2);
! 2358:
! 2359: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 2360: return;
! 2361: }
! 2362:
! 2363: nombre_elements = 0;
! 2364: l_element_courant = (struct_liste_chainee *)
! 2365: (*s_objet_argument_2).objet;
! 2366:
! 2367: while(l_element_courant != NULL)
! 2368: {
! 2369: nombre_elements++;
! 2370: l_element_courant = (*l_element_courant).suivant;
! 2371: }
! 2372:
! 2373: if (nombre_elements == 2)
! 2374: {
! 2375: liberation(s_etat_processus, s_objet_argument_1);
! 2376: liberation(s_etat_processus, s_objet_argument_2);
! 2377:
! 2378: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 2379: return;
! 2380: }
! 2381:
! 2382: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
! 2383: s_objet_argument_1, 'N')) == NULL)
! 2384: {
! 2385: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2386: return;
! 2387: }
! 2388:
! 2389: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
! 2390: s_objet_argument_2, 'N')) == NULL)
! 2391: {
! 2392: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2393: return;
! 2394: }
! 2395:
! 2396: l_element_courant = (struct_liste_chainee *)
! 2397: (*s_copie_argument_1).objet;
! 2398: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
! 2399: (*s_copie_argument_1).objet)).suivant;
! 2400:
! 2401: liberation(s_etat_processus, (*l_element_courant).donnee);
! 2402: free(l_element_courant);
! 2403:
! 2404: l_element_courant = (struct_liste_chainee *)
! 2405: (*s_copie_argument_2).objet;
! 2406: l_element_precedent = l_element_courant;
! 2407: s_objet_resultat = s_copie_argument_2;
! 2408:
! 2409: while((*l_element_courant).suivant != NULL)
! 2410: {
! 2411: l_element_precedent = l_element_courant;
! 2412: l_element_courant = (*l_element_courant).suivant;
! 2413: }
! 2414:
! 2415: liberation(s_etat_processus, (*l_element_courant).donnee);
! 2416: free(l_element_courant);
! 2417:
! 2418: (*l_element_precedent).suivant = (struct_liste_chainee *)
! 2419: (*s_copie_argument_1).objet;
! 2420: free(s_copie_argument_1);
! 2421:
! 2422: l_element_courant = (*l_element_precedent).suivant;
! 2423: while((*l_element_courant).suivant != NULL)
! 2424: {
! 2425: l_element_precedent = l_element_courant;
! 2426: l_element_courant = (*l_element_courant).suivant;
! 2427: }
! 2428:
! 2429: if (((*l_element_precedent).suivant =
! 2430: allocation_maillon(s_etat_processus)) == NULL)
! 2431: {
! 2432: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2433: return;
! 2434: }
! 2435:
! 2436: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 2437: l_element_courant = (*l_element_precedent).suivant;
! 2438:
! 2439: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 2440: == NULL)
! 2441: {
! 2442: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2443: return;
! 2444: }
! 2445:
! 2446: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2447: .nombre_arguments = 0;
! 2448: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2449: .fonction = instruction_same;
! 2450:
! 2451: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2452: .nom_fonction = malloc((strlen(
! 2453: (*s_etat_processus).instruction_courante) + 1) *
! 2454: sizeof(unsigned char))) == NULL)
! 2455: {
! 2456: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2457: return;
! 2458: }
! 2459:
! 2460: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2461: .nom_fonction, (*s_etat_processus).instruction_courante);
! 2462: }
! 2463:
! 2464: /*
! 2465: --------------------------------------------------------------------------------
! 2466: SAME nul
! 2467: --------------------------------------------------------------------------------
! 2468: */
! 2469:
! 2470: else
! 2471: {
! 2472: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 2473: {
! 2474: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2475: return;
! 2476: }
! 2477:
! 2478: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 2479: }
! 2480:
! 2481: liberation(s_etat_processus, s_objet_argument_1);
! 2482: liberation(s_etat_processus, s_objet_argument_2);
! 2483:
! 2484: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2485: s_objet_resultat) == d_erreur)
! 2486: {
! 2487: return;
! 2488: }
! 2489:
! 2490: return;
! 2491: }
! 2492:
! 2493:
! 2494: /*
! 2495: ================================================================================
! 2496: Fonction 'start'
! 2497: ================================================================================
! 2498: Entrées : structure processus
! 2499: --------------------------------------------------------------------------------
! 2500: Sorties :
! 2501: --------------------------------------------------------------------------------
! 2502: Effets de bord : néant
! 2503: ================================================================================
! 2504: */
! 2505:
! 2506: void
! 2507: instruction_start(struct_processus *s_etat_processus)
! 2508: {
! 2509: struct_objet *s_objet_1;
! 2510: struct_objet *s_objet_2;
! 2511:
! 2512: (*s_etat_processus).erreur_execution = d_ex;
! 2513:
! 2514: if ((*s_etat_processus).affichage_arguments == 'Y')
! 2515: {
! 2516: printf("\n START ");
! 2517:
! 2518: if ((*s_etat_processus).langue == 'F')
! 2519: {
! 2520: printf("(boucle définie sans compteur)\n\n");
! 2521: }
! 2522: else
! 2523: {
! 2524: printf("(define a loop without counter)\n\n");
! 2525: }
! 2526:
! 2527: if ((*s_etat_processus).langue == 'F')
! 2528: {
! 2529: printf(" Utilisation :\n\n");
! 2530: }
! 2531: else
! 2532: {
! 2533: printf(" Usage:\n\n");
! 2534: }
! 2535:
! 2536: printf(" %s/%s %s/%s START\n", d_INT, d_REL,
! 2537: d_INT, d_REL);
! 2538: printf(" (expression)\n");
! 2539: printf(" [EXIT]/[CYCLE]\n");
! 2540: printf(" ...\n");
! 2541: printf(" NEXT\n\n");
! 2542:
! 2543: printf(" %s/%s %s/%s START\n", d_INT, d_REL,
! 2544: d_INT, d_REL);
! 2545: printf(" (expression)\n");
! 2546: printf(" [EXIT]/[CYCLE]\n");
! 2547: printf(" ...\n");
! 2548: printf(" %s/%s STEP\n", d_INT, d_REL);
! 2549:
! 2550: return;
! 2551: }
! 2552: else if ((*s_etat_processus).test_instruction == 'Y')
! 2553: {
! 2554: (*s_etat_processus).nombre_arguments = -1;
! 2555: return;
! 2556: }
! 2557:
! 2558: if ((*s_etat_processus).erreur_systeme != d_es)
! 2559: {
! 2560: return;
! 2561: }
! 2562:
! 2563: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 2564: {
! 2565: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 2566: {
! 2567: return;
! 2568: }
! 2569: }
! 2570:
! 2571: empilement_pile_systeme(s_etat_processus);
! 2572: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'S';
! 2573:
! 2574: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2575: &s_objet_1) == d_erreur)
! 2576: {
! 2577: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 2578: return;
! 2579: }
! 2580:
! 2581: if (((*s_objet_1).type != INT) &&
! 2582: ((*s_objet_1).type != REL))
! 2583: {
! 2584: liberation(s_etat_processus, s_objet_1);
! 2585:
! 2586: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
! 2587: return;
! 2588: }
! 2589:
! 2590: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2591: &s_objet_2) == d_erreur)
! 2592: {
! 2593: liberation(s_etat_processus, s_objet_1);
! 2594:
! 2595: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 2596: return;
! 2597: }
! 2598:
! 2599: if (((*s_objet_2).type != INT) &&
! 2600: ((*s_objet_2).type != REL))
! 2601: {
! 2602: liberation(s_etat_processus, s_objet_1);
! 2603: liberation(s_etat_processus, s_objet_2);
! 2604:
! 2605: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
! 2606: return;
! 2607: }
! 2608:
! 2609: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet_2;
! 2610: (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
! 2611:
! 2612: if ((*s_etat_processus).mode_execution_programme == 'Y')
! 2613: {
! 2614: (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
! 2615: (*s_etat_processus).position_courante;
! 2616: (*(*s_etat_processus).l_base_pile_systeme)
! 2617: .origine_routine_evaluation = 'N';
! 2618: }
! 2619: else
! 2620: {
! 2621: (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
! 2622: (*s_etat_processus).expression_courante;
! 2623: (*(*s_etat_processus).l_base_pile_systeme)
! 2624: .origine_routine_evaluation = 'Y';
! 2625: }
! 2626:
! 2627: return;
! 2628: }
! 2629:
! 2630:
! 2631: /*
! 2632: ================================================================================
! 2633: Fonction 'step'
! 2634: ================================================================================
! 2635: Entrées : structure processus
! 2636: --------------------------------------------------------------------------------
! 2637: Sorties :
! 2638: --------------------------------------------------------------------------------
! 2639: Effets de bord : néant
! 2640: ================================================================================
! 2641: */
! 2642:
! 2643: void
! 2644: instruction_step(struct_processus *s_etat_processus)
! 2645: {
! 2646: struct_objet *s_objet;
! 2647: struct_objet *s_copie_objet;
! 2648:
! 2649: logical1 incrementation;
! 2650: logical1 presence_compteur;
! 2651:
! 2652: (*s_etat_processus).erreur_execution = d_ex;
! 2653:
! 2654: if ((*s_etat_processus).affichage_arguments == 'Y')
! 2655: {
! 2656: printf("\n STEP ");
! 2657:
! 2658: if ((*s_etat_processus).langue == 'F')
! 2659: {
! 2660: printf("(fin d'une boucle définie)\n\n");
! 2661: }
! 2662: else
! 2663: {
! 2664: printf("(end of defined loop)\n\n");
! 2665: }
! 2666:
! 2667: if ((*s_etat_processus).langue == 'F')
! 2668: {
! 2669: printf(" Utilisation :\n\n");
! 2670: }
! 2671: else
! 2672: {
! 2673: printf(" Usage:\n\n");
! 2674: }
! 2675:
! 2676: printf(" %s/%s %s/%s START\n", d_INT, d_REL,
! 2677: d_INT, d_REL);
! 2678: printf(" (expression)\n");
! 2679: printf(" [EXIT]/[CYCLE]\n");
! 2680: printf(" ...\n");
! 2681: printf(" (value) STEP\n\n");
! 2682:
! 2683: printf(" %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
! 2684: d_INT, d_REL);
! 2685: printf(" (expression)\n");
! 2686: printf(" [EXIT]/[CYCLE]\n");
! 2687: printf(" ...\n");
! 2688: printf(" (value) STEP\n");
! 2689:
! 2690: return;
! 2691: }
! 2692: else if ((*s_etat_processus).test_instruction == 'Y')
! 2693: {
! 2694: (*s_etat_processus).nombre_arguments = -1;
! 2695: return;
! 2696: }
! 2697:
! 2698: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 2699: {
! 2700: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 2701: {
! 2702: return;
! 2703: }
! 2704: }
! 2705:
! 2706: presence_compteur = ((*(*s_etat_processus).l_base_pile_systeme)
! 2707: .type_cloture == 'F') ? d_vrai : d_faux;
! 2708:
! 2709: if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'S')
! 2710: && (presence_compteur == d_faux))
! 2711: {
! 2712: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
! 2713: return;
! 2714: }
! 2715:
! 2716: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2717: &s_objet) == d_erreur)
! 2718: {
! 2719: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 2720: return;
! 2721: }
! 2722:
! 2723: if (((*s_objet).type != INT) &&
! 2724: ((*s_objet).type != REL))
! 2725: {
! 2726: liberation(s_etat_processus, s_objet);
! 2727:
! 2728: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
! 2729: return;
! 2730: }
! 2731:
! 2732: if ((*s_objet).type == INT)
! 2733: {
! 2734: incrementation = ((*((integer8 *) (*s_objet).objet)) >= 0)
! 2735: ? d_vrai : d_faux;
! 2736: }
! 2737: else
! 2738: {
! 2739: incrementation = ((*((real8 *) (*s_objet).objet)) >= 0)
! 2740: ? d_vrai : d_faux;
! 2741: }
! 2742:
! 2743: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2744: s_objet) == d_erreur)
! 2745: {
! 2746: return;
! 2747: }
! 2748:
! 2749: /*
! 2750: * Pour une boucle avec indice, on fait pointer
! 2751: * (*(*s_etat_processus).l_base_pile_systeme).indice_boucle sur
! 2752: * la variable correspondante. Remarque, le contenu de la variable
! 2753: * est détruit au courant de l'opération.
! 2754: */
! 2755:
! 2756: if (presence_compteur == d_vrai)
! 2757: {
! 2758: if (recherche_variable(s_etat_processus, (*(*s_etat_processus)
! 2759: .l_base_pile_systeme).nom_variable) == d_faux)
! 2760: {
! 2761: liberation(s_etat_processus, s_objet);
! 2762:
! 2763: (*s_etat_processus).erreur_systeme = d_es;
! 2764: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
! 2765: return;
! 2766: }
! 2767:
! 2768: if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 2769: .position_variable_courante]).variable_verrouillee == d_vrai)
! 2770: {
! 2771: liberation(s_etat_processus, s_objet);
! 2772:
! 2773: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
! 2774: return;
! 2775: }
! 2776:
! 2777: if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 2778: .position_variable_courante]).objet == NULL)
! 2779: {
! 2780: liberation(s_etat_processus, s_objet);
! 2781:
! 2782: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
! 2783: return;
! 2784: }
! 2785:
! 2786: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
! 2787: ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 2788: .position_variable_courante]).objet;
! 2789: }
! 2790:
! 2791: /*
! 2792: * Empilement pour calculer le nouvel indice. Au passage, la
! 2793: * variable (*(*s_etat_processus).l_base_pile_systeme).indice_boucle
! 2794: * est libérée.
! 2795: */
! 2796:
! 2797: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2798: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle)
! 2799: == d_erreur)
! 2800: {
! 2801: return;
! 2802: }
! 2803:
! 2804: instruction_plus(s_etat_processus);
! 2805:
! 2806: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2807: &s_objet) == d_erreur)
! 2808: {
! 2809: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 2810: return;
! 2811: }
! 2812:
! 2813: if (((*s_objet).type != INT) &&
! 2814: ((*s_objet).type != REL))
! 2815: {
! 2816: liberation(s_etat_processus, s_objet);
! 2817:
! 2818: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
! 2819: return;
! 2820: }
! 2821:
! 2822: if (presence_compteur == d_vrai)
! 2823: {
! 2824: /*
! 2825: * L'addition crée si besoin une copie de l'objet
! 2826: */
! 2827:
! 2828: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
! 2829: ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 2830: .position_variable_courante]).objet = s_objet;
! 2831: }
! 2832: else
! 2833: {
! 2834: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet;
! 2835: }
! 2836:
! 2837: if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'P')) == NULL)
! 2838: {
! 2839: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2840: return;
! 2841: }
! 2842:
! 2843: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2844: s_copie_objet) == d_erreur)
! 2845: {
! 2846: return;
! 2847: }
! 2848:
! 2849: if ((s_copie_objet = copie_objet(s_etat_processus,
! 2850: (*(*s_etat_processus).l_base_pile_systeme)
! 2851: .limite_indice_boucle, 'P')) == NULL)
! 2852: {
! 2853: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2854: return;
! 2855: }
! 2856:
! 2857: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2858: s_copie_objet) == d_erreur)
! 2859: {
! 2860: return;
! 2861: }
! 2862:
! 2863: if (incrementation == d_vrai)
! 2864: {
! 2865: instruction_le(s_etat_processus);
! 2866: }
! 2867: else
! 2868: {
! 2869: instruction_ge(s_etat_processus);
! 2870: }
! 2871:
! 2872: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2873: &s_objet) == d_erreur)
! 2874: {
! 2875: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 2876: return;
! 2877: }
! 2878:
! 2879: if ((*s_objet).type != INT)
! 2880: {
! 2881: liberation(s_etat_processus, s_objet);
! 2882:
! 2883: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
! 2884: return;
! 2885: }
! 2886:
! 2887: if ((*((integer8 *) (*s_objet).objet)) != 0)
! 2888: {
! 2889: if ((*(*s_etat_processus).l_base_pile_systeme)
! 2890: .origine_routine_evaluation == 'N')
! 2891: {
! 2892: (*s_etat_processus).position_courante = (*(*s_etat_processus)
! 2893: .l_base_pile_systeme).adresse_retour;
! 2894: }
! 2895: else
! 2896: {
! 2897: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
! 2898: .l_base_pile_systeme).pointeur_objet_retour;
! 2899: }
! 2900: }
! 2901: else
! 2902: {
! 2903: depilement_pile_systeme(s_etat_processus);
! 2904:
! 2905: if ((*s_etat_processus).erreur_systeme != d_es)
! 2906: {
! 2907: return;
! 2908: }
! 2909:
! 2910: if (presence_compteur == d_vrai)
! 2911: {
! 2912: (*s_etat_processus).niveau_courant--;
! 2913:
! 2914: if (retrait_variable_par_niveau(s_etat_processus) == d_erreur)
! 2915: {
! 2916: return;
! 2917: }
! 2918: }
! 2919: }
! 2920:
! 2921: liberation(s_etat_processus, s_objet);
! 2922:
! 2923: return;
! 2924: }
! 2925:
! 2926:
! 2927: /*
! 2928: ================================================================================
! 2929: Fonction 'sf'
! 2930: ================================================================================
! 2931: Entrées : structure processus
! 2932: --------------------------------------------------------------------------------
! 2933: Sorties :
! 2934: --------------------------------------------------------------------------------
! 2935: Effets de bord : néant
! 2936: ================================================================================
! 2937: */
! 2938:
! 2939: void
! 2940: instruction_sf(struct_processus *s_etat_processus)
! 2941: {
! 2942: struct_objet *s_objet;
! 2943:
! 2944: (*s_etat_processus).erreur_execution = d_ex;
! 2945:
! 2946: if ((*s_etat_processus).affichage_arguments == 'Y')
! 2947: {
! 2948: printf("\n SF ");
! 2949:
! 2950: if ((*s_etat_processus).langue == 'F')
! 2951: {
! 2952: printf("(positionne un indicateur binaire)\n\n");
! 2953: }
! 2954: else
! 2955: {
! 2956: printf("(set flag)\n\n");
! 2957: }
! 2958:
! 2959: printf(" 1: 1 <= %s <= 64\n", d_INT);
! 2960:
! 2961: return;
! 2962: }
! 2963: else if ((*s_etat_processus).test_instruction == 'Y')
! 2964: {
! 2965: (*s_etat_processus).nombre_arguments = -1;
! 2966: return;
! 2967: }
! 2968:
! 2969: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 2970: {
! 2971: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 2972: {
! 2973: return;
! 2974: }
! 2975: }
! 2976:
! 2977: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2978: &s_objet) == d_erreur)
! 2979: {
! 2980: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 2981: return;
! 2982: }
! 2983:
! 2984: if ((*s_objet).type == INT)
! 2985: {
! 2986: if (((*((integer8 *) (*s_objet).objet)) < 1) || ((*((integer8 *)
! 2987: (*s_objet).objet)) > 64))
! 2988: {
! 2989: liberation(s_etat_processus, s_objet);
! 2990:
! 2991: (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
! 2992: return;
! 2993: }
! 2994:
! 2995: sf(s_etat_processus, (unsigned char) (*((integer8 *)
! 2996: (*s_objet).objet)));
! 2997: }
! 2998: else
! 2999: {
! 3000: liberation(s_etat_processus, s_objet);
! 3001:
! 3002: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 3003: return;
! 3004: }
! 3005:
! 3006: liberation(s_etat_processus, s_objet);
! 3007:
! 3008: return;
! 3009: }
! 3010:
! 3011:
! 3012: /*
! 3013: ================================================================================
! 3014: Fonction 'stof'
! 3015: ================================================================================
! 3016: Entrées : structure processus
! 3017: --------------------------------------------------------------------------------
! 3018: Sorties :
! 3019: --------------------------------------------------------------------------------
! 3020: Effets de bord : néant
! 3021: ================================================================================
! 3022: */
! 3023:
! 3024: void
! 3025: instruction_stof(struct_processus *s_etat_processus)
! 3026: {
! 3027: struct_objet *s_objet;
! 3028:
! 3029: t_8_bits masque;
! 3030:
! 3031: unsigned char indice_bit;
! 3032: unsigned char indice_bloc;
! 3033: unsigned char indice_drapeau;
! 3034: unsigned char taille_bloc;
! 3035:
! 3036: unsigned long i;
! 3037:
! 3038: (*s_etat_processus).erreur_execution = d_ex;
! 3039:
! 3040: if ((*s_etat_processus).affichage_arguments == 'Y')
! 3041: {
! 3042: printf("\n STOF ");
! 3043:
! 3044: if ((*s_etat_processus).langue == 'F')
! 3045: {
! 3046: printf("(positionne les drapeaux d'état)\n\n");
! 3047: }
! 3048: else
! 3049: {
! 3050: printf("(set flags)\n\n");
! 3051: }
! 3052:
! 3053: printf("-> 1: %s\n", d_BIN);
! 3054:
! 3055: return;
! 3056: }
! 3057: else if ((*s_etat_processus).test_instruction == 'Y')
! 3058: {
! 3059: (*s_etat_processus).nombre_arguments = -1;
! 3060: return;
! 3061: }
! 3062:
! 3063: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 3064: {
! 3065: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 3066: {
! 3067: return;
! 3068: }
! 3069: }
! 3070:
! 3071: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 3072: &s_objet) == d_erreur)
! 3073: {
! 3074: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 3075: return;
! 3076: }
! 3077:
! 3078: if ((*s_objet).type == BIN)
! 3079: {
! 3080: taille_bloc = sizeof(t_8_bits) * 8;
! 3081:
! 3082: for(i = 0; i < 8; (*s_etat_processus).drapeaux_etat[i++] = 0);
! 3083:
! 3084: for(i = 1; i <= 64; i++)
! 3085: {
! 3086: indice_drapeau = i - 1;
! 3087: indice_bloc = indice_drapeau / taille_bloc;
! 3088: indice_bit = indice_drapeau % taille_bloc;
! 3089: masque = ((t_8_bits) 1) << (taille_bloc - indice_bit - 1);
! 3090:
! 3091: if (((*((logical8 *) (*s_objet).objet)) &
! 3092: ((logical8) 1) << indice_drapeau) != 0)
! 3093: {
! 3094: (*s_etat_processus).drapeaux_etat[indice_bloc] |= masque;
! 3095: }
! 3096: }
! 3097: }
! 3098: else
! 3099: {
! 3100: liberation(s_etat_processus, s_objet);
! 3101:
! 3102: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 3103: return;
! 3104: }
! 3105:
! 3106: liberation(s_etat_processus, s_objet);
! 3107:
! 3108: return;
! 3109: }
! 3110:
! 3111:
! 3112: /*
! 3113: ================================================================================
! 3114: Fonction 'sto'
! 3115: ================================================================================
! 3116: Entrées : structure processus
! 3117: --------------------------------------------------------------------------------
! 3118: Sorties :
! 3119: --------------------------------------------------------------------------------
! 3120: Effets de bord : néant
! 3121: ================================================================================
! 3122: */
! 3123:
! 3124: void
! 3125: instruction_sto(struct_processus *s_etat_processus)
! 3126: {
! 3127: struct_objet *s_objet_1;
! 3128: struct_objet *s_objet_2;
! 3129:
! 3130: struct_variable s_variable;
! 3131:
! 3132: (*s_etat_processus).erreur_execution = d_ex;
! 3133:
! 3134: if ((*s_etat_processus).affichage_arguments == 'Y')
! 3135: {
! 3136: printf("\n STO ");
! 3137:
! 3138: if ((*s_etat_processus).langue == 'F')
! 3139: {
! 3140: printf("(affecte un objet à une variable)\n\n");
! 3141: }
! 3142: else
! 3143: {
! 3144: printf("(store an object in a variable)\n\n");
! 3145: }
! 3146:
! 3147: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 3148: " %s, %s, %s, %s, %s,\n"
! 3149: " %s, %s, %s, %s, %s,\n"
! 3150: " %s, %s, %s, %s, %s,\n"
! 3151: " %s\n",
! 3152: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 3153: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 3154: d_SLB, d_PRC, d_MTX, d_SQL);
! 3155: printf(" 1: %s\n", d_NOM);
! 3156:
! 3157: return;
! 3158: }
! 3159: else if ((*s_etat_processus).test_instruction == 'Y')
! 3160: {
! 3161: (*s_etat_processus).nombre_arguments = -1;
! 3162: return;
! 3163: }
! 3164:
! 3165: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 3166: {
! 3167: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 3168: {
! 3169: return;
! 3170: }
! 3171: }
! 3172:
! 3173: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 3174: &s_objet_1) == d_erreur)
! 3175: {
! 3176: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 3177: return;
! 3178: }
! 3179:
! 3180: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 3181: &s_objet_2) == d_erreur)
! 3182: {
! 3183: liberation(s_etat_processus, s_objet_1);
! 3184:
! 3185: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 3186: return;
! 3187: }
! 3188:
! 3189: if ((*s_objet_1).type != NOM)
! 3190: {
! 3191: liberation(s_etat_processus, s_objet_1);
! 3192: liberation(s_etat_processus, s_objet_2);
! 3193:
! 3194: (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
! 3195: return;
! 3196: }
! 3197:
! 3198: if (recherche_variable(s_etat_processus, (*((struct_nom *)
! 3199: (*s_objet_1).objet)).nom) == d_vrai)
! 3200: {
! 3201: /*
! 3202: * La variable est accessible.
! 3203: */
! 3204:
! 3205: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 3206: .position_variable_courante].variable_verrouillee == d_vrai)
! 3207: {
! 3208: liberation(s_etat_processus, s_objet_1);
! 3209: liberation(s_etat_processus, s_objet_2);
! 3210:
! 3211: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
! 3212: return;
! 3213: }
! 3214:
! 3215: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 3216: .position_variable_courante].objet == NULL)
! 3217: {
! 3218: if (pthread_mutex_lock(&((*(*s_etat_processus)
! 3219: .s_liste_variables_partagees).mutex)) != 0)
! 3220: {
! 3221: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3222: return;
! 3223: }
! 3224:
! 3225: if (recherche_variable_partagee(s_etat_processus,
! 3226: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 3227: .position_variable_courante].nom,
! 3228: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 3229: .position_variable_courante].variable_partagee,
! 3230: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 3231: .position_variable_courante].origine) == d_faux)
! 3232: {
! 3233: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 3234: .s_liste_variables_partagees).mutex)) != 0)
! 3235: {
! 3236: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3237: return;
! 3238: }
! 3239:
! 3240: if ((s_variable.nom = malloc((strlen((*((struct_nom *)
! 3241: (*s_objet_1).objet)).nom) + 1) *
! 3242: sizeof(unsigned char))) == NULL)
! 3243: {
! 3244: (*s_etat_processus).erreur_systeme =
! 3245: d_es_allocation_memoire;
! 3246: return;
! 3247: }
! 3248:
! 3249: strcpy(s_variable.nom, (*((struct_nom *)
! 3250: (*s_objet_1).objet)).nom);
! 3251: s_variable.niveau = 1;
! 3252:
! 3253: /*
! 3254: * Le niveau 0 correspond aux définitions. Les variables
! 3255: * commencent à 1 car elles sont toujours incluses dans
! 3256: * une définition.
! 3257: */
! 3258:
! 3259: s_variable.objet = s_objet_2;
! 3260:
! 3261: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
! 3262: == d_erreur)
! 3263: {
! 3264: return;
! 3265: }
! 3266:
! 3267: (*s_etat_processus).erreur_systeme = d_es;
! 3268: }
! 3269: else
! 3270: {
! 3271: liberation(s_etat_processus, (*(*s_etat_processus)
! 3272: .s_liste_variables_partagees).table
! 3273: [(*(*s_etat_processus).s_liste_variables_partagees)
! 3274: .position_variable].objet);
! 3275:
! 3276: (*(*s_etat_processus).s_liste_variables_partagees).table
! 3277: [(*(*s_etat_processus).s_liste_variables_partagees)
! 3278: .position_variable].objet = s_objet_2;
! 3279:
! 3280: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 3281: .s_liste_variables_partagees).mutex)) != 0)
! 3282: {
! 3283: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3284: return;
! 3285: }
! 3286: }
! 3287: }
! 3288: else
! 3289: {
! 3290: liberation(s_etat_processus,
! 3291: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 3292: .position_variable_courante].objet);
! 3293:
! 3294: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 3295: .position_variable_courante].objet = s_objet_2;
! 3296: }
! 3297: }
! 3298: else
! 3299: {
! 3300: /*
! 3301: * La variable n'est pas accessible ou n'existe pas et on crée
! 3302: * une variable globale.
! 3303: */
! 3304:
! 3305: if ((s_variable.nom = malloc((strlen((*((struct_nom *)
! 3306: (*s_objet_1).objet)).nom) + 1) * sizeof(unsigned char)))
! 3307: == NULL)
! 3308: {
! 3309: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3310: return;
! 3311: }
! 3312:
! 3313: strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_1).objet)).nom);
! 3314: s_variable.niveau = 1;
! 3315:
! 3316: /*
! 3317: * Le niveau 0 correspond aux définitions. Les variables
! 3318: * commencent à 1 car elles sont toujours incluses dans
! 3319: * une définition.
! 3320: */
! 3321:
! 3322: s_variable.objet = s_objet_2;
! 3323:
! 3324: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
! 3325: == d_erreur)
! 3326: {
! 3327: return;
! 3328: }
! 3329:
! 3330: (*s_etat_processus).erreur_systeme = d_es;
! 3331: }
! 3332:
! 3333: liberation(s_etat_processus, s_objet_1);
! 3334:
! 3335: return;
! 3336: }
! 3337:
! 3338:
! 3339: /*
! 3340: ================================================================================
! 3341: Fonction 'syseval'
! 3342: ================================================================================
! 3343: Entrées : pointeur sur une struct_processus
! 3344: --------------------------------------------------------------------------------
! 3345: Sorties :
! 3346: --------------------------------------------------------------------------------
! 3347: Effets de bord : néant
! 3348: ================================================================================
! 3349: */
! 3350:
! 3351: void
! 3352: instruction_syseval(struct_processus *s_etat_processus)
! 3353: {
! 3354: char **arguments;
! 3355:
! 3356: int ios;
! 3357: int pipes_entree[2];
! 3358: int pipes_erreur[2];
! 3359: int pipes_sortie[2];
! 3360: int status;
! 3361:
! 3362: logical1 drapeau_fin;
! 3363: logical1 presence_stdin;
! 3364:
! 3365: long i;
! 3366: long nombre_arguments;
! 3367:
! 3368: pid_t pid;
! 3369:
! 3370: sigset_t oldset;
! 3371: sigset_t set;
! 3372:
! 3373: ssize_t longueur_ecriture;
! 3374:
! 3375: struct_liste_chainee *l_element_courant;
! 3376: struct_liste_chainee *l_element_precedent;
! 3377: struct_liste_chainee *l_element_stdin;
! 3378:
! 3379: struct_objet *s_objet;
! 3380: struct_objet *s_objet_composite;
! 3381: struct_objet *s_objet_resultat;
! 3382: struct_objet *s_objet_temporaire;
! 3383:
! 3384: struct sigaction action_courante;
! 3385: struct sigaction action_passee;
! 3386:
! 3387: unsigned char *ptr;
! 3388: unsigned char *ptr2;
! 3389: unsigned char registre_autorisation_empilement_programme;
! 3390: unsigned char *registre_instruction_courante;
! 3391: unsigned char *registre_programme;
! 3392: unsigned char *tampon;
! 3393:
! 3394: unsigned long longueur_lecture;
! 3395: unsigned long longueur_tampon;
! 3396: unsigned long nombre_iterations;
! 3397: unsigned long nombre_lignes;
! 3398: unsigned long pointeur;
! 3399: unsigned long registre_position_courante;
! 3400:
! 3401: (*s_etat_processus).erreur_execution = d_ex;
! 3402:
! 3403: if ((*s_etat_processus).affichage_arguments == 'Y')
! 3404: {
! 3405: printf("\n SYSEVAL ");
! 3406:
! 3407: if ((*s_etat_processus).langue == 'F')
! 3408: {
! 3409: printf("(exécute une commande système)\n\n");
! 3410: }
! 3411: else
! 3412: {
! 3413: printf("(execute a shell command)\n\n");
! 3414: }
! 3415:
! 3416: printf(" 1: %s\n", d_CHN);
! 3417: printf("-> 1: %s\n\n", d_LST);
! 3418:
! 3419: printf(" 1: %s\n", d_LST);
! 3420: printf("-> 1: %s\n", d_LST);
! 3421:
! 3422: return;
! 3423: }
! 3424: else if ((*s_etat_processus).test_instruction == 'Y')
! 3425: {
! 3426: (*s_etat_processus).nombre_arguments = -1;
! 3427: return;
! 3428: }
! 3429:
! 3430: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 3431: {
! 3432: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 3433: {
! 3434: return;
! 3435: }
! 3436: }
! 3437:
! 3438: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 3439: &s_objet) == d_erreur)
! 3440: {
! 3441: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 3442: return;
! 3443: }
! 3444:
! 3445: s_objet_composite = NULL;
! 3446: l_element_stdin = NULL;
! 3447: presence_stdin = d_faux;
! 3448:
! 3449: if ((*s_objet).type == LST)
! 3450: {
! 3451: s_objet_composite = s_objet;
! 3452: s_objet = (*((struct_liste_chainee *) (*s_objet_composite)
! 3453: .objet)).donnee;
! 3454: l_element_stdin = (*((struct_liste_chainee *) (*s_objet_composite)
! 3455: .objet)).suivant;
! 3456:
! 3457: l_element_courant = l_element_stdin;
! 3458:
! 3459: if (l_element_courant == NULL)
! 3460: {
! 3461: liberation(s_etat_processus, s_objet_composite);
! 3462:
! 3463: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 3464: return;
! 3465: }
! 3466:
! 3467: while(l_element_courant != NULL)
! 3468: {
! 3469: if ((*(*l_element_courant).donnee).type != CHN)
! 3470: {
! 3471: liberation(s_etat_processus, s_objet_composite);
! 3472:
! 3473: (*s_etat_processus).erreur_execution =
! 3474: d_ex_erreur_type_argument;
! 3475: return;
! 3476: }
! 3477:
! 3478: l_element_courant = (*l_element_courant).suivant;
! 3479: }
! 3480:
! 3481: presence_stdin = d_vrai;
! 3482: }
! 3483:
! 3484: if ((*s_objet).type == CHN)
! 3485: {
! 3486: registre_autorisation_empilement_programme =
! 3487: (*s_etat_processus).autorisation_empilement_programme;
! 3488: registre_instruction_courante =
! 3489: (*s_etat_processus).instruction_courante;
! 3490: registre_programme = (*s_etat_processus).definitions_chainees;
! 3491: registre_position_courante = (*s_etat_processus).position_courante;
! 3492:
! 3493: (*s_etat_processus).definitions_chainees =
! 3494: (unsigned char *) (*s_objet).objet;
! 3495: (*s_etat_processus).position_courante = 0;
! 3496: (*s_etat_processus).autorisation_empilement_programme = 'N';
! 3497:
! 3498: /*
! 3499: * Échappement des guillemets
! 3500: */
! 3501:
! 3502: ptr = (*s_etat_processus).definitions_chainees;
! 3503: ptr2 = ptr;
! 3504: i = 0;
! 3505:
! 3506: while((*ptr) != d_code_fin_chaine)
! 3507: {
! 3508: if ((*ptr) == '\\')
! 3509: {
! 3510: switch (*(ptr + 1))
! 3511: {
! 3512: case '"':
! 3513: case '\\':
! 3514: {
! 3515: ptr++;
! 3516: break;
! 3517: }
! 3518: }
! 3519: }
! 3520:
! 3521: *ptr2++ = *ptr++;
! 3522: }
! 3523:
! 3524: *ptr2 = d_code_fin_chaine;
! 3525:
! 3526: /*
! 3527: * Scission de la chaîne en différents arguments
! 3528: */
! 3529:
! 3530: nombre_arguments = 0;
! 3531: drapeau_fin = d_faux;
! 3532:
! 3533: do
! 3534: {
! 3535: if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
! 3536: {
! 3537: (*s_etat_processus).autorisation_empilement_programme =
! 3538: registre_autorisation_empilement_programme;
! 3539: (*s_etat_processus).instruction_courante =
! 3540: registre_instruction_courante;
! 3541: (*s_etat_processus).definitions_chainees = registre_programme;
! 3542: (*s_etat_processus).position_courante =
! 3543: registre_position_courante;
! 3544:
! 3545: return;
! 3546: }
! 3547:
! 3548: if ((*(*s_etat_processus).instruction_courante) !=
! 3549: d_code_fin_chaine)
! 3550: {
! 3551: if ((s_objet_temporaire = allocation(s_etat_processus, CHN))
! 3552: == NULL)
! 3553: {
! 3554: (*s_etat_processus).autorisation_empilement_programme =
! 3555: registre_autorisation_empilement_programme;
! 3556: (*s_etat_processus).instruction_courante =
! 3557: registre_instruction_courante;
! 3558: (*s_etat_processus).definitions_chainees =
! 3559: registre_programme;
! 3560: (*s_etat_processus).position_courante =
! 3561: registre_position_courante;
! 3562:
! 3563: (*s_etat_processus).erreur_systeme =
! 3564: d_es_allocation_memoire;
! 3565: return;
! 3566: }
! 3567:
! 3568: (*s_objet_temporaire).objet = (*s_etat_processus)
! 3569: .instruction_courante;
! 3570:
! 3571: /*
! 3572: * S'il y a des guillemets en début de chaîne, il y en
! 3573: * a aussi à la fin de la chaîne et on les ôte. Les
! 3574: * guillements intermédiaires sont protégés par une
! 3575: * séquence d'échappement qui est enlevée.
! 3576: */
! 3577:
! 3578: if ((*s_etat_processus).instruction_courante[0] == '"')
! 3579: {
! 3580: if (strlen((*s_etat_processus).instruction_courante) >= 2)
! 3581: {
! 3582: ptr = (*s_etat_processus).instruction_courante;
! 3583: ptr2 = ptr + 1;
! 3584:
! 3585: while((*ptr2) != d_code_fin_chaine)
! 3586: {
! 3587: *ptr++ = *ptr2++;
! 3588: }
! 3589:
! 3590: (*(--ptr)) = d_code_fin_chaine;
! 3591: }
! 3592: }
! 3593:
! 3594: if (empilement(s_etat_processus,
! 3595: &((*s_etat_processus).l_base_pile),
! 3596: s_objet_temporaire) == d_erreur)
! 3597: {
! 3598: return;
! 3599: }
! 3600: }
! 3601: else
! 3602: {
! 3603: free((*s_etat_processus).instruction_courante);
! 3604: drapeau_fin = d_vrai;
! 3605: }
! 3606:
! 3607: nombre_arguments++;
! 3608: } while(drapeau_fin == d_faux);
! 3609:
! 3610: (*s_etat_processus).autorisation_empilement_programme =
! 3611: registre_autorisation_empilement_programme;
! 3612: (*s_etat_processus).instruction_courante =
! 3613: registre_instruction_courante;
! 3614: (*s_etat_processus).definitions_chainees = registre_programme;
! 3615: (*s_etat_processus).position_courante = registre_position_courante;
! 3616:
! 3617: if ((arguments = malloc(nombre_arguments * sizeof(char *))) == NULL)
! 3618: {
! 3619: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3620: return;
! 3621: }
! 3622:
! 3623: l_element_courant = (*s_etat_processus).l_base_pile;
! 3624: nombre_arguments--;
! 3625:
! 3626: for(i = nombre_arguments, arguments[i--] = NULL; i >= 0; i--)
! 3627: {
! 3628: arguments[i] = (char *) (*(*l_element_courant).donnee).objet;
! 3629: l_element_courant = (*l_element_courant).suivant;
! 3630: }
! 3631:
! 3632: action_courante.sa_handler = SIG_IGN;
! 3633: action_courante.sa_flags = SA_NODEFER | SA_ONSTACK;
! 3634:
! 3635: if (sigaction(SIGINT, &action_courante, &action_passee) != 0)
! 3636: {
! 3637: for(i = 0; i < nombre_arguments; i++)
! 3638: {
! 3639: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 3640: &s_objet_temporaire);
! 3641: liberation(s_etat_processus, s_objet_temporaire);
! 3642: }
! 3643:
! 3644: free(arguments);
! 3645: (*s_etat_processus).erreur_systeme = d_es_signal;
! 3646: return;
! 3647: }
! 3648:
! 3649: if (pipe(pipes_entree) != 0)
! 3650: {
! 3651: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3652: return;
! 3653: }
! 3654:
! 3655: if (pipe(pipes_sortie) != 0)
! 3656: {
! 3657: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3658: return;
! 3659: }
! 3660:
! 3661: if (pipe(pipes_erreur) != 0)
! 3662: {
! 3663: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3664: return;
! 3665: }
! 3666:
! 3667: fflush(NULL);
! 3668:
! 3669: sigfillset(&set);
! 3670: pthread_sigmask(SIG_BLOCK, &set, &oldset);
! 3671:
! 3672: verrouillage_threads_concurrents(s_etat_processus);
! 3673: pid = fork();
! 3674: deverrouillage_threads_concurrents(s_etat_processus);
! 3675:
! 3676: pthread_sigmask(SIG_SETMASK, &oldset, NULL);
! 3677: sigpending(&set);
! 3678:
! 3679: if (pid < 0)
! 3680: {
! 3681: if (close(pipes_entree[0]) != 0)
! 3682: {
! 3683: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3684: return;
! 3685: }
! 3686:
! 3687: if (close(pipes_entree[1]) != 0)
! 3688: {
! 3689: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3690: return;
! 3691: }
! 3692:
! 3693: if (close(pipes_sortie[0]) != 0)
! 3694: {
! 3695: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3696: return;
! 3697: }
! 3698:
! 3699: if (close(pipes_sortie[1]) != 0)
! 3700: {
! 3701: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3702: return;
! 3703: }
! 3704:
! 3705: if (close(pipes_erreur[0]) != 0)
! 3706: {
! 3707: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3708: return;
! 3709: }
! 3710:
! 3711: if (close(pipes_erreur[1]) != 0)
! 3712: {
! 3713: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3714: return;
! 3715: }
! 3716:
! 3717: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3718: return;
! 3719: }
! 3720: else if (pid == 0)
! 3721: {
! 3722: if (close(pipes_entree[1]) != 0)
! 3723: {
! 3724: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3725: return;
! 3726: }
! 3727:
! 3728: if (close(pipes_sortie[0]) != 0)
! 3729: {
! 3730: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3731: return;
! 3732: }
! 3733:
! 3734: if (close(pipes_erreur[0]) != 0)
! 3735: {
! 3736: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3737: return;
! 3738: }
! 3739:
! 3740: if (pipes_entree[0] != STDIN_FILENO)
! 3741: {
! 3742: if (dup2(pipes_entree[0], STDIN_FILENO) == -1)
! 3743: {
! 3744: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3745: return;
! 3746: }
! 3747: }
! 3748:
! 3749: if (pipes_sortie[1] != STDOUT_FILENO)
! 3750: {
! 3751: if (dup2(pipes_sortie[1], STDOUT_FILENO) == -1)
! 3752: {
! 3753: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3754: return;
! 3755: }
! 3756: }
! 3757:
! 3758: if (pipes_sortie[1] != STDERR_FILENO)
! 3759: {
! 3760: if (dup2(pipes_sortie[1], STDERR_FILENO) == -1)
! 3761: {
! 3762: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3763: return;
! 3764: }
! 3765: }
! 3766:
! 3767: if (nombre_arguments != 0)
! 3768: {
! 3769: execvp(arguments[0], arguments);
! 3770: }
! 3771: else
! 3772: {
! 3773: exit(EXIT_SUCCESS);
! 3774: }
! 3775:
! 3776: /*
! 3777: * L'appel système execvp() a généré une erreur et n'a pu exécuter
! 3778: * argument[0] (fichier non exécutable ou inexistant).
! 3779: */
! 3780:
! 3781: close(pipes_entree[0]);
! 3782: close(pipes_sortie[1]);
! 3783:
! 3784: for(i = 0; i < nombre_arguments; i++)
! 3785: {
! 3786: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 3787: &s_objet_temporaire);
! 3788: liberation(s_etat_processus, s_objet_temporaire);
! 3789: }
! 3790:
! 3791: free(arguments);
! 3792: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3793:
! 3794: /*
! 3795: * Envoi d'une erreur dans le pipe idoine. On ne regarde pas
! 3796: * le nombre d'octets écrits car l'erreur ne pourra de toute
! 3797: * façon pas être traitée.
! 3798: */
! 3799:
! 3800: write_atomic(s_etat_processus, pipes_erreur[1], " ", 1);
! 3801: close(pipes_erreur[1]);
! 3802:
! 3803: exit(EXIT_SUCCESS);
! 3804: }
! 3805: else
! 3806: {
! 3807: if (close(pipes_entree[0]) != 0)
! 3808: {
! 3809: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3810: return;
! 3811: }
! 3812:
! 3813: if (close(pipes_sortie[1]) != 0)
! 3814: {
! 3815: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3816: return;
! 3817: }
! 3818:
! 3819: if (close(pipes_erreur[1]) != 0)
! 3820: {
! 3821: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3822: return;
! 3823: }
! 3824:
! 3825: if (presence_stdin == d_vrai)
! 3826: {
! 3827: l_element_courant = l_element_stdin;
! 3828:
! 3829: while(l_element_courant != NULL)
! 3830: {
! 3831: longueur_ecriture = strlen((unsigned char *)
! 3832: (*(*l_element_courant).donnee).objet);
! 3833:
! 3834: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
! 3835: {
! 3836: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3837: return;
! 3838: }
! 3839:
! 3840: while(write_atomic(s_etat_processus,
! 3841: pipes_entree[1], (unsigned char *)
! 3842: (*(*l_element_courant).donnee).objet,
! 3843: longueur_ecriture) != longueur_ecriture)
! 3844: {
! 3845: while(sem_wait(&((*s_etat_processus)
! 3846: .semaphore_fork)) == -1)
! 3847: {
! 3848: if (errno != EINTR)
! 3849: {
! 3850: (*s_etat_processus).erreur_systeme =
! 3851: d_es_processus;
! 3852: return;
! 3853: }
! 3854: }
! 3855:
! 3856: if (longueur_ecriture == -1)
! 3857: {
! 3858: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3859: return;
! 3860: }
! 3861:
! 3862: if (sem_post(&((*s_etat_processus)
! 3863: .semaphore_fork)) != 0)
! 3864: {
! 3865: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3866: return;
! 3867: }
! 3868: }
! 3869:
! 3870: while(write_atomic(s_etat_processus,
! 3871: pipes_entree[1], "\n", 1) != 1)
! 3872: {
! 3873: while(sem_wait(&((*s_etat_processus)
! 3874: .semaphore_fork)) == -1)
! 3875: {
! 3876: if (errno != EINTR)
! 3877: {
! 3878: (*s_etat_processus).erreur_systeme =
! 3879: d_es_processus;
! 3880: return;
! 3881: }
! 3882: }
! 3883:
! 3884: if (longueur_ecriture == -1)
! 3885: {
! 3886: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3887: return;
! 3888: }
! 3889:
! 3890: if (sem_post(&((*s_etat_processus)
! 3891: .semaphore_fork)) != 0)
! 3892: {
! 3893: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3894: return;
! 3895: }
! 3896: }
! 3897:
! 3898: while(sem_wait(&((*s_etat_processus).semaphore_fork))
! 3899: == -1)
! 3900: {
! 3901: if (errno != EINTR)
! 3902: {
! 3903: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3904: return;
! 3905: }
! 3906: }
! 3907:
! 3908: l_element_courant = (*l_element_courant).suivant;
! 3909: }
! 3910: }
! 3911:
! 3912: if (close(pipes_entree[1]) != 0)
! 3913: {
! 3914: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3915: return;
! 3916: }
! 3917:
! 3918: do
! 3919: {
! 3920: if (kill(pid, 0) != 0)
! 3921: {
! 3922: break;
! 3923: }
! 3924:
! 3925: /*
! 3926: * Récupération de la valeur de retour du processus détaché
! 3927: */
! 3928:
! 3929: if (sem_post(&((*s_etat_processus).semaphore_fork))
! 3930: != 0)
! 3931: {
! 3932: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3933: return;
! 3934: }
! 3935:
! 3936: if (waitpid(pid, &status, 0) == -1)
! 3937: {
! 3938: if (sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
! 3939: {
! 3940: if (errno != EINTR)
! 3941: {
! 3942: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3943: return;
! 3944: }
! 3945: }
! 3946:
! 3947: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3948: return;
! 3949: }
! 3950:
! 3951: if (sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
! 3952: {
! 3953: if (errno != EINTR)
! 3954: {
! 3955: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3956: return;
! 3957: }
! 3958: }
! 3959: } while((!WIFEXITED(status)) && (!WIFSIGNALED(status)));
! 3960:
! 3961: longueur_lecture = 256;
! 3962: pointeur = 0;
! 3963: nombre_iterations = 1;
! 3964:
! 3965: if ((tampon = malloc((longueur_lecture + 1) *
! 3966: sizeof(unsigned char))) == NULL)
! 3967: {
! 3968: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3969: return;
! 3970: }
! 3971:
! 3972: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
! 3973: {
! 3974: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3975: return;
! 3976: }
! 3977:
! 3978: while((ios = read_atomic(s_etat_processus,
! 3979: pipes_sortie[0], &(tampon[pointeur]),
! 3980: longueur_lecture)) > 0)
! 3981: {
! 3982: while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
! 3983: {
! 3984: if (errno != EINTR)
! 3985: {
! 3986: (*s_etat_processus).erreur_systeme = d_es_processus;
! 3987: return;
! 3988: }
! 3989: }
! 3990:
! 3991: tampon[pointeur + ios] = d_code_fin_chaine;
! 3992: pointeur += longueur_lecture;
! 3993: nombre_iterations++;
! 3994:
! 3995: if ((tampon = realloc(tampon,
! 3996: ((nombre_iterations * longueur_lecture) + 1) *
! 3997: sizeof(unsigned char))) == NULL)
! 3998: {
! 3999: (*s_etat_processus).erreur_systeme =
! 4000: d_es_allocation_memoire;
! 4001: return;
! 4002: }
! 4003:
! 4004: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
! 4005: {
! 4006: (*s_etat_processus).erreur_systeme = d_es_processus;
! 4007: return;
! 4008: }
! 4009: }
! 4010:
! 4011: while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
! 4012: {
! 4013: if (errno != EINTR)
! 4014: {
! 4015: (*s_etat_processus).erreur_systeme = d_es_processus;
! 4016: return;
! 4017: }
! 4018: }
! 4019:
! 4020: if ((tampon = realloc(tampon, (strlen(tampon) + 1) *
! 4021: sizeof(unsigned char))) == NULL)
! 4022: {
! 4023: (*s_etat_processus).erreur_systeme =
! 4024: d_es_allocation_memoire;
! 4025: return;
! 4026: }
! 4027:
! 4028: if (ios == -1)
! 4029: {
! 4030: (*s_etat_processus).erreur_systeme = d_es_processus;
! 4031: return;
! 4032: }
! 4033:
! 4034: if (close(pipes_sortie[0]) != 0)
! 4035: {
! 4036: (*s_etat_processus).erreur_systeme = d_es_processus;
! 4037: return;
! 4038: }
! 4039:
! 4040: /*
! 4041: * Transformation de la chaîne en liste
! 4042: */
! 4043:
! 4044: longueur_tampon = strlen(tampon);
! 4045:
! 4046: for(i = 0, ptr = tampon, nombre_lignes = 0;
! 4047: i < (long) longueur_tampon; i++, ptr++)
! 4048: {
! 4049: if ((*ptr) == d_code_retour_chariot)
! 4050: {
! 4051: nombre_lignes++;
! 4052: (*ptr) = d_code_fin_chaine;
! 4053: }
! 4054: }
! 4055:
! 4056: if ((s_objet_resultat = allocation(s_etat_processus, LST))
! 4057: == NULL)
! 4058: {
! 4059: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4060: return;
! 4061: }
! 4062:
! 4063: if (nombre_lignes == 0)
! 4064: {
! 4065: (*s_objet_resultat).objet = NULL;
! 4066: }
! 4067: else
! 4068: {
! 4069: if (((*s_objet_resultat).objet =
! 4070: allocation_maillon(s_etat_processus)) == NULL)
! 4071: {
! 4072: (*s_etat_processus).erreur_systeme =
! 4073: d_es_allocation_memoire;
! 4074: return;
! 4075: }
! 4076:
! 4077: l_element_precedent = NULL;
! 4078: l_element_courant = (struct_liste_chainee *)
! 4079: (*s_objet_resultat).objet;
! 4080:
! 4081: for(i = 0, ptr = tampon; i < (long) nombre_lignes; i++)
! 4082: {
! 4083: if (((*l_element_courant).donnee =
! 4084: allocation(s_etat_processus, CHN)) == NULL)
! 4085: {
! 4086: (*s_etat_processus).erreur_systeme =
! 4087: d_es_allocation_memoire;
! 4088: return;
! 4089: }
! 4090:
! 4091: if (((*(*l_element_courant).donnee).objet =
! 4092: malloc((strlen(ptr) + 1) * sizeof(unsigned char)))
! 4093: == NULL)
! 4094: {
! 4095: (*s_etat_processus).erreur_systeme =
! 4096: d_es_allocation_memoire;
! 4097: return;
! 4098: }
! 4099:
! 4100: strcpy((*(*l_element_courant).donnee).objet, ptr);
! 4101:
! 4102: while((*ptr) != d_code_fin_chaine)
! 4103: {
! 4104: ptr++;
! 4105: }
! 4106:
! 4107: ptr++;
! 4108:
! 4109: if (((*l_element_courant).suivant =
! 4110: allocation_maillon(s_etat_processus)) == NULL)
! 4111: {
! 4112: (*s_etat_processus).erreur_systeme =
! 4113: d_es_allocation_memoire;
! 4114: return;
! 4115: }
! 4116:
! 4117: l_element_precedent = l_element_courant;
! 4118: l_element_courant = (*l_element_courant).suivant;
! 4119: }
! 4120:
! 4121: free(l_element_courant);
! 4122:
! 4123: if (l_element_precedent != NULL)
! 4124: {
! 4125: (*l_element_precedent).suivant = NULL;
! 4126: }
! 4127: }
! 4128:
! 4129: free(tampon);
! 4130: }
! 4131:
! 4132: if (sigaction(SIGINT, &action_passee, NULL) != 0)
! 4133: {
! 4134: for(i = 0; i < nombre_arguments; i++)
! 4135: {
! 4136: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 4137: &s_objet_temporaire);
! 4138: liberation(s_etat_processus, s_objet_temporaire);
! 4139: }
! 4140:
! 4141: free(arguments);
! 4142: (*s_etat_processus).erreur_systeme = d_es_signal;
! 4143: return;
! 4144: }
! 4145:
! 4146: for(i = 0; i < nombre_arguments; i++)
! 4147: {
! 4148: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 4149: &s_objet_temporaire);
! 4150: liberation(s_etat_processus, s_objet_temporaire);
! 4151: }
! 4152:
! 4153: if ((tampon = malloc(sizeof(unsigned char))) == NULL)
! 4154: {
! 4155: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4156: return;
! 4157: }
! 4158:
! 4159: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
! 4160: {
! 4161: (*s_etat_processus).erreur_systeme = d_es_processus;
! 4162: return;
! 4163: }
! 4164:
! 4165: if (read_atomic(s_etat_processus, pipes_erreur[0], tampon, 1) > 0)
! 4166: {
! 4167: // Le processus fils renvoie une erreur.
! 4168:
! 4169: (*s_etat_processus).erreur_execution = d_ex_erreur_processus;
! 4170: liberation(s_etat_processus, s_objet_resultat);
! 4171: }
! 4172: else if (empilement(s_etat_processus,
! 4173: &((*s_etat_processus).l_base_pile), s_objet_resultat)
! 4174: == d_erreur)
! 4175: {
! 4176: while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
! 4177: {
! 4178: if (errno != EINTR)
! 4179: {
! 4180: (*s_etat_processus).erreur_systeme = d_es_processus;
! 4181: return;
! 4182: }
! 4183: }
! 4184:
! 4185: if (close(pipes_erreur[0]) != 0)
! 4186: {
! 4187: (*s_etat_processus).erreur_systeme = d_es_processus;
! 4188: return;
! 4189: }
! 4190:
! 4191: free(tampon);
! 4192: return;
! 4193: }
! 4194:
! 4195: while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
! 4196: {
! 4197: if (errno != EINTR)
! 4198: {
! 4199: (*s_etat_processus).erreur_systeme = d_es_processus;
! 4200: return;
! 4201: }
! 4202: }
! 4203:
! 4204: if (close(pipes_erreur[0]) != 0)
! 4205: {
! 4206: (*s_etat_processus).erreur_systeme = d_es_processus;
! 4207: return;
! 4208: }
! 4209:
! 4210: free(arguments);
! 4211: free(tampon);
! 4212: }
! 4213: else
! 4214: {
! 4215: if (presence_stdin == d_vrai)
! 4216: {
! 4217: s_objet = s_objet_composite;
! 4218: }
! 4219:
! 4220: liberation(s_etat_processus, s_objet);
! 4221:
! 4222: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 4223: return;
! 4224: }
! 4225:
! 4226: if (presence_stdin == d_vrai)
! 4227: {
! 4228: s_objet = s_objet_composite;
! 4229: }
! 4230:
! 4231: liberation(s_etat_processus, s_objet);
! 4232:
! 4233: return;
! 4234: }
! 4235:
! 4236:
! 4237: /*
! 4238: ================================================================================
! 4239: Fonction 'sign'
! 4240: ================================================================================
! 4241: Entrées :
! 4242: --------------------------------------------------------------------------------
! 4243: Sorties :
! 4244: --------------------------------------------------------------------------------
! 4245: Effets de bord : néant
! 4246: ================================================================================
! 4247: */
! 4248:
! 4249: void
! 4250: instruction_sign(struct_processus *s_etat_processus)
! 4251: {
! 4252: real8 norme;
! 4253:
! 4254: struct_liste_chainee *l_element_courant;
! 4255: struct_liste_chainee *l_element_precedent;
! 4256:
! 4257: struct_objet *s_copie_argument;
! 4258: struct_objet *s_objet_argument;
! 4259: struct_objet *s_objet_resultat;
! 4260:
! 4261: (*s_etat_processus).erreur_execution = d_ex;
! 4262:
! 4263: if ((*s_etat_processus).affichage_arguments == 'Y')
! 4264: {
! 4265: printf("\n SIGN ");
! 4266:
! 4267: if ((*s_etat_processus).langue == 'F')
! 4268: {
! 4269: printf("(signe)\n\n");
! 4270: }
! 4271: else
! 4272: {
! 4273: printf("(sign)\n\n");
! 4274: }
! 4275:
! 4276: printf(" 1: %s, %s\n", d_INT, d_REL);
! 4277: printf("-> 1: %s\n\n", d_INT);
! 4278:
! 4279: printf(" 1: %s\n", d_CPL);
! 4280: printf("-> 1: %s\n\n", d_CPL);
! 4281:
! 4282: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 4283: printf("-> 1: %s\n\n", d_ALG);
! 4284:
! 4285: printf(" 1: %s\n", d_RPN);
! 4286: printf("-> 1: %s\n", d_RPN);
! 4287:
! 4288: return;
! 4289: }
! 4290: else if ((*s_etat_processus).test_instruction == 'Y')
! 4291: {
! 4292: (*s_etat_processus).nombre_arguments = 1;
! 4293: return;
! 4294: }
! 4295:
! 4296: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 4297: {
! 4298: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 4299: {
! 4300: return;
! 4301: }
! 4302: }
! 4303:
! 4304: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 4305: &s_objet_argument) == d_erreur)
! 4306: {
! 4307: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 4308: return;
! 4309: }
! 4310:
! 4311: /*
! 4312: --------------------------------------------------------------------------------
! 4313: Signe d'un entier
! 4314: --------------------------------------------------------------------------------
! 4315: */
! 4316:
! 4317: if ((*s_objet_argument).type == INT)
! 4318: {
! 4319: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 4320: {
! 4321: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4322: return;
! 4323: }
! 4324:
! 4325: if ((*((integer8 *) (*s_objet_argument).objet)) > 0)
! 4326: {
! 4327: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
! 4328: }
! 4329: else if ((*((integer8 *) (*s_objet_argument).objet)) < 0)
! 4330: {
! 4331: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
! 4332: }
! 4333: else
! 4334: {
! 4335: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 4336: }
! 4337: }
! 4338:
! 4339: /*
! 4340: --------------------------------------------------------------------------------
! 4341: Signe d'un réel
! 4342: --------------------------------------------------------------------------------
! 4343: */
! 4344:
! 4345: else if ((*s_objet_argument).type == REL)
! 4346: {
! 4347: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
! 4348: {
! 4349: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4350: return;
! 4351: }
! 4352:
! 4353: if ((*((real8 *) (*s_objet_argument).objet)) > 0)
! 4354: {
! 4355: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
! 4356: }
! 4357: else if ((*((real8 *) (*s_objet_argument).objet)) < 0)
! 4358: {
! 4359: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
! 4360: }
! 4361: else
! 4362: {
! 4363: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 4364: }
! 4365: }
! 4366:
! 4367: /*
! 4368: --------------------------------------------------------------------------------
! 4369: Vecteur unité dans la direction du complexe
! 4370: --------------------------------------------------------------------------------
! 4371: */
! 4372:
! 4373: else if ((*s_objet_argument).type == CPL)
! 4374: {
! 4375: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
! 4376: {
! 4377: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4378: return;
! 4379: }
! 4380:
! 4381: f77absc_((struct_complexe16 *) (*s_objet_argument).objet, &norme);
! 4382: f77divisioncr_((struct_complexe16 *) (*s_objet_argument).objet,
! 4383: &norme, (struct_complexe16 *) (*s_objet_resultat).objet);
! 4384: }
! 4385:
! 4386: /*
! 4387: --------------------------------------------------------------------------------
! 4388: Signe d'un nom
! 4389: --------------------------------------------------------------------------------
! 4390: */
! 4391:
! 4392: else if ((*s_objet_argument).type == NOM)
! 4393: {
! 4394: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 4395: {
! 4396: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4397: return;
! 4398: }
! 4399:
! 4400: if (((*s_objet_resultat).objet =
! 4401: allocation_maillon(s_etat_processus)) == NULL)
! 4402: {
! 4403: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4404: return;
! 4405: }
! 4406:
! 4407: l_element_courant = (*s_objet_resultat).objet;
! 4408:
! 4409: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 4410: == NULL)
! 4411: {
! 4412: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4413: return;
! 4414: }
! 4415:
! 4416: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4417: .nombre_arguments = 0;
! 4418: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4419: .fonction = instruction_vers_niveau_superieur;
! 4420:
! 4421: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4422: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 4423: {
! 4424: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4425: return;
! 4426: }
! 4427:
! 4428: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4429: .nom_fonction, "<<");
! 4430:
! 4431: if (((*l_element_courant).suivant =
! 4432: allocation_maillon(s_etat_processus)) == NULL)
! 4433: {
! 4434: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4435: return;
! 4436: }
! 4437:
! 4438: l_element_courant = (*l_element_courant).suivant;
! 4439: (*l_element_courant).donnee = s_objet_argument;
! 4440:
! 4441: if (((*l_element_courant).suivant =
! 4442: allocation_maillon(s_etat_processus)) == NULL)
! 4443: {
! 4444: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4445: return;
! 4446: }
! 4447:
! 4448: l_element_courant = (*l_element_courant).suivant;
! 4449:
! 4450: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 4451: == NULL)
! 4452: {
! 4453: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4454: return;
! 4455: }
! 4456:
! 4457: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4458: .nombre_arguments = 1;
! 4459: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4460: .fonction = instruction_sign;
! 4461:
! 4462: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4463: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
! 4464: {
! 4465: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4466: return;
! 4467: }
! 4468:
! 4469: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4470: .nom_fonction, "SIGN");
! 4471:
! 4472: if (((*l_element_courant).suivant =
! 4473: allocation_maillon(s_etat_processus)) == NULL)
! 4474: {
! 4475: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4476: return;
! 4477: }
! 4478:
! 4479: l_element_courant = (*l_element_courant).suivant;
! 4480:
! 4481: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 4482: == NULL)
! 4483: {
! 4484: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4485: return;
! 4486: }
! 4487:
! 4488: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4489: .nombre_arguments = 0;
! 4490: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4491: .fonction = instruction_vers_niveau_inferieur;
! 4492:
! 4493: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4494: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 4495: {
! 4496: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4497: return;
! 4498: }
! 4499:
! 4500: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 4501: .nom_fonction, ">>");
! 4502:
! 4503: (*l_element_courant).suivant = NULL;
! 4504: s_objet_argument = NULL;
! 4505: }
! 4506:
! 4507: /*
! 4508: --------------------------------------------------------------------------------
! 4509: Signe d'une expression
! 4510: --------------------------------------------------------------------------------
! 4511: */
! 4512:
! 4513: else if (((*s_objet_argument).type == ALG) ||
! 4514: ((*s_objet_argument).type == RPN))
! 4515: {
! 4516: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
! 4517: 'N')) == NULL)
! 4518: {
! 4519: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4520: return;
! 4521: }
! 4522:
! 4523: l_element_courant = (struct_liste_chainee *)
! 4524: (*s_copie_argument).objet;
! 4525: l_element_precedent = l_element_courant;
! 4526:
! 4527: while((*l_element_courant).suivant != NULL)
! 4528: {
! 4529: l_element_precedent = l_element_courant;
! 4530: l_element_courant = (*l_element_courant).suivant;
! 4531: }
! 4532:
! 4533: if (((*l_element_precedent).suivant =
! 4534: allocation_maillon(s_etat_processus)) == NULL)
! 4535: {
! 4536: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4537: return;
! 4538: }
! 4539:
! 4540: if (((*(*l_element_precedent).suivant).donnee =
! 4541: allocation(s_etat_processus, FCT)) == NULL)
! 4542: {
! 4543: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4544: return;
! 4545: }
! 4546:
! 4547: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 4548: .donnee).objet)).nombre_arguments = 1;
! 4549: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 4550: .donnee).objet)).fonction = instruction_sign;
! 4551:
! 4552: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 4553: .suivant).donnee).objet)).nom_fonction =
! 4554: malloc(5 * sizeof(unsigned char))) == NULL)
! 4555: {
! 4556: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4557: return;
! 4558: }
! 4559:
! 4560: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 4561: .suivant).donnee).objet)).nom_fonction, "SIGN");
! 4562:
! 4563: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 4564:
! 4565: s_objet_resultat = s_copie_argument;
! 4566: }
! 4567:
! 4568: /*
! 4569: --------------------------------------------------------------------------------
! 4570: Fonction signe impossible à réaliser
! 4571: --------------------------------------------------------------------------------
! 4572: */
! 4573:
! 4574: else
! 4575: {
! 4576: liberation(s_etat_processus, s_objet_argument);
! 4577:
! 4578: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 4579: return;
! 4580: }
! 4581:
! 4582: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 4583: s_objet_resultat) == d_erreur)
! 4584: {
! 4585: return;
! 4586: }
! 4587:
! 4588: liberation(s_etat_processus, s_objet_argument);
! 4589:
! 4590: return;
! 4591: }
! 4592:
! 4593:
! 4594: /*
! 4595: ================================================================================
! 4596: Fonction 'select'
! 4597: ================================================================================
! 4598: Entrées : pointeur sur une struct_processus
! 4599: --------------------------------------------------------------------------------
! 4600: Sorties :
! 4601: --------------------------------------------------------------------------------
! 4602: Effets de bord : néant
! 4603: ================================================================================
! 4604: */
! 4605:
! 4606: void
! 4607: instruction_select(struct_processus *s_etat_processus)
! 4608: {
! 4609: (*s_etat_processus).erreur_execution = d_ex;
! 4610:
! 4611: if ((*s_etat_processus).affichage_arguments == 'Y')
! 4612: {
! 4613: printf("\n SELECT ");
! 4614:
! 4615: if ((*s_etat_processus).langue == 'F')
! 4616: {
! 4617: printf("(structure de contrôle)\n\n");
! 4618: printf(" Utilisation :\n\n");
! 4619: }
! 4620: else
! 4621: {
! 4622: printf("(control statement)\n\n");
! 4623: printf(" Usage:\n\n");
! 4624: }
! 4625:
! 4626: printf(" SELECT (expression test)\n");
! 4627: printf(" CASE (clause 1) THEN (expression 1) END\n");
! 4628: printf(" CASE (clause 2) THEN (expression 2) END\n");
! 4629: printf(" ...\n");
! 4630: printf(" CASE (clause n) THEN (expression n) END\n");
! 4631: printf(" DEFAULT\n");
! 4632: printf(" (expression)\n");
! 4633: printf(" END\n\n");
! 4634:
! 4635: printf(" SELECT (expression test)\n");
! 4636: printf(" CASE (clause 1) THEN (expression 1) END\n");
! 4637: printf(" (expression)\n");
! 4638: printf(" CASE (clause 2) THEN (expression 2) END\n");
! 4639: printf(" END\n");
! 4640:
! 4641: return;
! 4642: }
! 4643: else if ((*s_etat_processus).test_instruction == 'Y')
! 4644: {
! 4645: (*s_etat_processus).nombre_arguments = -1;
! 4646: return;
! 4647: }
! 4648:
! 4649: empilement_pile_systeme(s_etat_processus);
! 4650:
! 4651: if ((*s_etat_processus).erreur_systeme != d_es)
! 4652: {
! 4653: return;
! 4654: }
! 4655:
! 4656: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'C';
! 4657: (*(*s_etat_processus).l_base_pile_systeme).clause = 'S';
! 4658:
! 4659: return;
! 4660: }
! 4661:
! 4662:
! 4663: /*
! 4664: ================================================================================
! 4665: Fonction 'std'
! 4666: ================================================================================
! 4667: Entrées : pointeur sur une struct_processus
! 4668: --------------------------------------------------------------------------------
! 4669: Sorties :
! 4670: --------------------------------------------------------------------------------
! 4671: Effets de bord : néant
! 4672: ================================================================================
! 4673: */
! 4674:
! 4675: void
! 4676: instruction_std(struct_processus *s_etat_processus)
! 4677: {
! 4678: (*s_etat_processus).erreur_execution = d_ex;
! 4679:
! 4680: if ((*s_etat_processus).affichage_arguments == 'Y')
! 4681: {
! 4682: printf("\n STD ");
! 4683:
! 4684: if ((*s_etat_processus).langue == 'F')
! 4685: {
! 4686: printf("(format standard)\n\n");
! 4687: printf(" Aucun argument\n");
! 4688: }
! 4689: else
! 4690: {
! 4691: printf("(standard format)\n\n");
! 4692: printf(" No argument\n");
! 4693: }
! 4694:
! 4695: return;
! 4696: }
! 4697: else if ((*s_etat_processus).test_instruction == 'Y')
! 4698: {
! 4699: (*s_etat_processus).nombre_arguments = -1;
! 4700: return;
! 4701: }
! 4702:
! 4703: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 4704: {
! 4705: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 4706: {
! 4707: return;
! 4708: }
! 4709: }
! 4710:
! 4711: cf(s_etat_processus, 49);
! 4712: cf(s_etat_processus, 50);
! 4713:
! 4714: return;
! 4715: }
! 4716:
! 4717:
! 4718: /*
! 4719: ================================================================================
! 4720: Fonction 'sci'
! 4721: ================================================================================
! 4722: Entrées : pointeur sur une struct_processus
! 4723: --------------------------------------------------------------------------------
! 4724: Sorties :
! 4725: --------------------------------------------------------------------------------
! 4726: Effets de bord : néant
! 4727: ================================================================================
! 4728: */
! 4729:
! 4730: void
! 4731: instruction_sci(struct_processus *s_etat_processus)
! 4732: {
! 4733: struct_objet *s_objet_argument;
! 4734: struct_objet *s_objet;
! 4735:
! 4736: logical1 i43;
! 4737: logical1 i44;
! 4738:
! 4739: unsigned char *valeur_binaire;
! 4740:
! 4741: unsigned long i;
! 4742: unsigned long j;
! 4743:
! 4744: (*s_etat_processus).erreur_execution = d_ex;
! 4745:
! 4746: if ((*s_etat_processus).affichage_arguments == 'Y')
! 4747: {
! 4748: printf("\n SCI ");
! 4749:
! 4750: if ((*s_etat_processus).langue == 'F')
! 4751: {
! 4752: printf("(format scientifique)\n\n");
! 4753: }
! 4754: else
! 4755: {
! 4756: printf("(scientific format)\n\n");
! 4757: }
! 4758:
! 4759: printf(" 1: %s\n", d_INT);
! 4760:
! 4761: return;
! 4762: }
! 4763: else if ((*s_etat_processus).test_instruction == 'Y')
! 4764: {
! 4765: (*s_etat_processus).nombre_arguments = -1;
! 4766: return;
! 4767: }
! 4768:
! 4769: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 4770: {
! 4771: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 4772: {
! 4773: return;
! 4774: }
! 4775: }
! 4776:
! 4777: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 4778: &s_objet_argument) == d_erreur)
! 4779: {
! 4780: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 4781: return;
! 4782: }
! 4783:
! 4784: if ((*s_objet_argument).type == INT)
! 4785: {
! 4786: if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
! 4787: ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
! 4788: {
! 4789: if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
! 4790: {
! 4791: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4792: return;
! 4793: }
! 4794:
! 4795: (*((logical8 *) (*s_objet).objet)) =
! 4796: (*((integer8 *) (*s_objet_argument).objet));
! 4797:
! 4798: i43 = test_cfsf(s_etat_processus, 43);
! 4799: i44 = test_cfsf(s_etat_processus, 44);
! 4800:
! 4801: sf(s_etat_processus, 44);
! 4802: cf(s_etat_processus, 43);
! 4803:
! 4804: if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
! 4805: == NULL)
! 4806: {
! 4807: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 4808: return;
! 4809: }
! 4810:
! 4811: if (i43 == d_vrai)
! 4812: {
! 4813: sf(s_etat_processus, 43);
! 4814: }
! 4815: else
! 4816: {
! 4817: cf(s_etat_processus, 43);
! 4818: }
! 4819:
! 4820: if (i44 == d_vrai)
! 4821: {
! 4822: sf(s_etat_processus, 44);
! 4823: }
! 4824: else
! 4825: {
! 4826: cf(s_etat_processus, 44);
! 4827: }
! 4828:
! 4829: for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
! 4830: {
! 4831: if (valeur_binaire[i] == '0')
! 4832: {
! 4833: cf(s_etat_processus, j++);
! 4834: }
! 4835: else
! 4836: {
! 4837: sf(s_etat_processus, j++);
! 4838: }
! 4839: }
! 4840:
! 4841: for(; j <= 56; cf(s_etat_processus, j++));
! 4842:
! 4843: cf(s_etat_processus, 49);
! 4844: sf(s_etat_processus, 50);
! 4845:
! 4846: free(valeur_binaire);
! 4847: liberation(s_etat_processus, s_objet);
! 4848: }
! 4849: else
! 4850: {
! 4851: liberation(s_etat_processus, s_objet_argument);
! 4852:
! 4853: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 4854: return;
! 4855: }
! 4856: }
! 4857: else
! 4858: {
! 4859: liberation(s_etat_processus, s_objet_argument);
! 4860:
! 4861: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 4862: return;
! 4863: }
! 4864:
! 4865: liberation(s_etat_processus, s_objet_argument);
! 4866:
! 4867: return;
! 4868: }
! 4869:
! 4870: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>