Annotation of rpl/src/instructions_f3.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 'FORMAT'
! 29: ================================================================================
! 30: Entrées : structure processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_format(struct_processus *s_etat_processus)
! 40: {
! 41: struct_objet *s_copie_argument_1;
! 42: struct_objet *s_objet_argument_1;
! 43: struct_objet *s_objet_argument_2;
! 44:
! 45: (*s_etat_processus).erreur_execution = d_ex;
! 46:
! 47: if ((*s_etat_processus).affichage_arguments == 'Y')
! 48: {
! 49: printf("\n FORMAT ");
! 50:
! 51: if ((*s_etat_processus).langue == 'F')
! 52: {
! 53: printf("(associe un format à un descripteur de fichier "
! 54: "ou à une socket)\n\n");
! 55: }
! 56: else
! 57: {
! 58: printf("(associate a format to a file or socket descriptor)\n\n");
! 59: }
! 60:
! 61: printf(" 2: %s\n", d_LST);
! 62: printf(" 1: %s, %s\n", d_FCH, d_SCK);
! 63: printf("-> 1: %s, %s\n\n", d_FCH, d_SCK);
! 64:
! 65: if ((*s_etat_processus).langue == 'F')
! 66: {
! 67: printf(" Utilisation :\n\n");
! 68: }
! 69: else
! 70: {
! 71: printf(" Usage:\n\n");
! 72: }
! 73:
! 74: printf(" { \"STANDARD*(*)\" }\n");
! 75: printf(" { \"lambda\" 'SEQUENTIAL' 'NEW' 'WRITEONLY' 'FORMATTED' }"
! 76: " OPEN FORMAT\n\n");
! 77:
! 78: if ((*s_etat_processus).langue == 'F')
! 79: {
! 80: printf(" Formats autorisés :\n\n");
! 81: }
! 82: else
! 83: {
! 84: printf(" Authorized formats:\n\n");
! 85: }
! 86:
! 87: printf(" FORMATTED\n");
! 88: printf(" { \"STANDARD*(*)\" }\n");
! 89: printf(" { \"STANDARD*(%s)\" }\n", d_INT);
! 90: printf(" { \"FIXED*%s(*)\" }\n", d_INT);
! 91: printf(" { \"FIXED*%s(%s)}\n", d_INT, d_INT);
! 92: printf(" { \"SCIENTIFIC*%s(*)\" }\n", d_INT);
! 93: printf(" { \"SCIENTIFIC*%s(%s)\" }\n", d_INT, d_INT);
! 94: printf(" { \"ENGINEER*%s(*)\" }\n", d_INT);
! 95: printf(" { \"ENGINEER*%s(%s)\" }\n", d_INT, d_INT);
! 96: printf(" { \"CHARACTER*(*)\" }\n");
! 97: printf(" { \"CHARACTER*(%s)\" }\n", d_INT);
! 98: printf(" { \"BINARY*%s(*)\" }\n", d_INT);
! 99: printf(" { \"BINARY*%s(%s)\" }\n\n", d_INT, d_INT);
! 100:
! 101: printf(" UNFORMATTED\n");
! 102: printf(" { \"INTEGER*1\", \"INTEGER*2\", \"INTEGER*4\", "
! 103: "\"INTEGER*8\" }\n");
! 104: printf(" { \"LOGICAL*1\", \"LOGICAL*2\", \"LOGICAL*4\", "
! 105: "\"LOGICAL*8\" }\n");
! 106: printf(" { \"REAL*4\", \"REAL*8\" }\n");
! 107: printf(" { \"COMPLEX*8\", \"COMPLEX*16\" }\n");
! 108: printf(" { \"CHARACTER\" }\n\n");
! 109:
! 110: printf(" FLOW\n");
! 111: printf(" { \"CHARACTER*(*)\" }\n");
! 112: printf(" { \"CHARACTER*(%s)\" }\n", d_INT);
! 113: printf(" { \"LENGTH*(*)\" }\n");
! 114: printf(" { \"LENGTH*(%s)\" }\n", d_INT);
! 115:
! 116: return;
! 117: }
! 118: else if ((*s_etat_processus).test_instruction == 'Y')
! 119: {
! 120: (*s_etat_processus).nombre_arguments = -1;
! 121: return;
! 122: }
! 123:
! 124: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 125: {
! 126: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 127: {
! 128: return;
! 129: }
! 130: }
! 131:
! 132: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 133: &s_objet_argument_1) == d_erreur)
! 134: {
! 135: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 136: return;
! 137: }
! 138:
! 139: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 140: &s_objet_argument_2) == d_erreur)
! 141: {
! 142: liberation(s_etat_processus, s_objet_argument_1);
! 143:
! 144: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 145: return;
! 146: }
! 147:
! 148: if (((*s_objet_argument_1).type == FCH) &&
! 149: ((*s_objet_argument_2).type == LST))
! 150: {
! 151: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
! 152: s_objet_argument_1, 'N')) == NULL)
! 153: {
! 154: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 155: return;
! 156: }
! 157:
! 158: liberation(s_etat_processus, s_objet_argument_1);
! 159: s_objet_argument_1 = s_copie_argument_1;
! 160:
! 161: liberation(s_etat_processus, (*((struct_fichier *)
! 162: (*s_objet_argument_1).objet)).format);
! 163:
! 164: (*((struct_fichier *) (*s_objet_argument_1).objet)).format =
! 165: s_objet_argument_2;
! 166: }
! 167: else if (((*s_objet_argument_1).type == SCK) &&
! 168: ((*s_objet_argument_2).type == LST))
! 169: {
! 170: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
! 171: s_objet_argument_1, 'N')) == NULL)
! 172: {
! 173: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 174: return;
! 175: }
! 176:
! 177: liberation(s_etat_processus, s_objet_argument_1);
! 178: s_objet_argument_1 = s_copie_argument_1;
! 179:
! 180: liberation(s_etat_processus, (*((struct_socket *)
! 181: (*s_objet_argument_1).objet)).format);
! 182:
! 183: (*((struct_socket *) (*s_objet_argument_1).objet)).format =
! 184: s_objet_argument_2;
! 185: }
! 186: else
! 187: {
! 188: liberation(s_etat_processus, s_objet_argument_1);
! 189: liberation(s_etat_processus, s_objet_argument_2);
! 190:
! 191: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 192: return;
! 193: }
! 194:
! 195: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 196: s_objet_argument_1) == d_erreur)
! 197: {
! 198: return;
! 199: }
! 200:
! 201: return;
! 202: }
! 203:
! 204:
! 205: /*
! 206: ================================================================================
! 207: Fonction '->LCD'
! 208: ================================================================================
! 209: Entrées : structure processus
! 210: --------------------------------------------------------------------------------
! 211: Sorties :
! 212: --------------------------------------------------------------------------------
! 213: Effets de bord : néant
! 214: ================================================================================
! 215: */
! 216:
! 217: void
! 218: instruction_fleche_lcd(struct_processus *s_etat_processus)
! 219: {
! 220: file *fichier_destination;
! 221: file *fichier_source;
! 222:
! 223: int caractere;
! 224: int dimensions;
! 225:
! 226: integer8 systeme_axes;
! 227:
! 228: logical1 axes;
! 229:
! 230: struct_fichier_graphique *l_fichier_courant;
! 231:
! 232: struct_objet *s_objet_argument;
! 233:
! 234: unsigned char drapeau_axes;
! 235: unsigned char *nom_fichier;
! 236: unsigned char type[21];
! 237:
! 238: (*s_etat_processus).erreur_execution = d_ex;
! 239:
! 240: if ((*s_etat_processus).affichage_arguments == 'Y')
! 241: {
! 242: printf("\n ->LCD ");
! 243:
! 244: if ((*s_etat_processus).langue == 'F')
! 245: {
! 246: printf("(lecture d'un fichier graphique)\n\n");
! 247: }
! 248: else
! 249: {
! 250: printf("(read a graphical file)\n\n");
! 251: }
! 252:
! 253: printf(" 1: %s\n", d_CHN);
! 254:
! 255: return;
! 256: }
! 257: else if ((*s_etat_processus).test_instruction == 'Y')
! 258: {
! 259: (*s_etat_processus).nombre_arguments = -1;
! 260: return;
! 261: }
! 262:
! 263: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 264: {
! 265: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 266: {
! 267: return;
! 268: }
! 269: }
! 270:
! 271: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 272: &s_objet_argument) == d_erreur)
! 273: {
! 274: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 275: return;
! 276: }
! 277:
! 278: if ((*s_objet_argument).type == CHN)
! 279: {
! 280: if (fflush(NULL) != 0)
! 281: {
! 282: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 283: return;
! 284: }
! 285:
! 286: if ((fichier_source = fopen((unsigned char *) (*s_objet_argument).objet,
! 287: "r")) == NULL)
! 288: {
! 289: liberation(s_etat_processus, s_objet_argument);
! 290:
! 291: (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
! 292: return;
! 293: }
! 294:
! 295: fichier_destination = NULL;
! 296:
! 297: while((caractere = getc(fichier_source)) != EOF)
! 298: {
! 299: if (caractere == '@')
! 300: {
! 301: /* Création d'un nouveau fichier */
! 302:
! 303: if (fichier_destination != NULL)
! 304: {
! 305: if (fclose(fichier_destination) != 0)
! 306: {
! 307: (*s_etat_processus).erreur_systeme =
! 308: d_es_erreur_fichier;
! 309: return;
! 310: }
! 311: }
! 312:
! 313: if (fscanf(fichier_source, " %c %d %lld %s",
! 314: &drapeau_axes, &dimensions, &systeme_axes, type) != 4)
! 315: {
! 316: (*s_etat_processus).erreur_systeme =
! 317: d_es_erreur_fichier;
! 318: return;
! 319: }
! 320:
! 321: axes = (drapeau_axes == 'T') ? d_vrai : d_faux;
! 322:
! 323: if ((nom_fichier = creation_nom_fichier(s_etat_processus,
! 324: (*s_etat_processus).chemin_fichiers_temporaires))
! 325: == NULL)
! 326: {
! 327: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 328: return;
! 329: }
! 330:
! 331: if ((fichier_destination = fopen(nom_fichier, "w")) == NULL)
! 332: {
! 333: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 334: return;
! 335: }
! 336:
! 337: /* Chaînage */
! 338:
! 339: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
! 340:
! 341: if (l_fichier_courant == NULL)
! 342: {
! 343: if (((*s_etat_processus).fichiers_graphiques =
! 344: malloc(sizeof(struct_fichier_graphique))) == NULL)
! 345: {
! 346: (*s_etat_processus).erreur_systeme =
! 347: d_es_allocation_memoire;
! 348: return;
! 349: }
! 350:
! 351: (*(*s_etat_processus).fichiers_graphiques).suivant = NULL;
! 352: (*(*s_etat_processus).fichiers_graphiques).nom =
! 353: nom_fichier;
! 354: (*(*s_etat_processus).fichiers_graphiques).legende =
! 355: NULL;
! 356: (*(*s_etat_processus).fichiers_graphiques).presence_axes =
! 357: axes;
! 358: (*(*s_etat_processus).fichiers_graphiques).dimensions =
! 359: dimensions;
! 360: (*(*s_etat_processus).fichiers_graphiques).systeme_axes =
! 361: systeme_axes;
! 362: strcpy((*(*s_etat_processus).fichiers_graphiques).type,
! 363: type);
! 364: }
! 365: else
! 366: {
! 367: while((*l_fichier_courant).suivant != NULL)
! 368: {
! 369: l_fichier_courant = (*l_fichier_courant).suivant;
! 370: }
! 371:
! 372: if (((*l_fichier_courant).suivant =
! 373: malloc(sizeof(struct_fichier_graphique))) == NULL)
! 374: {
! 375: (*s_etat_processus).erreur_systeme =
! 376: d_es_allocation_memoire;
! 377: return;
! 378: }
! 379:
! 380: l_fichier_courant = (*l_fichier_courant).suivant;
! 381:
! 382: (*l_fichier_courant).suivant = NULL;
! 383: (*l_fichier_courant).nom = nom_fichier;
! 384: (*l_fichier_courant).legende = NULL;
! 385: (*l_fichier_courant).presence_axes = axes;
! 386: (*l_fichier_courant).dimensions = dimensions;
! 387: (*l_fichier_courant).systeme_axes = systeme_axes;
! 388: strcpy((*l_fichier_courant).type, type);
! 389: }
! 390: }
! 391: else
! 392: {
! 393: if (putc(caractere, fichier_destination) == EOF)
! 394: {
! 395: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 396: return;
! 397: }
! 398: }
! 399: }
! 400:
! 401: if (fichier_destination != NULL)
! 402: {
! 403: if (fclose(fichier_destination) != 0)
! 404: {
! 405: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 406: return;
! 407: }
! 408: }
! 409:
! 410: if (fclose(fichier_source) != 0)
! 411: {
! 412: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 413: return;
! 414: }
! 415: }
! 416: else
! 417: {
! 418: liberation(s_etat_processus, s_objet_argument);
! 419:
! 420: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 421: return;
! 422: }
! 423:
! 424: liberation(s_etat_processus, s_objet_argument);
! 425:
! 426: appel_gnuplot(s_etat_processus, 'N');
! 427:
! 428: return;
! 429: }
! 430:
! 431:
! 432: /*
! 433: ================================================================================
! 434: Fonction '->Q'
! 435: ================================================================================
! 436: Entrées : structure processus
! 437: --------------------------------------------------------------------------------
! 438: Sorties :
! 439: --------------------------------------------------------------------------------
! 440: Effets de bord : néant
! 441: ================================================================================
! 442: */
! 443:
! 444: void
! 445: instruction_fleche_q(struct_processus *s_etat_processus)
! 446: {
! 447: double epsilon;
! 448:
! 449: struct_liste_chainee *l_element_courant;
! 450:
! 451: struct_objet *s_objet_argument;
! 452: struct_objet *s_objet_argument_1;
! 453: struct_objet *s_objet_argument_2;
! 454: struct_objet *s_objet_resultat;
! 455:
! 456: real8 f;
! 457: real8 objectif;
! 458: real8 r1;
! 459: real8 r2;
! 460: real8 s1;
! 461: real8 s2;
! 462: real8 t1;
! 463: real8 t2;
! 464: real8 x;
! 465: real8 y;
! 466: real8 z;
! 467:
! 468: (*s_etat_processus).erreur_execution = d_ex;
! 469:
! 470: if ((*s_etat_processus).affichage_arguments == 'Y')
! 471: {
! 472: printf("\n ->Q ");
! 473:
! 474: if ((*s_etat_processus).langue == 'F')
! 475: {
! 476: printf("(transformation d'un réel en rationnel)\n\n");
! 477: }
! 478: else
! 479: {
! 480: printf("(transform a real into a rational)\n\n");
! 481: }
! 482:
! 483: printf(" 1: %s\n", d_INT);
! 484: printf("-> 1: %s\n\n", d_INT);
! 485:
! 486: printf(" 1: %s\n", d_REL);
! 487: printf("-> 1: %s\n", d_ALG);
! 488:
! 489: return;
! 490: }
! 491: else if ((*s_etat_processus).test_instruction == 'Y')
! 492: {
! 493: (*s_etat_processus).nombre_arguments = -1;
! 494: return;
! 495: }
! 496:
! 497: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 498: {
! 499: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 500: {
! 501: return;
! 502: }
! 503: }
! 504:
! 505: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 506: &s_objet_argument) == d_erreur)
! 507: {
! 508: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 509: return;
! 510: }
! 511:
! 512: if ((*s_objet_argument).type == INT)
! 513: {
! 514: s_objet_resultat = s_objet_argument;
! 515: s_objet_argument = NULL;
! 516: }
! 517: else if ((*s_objet_argument).type == REL)
! 518: {
! 519: x = (*((real8 *) (*s_objet_argument).objet));
! 520: objectif = x;
! 521: epsilon = nextafter(-abs(x), 0) + abs(x);
! 522:
! 523: r1 = 1;
! 524: r2 = 0;
! 525: s1 = 0;
! 526: s2 = 1;
! 527:
! 528: do
! 529: {
! 530: f = floor(x);
! 531:
! 532: t1 = r1;
! 533: t2 = r2;
! 534:
! 535: r1 = (f * r1) + s1;
! 536: r2 = (f * r2) + s2;
! 537:
! 538: s1 = t1;
! 539: s2 = t2;
! 540:
! 541: y = x - f;
! 542:
! 543: if (y != 0)
! 544: {
! 545: z = fabs(objectif - (r1 / r2));
! 546: x = ((real8) 1) / y;
! 547: }
! 548: else
! 549: {
! 550: z = 0;
! 551: }
! 552: } while(z > epsilon);
! 553:
! 554: if ((s_objet_argument_1 = allocation(s_etat_processus, REL)) == NULL)
! 555: {
! 556: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 557: return;
! 558: }
! 559:
! 560: (*((real8 *) (*s_objet_argument_1).objet)) = r2;
! 561:
! 562: if ((s_objet_argument_2 = allocation(s_etat_processus, REL)) == NULL)
! 563: {
! 564: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 565: return;
! 566: }
! 567:
! 568: (*((real8 *) (*s_objet_argument_2).objet)) = r1;
! 569:
! 570: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 571: {
! 572: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 573: return;
! 574: }
! 575:
! 576: if (((*s_objet_resultat).objet =
! 577: allocation_maillon(s_etat_processus)) == NULL)
! 578: {
! 579: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 580: return;
! 581: }
! 582:
! 583: l_element_courant = (*s_objet_resultat).objet;
! 584:
! 585: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 586: == NULL)
! 587: {
! 588: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 589: return;
! 590: }
! 591:
! 592: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 593: .nombre_arguments = 0;
! 594: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 595: .fonction = instruction_vers_niveau_superieur;
! 596:
! 597: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 598: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 599: {
! 600: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 601: return;
! 602: }
! 603:
! 604: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 605: .nom_fonction, "<<");
! 606:
! 607: if (((*l_element_courant).suivant =
! 608: allocation_maillon(s_etat_processus)) == NULL)
! 609: {
! 610: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 611: return;
! 612: }
! 613:
! 614: l_element_courant = (*l_element_courant).suivant;
! 615: (*l_element_courant).donnee = s_objet_argument_2;
! 616:
! 617: if (((*l_element_courant).suivant =
! 618: allocation_maillon(s_etat_processus)) == NULL)
! 619: {
! 620: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 621: return;
! 622: }
! 623:
! 624: l_element_courant = (*l_element_courant).suivant;
! 625: (*l_element_courant).donnee = s_objet_argument_1;
! 626:
! 627: if (((*l_element_courant).suivant =
! 628: allocation_maillon(s_etat_processus)) == NULL)
! 629: {
! 630: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 631: return;
! 632: }
! 633:
! 634: l_element_courant = (*l_element_courant).suivant;
! 635:
! 636: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 637: == NULL)
! 638: {
! 639: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 640: return;
! 641: }
! 642:
! 643: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 644: .nombre_arguments = 0;
! 645: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 646: .fonction = instruction_division;
! 647:
! 648: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 649: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
! 650: {
! 651: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 652: return;
! 653: }
! 654:
! 655: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 656: .nom_fonction, "/");
! 657:
! 658: if (((*l_element_courant).suivant =
! 659: allocation_maillon(s_etat_processus)) == NULL)
! 660: {
! 661: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 662: return;
! 663: }
! 664:
! 665: l_element_courant = (*l_element_courant).suivant;
! 666:
! 667: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 668: == NULL)
! 669: {
! 670: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 671: return;
! 672: }
! 673:
! 674: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 675: .nombre_arguments = 0;
! 676: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 677: .fonction = instruction_vers_niveau_inferieur;
! 678:
! 679: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 680: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 681: {
! 682: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 683: return;
! 684: }
! 685:
! 686: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 687: .nom_fonction, ">>");
! 688:
! 689: (*l_element_courant).suivant = NULL;
! 690:
! 691: s_objet_argument_1 = NULL;
! 692: s_objet_argument_2 = NULL;
! 693:
! 694: liberation(s_etat_processus, s_objet_argument_1);
! 695: liberation(s_etat_processus, s_objet_argument_2);
! 696: }
! 697: else
! 698: {
! 699: liberation(s_etat_processus, s_objet_argument);
! 700:
! 701: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 702: return;
! 703: }
! 704:
! 705: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 706: s_objet_resultat) == d_erreur)
! 707: {
! 708: return;
! 709: }
! 710:
! 711: liberation(s_etat_processus, s_objet_argument);
! 712:
! 713: return;
! 714: }
! 715:
! 716:
! 717: /*
! 718: ================================================================================
! 719: Fonction '->ROW'
! 720: ================================================================================
! 721: Entrées : structure processus
! 722: --------------------------------------------------------------------------------
! 723: Sorties :
! 724: --------------------------------------------------------------------------------
! 725: Effets de bord : néant
! 726: ================================================================================
! 727: */
! 728:
! 729: void
! 730: instruction_fleche_row(struct_processus *s_etat_processus)
! 731: {
! 732: integer8 i;
! 733: integer8 j;
! 734: integer8 nombre_colonnes;
! 735: integer8 nombre_lignes;
! 736:
! 737: struct_liste_chainee *l_element_courant;
! 738:
! 739: struct_objet *s_objet;
! 740: struct_objet *s_objet_resultat;
! 741:
! 742: unsigned char type;
! 743:
! 744: (*s_etat_processus).erreur_execution = d_ex;
! 745:
! 746: if ((*s_etat_processus).affichage_arguments == 'Y')
! 747: {
! 748: printf("\n ->ROW ");
! 749:
! 750: if ((*s_etat_processus).langue == 'F')
! 751: {
! 752: printf("(construction d'une matrice à partir de ses lignes)\n\n");
! 753: }
! 754: else
! 755: {
! 756: printf("(build a matrix from rows)\n\n");
! 757: }
! 758:
! 759: printf(" n: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 760: printf(" ...\n");
! 761: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 762: printf(" 1: %s\n", d_INT);
! 763: printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 764:
! 765: return;
! 766: }
! 767: else if ((*s_etat_processus).test_instruction == 'Y')
! 768: {
! 769: (*s_etat_processus).nombre_arguments = -1;
! 770: return;
! 771: }
! 772:
! 773: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 774: {
! 775: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 776: {
! 777: return;
! 778: }
! 779: }
! 780:
! 781: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
! 782: {
! 783: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 784: return;
! 785: }
! 786:
! 787: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
! 788: {
! 789: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 790: return;
! 791: }
! 792:
! 793: nombre_lignes = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
! 794: .donnee).objet));
! 795:
! 796: if (nombre_lignes <= 0)
! 797: {
! 798: /*
! 799: * Nombre lignes négatif ou nul, l'opération est absurde.
! 800: */
! 801:
! 802: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 803: return;
! 804: }
! 805:
! 806: if (nombre_lignes >= (integer8) (*s_etat_processus)
! 807: .hauteur_pile_operationnelle)
! 808: {
! 809: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 810: return;
! 811: }
! 812:
! 813: /*
! 814: * Traitement de la pile last le cas échéant.
! 815: */
! 816:
! 817: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 818: {
! 819: if (empilement_pile_last(s_etat_processus, nombre_lignes + 1)
! 820: == d_erreur)
! 821: {
! 822: return;
! 823: }
! 824: }
! 825:
! 826: /*
! 827: * Retrait de l'objet indiquant le nombre de lignes.
! 828: */
! 829:
! 830: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 831: &s_objet) == d_erreur)
! 832: {
! 833: return;
! 834: }
! 835:
! 836: liberation(s_etat_processus, s_objet);
! 837:
! 838: /*
! 839: * Recherche du type de la matrice finale.
! 840: */
! 841:
! 842: type = 'I';
! 843: l_element_courant = (*s_etat_processus).l_base_pile;
! 844: nombre_colonnes = 0;
! 845:
! 846: for(i = 0; i < nombre_lignes; i++)
! 847: {
! 848: if (((*(*l_element_courant).donnee).type != MIN) &&
! 849: ((*(*l_element_courant).donnee).type != MRL) &&
! 850: ((*(*l_element_courant).donnee).type != MCX))
! 851: {
! 852: /*
! 853: * Problème : on vient de tirer autre chose qu'une matrice
! 854: * dans la pile.
! 855: */
! 856:
! 857: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 858: return;
! 859: }
! 860:
! 861: if ((*((struct_matrice *) (*(*l_element_courant).donnee).objet))
! 862: .nombre_lignes != 1)
! 863: {
! 864: /*
! 865: * La matrice n'est pas une matrice ligne.
! 866: */
! 867:
! 868: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 869: return;
! 870: }
! 871:
! 872: if (i == 0)
! 873: {
! 874: nombre_colonnes = (*((struct_matrice *) (*(*l_element_courant)
! 875: .donnee).objet)).nombre_colonnes;
! 876: }
! 877: else
! 878: {
! 879: if (nombre_colonnes != (integer8) (*((struct_matrice *)
! 880: (*(*l_element_courant).donnee).objet)).nombre_colonnes)
! 881: {
! 882: /*
! 883: * La dernière matrice observée n'a pas les mêmes dimensions
! 884: * (nombre de colonnes) que les précédentes.
! 885: */
! 886:
! 887: (*s_etat_processus).erreur_execution =
! 888: d_ex_dimensions_invalides;
! 889: return;
! 890: }
! 891: }
! 892:
! 893: if (type == 'I')
! 894: {
! 895: if ((*(*l_element_courant).donnee).type == MRL)
! 896: {
! 897: type = 'R';
! 898: }
! 899: else if ((*(*l_element_courant).donnee).type == MCX)
! 900: {
! 901: type = 'C';
! 902: }
! 903: }
! 904: else if (type == 'R')
! 905: {
! 906: if ((*(*l_element_courant).donnee).type == MCX)
! 907: {
! 908: type = 'C';
! 909: }
! 910: }
! 911:
! 912: l_element_courant = (*l_element_courant).suivant;
! 913: }
! 914:
! 915: if (type == 'I')
! 916: {
! 917: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
! 918: {
! 919: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 920: return;
! 921: }
! 922:
! 923: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 924: nombre_colonnes;
! 925: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 926: nombre_lignes;
! 927:
! 928: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 929: malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
! 930: {
! 931: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 932: return;
! 933: }
! 934:
! 935: for(i = nombre_lignes - 1; i >= 0; i--)
! 936: {
! 937: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 938: &s_objet) == d_erreur)
! 939: {
! 940: return;
! 941: }
! 942:
! 943: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 944: .objet)).tableau)[i] = malloc(nombre_colonnes *
! 945: sizeof(integer8))) == NULL)
! 946: {
! 947: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 948: return;
! 949: }
! 950:
! 951: for(j = 0; j < nombre_colonnes; j++)
! 952: {
! 953: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 954: .objet)).tableau)[i][j] = ((integer8 **)
! 955: (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j];
! 956: }
! 957:
! 958: liberation(s_etat_processus, s_objet);
! 959: }
! 960: }
! 961: else if (type == 'R')
! 962: {
! 963: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
! 964: {
! 965: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 966: return;
! 967: }
! 968:
! 969: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 970: nombre_colonnes;
! 971: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 972: nombre_lignes;
! 973:
! 974: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 975: malloc(nombre_lignes * sizeof(real8 *))) == NULL)
! 976: {
! 977: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 978: return;
! 979: }
! 980:
! 981: for(i = nombre_lignes - 1; i >= 0; i--)
! 982: {
! 983: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 984: &s_objet) == d_erreur)
! 985: {
! 986: return;
! 987: }
! 988:
! 989: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 990: .objet)).tableau)[i] = malloc(nombre_colonnes *
! 991: sizeof(real8))) == NULL)
! 992: {
! 993: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 994: return;
! 995: }
! 996:
! 997: if ((*s_objet).type == MIN)
! 998: {
! 999: for(j = 0; j < nombre_colonnes; j++)
! 1000: {
! 1001: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 1002: .objet)).tableau)[i][j] = ((integer8 **)
! 1003: (*((struct_matrice *) (*s_objet).objet))
! 1004: .tableau)[0][j];
! 1005: }
! 1006: }
! 1007: else
! 1008: {
! 1009: for(j = 0; j < nombre_colonnes; j++)
! 1010: {
! 1011: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 1012: .objet)).tableau)[i][j] = ((real8 **)
! 1013: (*((struct_matrice *) (*s_objet).objet))
! 1014: .tableau)[0][j];
! 1015: }
! 1016: }
! 1017:
! 1018: liberation(s_etat_processus, s_objet);
! 1019: }
! 1020: }
! 1021: else
! 1022: {
! 1023: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 1024: {
! 1025: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1026: return;
! 1027: }
! 1028:
! 1029: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 1030: nombre_colonnes;
! 1031: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 1032: nombre_lignes;
! 1033:
! 1034: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 1035: malloc(nombre_lignes * sizeof(complex16 *))) == NULL)
! 1036: {
! 1037: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1038: return;
! 1039: }
! 1040:
! 1041: for(i = nombre_lignes - 1; i >= 0; i--)
! 1042: {
! 1043: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1044: &s_objet) == d_erreur)
! 1045: {
! 1046: return;
! 1047: }
! 1048:
! 1049: if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1050: .objet)).tableau)[i] = malloc(nombre_colonnes *
! 1051: sizeof(complex16))) == NULL)
! 1052: {
! 1053: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1054: return;
! 1055: }
! 1056:
! 1057: if ((*s_objet).type == MIN)
! 1058: {
! 1059: for(j = 0; j < nombre_colonnes; j++)
! 1060: {
! 1061: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1062: .objet)).tableau)[i][j]).partie_reelle =
! 1063: ((integer8 **) (*((struct_matrice *)
! 1064: (*s_objet).objet)).tableau)[0][j];
! 1065: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1066: .objet)).tableau)[i][j]).partie_imaginaire = 0;
! 1067: }
! 1068: }
! 1069: else if ((*s_objet).type == MRL)
! 1070: {
! 1071: for(j = 0; j < nombre_colonnes; j++)
! 1072: {
! 1073: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1074: .objet)).tableau)[i][j]).partie_reelle =
! 1075: ((real8 **) (*((struct_matrice *)
! 1076: (*s_objet).objet)).tableau)[0][j];
! 1077: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1078: .objet)).tableau)[i][j]).partie_imaginaire = 0;
! 1079: }
! 1080: }
! 1081: else
! 1082: {
! 1083: for(j = 0; j < nombre_colonnes; j++)
! 1084: {
! 1085: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1086: .objet)).tableau)[i][j]).partie_reelle =
! 1087: (((complex16 **) (*((struct_matrice *)
! 1088: (*s_objet).objet)).tableau)[0][j])
! 1089: .partie_reelle;
! 1090: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1091: .objet)).tableau)[i][j]).partie_imaginaire =
! 1092: (((complex16 **) (*((struct_matrice *)
! 1093: (*s_objet).objet)).tableau)[0][j])
! 1094: .partie_imaginaire;
! 1095: }
! 1096: }
! 1097:
! 1098: liberation(s_etat_processus, s_objet);
! 1099: }
! 1100: }
! 1101:
! 1102: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1103: s_objet_resultat) == d_erreur)
! 1104: {
! 1105: return;
! 1106: }
! 1107:
! 1108: return;
! 1109: }
! 1110:
! 1111:
! 1112: /*
! 1113: ================================================================================
! 1114: Fonction '->COL'
! 1115: ================================================================================
! 1116: Entrées : structure processus
! 1117: --------------------------------------------------------------------------------
! 1118: Sorties :
! 1119: --------------------------------------------------------------------------------
! 1120: Effets de bord : néant
! 1121: ================================================================================
! 1122: */
! 1123:
! 1124: void
! 1125: instruction_fleche_col(struct_processus *s_etat_processus)
! 1126: {
! 1127: integer8 i;
! 1128: integer8 j;
! 1129: integer8 nombre_colonnes;
! 1130: integer8 nombre_lignes;
! 1131:
! 1132: struct_liste_chainee *l_element_courant;
! 1133:
! 1134: struct_objet *s_objet;
! 1135: struct_objet *s_objet_resultat;
! 1136:
! 1137: unsigned char type;
! 1138:
! 1139: (*s_etat_processus).erreur_execution = d_ex;
! 1140:
! 1141: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1142: {
! 1143: printf("\n ->COL ");
! 1144:
! 1145: if ((*s_etat_processus).langue == 'F')
! 1146: {
! 1147: printf("(construction d'une matrice à partir de ses colonnes)\n\n");
! 1148: }
! 1149: else
! 1150: {
! 1151: printf("(build a matrix from columns)\n\n");
! 1152: }
! 1153:
! 1154: printf(" n: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1155: printf(" ...\n");
! 1156: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1157: printf(" 1: %s\n", d_INT);
! 1158: printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1159:
! 1160: return;
! 1161: }
! 1162: else if ((*s_etat_processus).test_instruction == 'Y')
! 1163: {
! 1164: (*s_etat_processus).nombre_arguments = -1;
! 1165: return;
! 1166: }
! 1167:
! 1168: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1169: {
! 1170: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1171: {
! 1172: return;
! 1173: }
! 1174: }
! 1175:
! 1176: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
! 1177: {
! 1178: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1179: return;
! 1180: }
! 1181:
! 1182: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
! 1183: {
! 1184: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 1185: return;
! 1186: }
! 1187:
! 1188: nombre_colonnes = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
! 1189: .donnee).objet));
! 1190:
! 1191: if (nombre_colonnes <= 0)
! 1192: {
! 1193: /*
! 1194: * Nombre lignes négatif ou nul, l'opération est absurde.
! 1195: */
! 1196:
! 1197: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 1198: return;
! 1199: }
! 1200:
! 1201: if (nombre_colonnes >= (integer8) (*s_etat_processus)
! 1202: .hauteur_pile_operationnelle)
! 1203: {
! 1204: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1205: return;
! 1206: }
! 1207:
! 1208: /*
! 1209: * Traitement de la pile last le cas échéant.
! 1210: */
! 1211:
! 1212: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1213: {
! 1214: if (empilement_pile_last(s_etat_processus, nombre_colonnes + 1)
! 1215: == d_erreur)
! 1216: {
! 1217: return;
! 1218: }
! 1219: }
! 1220:
! 1221: /*
! 1222: * Retrait de l'objet indiquant le nombre de lignes.
! 1223: */
! 1224:
! 1225: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1226: &s_objet) == d_erreur)
! 1227: {
! 1228: return;
! 1229: }
! 1230:
! 1231: liberation(s_etat_processus, s_objet);
! 1232:
! 1233: /*
! 1234: * Recherche du type de la matrice finale.
! 1235: */
! 1236:
! 1237: type = 'I';
! 1238: l_element_courant = (*s_etat_processus).l_base_pile;
! 1239: nombre_lignes = 0;
! 1240:
! 1241: for(i = 0; i < nombre_colonnes; i++)
! 1242: {
! 1243: if (((*(*l_element_courant).donnee).type != MIN) &&
! 1244: ((*(*l_element_courant).donnee).type != MRL) &&
! 1245: ((*(*l_element_courant).donnee).type != MCX))
! 1246: {
! 1247: /*
! 1248: * Problème : on vient de tirer autre chose qu'une matrice
! 1249: * dans la pile.
! 1250: */
! 1251:
! 1252: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1253: return;
! 1254: }
! 1255:
! 1256: if ((*((struct_matrice *) (*(*l_element_courant).donnee).objet))
! 1257: .nombre_colonnes != 1)
! 1258: {
! 1259: /*
! 1260: * La matrice n'est pas une matrice colonne.
! 1261: */
! 1262:
! 1263: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 1264: return;
! 1265: }
! 1266:
! 1267: if (i == 0)
! 1268: {
! 1269: nombre_lignes = (*((struct_matrice *) (*(*l_element_courant)
! 1270: .donnee).objet)).nombre_lignes;
! 1271: }
! 1272: else
! 1273: {
! 1274: if (nombre_lignes != (integer8) (*((struct_matrice *)
! 1275: (*(*l_element_courant).donnee).objet)).nombre_lignes)
! 1276: {
! 1277: /*
! 1278: * La dernière matrice observée n'a pas les mêmes dimensions
! 1279: * (nombre de colonnes) que les précédentes.
! 1280: */
! 1281:
! 1282: (*s_etat_processus).erreur_execution =
! 1283: d_ex_dimensions_invalides;
! 1284: return;
! 1285: }
! 1286: }
! 1287:
! 1288: if (type == 'I')
! 1289: {
! 1290: if ((*(*l_element_courant).donnee).type == MRL)
! 1291: {
! 1292: type = 'R';
! 1293: }
! 1294: else if ((*(*l_element_courant).donnee).type == MCX)
! 1295: {
! 1296: type = 'C';
! 1297: }
! 1298: }
! 1299: else if (type == 'R')
! 1300: {
! 1301: if ((*(*l_element_courant).donnee).type == MCX)
! 1302: {
! 1303: type = 'C';
! 1304: }
! 1305: }
! 1306:
! 1307: l_element_courant = (*l_element_courant).suivant;
! 1308: }
! 1309:
! 1310: if (type == 'I')
! 1311: {
! 1312: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
! 1313: {
! 1314: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1315: return;
! 1316: }
! 1317:
! 1318: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 1319: nombre_colonnes;
! 1320: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 1321: nombre_lignes;
! 1322:
! 1323: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 1324: malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
! 1325: {
! 1326: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1327: return;
! 1328: }
! 1329:
! 1330: for(i = 0; i < nombre_lignes; i++)
! 1331: {
! 1332: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 1333: .objet)).tableau)[i] = malloc(nombre_colonnes *
! 1334: sizeof(integer8))) == NULL)
! 1335: {
! 1336: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1337: return;
! 1338: }
! 1339: }
! 1340:
! 1341: for(j = nombre_colonnes - 1; j >= 0; j--)
! 1342: {
! 1343: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1344: &s_objet) == d_erreur)
! 1345: {
! 1346: return;
! 1347: }
! 1348:
! 1349: for(i = 0; i < nombre_lignes; i++)
! 1350: {
! 1351: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 1352: .objet)).tableau)[i][j] = ((integer8 **)
! 1353: (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0];
! 1354: }
! 1355:
! 1356: liberation(s_etat_processus, s_objet);
! 1357: }
! 1358: }
! 1359: else if (type == 'R')
! 1360: {
! 1361: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
! 1362: {
! 1363: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1364: return;
! 1365: }
! 1366:
! 1367: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 1368: nombre_colonnes;
! 1369: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 1370: nombre_lignes;
! 1371:
! 1372: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 1373: malloc(nombre_lignes * sizeof(real8 *))) == NULL)
! 1374: {
! 1375: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1376: return;
! 1377: }
! 1378:
! 1379: for(i = 0; i < nombre_lignes; i++)
! 1380: {
! 1381: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 1382: .objet)).tableau)[i] = malloc(nombre_colonnes *
! 1383: sizeof(real8))) == NULL)
! 1384: {
! 1385: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1386: return;
! 1387: }
! 1388: }
! 1389:
! 1390: for(j = nombre_colonnes - 1; j >= 0; j--)
! 1391: {
! 1392: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1393: &s_objet) == d_erreur)
! 1394: {
! 1395: return;
! 1396: }
! 1397:
! 1398: if ((*s_objet).type == MIN)
! 1399: {
! 1400: for(i = 0; i < nombre_lignes; i++)
! 1401: {
! 1402: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 1403: .objet)).tableau)[i][j] = ((integer8 **)
! 1404: (*((struct_matrice *) (*s_objet).objet))
! 1405: .tableau)[i][0];
! 1406: }
! 1407: }
! 1408: else
! 1409: {
! 1410: for(i = 0; i < nombre_lignes; i++)
! 1411: {
! 1412: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 1413: .objet)).tableau)[i][j] = ((real8 **)
! 1414: (*((struct_matrice *) (*s_objet).objet))
! 1415: .tableau)[i][0];
! 1416: }
! 1417: }
! 1418:
! 1419: liberation(s_etat_processus, s_objet);
! 1420: }
! 1421: }
! 1422: else
! 1423: {
! 1424: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
! 1425: {
! 1426: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1427: return;
! 1428: }
! 1429:
! 1430: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 1431: nombre_colonnes;
! 1432: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 1433: nombre_lignes;
! 1434:
! 1435: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 1436: malloc(nombre_lignes * sizeof(complex16 *))) == NULL)
! 1437: {
! 1438: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1439: return;
! 1440: }
! 1441:
! 1442: for(i = 0; i < nombre_lignes; i++)
! 1443: {
! 1444: if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1445: .objet)).tableau)[i] = malloc(nombre_colonnes *
! 1446: sizeof(complex16))) == NULL)
! 1447: {
! 1448: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1449: return;
! 1450: }
! 1451: }
! 1452:
! 1453: for(j = nombre_colonnes - 1; j >= 0; j--)
! 1454: {
! 1455: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1456: &s_objet) == d_erreur)
! 1457: {
! 1458: return;
! 1459: }
! 1460:
! 1461: if ((*s_objet).type == MIN)
! 1462: {
! 1463: for(i = 0; i < nombre_lignes; i++)
! 1464: {
! 1465: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1466: .objet)).tableau)[i][j]).partie_reelle =
! 1467: ((integer8 **) (*((struct_matrice *)
! 1468: (*s_objet).objet)).tableau)[i][0];
! 1469: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1470: .objet)).tableau)[i][j]).partie_imaginaire = 0;
! 1471: }
! 1472: }
! 1473: else if ((*s_objet).type == MRL)
! 1474: {
! 1475: for(i = 0; i < nombre_lignes; i++)
! 1476: {
! 1477: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1478: .objet)).tableau)[i][j]).partie_reelle =
! 1479: ((real8 **) (*((struct_matrice *)
! 1480: (*s_objet).objet)).tableau)[i][0];
! 1481: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1482: .objet)).tableau)[i][j]).partie_imaginaire = 0;
! 1483: }
! 1484: }
! 1485: else
! 1486: {
! 1487: for(i = 0; i < nombre_lignes; i++)
! 1488: {
! 1489: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1490: .objet)).tableau)[i][j]).partie_reelle =
! 1491: (((complex16 **) (*((struct_matrice *)
! 1492: (*s_objet).objet)).tableau)[i][0]).partie_reelle;
! 1493: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 1494: .objet)).tableau)[i][j]).partie_imaginaire =
! 1495: (((complex16 **) (*((struct_matrice *)
! 1496: (*s_objet).objet)).tableau)[i][0])
! 1497: .partie_imaginaire;
! 1498: }
! 1499: }
! 1500:
! 1501: liberation(s_etat_processus, s_objet);
! 1502: }
! 1503: }
! 1504:
! 1505: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1506: s_objet_resultat) == d_erreur)
! 1507: {
! 1508: return;
! 1509: }
! 1510:
! 1511: return;
! 1512: }
! 1513:
! 1514:
! 1515: /*
! 1516: ================================================================================
! 1517: Fonction '->NUM'
! 1518: ================================================================================
! 1519: Entrées : structure processus
! 1520: --------------------------------------------------------------------------------
! 1521: Sorties :
! 1522: --------------------------------------------------------------------------------
! 1523: Effets de bord : néant
! 1524: ================================================================================
! 1525: */
! 1526:
! 1527: void
! 1528: instruction_fleche_num(struct_processus *s_etat_processus)
! 1529: {
! 1530: logical1 last_valide;
! 1531:
! 1532: struct_objet *s_objet;
! 1533: struct_objet *s_objet_simplifie;
! 1534:
! 1535: unsigned char registre_type_evaluation;
! 1536:
! 1537: (*s_etat_processus).erreur_execution = d_ex;
! 1538:
! 1539: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1540: {
! 1541: printf("\n ->NUM ");
! 1542:
! 1543: if ((*s_etat_processus).langue == 'F')
! 1544: {
! 1545: printf("(évaluation d'un objet)\n\n");
! 1546: }
! 1547: else
! 1548: {
! 1549: printf("(object evaluation)\n\n");
! 1550: }
! 1551:
! 1552: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 1553: " %s, %s, %s, %s, %s,\n"
! 1554: " %s, %s, %s, %s, %s,\n"
! 1555: " %s\n",
! 1556: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 1557: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 1558: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
! 1559: " %s, %s, %s, %s, %s,\n"
! 1560: " %s, %s, %s, %s, %s,\n"
! 1561: " %s\n",
! 1562: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 1563: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 1564: printf(" ...\n");
! 1565: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 1566: " %s, %s, %s, %s, %s,\n"
! 1567: " %s, %s, %s, %s, %s,\n"
! 1568: " %s\n",
! 1569: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 1570: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 1571:
! 1572: return;
! 1573: }
! 1574: else if ((*s_etat_processus).test_instruction == 'Y')
! 1575: {
! 1576: (*s_etat_processus).nombre_arguments = -1;
! 1577: return;
! 1578: }
! 1579:
! 1580: if ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai)
! 1581: {
! 1582: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1583: {
! 1584: return;
! 1585: }
! 1586:
! 1587: cf(s_etat_processus, 31);
! 1588: }
! 1589:
! 1590: registre_type_evaluation = (test_cfsf(s_etat_processus, 35) == d_vrai)
! 1591: ? 'E' : 'N';
! 1592: cf(s_etat_processus, 35);
! 1593:
! 1594: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1595: &s_objet) == d_erreur)
! 1596: {
! 1597: if (last_valide == d_vrai)
! 1598: {
! 1599: sf(s_etat_processus, 31);
! 1600: }
! 1601:
! 1602: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1603: return;
! 1604: }
! 1605:
! 1606: if ((s_objet_simplifie = simplification(s_etat_processus, s_objet)) == NULL)
! 1607: {
! 1608: if (last_valide == d_vrai)
! 1609: {
! 1610: sf(s_etat_processus, 31);
! 1611: }
! 1612:
! 1613: return;
! 1614: }
! 1615:
! 1616: liberation(s_etat_processus, s_objet);
! 1617: s_objet = s_objet_simplifie;
! 1618:
! 1619: if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur)
! 1620: {
! 1621: if (last_valide == d_vrai)
! 1622: {
! 1623: sf(s_etat_processus, 31);
! 1624: }
! 1625:
! 1626: liberation(s_etat_processus, s_objet);
! 1627: return;
! 1628: }
! 1629:
! 1630: liberation(s_etat_processus, s_objet);
! 1631:
! 1632: if (registre_type_evaluation == 'E')
! 1633: {
! 1634: sf(s_etat_processus, 35);
! 1635: }
! 1636: else
! 1637: {
! 1638: cf(s_etat_processus, 35);
! 1639: }
! 1640:
! 1641: if (last_valide == d_vrai)
! 1642: {
! 1643: sf(s_etat_processus, 31);
! 1644: }
! 1645:
! 1646: return;
! 1647: }
! 1648:
! 1649:
! 1650: /*
! 1651: ================================================================================
! 1652: Fonction 'fuse'
! 1653: ================================================================================
! 1654: Entrées :
! 1655: --------------------------------------------------------------------------------
! 1656: Sorties :
! 1657: --------------------------------------------------------------------------------
! 1658: Effets de bord : néant
! 1659: ================================================================================
! 1660: */
! 1661:
! 1662: void
! 1663: instruction_fuse(struct_processus *s_etat_processus)
! 1664: {
! 1665: pthread_attr_t attributs;
! 1666:
! 1667: real8 timeout;
! 1668:
! 1669: struct_objet *s_objet_argument;
! 1670:
! 1671: (*s_etat_processus).erreur_execution = d_ex;
! 1672:
! 1673: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1674: {
! 1675: printf("\n FUSE ");
! 1676:
! 1677: if ((*s_etat_processus).langue == 'F')
! 1678: {
! 1679: printf("(mise en place d'un fusible)\n\n");
! 1680: }
! 1681: else
! 1682: {
! 1683: printf("(set fuse signal)\n\n");
! 1684: }
! 1685:
! 1686: printf(" 1: %s, %s\n", d_INT, d_REL);
! 1687: return;
! 1688: }
! 1689: else if ((*s_etat_processus).test_instruction == 'Y')
! 1690: {
! 1691: (*s_etat_processus).nombre_arguments = -1;
! 1692: return;
! 1693: }
! 1694:
! 1695: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1696: {
! 1697: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1698: {
! 1699: return;
! 1700: }
! 1701: }
! 1702:
! 1703: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1704: &s_objet_argument) == d_erreur)
! 1705: {
! 1706: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1707: return;
! 1708: }
! 1709:
! 1710: if ((*s_etat_processus).presence_fusible == d_vrai)
! 1711: {
! 1712: liberation(s_etat_processus, s_objet_argument);
! 1713:
! 1714: (*s_etat_processus).erreur_execution = d_ex_fusible;
! 1715: return;
! 1716: }
! 1717:
! 1718: if ((*s_objet_argument).type == INT)
! 1719: {
! 1720: timeout = (real8) (*((integer8 *) (*s_objet_argument).objet));
! 1721: }
! 1722: else if ((*s_objet_argument).type == REL)
! 1723: {
! 1724: timeout = (*((real8 *) (*s_objet_argument).objet));
! 1725: }
! 1726: else
! 1727: {
! 1728: liberation(s_etat_processus, s_objet_argument);
! 1729:
! 1730: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1731: return;
! 1732: }
! 1733:
! 1734: liberation(s_etat_processus, s_objet_argument);
! 1735:
! 1736: if (timeout < 0)
! 1737: {
! 1738: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 1739: return;
! 1740: }
! 1741:
! 1742: (*s_etat_processus).temps_maximal_cpu = timeout;
! 1743: (*s_etat_processus).presence_fusible = d_vrai;
! 1744: (*s_etat_processus).thread_surveille_par_fusible = pthread_self();
! 1745:
! 1746: // Génération du thread de surveillance
! 1747:
! 1748: if (pthread_attr_init(&attributs) != 0)
! 1749: {
! 1750: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1751: return;
! 1752: }
! 1753:
! 1754: if (pthread_attr_setdetachstate(&attributs,
! 1755: PTHREAD_CREATE_DETACHED) != 0)
! 1756: {
! 1757: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1758: return;
! 1759: }
! 1760:
! 1761: if (pthread_attr_setschedpolicy(&attributs, SCHED_OTHER) != 0)
! 1762: {
! 1763: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1764: return;
! 1765: }
! 1766:
! 1767: if (pthread_attr_setinheritsched(&attributs,
! 1768: PTHREAD_EXPLICIT_SCHED) != 0)
! 1769: {
! 1770: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1771: return;
! 1772: }
! 1773:
! 1774: if (pthread_attr_setscope(&attributs, PTHREAD_SCOPE_SYSTEM) != 0)
! 1775: {
! 1776: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1777: return;
! 1778: }
! 1779:
! 1780: if (pthread_create(&(*s_etat_processus).thread_fusible, &attributs,
! 1781: fusible, s_etat_processus) != 0)
! 1782: {
! 1783: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1784: return;
! 1785: }
! 1786:
! 1787: if (pthread_attr_destroy(&attributs) != 0)
! 1788: {
! 1789: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1790: return;
! 1791: }
! 1792:
! 1793: return;
! 1794: }
! 1795:
! 1796: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_f3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src