Annotation of rpl/src/instructions_d6.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 'dupcntxt'
! 29: ================================================================================
! 30: Entrées : pointeur sur une structure struct_processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_dupcntxt(struct_processus *s_etat_processus)
! 40: {
! 41: struct_objet *s_objet;
! 42: struct_objet *s_pile;
! 43:
! 44: (*s_etat_processus).erreur_execution = d_ex;
! 45:
! 46: if ((*s_etat_processus).affichage_arguments == 'Y')
! 47: {
! 48: printf("\n DUPCNTXT ");
! 49:
! 50: if ((*s_etat_processus).langue == 'F')
! 51: {
! 52: printf("(duplication du contexte)\n\n");
! 53: printf(" Aucun argument\n");
! 54: }
! 55: else
! 56: {
! 57: printf("(context duplication)\n\n");
! 58: printf(" No argument\n");
! 59: }
! 60:
! 61: return;
! 62: }
! 63: else if ((*s_etat_processus).test_instruction == 'Y')
! 64: {
! 65: (*s_etat_processus).nombre_arguments = -1;
! 66: return;
! 67: }
! 68:
! 69: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 70: {
! 71: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 72: {
! 73: return;
! 74: }
! 75: }
! 76:
! 77: if ((s_objet = allocation(s_etat_processus, LST)) == NULL)
! 78: {
! 79: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 80: return;
! 81: }
! 82:
! 83: (*s_objet).objet = (*s_etat_processus).l_base_pile;
! 84:
! 85: if ((s_pile = copie_objet(s_etat_processus, s_objet, 'N')) == NULL)
! 86: {
! 87: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 88: return;
! 89: }
! 90:
! 91: if (empilement(s_etat_processus, &((*s_etat_processus).
! 92: l_base_pile_contextes), s_objet) == d_erreur)
! 93: {
! 94: return;
! 95: }
! 96:
! 97: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
! 98: {
! 99: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 100: return;
! 101: }
! 102:
! 103: (*((integer8 *) (*s_objet).objet)) = (*s_etat_processus)
! 104: .hauteur_pile_operationnelle;
! 105:
! 106: if (empilement(s_etat_processus, &((*s_etat_processus)
! 107: .l_base_pile_taille_contextes), s_objet) == d_erreur)
! 108: {
! 109: return;
! 110: }
! 111:
! 112: /*
! 113: * Copie de la pile opérationnelle
! 114: */
! 115:
! 116: (*s_etat_processus).l_base_pile = (*s_pile).objet;
! 117:
! 118: (*s_pile).objet = NULL;
! 119: liberation(s_etat_processus, s_pile);
! 120:
! 121: return;
! 122: }
! 123:
! 124:
! 125: /*
! 126: ================================================================================
! 127: Fonction 'dropcntxt'
! 128: ================================================================================
! 129: Entrées : pointeur sur une structure struct_processus
! 130: --------------------------------------------------------------------------------
! 131: Sorties :
! 132: --------------------------------------------------------------------------------
! 133: Effets de bord : néant
! 134: ================================================================================
! 135: */
! 136:
! 137: void
! 138: instruction_dropcntxt(struct_processus *s_etat_processus)
! 139: {
! 140: struct_objet *s_objet;
! 141:
! 142: (*s_etat_processus).erreur_execution = d_ex;
! 143:
! 144: if ((*s_etat_processus).affichage_arguments == 'Y')
! 145: {
! 146: printf("\n DROPCNTXT ");
! 147:
! 148: if ((*s_etat_processus).langue == 'F')
! 149: {
! 150: printf("(effacement d'un contexte)\n\n");
! 151: printf(" Aucun argument\n");
! 152: }
! 153: else
! 154: {
! 155: printf("(drops context)\n\n");
! 156: printf(" No argument\n");
! 157: }
! 158:
! 159: return;
! 160: }
! 161: else if ((*s_etat_processus).test_instruction == 'Y')
! 162: {
! 163: (*s_etat_processus).nombre_arguments = -1;
! 164: return;
! 165: }
! 166:
! 167: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 168: {
! 169: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 170: {
! 171: return;
! 172: }
! 173: }
! 174:
! 175: if (((*s_etat_processus).l_base_pile_contextes == NULL) ||
! 176: ((*s_etat_processus).l_base_pile_taille_contextes == NULL))
! 177: {
! 178: (*s_etat_processus).erreur_execution = d_ex_contexte;
! 179: return;
! 180: }
! 181:
! 182: if (depilement(s_etat_processus, &((*s_etat_processus)
! 183: .l_base_pile_contextes), &s_objet) == d_erreur)
! 184: {
! 185: return;
! 186: }
! 187:
! 188: liberation(s_etat_processus, s_objet);
! 189:
! 190: if (depilement(s_etat_processus, &((*s_etat_processus)
! 191: .l_base_pile_taille_contextes), &s_objet) == d_erreur)
! 192: {
! 193: return;
! 194: }
! 195:
! 196: liberation(s_etat_processus, s_objet);
! 197:
! 198: return;
! 199: }
! 200:
! 201:
! 202: /*
! 203: ================================================================================
! 204: Fonction 'dgtiz'
! 205: ================================================================================
! 206: Entrées : pointeur sur une structure struct_processus
! 207: --------------------------------------------------------------------------------
! 208: Sorties :
! 209: --------------------------------------------------------------------------------
! 210: Effets de bord : néant
! 211: ================================================================================
! 212: */
! 213:
! 214: void
! 215: instruction_dgtiz(struct_processus *s_etat_processus)
! 216: {
! 217: (*s_etat_processus).erreur_execution = d_ex;
! 218:
! 219: if ((*s_etat_processus).affichage_arguments == 'Y')
! 220: {
! 221: printf("\n DGTIZ ");
! 222:
! 223: if ((*s_etat_processus).langue == 'F')
! 224: {
! 225: printf("(mouse support in plot functions)\n\n");
! 226: printf(" Aucun argument\n");
! 227: }
! 228: else
! 229: {
! 230: printf("(support de la souris dans les fonctions graphiques)\n\n");
! 231: printf(" No argument\n");
! 232: }
! 233:
! 234: return;
! 235: }
! 236: else if ((*s_etat_processus).test_instruction == 'Y')
! 237: {
! 238: (*s_etat_processus).nombre_arguments = -1;
! 239: return;
! 240: }
! 241:
! 242: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 243: {
! 244: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 245: {
! 246: return;
! 247: }
! 248: }
! 249:
! 250: if ((*s_etat_processus).fichiers_graphiques != NULL)
! 251: {
! 252: (*s_etat_processus).souris_active = d_vrai;
! 253: appel_gnuplot(s_etat_processus, 'N');
! 254: (*s_etat_processus).souris_active = d_faux;
! 255: }
! 256:
! 257: return;
! 258: }
! 259:
! 260:
! 261: /*
! 262: ================================================================================
! 263: Fonction 'daemonize'
! 264: ================================================================================
! 265: Entrées : pointeur sur une structure struct_processus
! 266: --------------------------------------------------------------------------------
! 267: Sorties :
! 268: --------------------------------------------------------------------------------
! 269: Effets de bord : néant
! 270: ================================================================================
! 271: */
! 272:
! 273: void
! 274: instruction_daemonize(struct_processus *s_etat_processus)
! 275: {
! 276: (*s_etat_processus).erreur_execution = d_ex;
! 277:
! 278: if ((*s_etat_processus).affichage_arguments == 'Y')
! 279: {
! 280: printf("\n DAEMONIZE ");
! 281:
! 282: if ((*s_etat_processus).langue == 'F')
! 283: {
! 284: printf("(basculement en mode daemon)\n\n");
! 285: printf(" Aucun argument\n");
! 286: }
! 287: else
! 288: {
! 289: printf("(convert to daemon)\n\n");
! 290: printf(" No argument\n");
! 291: }
! 292:
! 293: return;
! 294: }
! 295: else if ((*s_etat_processus).test_instruction == 'Y')
! 296: {
! 297: (*s_etat_processus).nombre_arguments = -1;
! 298: return;
! 299: }
! 300:
! 301: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 302: {
! 303: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 304: {
! 305: return;
! 306: }
! 307: }
! 308:
! 309: if (((*s_etat_processus).var_volatile_processus_pere == -1) &&
! 310: ((*s_etat_processus).l_base_pile_processus == NULL))
! 311: {
! 312: lancement_daemon(s_etat_processus);
! 313: }
! 314: else
! 315: {
! 316: (*s_etat_processus).erreur_execution = d_ex_daemon;
! 317: return;
! 318: }
! 319:
! 320: return;
! 321: }
! 322:
! 323:
! 324: /*
! 325: ================================================================================
! 326: Fonction 'diag->'
! 327: ================================================================================
! 328: Entrées : pointeur sur une structure struct_processus
! 329: --------------------------------------------------------------------------------
! 330: Sorties :
! 331: --------------------------------------------------------------------------------
! 332: Effets de bord : néant
! 333: ================================================================================
! 334: */
! 335:
! 336: void
! 337: instruction_diag_fleche(struct_processus *s_etat_processus)
! 338: {
! 339: struct_objet *s_objet_argument;
! 340: struct_objet *s_objet_resultat;
! 341:
! 342: unsigned long i;
! 343: unsigned long j;
! 344:
! 345: (*s_etat_processus).erreur_execution = d_ex;
! 346:
! 347: if ((*s_etat_processus).affichage_arguments == 'Y')
! 348: {
! 349: printf("\n DIAG-> ");
! 350:
! 351: if ((*s_etat_processus).langue == 'F')
! 352: {
! 353: printf("(conversion d'une matrice diagonale en vecteur)\n\n");
! 354: }
! 355: else
! 356: {
! 357: printf("(diagonal matrix to vector conversion)\n\n");
! 358: }
! 359:
! 360: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 361: printf("-> 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 362:
! 363: return;
! 364: }
! 365: else if ((*s_etat_processus).test_instruction == 'Y')
! 366: {
! 367: (*s_etat_processus).nombre_arguments = -1;
! 368: return;
! 369: }
! 370:
! 371: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 372: {
! 373: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 374: {
! 375: return;
! 376: }
! 377: }
! 378:
! 379: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 380: &s_objet_argument) == d_erreur)
! 381: {
! 382: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 383: return;
! 384: }
! 385:
! 386: /*
! 387: * Conversion d'une matrice
! 388: */
! 389:
! 390: if ((*s_objet_argument).type == MIN)
! 391: {
! 392: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
! 393: (*((struct_matrice *) (*s_objet_argument).objet))
! 394: .nombre_colonnes)
! 395: {
! 396: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 397:
! 398: liberation(s_etat_processus, s_objet_argument);
! 399: return;
! 400: }
! 401:
! 402: if ((s_objet_resultat = allocation(s_etat_processus, VIN)) == NULL)
! 403: {
! 404: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 405: return;
! 406: }
! 407:
! 408: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 409: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
! 410:
! 411: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau
! 412: = malloc((*((struct_vecteur *) (*s_objet_resultat).objet))
! 413: .taille * sizeof(integer8))) == NULL)
! 414: {
! 415: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 416: return;
! 417: }
! 418:
! 419: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
! 420: .nombre_lignes; i++)
! 421: {
! 422: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
! 423: .nombre_colonnes; j++)
! 424: {
! 425: if (i != j)
! 426: {
! 427: if (((integer8 **) (*((struct_matrice *) (*s_objet_argument)
! 428: .objet)).tableau)[i][j] != 0)
! 429: {
! 430: liberation(s_etat_processus, s_objet_argument);
! 431: liberation(s_etat_processus, s_objet_resultat);
! 432:
! 433: (*s_etat_processus).erreur_execution =
! 434: d_ex_matrice_non_diagonale;
! 435: return;
! 436: }
! 437: }
! 438: else
! 439: {
! 440: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
! 441: .objet)).tableau)[i] = ((integer8 **)
! 442: (*((struct_matrice *) (*s_objet_argument)
! 443: .objet)).tableau)[i][j];
! 444: }
! 445: }
! 446: }
! 447: }
! 448: else if ((*s_objet_argument).type == MRL)
! 449: {
! 450: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
! 451: (*((struct_matrice *) (*s_objet_argument).objet))
! 452: .nombre_colonnes)
! 453: {
! 454: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 455:
! 456: liberation(s_etat_processus, s_objet_argument);
! 457: return;
! 458: }
! 459:
! 460: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
! 461: {
! 462: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 463: return;
! 464: }
! 465:
! 466: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 467: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
! 468:
! 469: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau
! 470: = malloc((*((struct_vecteur *) (*s_objet_resultat).objet))
! 471: .taille * sizeof(real8))) == NULL)
! 472: {
! 473: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 474: return;
! 475: }
! 476:
! 477: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
! 478: .nombre_lignes; i++)
! 479: {
! 480: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
! 481: .nombre_colonnes; j++)
! 482: {
! 483: if (i != j)
! 484: {
! 485: if (((real8 **) (*((struct_matrice *) (*s_objet_argument)
! 486: .objet)).tableau)[i][j] != 0)
! 487: {
! 488: liberation(s_etat_processus, s_objet_argument);
! 489: liberation(s_etat_processus, s_objet_resultat);
! 490:
! 491: (*s_etat_processus).erreur_execution =
! 492: d_ex_matrice_non_diagonale;
! 493: return;
! 494: }
! 495: }
! 496: else
! 497: {
! 498: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
! 499: .objet)).tableau)[i] = ((real8 **)
! 500: (*((struct_matrice *) (*s_objet_argument)
! 501: .objet)).tableau)[i][j];
! 502: }
! 503: }
! 504: }
! 505: }
! 506: else if ((*s_objet_argument).type == MCX)
! 507: {
! 508: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
! 509: (*((struct_matrice *) (*s_objet_argument).objet))
! 510: .nombre_colonnes)
! 511: {
! 512: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 513:
! 514: liberation(s_etat_processus, s_objet_argument);
! 515: return;
! 516: }
! 517:
! 518: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
! 519: {
! 520: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 521: return;
! 522: }
! 523:
! 524: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 525: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
! 526:
! 527: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau
! 528: = malloc((*((struct_vecteur *) (*s_objet_resultat).objet))
! 529: .taille * sizeof(complex16))) == NULL)
! 530: {
! 531: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 532: return;
! 533: }
! 534:
! 535: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
! 536: .nombre_lignes; i++)
! 537: {
! 538: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
! 539: .nombre_colonnes; j++)
! 540: {
! 541: if (i != j)
! 542: {
! 543: if ((((complex16 **) (*((struct_matrice *)
! 544: (*s_objet_argument).objet)).tableau)[i][j]
! 545: .partie_reelle != 0) ||
! 546: (((complex16 **) (*((struct_matrice *)
! 547: (*s_objet_argument).objet)).tableau)[i][j]
! 548: .partie_imaginaire != 0))
! 549: {
! 550: liberation(s_etat_processus, s_objet_argument);
! 551: liberation(s_etat_processus, s_objet_resultat);
! 552:
! 553: (*s_etat_processus).erreur_execution =
! 554: d_ex_matrice_non_diagonale;
! 555: return;
! 556: }
! 557: }
! 558: else
! 559: {
! 560: ((complex16 *) (*((struct_vecteur *) (*s_objet_resultat)
! 561: .objet)).tableau)[i] = ((complex16 **)
! 562: (*((struct_matrice *) (*s_objet_argument)
! 563: .objet)).tableau)[i][j];
! 564: }
! 565: }
! 566: }
! 567: }
! 568:
! 569: /*
! 570: * Conversion impossible impossible
! 571: */
! 572:
! 573: else
! 574: {
! 575: liberation(s_etat_processus, s_objet_argument);
! 576:
! 577: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 578: return;
! 579: }
! 580:
! 581: liberation(s_etat_processus, s_objet_argument);
! 582:
! 583: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 584: s_objet_resultat) == d_erreur)
! 585: {
! 586: return;
! 587: }
! 588:
! 589: return;
! 590: }
! 591:
! 592: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_d6.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src