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