Annotation of rpl/src/instructions_f2.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 '->HMS'
! 29: ================================================================================
! 30: Entrées : structure processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_fleche_hms(struct_processus *s_etat_processus)
! 40: {
! 41: struct_objet *s_copie;
! 42: struct_objet *s_objet;
! 43:
! 44: (*s_etat_processus).erreur_execution = d_ex;
! 45:
! 46: if ((*s_etat_processus).affichage_arguments == 'Y')
! 47: {
! 48: printf("\n ->HMS ");
! 49:
! 50: if ((*s_etat_processus).langue == 'F')
! 51: {
! 52: printf("(conversion sexadécimale)\n\n");
! 53: }
! 54: else
! 55: {
! 56: printf("(conversion to hours minutes seconds)\n\n");
! 57: }
! 58:
! 59: printf(" 1: %s\n", d_INT);
! 60: printf("-> 1: %s\n\n", d_INT);
! 61:
! 62: printf(" 1: %s\n", d_REL);
! 63: printf("-> 1: %s\n", d_REL);
! 64:
! 65: return;
! 66: }
! 67: else if ((*s_etat_processus).test_instruction == 'Y')
! 68: {
! 69: (*s_etat_processus).nombre_arguments = -1;
! 70: return;
! 71: }
! 72:
! 73: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 74: {
! 75: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 76: {
! 77: return;
! 78: }
! 79: }
! 80:
! 81: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 82: &s_objet) == d_erreur)
! 83: {
! 84: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 85: return;
! 86: }
! 87:
! 88: /*
! 89: --------------------------------------------------------------------------------
! 90: Argument entier
! 91: --------------------------------------------------------------------------------
! 92: */
! 93:
! 94: if ((*s_objet).type == INT)
! 95: {
! 96: /*
! 97: * On ne fait rien...
! 98: */
! 99: }
! 100:
! 101: /*
! 102: --------------------------------------------------------------------------------
! 103: Argument réel
! 104: --------------------------------------------------------------------------------
! 105: */
! 106:
! 107: else if ((*s_objet).type == REL)
! 108: {
! 109: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
! 110: {
! 111: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 112: return;
! 113: }
! 114:
! 115: liberation(s_etat_processus, s_objet);
! 116: s_objet = s_copie;
! 117:
! 118: conversion_decimal_vers_hms((real8 *) (*s_objet).objet);
! 119: }
! 120:
! 121: /*
! 122: --------------------------------------------------------------------------------
! 123: Argument invalide
! 124: --------------------------------------------------------------------------------
! 125: */
! 126:
! 127: else
! 128: {
! 129: liberation(s_etat_processus, s_objet);
! 130:
! 131: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 132: return;
! 133: }
! 134:
! 135: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 136: s_objet) == d_erreur)
! 137: {
! 138: return;
! 139: }
! 140:
! 141: return;
! 142: }
! 143:
! 144:
! 145: /*
! 146: ================================================================================
! 147: Fonction '->ARRAY'
! 148: ================================================================================
! 149: Entrées : structure processus
! 150: --------------------------------------------------------------------------------
! 151: Sorties :
! 152: --------------------------------------------------------------------------------
! 153: Effets de bord : néant
! 154: ================================================================================
! 155: */
! 156:
! 157: void
! 158: instruction_fleche_array(struct_processus *s_etat_processus)
! 159: {
! 160: enum t_type type;
! 161:
! 162: struct_liste_chainee *l_element_courant;
! 163:
! 164: struct_objet *s_objet;
! 165: struct_objet *s_objet_elementaire;
! 166:
! 167: unsigned long i;
! 168: unsigned long j;
! 169: unsigned long nombre_colonnes;
! 170: unsigned long nombre_lignes;
! 171: unsigned long nombre_dimensions;
! 172: unsigned long nombre_termes;
! 173:
! 174: (*s_etat_processus).erreur_execution = d_ex;
! 175:
! 176: if ((*s_etat_processus).affichage_arguments == 'Y')
! 177: {
! 178: printf("\n ->ARRAY [->ARRY] ");
! 179:
! 180: if ((*s_etat_processus).langue == 'F')
! 181: {
! 182: printf("(création d'un vecteur ou d'une matrice)\n\n");
! 183: }
! 184: else
! 185: {
! 186: printf("(create vector or matrix)\n\n");
! 187: }
! 188:
! 189: printf(" n: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 190: printf(" ...\n");
! 191: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 192: printf(" 1: %s\n", d_LST);
! 193: printf("-> 1: %s, %s, %s,\n"
! 194: " %s, %s, %s\n", d_VIN, d_VRL, d_VCX,
! 195: d_MIN, d_MRL, d_MCX);
! 196:
! 197: return;
! 198: }
! 199: else if ((*s_etat_processus).test_instruction == 'Y')
! 200: {
! 201: (*s_etat_processus).nombre_arguments = -1;
! 202: return;
! 203: }
! 204:
! 205: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 206: {
! 207: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 208: {
! 209: return;
! 210: }
! 211: }
! 212:
! 213: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
! 214: {
! 215: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 216: return;
! 217: }
! 218:
! 219: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != LST)
! 220: {
! 221: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 222: return;
! 223: }
! 224:
! 225: l_element_courant = (*(*(*s_etat_processus).l_base_pile).donnee).objet;
! 226: nombre_dimensions = 0;
! 227:
! 228: while(l_element_courant != NULL)
! 229: {
! 230: nombre_dimensions++;
! 231: l_element_courant = (*l_element_courant).suivant;
! 232: }
! 233:
! 234: if (nombre_dimensions > 2)
! 235: {
! 236: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 237: return;
! 238: }
! 239:
! 240: l_element_courant = (*(*(*s_etat_processus).l_base_pile).donnee).objet;
! 241: nombre_termes = 1;
! 242:
! 243: nombre_lignes = 0;
! 244: nombre_colonnes = 0;
! 245:
! 246: while(l_element_courant != NULL)
! 247: {
! 248: if ((*(*l_element_courant).donnee).type != INT)
! 249: {
! 250: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 251: return;
! 252: }
! 253:
! 254: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
! 255: {
! 256: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 257: return;
! 258: }
! 259:
! 260: if (nombre_lignes == 0)
! 261: {
! 262: nombre_lignes = (*((integer8 *) (*(*l_element_courant)
! 263: .donnee).objet));
! 264: }
! 265: else
! 266: {
! 267: nombre_colonnes = (*((integer8 *) (*(*l_element_courant)
! 268: .donnee).objet));
! 269: }
! 270:
! 271: nombre_termes *= (*((integer8 *) (*(*l_element_courant)
! 272: .donnee).objet));
! 273: l_element_courant = (*l_element_courant).suivant;
! 274: }
! 275:
! 276: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 277: {
! 278: if (empilement_pile_last(s_etat_processus, nombre_termes + 1) ==
! 279: d_erreur)
! 280: {
! 281: return;
! 282: }
! 283: }
! 284:
! 285: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 286: &s_objet) == d_erreur)
! 287: {
! 288: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 289: return;
! 290: }
! 291:
! 292: liberation(s_etat_processus, s_objet);
! 293:
! 294: if ((*s_etat_processus).hauteur_pile_operationnelle < nombre_termes)
! 295: {
! 296: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 297: return;
! 298: }
! 299:
! 300: type = (nombre_dimensions == 1) ? VIN : MIN;
! 301:
! 302: l_element_courant = (*s_etat_processus).l_base_pile;
! 303:
! 304: for(i = 0; i < nombre_termes; i++)
! 305: {
! 306: if ((*(*l_element_courant).donnee).type == INT)
! 307: {
! 308: /*
! 309: * Rien à faire...
! 310: */
! 311: }
! 312: else if ((*(*l_element_courant).donnee).type == REL)
! 313: {
! 314: type = (nombre_dimensions == 1) ? VRL : MRL;
! 315: }
! 316: else if ((*(*l_element_courant).donnee).type == CPL)
! 317: {
! 318: type = (nombre_dimensions == 1) ? VCX : MCX;
! 319: }
! 320: else
! 321: {
! 322: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 323: return;
! 324: }
! 325:
! 326: l_element_courant = (*l_element_courant).suivant;
! 327: }
! 328:
! 329: /*
! 330: --------------------------------------------------------------------------------
! 331: Traitement des vecteurs
! 332: --------------------------------------------------------------------------------
! 333: */
! 334:
! 335: if (nombre_dimensions == 1)
! 336: {
! 337: if (type == VIN)
! 338: {
! 339: if ((s_objet = allocation(s_etat_processus, VIN)) == NULL)
! 340: {
! 341: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 342: return;
! 343: }
! 344:
! 345: if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
! 346: malloc(nombre_lignes * sizeof(integer8))) == NULL)
! 347: {
! 348: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 349: return;
! 350: }
! 351: }
! 352: else if (type == VRL)
! 353: {
! 354: if ((s_objet = allocation(s_etat_processus, VRL)) == NULL)
! 355: {
! 356: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 357: return;
! 358: }
! 359:
! 360: if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
! 361: malloc(nombre_lignes * sizeof(real8))) == NULL)
! 362: {
! 363: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 364: return;
! 365: }
! 366: }
! 367: else
! 368: {
! 369: if ((s_objet = allocation(s_etat_processus, VCX)) == NULL)
! 370: {
! 371: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 372: return;
! 373: }
! 374:
! 375: if (((*((struct_vecteur *) (*s_objet).objet)).tableau =
! 376: malloc(nombre_lignes * sizeof(struct_complexe16)))
! 377: == NULL)
! 378: {
! 379: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 380: return;
! 381: }
! 382: }
! 383:
! 384: (*((struct_vecteur *) (*s_objet).objet)).taille = nombre_lignes;
! 385:
! 386: for(i = 0; i < nombre_lignes; i++)
! 387: {
! 388: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 389: &s_objet_elementaire) == d_erreur)
! 390: {
! 391: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 392: return;
! 393: }
! 394:
! 395: if ((*((struct_vecteur *) (*s_objet).objet)).type == 'I')
! 396: {
! 397: ((integer8 *) (*((struct_vecteur *) (*s_objet).objet))
! 398: .tableau)[nombre_lignes - (i + 1)] = (*((integer8 *)
! 399: (*s_objet_elementaire).objet));
! 400: }
! 401: else if ((*((struct_vecteur *) (*s_objet).objet)).type == 'R')
! 402: {
! 403: if ((*s_objet_elementaire).type == INT)
! 404: {
! 405: ((real8 *) (*((struct_vecteur *) (*s_objet).objet))
! 406: .tableau)[nombre_lignes - (i + 1)] =
! 407: (real8) (*((integer8 *)
! 408: (*s_objet_elementaire).objet));
! 409: }
! 410: else
! 411: {
! 412: ((real8 *) (*((struct_vecteur *) (*s_objet).objet))
! 413: .tableau)[nombre_lignes - (i + 1)] = (*((real8 *)
! 414: (*s_objet_elementaire).objet));
! 415: }
! 416: }
! 417: else
! 418: {
! 419: if ((*s_objet_elementaire).type == INT)
! 420: {
! 421: ((struct_complexe16 *) (*((struct_vecteur *)
! 422: (*s_objet).objet)).tableau)
! 423: [nombre_lignes - (i + 1)].partie_reelle =
! 424: (real8) (*((integer8 *)
! 425: (*s_objet_elementaire).objet));
! 426: ((struct_complexe16 *) (*((struct_vecteur *)
! 427: (*s_objet).objet)).tableau)
! 428: [nombre_lignes - (i + 1)].partie_imaginaire = 0;
! 429: }
! 430: else if ((*s_objet_elementaire).type == REL)
! 431: {
! 432: ((struct_complexe16 *) (*((struct_vecteur *)
! 433: (*s_objet).objet)).tableau)
! 434: [nombre_lignes - (i + 1)].partie_reelle =
! 435: (*((real8 *) (*s_objet_elementaire).objet));
! 436: ((struct_complexe16 *) (*((struct_vecteur *)
! 437: (*s_objet).objet)).tableau)
! 438: [nombre_lignes - (i + 1)].partie_imaginaire = 0;
! 439: }
! 440: else
! 441: {
! 442: ((struct_complexe16 *) (*((struct_vecteur *)
! 443: (*s_objet).objet)).tableau)
! 444: [nombre_lignes - (i + 1)].partie_reelle =
! 445: (*((struct_complexe16 *)
! 446: (*s_objet_elementaire).objet)).partie_reelle;
! 447: ((struct_complexe16 *) (*((struct_vecteur *)
! 448: (*s_objet).objet)).tableau)
! 449: [nombre_lignes - (i + 1)].partie_imaginaire =
! 450: (*((struct_complexe16 *)
! 451: (*s_objet_elementaire).objet)).partie_imaginaire;
! 452: }
! 453: }
! 454:
! 455: liberation(s_etat_processus, s_objet_elementaire);
! 456: }
! 457: }
! 458:
! 459: /*
! 460: --------------------------------------------------------------------------------
! 461: Traitement des matrices
! 462: --------------------------------------------------------------------------------
! 463: */
! 464:
! 465: else
! 466: {
! 467: if (type == MIN)
! 468: {
! 469: if ((s_objet = allocation(s_etat_processus, MIN))
! 470: == NULL)
! 471: {
! 472: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 473: return;
! 474: }
! 475:
! 476: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
! 477: malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
! 478: {
! 479: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 480: return;
! 481: }
! 482: }
! 483: else if (type == MRL)
! 484: {
! 485: if ((s_objet = allocation(s_etat_processus, MRL))
! 486: == NULL)
! 487: {
! 488: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 489: return;
! 490: }
! 491:
! 492: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
! 493: malloc(nombre_lignes * sizeof(real8 *))) == NULL)
! 494: {
! 495: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 496: return;
! 497: }
! 498: }
! 499: else
! 500: {
! 501: if ((s_objet = allocation(s_etat_processus, MCX))
! 502: == NULL)
! 503: {
! 504: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 505: return;
! 506: }
! 507:
! 508: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
! 509: malloc(nombre_lignes * sizeof(struct_complexe16 *)))
! 510: == NULL)
! 511: {
! 512: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 513: return;
! 514: }
! 515: }
! 516:
! 517: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes = nombre_lignes;
! 518: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
! 519: nombre_colonnes;
! 520:
! 521: for(i = 0; i < nombre_lignes; i++)
! 522: {
! 523: if ((*((struct_matrice *) (*s_objet).objet)).type == 'I')
! 524: {
! 525: if ((((integer8 **) (*((struct_matrice *)
! 526: (*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
! 527: = malloc(nombre_colonnes * sizeof(integer8))) == NULL)
! 528: {
! 529: (*s_etat_processus).erreur_systeme =
! 530: d_es_allocation_memoire;
! 531: return;
! 532: }
! 533: }
! 534: else if ((*((struct_matrice *) (*s_objet).objet)).type == 'R')
! 535: {
! 536: if ((((real8 **) (*((struct_matrice *)
! 537: (*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
! 538: = malloc(nombre_colonnes * sizeof(real8))) == NULL)
! 539: {
! 540: (*s_etat_processus).erreur_systeme =
! 541: d_es_allocation_memoire;
! 542: return;
! 543: }
! 544: }
! 545: else
! 546: {
! 547: if ((((struct_complexe16 **) (*((struct_matrice *)
! 548: (*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
! 549: = malloc(nombre_colonnes * sizeof(struct_complexe16)))
! 550: == NULL)
! 551: {
! 552: (*s_etat_processus).erreur_systeme =
! 553: d_es_allocation_memoire;
! 554: return;
! 555: }
! 556: }
! 557:
! 558: for(j = 0; j < nombre_colonnes; j++)
! 559: {
! 560: if (depilement(s_etat_processus, &((*s_etat_processus)
! 561: .l_base_pile), &s_objet_elementaire) == d_erreur)
! 562: {
! 563: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 564: return;
! 565: }
! 566:
! 567: if ((*((struct_matrice *) (*s_objet).objet)).type == 'I')
! 568: {
! 569: ((integer8 **) (*((struct_matrice *) (*s_objet).objet))
! 570: .tableau)[nombre_lignes - (i + 1)]
! 571: [nombre_colonnes - (j + 1)] = (*((integer8 *)
! 572: (*s_objet_elementaire).objet));
! 573: }
! 574: else if ((*((struct_matrice *) (*s_objet).objet)).type == 'R')
! 575: {
! 576: if ((*s_objet_elementaire).type == INT)
! 577: {
! 578: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
! 579: .tableau)[nombre_lignes - (i + 1)]
! 580: [nombre_colonnes - (j + 1)] =
! 581: (real8) (*((integer8 *)
! 582: (*s_objet_elementaire).objet));
! 583: }
! 584: else
! 585: {
! 586: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
! 587: .tableau)[nombre_lignes - (i + 1)]
! 588: [nombre_colonnes - (j + 1)] = (*((real8 *)
! 589: (*s_objet_elementaire).objet));
! 590: }
! 591: }
! 592: else
! 593: {
! 594: if ((*s_objet_elementaire).type == INT)
! 595: {
! 596: ((struct_complexe16 **) (*((struct_matrice *)
! 597: (*s_objet).objet)).tableau)
! 598: [nombre_lignes - (i + 1)]
! 599: [nombre_colonnes - (j + 1)].partie_reelle =
! 600: (real8) (*((integer8 *)
! 601: (*s_objet_elementaire).objet));
! 602: ((struct_complexe16 **) (*((struct_matrice *)
! 603: (*s_objet).objet)).tableau)
! 604: [nombre_lignes - (i + 1)]
! 605: [nombre_colonnes - (j + 1)]
! 606: .partie_imaginaire = 0;
! 607: }
! 608: else if ((*s_objet_elementaire).type == REL)
! 609: {
! 610: ((struct_complexe16 **) (*((struct_matrice *)
! 611: (*s_objet).objet)).tableau)
! 612: [nombre_lignes - (i + 1)]
! 613: [nombre_colonnes - (j + 1)].partie_reelle =
! 614: (*((real8 *) (*s_objet_elementaire).objet));
! 615: ((struct_complexe16 **) (*((struct_matrice *)
! 616: (*s_objet).objet)).tableau)
! 617: [nombre_lignes - (i + 1)]
! 618: [nombre_colonnes - (j + 1)]
! 619: .partie_imaginaire = 0;
! 620: }
! 621: else
! 622: {
! 623: ((struct_complexe16 **) (*((struct_matrice *)
! 624: (*s_objet).objet)).tableau)
! 625: [nombre_lignes - (i + 1)]
! 626: [nombre_colonnes - (j + 1)].partie_reelle =
! 627: (*((struct_complexe16 *)
! 628: (*s_objet_elementaire).objet)).partie_reelle;
! 629: ((struct_complexe16 **) (*((struct_matrice *)
! 630: (*s_objet).objet)).tableau)
! 631: [nombre_lignes - (i + 1)]
! 632: [nombre_colonnes - (j + 1)].partie_imaginaire =
! 633: (*((struct_complexe16 *)
! 634: (*s_objet_elementaire).objet))
! 635: .partie_imaginaire;
! 636: }
! 637: }
! 638:
! 639: liberation(s_etat_processus, s_objet_elementaire);
! 640: }
! 641: }
! 642: }
! 643:
! 644: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 645: s_objet) == d_erreur)
! 646: {
! 647: return;
! 648: }
! 649:
! 650: return;
! 651: }
! 652:
! 653:
! 654: /*
! 655: ================================================================================
! 656: Fonction 'false'
! 657: ================================================================================
! 658: Entrées : structure processus
! 659: --------------------------------------------------------------------------------
! 660: Sorties :
! 661: --------------------------------------------------------------------------------
! 662: Effets de bord : néant
! 663: ================================================================================
! 664: */
! 665:
! 666: void
! 667: instruction_false(struct_processus *s_etat_processus)
! 668: {
! 669: struct_objet *s_objet;
! 670:
! 671: (*s_etat_processus).erreur_execution = d_ex;
! 672:
! 673: if ((*s_etat_processus).affichage_arguments == 'Y')
! 674: {
! 675: printf("\n FALSE ");
! 676:
! 677: if ((*s_etat_processus).langue == 'F')
! 678: {
! 679: printf("(valeur fausse)\n\n");
! 680: }
! 681: else
! 682: {
! 683: printf("(false value)\n\n");
! 684: }
! 685:
! 686: printf("-> 1: %s\n", d_INT);
! 687:
! 688: return;
! 689: }
! 690: else if ((*s_etat_processus).test_instruction == 'Y')
! 691: {
! 692: (*s_etat_processus).nombre_arguments = -1;
! 693: return;
! 694: }
! 695:
! 696: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
! 697: {
! 698: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 699: return;
! 700: }
! 701:
! 702: (*((integer8 *) (*s_objet).objet)) = 0;
! 703:
! 704: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 705: s_objet) == d_erreur)
! 706: {
! 707: return;
! 708: }
! 709:
! 710: return;
! 711: }
! 712:
! 713:
! 714: /*
! 715: ================================================================================
! 716: Fonction '->STR'
! 717: ================================================================================
! 718: Entrées : structure processus
! 719: --------------------------------------------------------------------------------
! 720: Sorties :
! 721: --------------------------------------------------------------------------------
! 722: Effets de bord : néant
! 723: ================================================================================
! 724: */
! 725:
! 726: void
! 727: instruction_fleche_str(struct_processus *s_etat_processus)
! 728: {
! 729: struct_objet *s_objet_argument;
! 730: struct_objet *s_objet_resultat;
! 731:
! 732: (*s_etat_processus).erreur_execution = d_ex;
! 733:
! 734: if ((*s_etat_processus).affichage_arguments == 'Y')
! 735: {
! 736: printf("\n ->STR ");
! 737:
! 738: if ((*s_etat_processus).langue == 'F')
! 739: {
! 740: printf("(conversion en chaîne)\n\n");
! 741: }
! 742: else
! 743: {
! 744: printf("(conversion into string of chars)\n\n");
! 745: }
! 746:
! 747: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 748: " %s, %s, %s, %s, %s,\n"
! 749: " %s, %s, %s, %s, %s,\n"
! 750: " %s\n",
! 751: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 752: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 753: printf("-> 1: %s\n", d_INT);
! 754:
! 755: return;
! 756: }
! 757: else if ((*s_etat_processus).test_instruction == 'Y')
! 758: {
! 759: (*s_etat_processus).nombre_arguments = -1;
! 760: return;
! 761: }
! 762:
! 763: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 764: {
! 765: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 766: {
! 767: return;
! 768: }
! 769: }
! 770:
! 771: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 772: &s_objet_argument) == d_erreur)
! 773: {
! 774: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 775: return;
! 776: }
! 777:
! 778: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
! 779: {
! 780: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 781: return;
! 782: }
! 783:
! 784: (*s_objet_resultat).objet = (void *) formateur(s_etat_processus, 0,
! 785: s_objet_argument);
! 786:
! 787: if ((*s_objet_resultat).objet == NULL)
! 788: {
! 789: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 790: return;
! 791: }
! 792:
! 793: liberation(s_etat_processus, s_objet_argument);
! 794:
! 795: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 796: s_objet_resultat) == d_erreur)
! 797: {
! 798: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 799: return;
! 800: }
! 801:
! 802: return;
! 803: }
! 804:
! 805:
! 806: /*
! 807: ================================================================================
! 808: Fonction 'FFT'
! 809: ================================================================================
! 810: Entrées : structure processus
! 811: --------------------------------------------------------------------------------
! 812: Sorties :
! 813: --------------------------------------------------------------------------------
! 814: Effets de bord : néant
! 815: ================================================================================
! 816: */
! 817:
! 818: void
! 819: instruction_fft(struct_processus *s_etat_processus)
! 820: {
! 821: integer4 erreur;
! 822: integer4 inverse;
! 823: integer4 nombre_colonnes;
! 824: integer4 nombre_lignes;
! 825:
! 826: logical1 presence_longueur_fft;
! 827:
! 828: long longueur_fft_signee;
! 829:
! 830: struct_complexe16 *matrice_f77;
! 831:
! 832: struct_objet *s_objet_argument;
! 833: struct_objet *s_objet_longueur_fft;
! 834: struct_objet *s_objet_resultat;
! 835:
! 836: unsigned long i;
! 837: unsigned long j;
! 838: unsigned long k;
! 839: unsigned long longueur_fft;
! 840:
! 841: (*s_etat_processus).erreur_execution =d_ex;
! 842:
! 843: if ((*s_etat_processus).affichage_arguments == 'Y')
! 844: {
! 845: printf("\n FFT ");
! 846:
! 847: if ((*s_etat_processus).langue == 'F')
! 848: {
! 849: printf("(transformée de Fourier rapide)\n\n");
! 850: }
! 851: else
! 852: {
! 853: printf("(fast Fourier transform)\n\n");
! 854: }
! 855:
! 856: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 857: printf("-> 1: %s\n\n", d_VCX);
! 858:
! 859: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 860: printf("-> 1: %s\n\n", d_MCX);
! 861:
! 862: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 863: printf(" 1: %s\n", d_INT);
! 864: printf("-> 1: %s\n\n", d_VCX);
! 865:
! 866: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 867: printf(" 1: %s\n", d_INT);
! 868: printf("-> 1: %s\n", d_MCX);
! 869:
! 870: return;
! 871: }
! 872: else if ((*s_etat_processus).test_instruction == 'Y')
! 873: {
! 874: (*s_etat_processus).nombre_arguments = -1;
! 875: return;
! 876: }
! 877:
! 878: /*
! 879: * Il est possible d'imposer une longueur de FFT au premier niveau
! 880: * de la pile.
! 881: */
! 882:
! 883: if ((*s_etat_processus).l_base_pile == NULL)
! 884: {
! 885: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 886: return;
! 887: }
! 888:
! 889: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
! 890: {
! 891: presence_longueur_fft = d_vrai;
! 892:
! 893: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 894: {
! 895: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 896: {
! 897: return;
! 898: }
! 899: }
! 900:
! 901: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 902: &s_objet_longueur_fft) == d_erreur)
! 903: {
! 904: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 905: return;
! 906: }
! 907:
! 908: longueur_fft_signee = (*((integer8 *) (*s_objet_longueur_fft).objet));
! 909:
! 910: liberation(s_etat_processus, s_objet_longueur_fft);
! 911:
! 912: if (longueur_fft_signee <= 0)
! 913: {
! 914: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
! 915: return;
! 916: }
! 917:
! 918: longueur_fft = longueur_fft_signee;
! 919: }
! 920: else
! 921: {
! 922: presence_longueur_fft = d_faux;
! 923: longueur_fft = 0;
! 924:
! 925: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 926: {
! 927: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 928: {
! 929: return;
! 930: }
! 931: }
! 932: }
! 933:
! 934: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 935: &s_objet_argument) == d_erreur)
! 936: {
! 937: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 938: return;
! 939: }
! 940:
! 941: /*
! 942: --------------------------------------------------------------------------------
! 943: Vecteur
! 944: --------------------------------------------------------------------------------
! 945: */
! 946:
! 947: if (((*s_objet_argument).type == VIN) ||
! 948: ((*s_objet_argument).type == VRL) ||
! 949: ((*s_objet_argument).type == VCX))
! 950: {
! 951: if (presence_longueur_fft == d_faux)
! 952: {
! 953: longueur_fft = pow(2, (integer4) ceil(log((real8)
! 954: (*((struct_vecteur *)
! 955: (*s_objet_argument).objet)).taille) / log((real8) 2)));
! 956:
! 957: if ((longueur_fft / ((real8) (*((struct_vecteur *)
! 958: (*s_objet_argument).objet)).taille)) == 2)
! 959: {
! 960: longueur_fft /= 2;
! 961: }
! 962: }
! 963:
! 964: if ((matrice_f77 = malloc(longueur_fft *
! 965: sizeof(struct_complexe16))) == NULL)
! 966: {
! 967: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 968: return;
! 969: }
! 970:
! 971: if ((*s_objet_argument).type == VIN)
! 972: {
! 973: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
! 974: .taille; i++)
! 975: {
! 976: matrice_f77[i].partie_reelle = (real8) ((integer8 *)
! 977: (*((struct_vecteur *) (*s_objet_argument).objet))
! 978: .tableau)[i];
! 979: matrice_f77[i].partie_imaginaire = (real8) 0;
! 980: }
! 981: }
! 982: else if ((*s_objet_argument).type == VRL)
! 983: {
! 984: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
! 985: .taille; i++)
! 986: {
! 987: matrice_f77[i].partie_reelle = ((real8 *)
! 988: (*((struct_vecteur *) (*s_objet_argument).objet))
! 989: .tableau)[i];
! 990: matrice_f77[i].partie_imaginaire = (real8) 0;
! 991: }
! 992: }
! 993: else
! 994: {
! 995: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
! 996: .taille; i++)
! 997: {
! 998: matrice_f77[i].partie_reelle = ((struct_complexe16 *)
! 999: (*((struct_vecteur *) (*s_objet_argument).objet))
! 1000: .tableau)[i].partie_reelle;
! 1001: matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
! 1002: (*((struct_vecteur *) (*s_objet_argument).objet))
! 1003: .tableau)[i].partie_imaginaire;
! 1004: }
! 1005: }
! 1006:
! 1007: for(; i < longueur_fft; i++)
! 1008: {
! 1009: matrice_f77[i].partie_reelle = (real8) 0;
! 1010: matrice_f77[i].partie_imaginaire = (real8) 0;
! 1011: }
! 1012:
! 1013: nombre_lignes = 1;
! 1014: nombre_colonnes = longueur_fft;
! 1015: inverse = 0;
! 1016:
! 1017: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
! 1018:
! 1019: if (erreur != 0)
! 1020: {
! 1021: liberation(s_etat_processus, s_objet_argument);
! 1022: free(matrice_f77);
! 1023:
! 1024: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
! 1025: return;
! 1026: }
! 1027:
! 1028: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
! 1029: == NULL)
! 1030: {
! 1031: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1032: return;
! 1033: }
! 1034:
! 1035: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_fft;
! 1036: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
! 1037: }
! 1038:
! 1039: /*
! 1040: --------------------------------------------------------------------------------
! 1041: Matrice
! 1042: --------------------------------------------------------------------------------
! 1043: */
! 1044:
! 1045: else if (((*s_objet_argument).type == MIN) ||
! 1046: ((*s_objet_argument).type == MRL) ||
! 1047: ((*s_objet_argument).type == MCX))
! 1048: {
! 1049: if (presence_longueur_fft == d_faux)
! 1050: {
! 1051: longueur_fft = pow(2, (integer4) ceil(log((real8)
! 1052: (*((struct_matrice *)
! 1053: (*s_objet_argument).objet)).nombre_colonnes) /
! 1054: log((real8) 2)));
! 1055:
! 1056: if ((longueur_fft / ((real8) (*((struct_matrice *)
! 1057: (*s_objet_argument).objet)).nombre_colonnes)) == 2)
! 1058: {
! 1059: longueur_fft /= 2;
! 1060: }
! 1061: }
! 1062:
! 1063: if ((matrice_f77 = malloc(longueur_fft *
! 1064: (*((struct_matrice *) (*s_objet_argument).objet))
! 1065: .nombre_lignes * sizeof(struct_complexe16))) == NULL)
! 1066: {
! 1067: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1068: return;
! 1069: }
! 1070:
! 1071: if ((*s_objet_argument).type == MIN)
! 1072: {
! 1073: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
! 1074: .objet)).nombre_colonnes; i++)
! 1075: {
! 1076: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
! 1077: .objet)).nombre_lignes; j++)
! 1078: {
! 1079: matrice_f77[k].partie_reelle = (real8) ((integer8 **)
! 1080: (*((struct_matrice *) (*s_objet_argument).objet))
! 1081: .tableau)[j][i];
! 1082: matrice_f77[k++].partie_imaginaire = (real8) 0;
! 1083: }
! 1084: }
! 1085:
! 1086: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
! 1087: .objet)).nombre_lignes; k++)
! 1088: {
! 1089: matrice_f77[k].partie_reelle = (real8) 0;
! 1090: matrice_f77[k].partie_imaginaire = (real8) 0;
! 1091: }
! 1092: }
! 1093: else if ((*s_objet_argument).type == MRL)
! 1094: {
! 1095: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
! 1096: .objet)).nombre_colonnes; i++)
! 1097: {
! 1098: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
! 1099: .objet)).nombre_lignes; j++)
! 1100: {
! 1101: matrice_f77[k].partie_reelle = ((real8 **)
! 1102: (*((struct_matrice *) (*s_objet_argument).objet))
! 1103: .tableau)[j][i];
! 1104: matrice_f77[k++].partie_imaginaire = (real8) 0;
! 1105: }
! 1106: }
! 1107:
! 1108: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
! 1109: .objet)).nombre_lignes; k++)
! 1110: {
! 1111: matrice_f77[k].partie_reelle = (real8) 0;
! 1112: matrice_f77[k].partie_imaginaire = (real8) 0;
! 1113: }
! 1114: }
! 1115: else
! 1116: {
! 1117: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
! 1118: .objet)).nombre_colonnes; i++)
! 1119: {
! 1120: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
! 1121: .objet)).nombre_lignes; j++)
! 1122: {
! 1123: matrice_f77[k].partie_reelle = ((struct_complexe16 **)
! 1124: (*((struct_matrice *) (*s_objet_argument).objet))
! 1125: .tableau)[j][i].partie_reelle;
! 1126: matrice_f77[k++].partie_imaginaire =
! 1127: ((struct_complexe16 **) (*((struct_matrice *)
! 1128: (*s_objet_argument).objet)).tableau)[j][i]
! 1129: .partie_imaginaire;
! 1130: }
! 1131: }
! 1132:
! 1133: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
! 1134: .objet)).nombre_lignes; k++)
! 1135: {
! 1136: matrice_f77[k].partie_reelle = (real8) 0;
! 1137: matrice_f77[k].partie_imaginaire = (real8) 0;
! 1138: }
! 1139: }
! 1140:
! 1141: nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet))
! 1142: .nombre_lignes;
! 1143: nombre_colonnes = longueur_fft;
! 1144: inverse = 0;
! 1145:
! 1146: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
! 1147:
! 1148: if (erreur != 0)
! 1149: {
! 1150: liberation(s_etat_processus, s_objet_argument);
! 1151: free(matrice_f77);
! 1152:
! 1153: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
! 1154: return;
! 1155: }
! 1156:
! 1157: if ((s_objet_resultat = allocation(s_etat_processus, MCX))
! 1158: == NULL)
! 1159: {
! 1160: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1161: return;
! 1162: }
! 1163:
! 1164: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 1165: (*((struct_matrice *) (*s_objet_argument).objet))
! 1166: .nombre_lignes;
! 1167: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 1168: longueur_fft;
! 1169:
! 1170: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 1171: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
! 1172: .nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
! 1173: {
! 1174: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1175: return;
! 1176: }
! 1177:
! 1178: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 1179: .nombre_lignes; i++)
! 1180: {
! 1181: if ((((struct_complexe16 **) (*((struct_matrice *)
! 1182: (*s_objet_resultat).objet)).tableau)[i] =
! 1183: malloc((*((struct_matrice *)
! 1184: (*s_objet_resultat).objet)).nombre_colonnes *
! 1185: sizeof(struct_complexe16))) == NULL)
! 1186: {
! 1187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1188: return;
! 1189: }
! 1190: }
! 1191:
! 1192: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 1193: .nombre_colonnes; i++)
! 1194: {
! 1195: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 1196: .nombre_lignes; j++)
! 1197: {
! 1198: ((struct_complexe16 **) (*((struct_matrice *)
! 1199: (*s_objet_resultat).objet)).tableau)[j][i]
! 1200: .partie_reelle = matrice_f77[k].partie_reelle;
! 1201: ((struct_complexe16 **) (*((struct_matrice *)
! 1202: (*s_objet_resultat).objet)).tableau)[j][i]
! 1203: .partie_imaginaire = matrice_f77[k++].partie_imaginaire;
! 1204: }
! 1205: }
! 1206:
! 1207: free(matrice_f77);
! 1208: }
! 1209:
! 1210: /*
! 1211: --------------------------------------------------------------------------------
! 1212: Calcul de FFT impossible
! 1213: --------------------------------------------------------------------------------
! 1214: */
! 1215:
! 1216: else
! 1217: {
! 1218: liberation(s_etat_processus, s_objet_argument);
! 1219:
! 1220: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1221: return;
! 1222: }
! 1223:
! 1224: liberation(s_etat_processus, s_objet_argument);
! 1225:
! 1226: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1227: s_objet_resultat) == d_erreur)
! 1228: {
! 1229: return;
! 1230: }
! 1231:
! 1232: return;
! 1233: }
! 1234:
! 1235:
! 1236: /*
! 1237: ================================================================================
! 1238: Fonction 'function' (passe en mode d'affichage y=f(x))
! 1239: ================================================================================
! 1240: Entrées : structure processus
! 1241: --------------------------------------------------------------------------------
! 1242: Sorties :
! 1243: --------------------------------------------------------------------------------
! 1244: Effets de bord : néant
! 1245: ================================================================================
! 1246: */
! 1247:
! 1248: void
! 1249: instruction_function(struct_processus *s_etat_processus)
! 1250: {
! 1251: (*s_etat_processus).erreur_execution = d_ex;
! 1252:
! 1253: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1254: {
! 1255: printf("\n FUNCTION ");
! 1256:
! 1257: if ((*s_etat_processus).langue == 'F')
! 1258: {
! 1259: printf("(tracé y=f(x))\n\n");
! 1260: printf(" Aucun argument\n");
! 1261: }
! 1262: else
! 1263: {
! 1264: printf("(plot y=f(x))\n\n");
! 1265: printf(" No argument\n");
! 1266: }
! 1267:
! 1268: return;
! 1269: }
! 1270: else if ((*s_etat_processus).test_instruction == 'Y')
! 1271: {
! 1272: (*s_etat_processus).nombre_arguments = -1;
! 1273: return;
! 1274: }
! 1275:
! 1276: strcpy((*s_etat_processus).type_trace_eq, "FONCTION");
! 1277:
! 1278: return;
! 1279: }
! 1280:
! 1281: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_f2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src