Annotation of rpl/src/instructions_p4.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 'pr1'
! 29: ================================================================================
! 30: Entrées :
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_pr1(struct_processus *s_etat_processus)
! 40: {
! 41: struct_objet *s_objet;
! 42:
! 43: (*s_etat_processus).erreur_execution = d_ex;
! 44:
! 45: if ((*s_etat_processus).affichage_arguments == 'Y')
! 46: {
! 47: printf("\n PR1 ");
! 48:
! 49: if ((*s_etat_processus).langue == 'F')
! 50: {
! 51: printf("(impression d'un objet)\n\n");
! 52: }
! 53: else
! 54: {
! 55: printf("(print object)\n\n");
! 56: }
! 57:
! 58: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 59: " %s, %s, %s, %s, %s,\n"
! 60: " %s, %s, %s, %s, %s,\n"
! 61: " %s\n",
! 62: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 63: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 64: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
! 65: " %s, %s, %s, %s, %s,\n"
! 66: " %s, %s, %s, %s, %s,\n"
! 67: " %s\n",
! 68: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 69: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 70:
! 71: return;
! 72: }
! 73: else if ((*s_etat_processus).test_instruction == 'Y')
! 74: {
! 75: (*s_etat_processus).nombre_arguments = -1;
! 76: return;
! 77: }
! 78:
! 79: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 80: {
! 81: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 82: {
! 83: return;
! 84: }
! 85: }
! 86:
! 87: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 88: &s_objet) == d_erreur)
! 89: {
! 90: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 91: return;
! 92: }
! 93:
! 94: formateur_tex(s_etat_processus, s_objet, 'N');
! 95:
! 96: /*
! 97: * La fonction pr1 ne modifie pas la pile
! 98: */
! 99:
! 100: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 101: s_objet) == d_erreur)
! 102: {
! 103: return;
! 104: }
! 105:
! 106: return;
! 107: }
! 108:
! 109:
! 110: /*
! 111: ================================================================================
! 112: Fonction 'print'
! 113: ================================================================================
! 114: Entrées :
! 115: --------------------------------------------------------------------------------
! 116: Sorties :
! 117: --------------------------------------------------------------------------------
! 118: Effets de bord : néant
! 119: ================================================================================
! 120: */
! 121:
! 122: void
! 123: instruction_print(struct_processus *s_etat_processus)
! 124: {
! 125: (*s_etat_processus).erreur_execution = d_ex;
! 126:
! 127: if ((*s_etat_processus).affichage_arguments == 'Y')
! 128: {
! 129: printf("\n PRINT ");
! 130:
! 131: if ((*s_etat_processus).langue == 'F')
! 132: {
! 133: printf("(impression puis destruction de la file d'impression)"
! 134: "\n\n");
! 135: printf(" Aucun argument\n");
! 136: }
! 137: else
! 138: {
! 139: printf("(print and purge the printer queue)\n\n");
! 140: printf(" No argument\n");
! 141: }
! 142:
! 143: return;
! 144: }
! 145: else if ((*s_etat_processus).test_instruction == 'Y')
! 146: {
! 147: (*s_etat_processus).nombre_arguments = -1;
! 148: return;
! 149: }
! 150:
! 151: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 152: {
! 153: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 154: {
! 155: return;
! 156: }
! 157: }
! 158:
! 159: if ((*s_etat_processus).nom_fichier_impression == NULL)
! 160: {
! 161: (*s_etat_processus).erreur_execution = d_ex_queue_impression;
! 162: return;
! 163: }
! 164:
! 165: # ifdef POSTSCRIPT_SUPPORT
! 166: impression_tex(s_etat_processus);
! 167: # else
! 168: if ((*s_etat_processus).langue == 'F')
! 169: {
! 170: printf("+++Attention : Support de TeX non compilé !\n");
! 171: }
! 172: else
! 173: {
! 174: printf("+++Warning : TeX not available !\n");
! 175: }
! 176:
! 177: fflush(stdout);
! 178: # endif
! 179:
! 180: return;
! 181: }
! 182:
! 183:
! 184: /*
! 185: ================================================================================
! 186: Fonction 'prst'
! 187: ================================================================================
! 188: Entrées :
! 189: --------------------------------------------------------------------------------
! 190: Sorties :
! 191: --------------------------------------------------------------------------------
! 192: Effets de bord : néant
! 193: ================================================================================
! 194: */
! 195:
! 196: void
! 197: instruction_prst(struct_processus *s_etat_processus)
! 198: {
! 199: (*s_etat_processus).erreur_execution = d_ex;
! 200:
! 201: if ((*s_etat_processus).affichage_arguments == 'Y')
! 202: {
! 203: printf("\n PRST ");
! 204:
! 205: if ((*s_etat_processus).langue == 'F')
! 206: {
! 207: printf("(imprime la pile opérationnelle)\n\n");
! 208: }
! 209: else
! 210: {
! 211: printf("(print stack)\n\n");
! 212: }
! 213:
! 214: printf(" n: %s, %s, %s, %s, %s, %s,\n"
! 215: " %s, %s, %s, %s, %s,\n"
! 216: " %s, %s, %s, %s, %s,\n"
! 217: " %s\n",
! 218: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 219: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 220: printf(" ...\n");
! 221: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 222: " %s, %s, %s, %s, %s,\n"
! 223: " %s, %s, %s, %s, %s,\n"
! 224: " %s\n",
! 225: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 226: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 227: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
! 228: " %s, %s, %s, %s, %s,\n"
! 229: " %s, %s, %s, %s, %s,\n"
! 230: " %s\n",
! 231: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 232: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 233: printf(" ...\n");
! 234: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 235: " %s, %s, %s, %s, %s,\n"
! 236: " %s, %s, %s, %s, %s,\n"
! 237: " %s\n",
! 238: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 239: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 240:
! 241: return;
! 242: }
! 243: else if ((*s_etat_processus).test_instruction == 'Y')
! 244: {
! 245: (*s_etat_processus).nombre_arguments = -1;
! 246: return;
! 247: }
! 248:
! 249: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 250: {
! 251: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 252: {
! 253: return;
! 254: }
! 255: }
! 256:
! 257: impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
! 258: 'E', 1);
! 259: return;
! 260: }
! 261:
! 262:
! 263: /*
! 264: ================================================================================
! 265: Fonction 'prstc'
! 266: ================================================================================
! 267: Entrées :
! 268: --------------------------------------------------------------------------------
! 269: Sorties :
! 270: --------------------------------------------------------------------------------
! 271: Effets de bord : néant
! 272: ================================================================================
! 273: */
! 274:
! 275: void
! 276: instruction_prstc(struct_processus *s_etat_processus)
! 277: {
! 278: (*s_etat_processus).erreur_execution = d_ex;
! 279:
! 280: if ((*s_etat_processus).affichage_arguments == 'Y')
! 281: {
! 282: printf("\n PRSTC ");
! 283:
! 284: if ((*s_etat_processus).langue == 'F')
! 285: {
! 286: printf("(imprime la pile opérationnelle en mode compact)\n\n");
! 287: }
! 288: else
! 289: {
! 290: printf("(print stack in compact mode)\n\n");
! 291: }
! 292:
! 293: printf(" n: %s, %s, %s, %s, %s, %s,\n"
! 294: " %s, %s, %s, %s, %s,\n"
! 295: " %s, %s, %s, %s, %s,\n"
! 296: " %s\n",
! 297: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 298: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 299: printf(" ...\n");
! 300: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 301: " %s, %s, %s, %s, %s,\n"
! 302: " %s, %s, %s, %s, %s,\n"
! 303: " %s\n",
! 304: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 305: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 306: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
! 307: " %s, %s, %s, %s, %s,\n"
! 308: " %s, %s, %s, %s, %s,\n"
! 309: " %s\n",
! 310: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 311: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 312: printf(" ...\n");
! 313: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 314: " %s, %s, %s, %s, %s,\n"
! 315: " %s, %s, %s, %s, %s,\n"
! 316: " %s\n",
! 317: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 318: d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 319:
! 320: return;
! 321: }
! 322: else if ((*s_etat_processus).test_instruction == 'Y')
! 323: {
! 324: (*s_etat_processus).nombre_arguments = -1;
! 325: return;
! 326: }
! 327:
! 328: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 329: {
! 330: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 331: {
! 332: return;
! 333: }
! 334: }
! 335:
! 336: impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
! 337: 'C', 1);
! 338: return;
! 339: }
! 340:
! 341:
! 342: /*
! 343: ================================================================================
! 344: Fonction 'prvar'
! 345: ================================================================================
! 346: Entrées :
! 347: --------------------------------------------------------------------------------
! 348: Sorties :
! 349: --------------------------------------------------------------------------------
! 350: Effets de bord : néant
! 351: ================================================================================
! 352: */
! 353:
! 354: void
! 355: instruction_prvar(struct_processus *s_etat_processus)
! 356: {
! 357: struct_objet *s_objet;
! 358:
! 359: (*s_etat_processus).erreur_execution = d_ex;
! 360:
! 361: if ((*s_etat_processus).affichage_arguments == 'Y')
! 362: {
! 363: printf("\n PRVAR ");
! 364:
! 365: if ((*s_etat_processus).langue == 'F')
! 366: {
! 367: printf("(imprime le contenu d'une variable)\n\n");
! 368: }
! 369: else
! 370: {
! 371: printf("(print variable)\n\n");
! 372: }
! 373:
! 374: printf(" 1: %s\n", d_NOM);
! 375:
! 376: return;
! 377: }
! 378: else if ((*s_etat_processus).test_instruction == 'Y')
! 379: {
! 380: (*s_etat_processus).nombre_arguments = -1;
! 381: return;
! 382: }
! 383:
! 384: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 385: {
! 386: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 387: {
! 388: return;
! 389: }
! 390: }
! 391:
! 392: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 393: &s_objet) == d_erreur)
! 394: {
! 395: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 396: return;
! 397: }
! 398:
! 399: if ((*s_objet).type != NOM)
! 400: {
! 401: liberation(s_etat_processus, s_objet);
! 402:
! 403: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 404: return;
! 405: }
! 406:
! 407: if (recherche_variable(s_etat_processus, (*((struct_nom *)
! 408: (*s_objet).objet)).nom) == d_faux)
! 409: {
! 410: (*s_etat_processus).erreur_systeme = d_es;
! 411: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
! 412:
! 413: liberation(s_etat_processus, s_objet);
! 414: return;
! 415: }
! 416:
! 417: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 418: .position_variable_courante].objet != NULL)
! 419: {
! 420: formateur_tex(s_etat_processus, (*s_etat_processus).s_liste_variables
! 421: [(*s_etat_processus).position_variable_courante].objet, 'N');
! 422: }
! 423: else
! 424: {
! 425: if (pthread_mutex_lock(&((*(*s_etat_processus)
! 426: .s_liste_variables_partagees).mutex)) != 0)
! 427: {
! 428: (*s_etat_processus).erreur_systeme = d_es_processus;
! 429: return;
! 430: }
! 431:
! 432: if (recherche_variable_partagee(s_etat_processus,
! 433: (*s_etat_processus).s_liste_variables
! 434: [(*s_etat_processus).position_variable_courante].nom,
! 435: (*s_etat_processus).s_liste_variables
! 436: [(*s_etat_processus).position_variable_courante]
! 437: .variable_partagee, (*s_etat_processus).s_liste_variables
! 438: [(*s_etat_processus).position_variable_courante].origine)
! 439: == d_faux)
! 440: {
! 441: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 442: .s_liste_variables_partagees).mutex)) != 0)
! 443: {
! 444: (*s_etat_processus).erreur_systeme = d_es_processus;
! 445: return;
! 446: }
! 447:
! 448: (*s_etat_processus).erreur_systeme = d_es;
! 449: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
! 450:
! 451: liberation(s_etat_processus, s_objet);
! 452: return;
! 453: }
! 454:
! 455: formateur_tex(s_etat_processus, (*(*s_etat_processus)
! 456: .s_liste_variables_partagees).table
! 457: [(*(*s_etat_processus).s_liste_variables_partagees)
! 458: .position_variable].objet, 'N');
! 459:
! 460: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 461: .s_liste_variables_partagees).mutex)) != 0)
! 462: {
! 463: (*s_etat_processus).erreur_systeme = d_es_processus;
! 464: return;
! 465: }
! 466: }
! 467:
! 468: liberation(s_etat_processus, s_objet);
! 469:
! 470: return;
! 471: }
! 472:
! 473:
! 474: /*
! 475: ================================================================================
! 476: Fonction 'prusr'
! 477: ================================================================================
! 478: Entrées :
! 479: --------------------------------------------------------------------------------
! 480: Sorties :
! 481: --------------------------------------------------------------------------------
! 482: Effets de bord : néant
! 483: ================================================================================
! 484: */
! 485:
! 486: void
! 487: instruction_prusr(struct_processus *s_etat_processus)
! 488: {
! 489: struct_objet s_objet;
! 490:
! 491: unsigned long i;
! 492:
! 493: (*s_etat_processus).erreur_execution = d_ex;
! 494:
! 495: if ((*s_etat_processus).affichage_arguments == 'Y')
! 496: {
! 497: printf("\n PRUSR ");
! 498:
! 499: if ((*s_etat_processus).langue == 'F')
! 500: {
! 501: printf("(impression de toutes les variables utilisateur)\n\n");
! 502: printf(" Aucun argument\n");
! 503: }
! 504: else
! 505: {
! 506: printf("(print all user variables)\n\n");
! 507: printf(" No argument\n");
! 508: }
! 509:
! 510: return;
! 511: }
! 512: else if ((*s_etat_processus).test_instruction == 'Y')
! 513: {
! 514: (*s_etat_processus).nombre_arguments = -1;
! 515: return;
! 516: }
! 517:
! 518: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 519: {
! 520: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 521: {
! 522: return;
! 523: }
! 524: }
! 525:
! 526: s_objet.type = CHN;
! 527:
! 528: for(i = 0; i < (*s_etat_processus).nombre_variables; i++)
! 529: {
! 530: if ((s_objet.objet = malloc((strlen((*s_etat_processus)
! 531: .s_liste_variables[i].nom) + 64) * sizeof(unsigned char)))
! 532: == NULL)
! 533: {
! 534: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 535: return;
! 536: }
! 537:
! 538: sprintf((unsigned char *) s_objet.objet, "\\noindent %s [%lu]\n",
! 539: (*s_etat_processus).s_liste_variables[i].nom,
! 540: (*s_etat_processus).s_liste_variables[i].niveau);
! 541:
! 542: formateur_tex(s_etat_processus, &s_objet, 'N');
! 543: free(s_objet.objet);
! 544: }
! 545:
! 546: return;
! 547: }
! 548:
! 549:
! 550: /*
! 551: ================================================================================
! 552: Fonction 'prmd'
! 553: ================================================================================
! 554: Entrées :
! 555: --------------------------------------------------------------------------------
! 556: Sorties :
! 557: --------------------------------------------------------------------------------
! 558: Effets de bord : néant
! 559: ================================================================================
! 560: */
! 561:
! 562: void
! 563: instruction_prmd(struct_processus *s_etat_processus)
! 564: {
! 565: long longueur_utile;
! 566: long longueur_utile_limite;
! 567:
! 568: struct_objet s_objet;
! 569:
! 570: unsigned long i;
! 571: unsigned long j;
! 572:
! 573: (*s_etat_processus).erreur_execution = d_ex;
! 574:
! 575: if ((*s_etat_processus).affichage_arguments == 'Y')
! 576: {
! 577: printf("\n PRMD ");
! 578:
! 579: if ((*s_etat_processus).langue == 'F')
! 580: {
! 581: printf("(impression de l'état du séquenceur)\n\n");
! 582: printf(" Aucun argument\n");
! 583: }
! 584: else
! 585: {
! 586: printf("(print sequencer state)\n\n");
! 587: printf(" No argument\n");
! 588: }
! 589:
! 590: return;
! 591: }
! 592: else if ((*s_etat_processus).test_instruction == 'Y')
! 593: {
! 594: (*s_etat_processus).nombre_arguments = -1;
! 595: return;
! 596: }
! 597:
! 598: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 599: {
! 600: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 601: {
! 602: return;
! 603: }
! 604: }
! 605:
! 606: s_objet.type = CHN;
! 607:
! 608: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
! 609: {
! 610: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 611: return;
! 612: }
! 613:
! 614: longueur_utile = 0;
! 615: j = 1;
! 616:
! 617: for(i = 53; i <= 56; i++)
! 618: {
! 619: longueur_utile += (test_cfsf(s_etat_processus, (unsigned char) i)
! 620: == d_vrai) ? j : 0;
! 621: j *= 2;
! 622: }
! 623:
! 624: longueur_utile_limite = 12;
! 625:
! 626: if (longueur_utile > longueur_utile_limite)
! 627: {
! 628: longueur_utile = longueur_utile_limite;
! 629: }
! 630:
! 631: if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
! 632: (test_cfsf(s_etat_processus, 50) == d_faux))
! 633: {
! 634: if ((*s_etat_processus).langue == 'F')
! 635: {
! 636: sprintf((unsigned char *) s_objet.objet,
! 637: "\\noindent Mode d'affichage numérique: standard\n");
! 638: }
! 639: else
! 640: {
! 641: sprintf((unsigned char *) s_objet.objet,
! 642: "\\noindent Numerical mode: standard\n");
! 643: }
! 644: }
! 645: else if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
! 646: (test_cfsf(s_etat_processus, 50) == d_vrai))
! 647: {
! 648: if ((*s_etat_processus).langue == 'F')
! 649: {
! 650: sprintf((unsigned char *) s_objet.objet,
! 651: "\\noindent Mode d'affichage numérique: "
! 652: "scientifique (%ld)\n", longueur_utile);
! 653: }
! 654: else
! 655: {
! 656: sprintf((unsigned char *) s_objet.objet,
! 657: "\\noindent Numerical mode: scientific (%ld)\n",
! 658: longueur_utile);
! 659: }
! 660: }
! 661: else if ((test_cfsf(s_etat_processus, 49) == d_vrai) &&
! 662: (test_cfsf(s_etat_processus, 50) == d_faux))
! 663: {
! 664: if ((*s_etat_processus).langue == 'F')
! 665: {
! 666: sprintf((unsigned char *) s_objet.objet,
! 667: "\\noindent Mode d'affichage numérique: "
! 668: "virgule fixe (%ld)\n", longueur_utile);
! 669: }
! 670: else
! 671: {
! 672: sprintf((unsigned char *) s_objet.objet,
! 673: "\\noindent Numerical mode: fixed point (%ld)\n", longueur_utile);
! 674: }
! 675: }
! 676: else
! 677: {
! 678: if ((*s_etat_processus).langue == 'F')
! 679: {
! 680: sprintf((unsigned char *) s_objet.objet,
! 681: "\\noindent Mode d'affichage numérique: notation ingénieur "
! 682: "(%ld)\n", longueur_utile);
! 683: }
! 684: else
! 685: {
! 686: sprintf((unsigned char *) s_objet.objet,
! 687: "\\noindent Numerical mode: engineer "
! 688: "(%ld)\n", longueur_utile);
! 689: }
! 690: }
! 691:
! 692:
! 693: formateur_tex(s_etat_processus, &s_objet, 'N');
! 694: free(s_objet.objet);
! 695:
! 696: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
! 697: {
! 698: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 699: return;
! 700: }
! 701:
! 702: if ((*s_etat_processus).langue == 'F')
! 703: {
! 704: sprintf((unsigned char *) s_objet.objet,
! 705: "\\noindent \\'Echelle angulaire: %s\n",
! 706: (test_cfsf(s_etat_processus, 60) == d_faux)
! 707: ? "degrés" : "radians");
! 708: }
! 709: else
! 710: {
! 711: sprintf((unsigned char *) s_objet.objet,
! 712: "\\noindent Angular scale: %s\n",
! 713: (test_cfsf(s_etat_processus, 60) == d_faux)
! 714: ? "degrees" : "radians");
! 715: }
! 716:
! 717: formateur_tex(s_etat_processus, &s_objet, 'N');
! 718: free(s_objet.objet);
! 719:
! 720: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
! 721: {
! 722: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 723: return;
! 724: }
! 725:
! 726: if ((test_cfsf(s_etat_processus, 43) == d_faux) &&
! 727: (test_cfsf(s_etat_processus, 44) == d_faux))
! 728: {
! 729: if ((*s_etat_processus).langue == 'F')
! 730: {
! 731: sprintf((unsigned char *) s_objet.objet,
! 732: "\\noindent Base des entiers : décimale\n");
! 733: }
! 734: else
! 735: {
! 736: sprintf((unsigned char *) s_objet.objet,
! 737: "\\noindent Integer base: decimal\n");
! 738: }
! 739: }
! 740: else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
! 741: (test_cfsf(s_etat_processus, 44) == d_faux))
! 742: {
! 743: if ((*s_etat_processus).langue == 'F')
! 744: {
! 745: sprintf((unsigned char *) s_objet.objet,
! 746: "\\noindent Base des entiers : octale\n");
! 747: }
! 748: else
! 749: {
! 750: sprintf((unsigned char *) s_objet.objet,
! 751: "\\noindent Integer base: octal\n");
! 752: }
! 753: }
! 754: else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
! 755: (test_cfsf(s_etat_processus, 44) == d_vrai))
! 756: {
! 757: if ((*s_etat_processus).langue == 'F')
! 758: {
! 759: sprintf((unsigned char *) s_objet.objet,
! 760: "\\noindent Base des entiers : hexadécimale\n");
! 761: }
! 762: else
! 763: {
! 764: sprintf((unsigned char *) s_objet.objet,
! 765: "\\noindent Integer base: hexadecimal\n");
! 766: }
! 767: }
! 768: else
! 769: {
! 770: if ((*s_etat_processus).langue == 'F')
! 771: {
! 772: sprintf((unsigned char *) s_objet.objet,
! 773: "\\noindent Base des entiers : binaire\n");
! 774: }
! 775: else
! 776: {
! 777: sprintf((unsigned char *) s_objet.objet,
! 778: "\\noindent Integer base: binary\n");
! 779: }
! 780: }
! 781:
! 782: formateur_tex(s_etat_processus, &s_objet, 'N');
! 783: free(s_objet.objet);
! 784:
! 785: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
! 786: {
! 787: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 788: return;
! 789: }
! 790:
! 791: if ((*s_etat_processus).langue == 'F')
! 792: {
! 793: sprintf((unsigned char *) s_objet.objet,
! 794: "\\noindent Longueur des entiers : %d bits\n",
! 795: longueur_entiers_binaires(s_etat_processus));
! 796: }
! 797: else
! 798: {
! 799: sprintf((unsigned char *) s_objet.objet,
! 800: "\\noindent Length of integers: %d bits\n",
! 801: longueur_entiers_binaires(s_etat_processus));
! 802: }
! 803:
! 804: formateur_tex(s_etat_processus, &s_objet, 'N');
! 805: free(s_objet.objet);
! 806:
! 807: if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
! 808: {
! 809: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 810: return;
! 811: }
! 812:
! 813: if ((*s_etat_processus).langue == 'F')
! 814: {
! 815: sprintf((unsigned char *) s_objet.objet,
! 816: "\\noindent Séparateur décimal: %s\n",
! 817: (test_cfsf(s_etat_processus, 48) == d_faux)
! 818: ? "point" : "virgule");
! 819: }
! 820: else
! 821: {
! 822: sprintf((unsigned char *) s_objet.objet,
! 823: "\\noindent Radix: %s\n",
! 824: (test_cfsf(s_etat_processus, 48) == d_faux)
! 825: ? "period" : "coma");
! 826: }
! 827:
! 828: formateur_tex(s_etat_processus, &s_objet, 'N');
! 829: free(s_objet.objet);
! 830:
! 831: return;
! 832: }
! 833:
! 834:
! 835: /*
! 836: ================================================================================
! 837: Fonction 'pmin'
! 838: ================================================================================
! 839: Entrées :
! 840: --------------------------------------------------------------------------------
! 841: Sorties :
! 842: --------------------------------------------------------------------------------
! 843: Effets de bord : néant
! 844: ================================================================================
! 845: */
! 846:
! 847: void
! 848: instruction_pmin(struct_processus *s_etat_processus)
! 849: {
! 850: struct_objet *s_objet;
! 851:
! 852: (*s_etat_processus).erreur_execution = d_ex;
! 853:
! 854: if ((*s_etat_processus).affichage_arguments == 'Y')
! 855: {
! 856: printf("\n PMIN ");
! 857:
! 858: if ((*s_etat_processus).langue == 'F')
! 859: {
! 860: printf("(minima d'un graphique 2D)\n\n");
! 861: }
! 862: else
! 863: {
! 864: printf("(2D-graphic minima)\n\n");
! 865: }
! 866:
! 867: printf(" 1: %s\n", d_CPL);
! 868:
! 869: return;
! 870: }
! 871: else if ((*s_etat_processus).test_instruction == 'Y')
! 872: {
! 873: (*s_etat_processus).nombre_arguments = -1;
! 874: return;
! 875: }
! 876:
! 877: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 878: {
! 879: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 880: {
! 881: return;
! 882: }
! 883: }
! 884:
! 885: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 886: &s_objet) == d_erreur)
! 887: {
! 888: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 889: return;
! 890: }
! 891:
! 892: if ((*s_objet).type == CPL)
! 893: {
! 894: if ((*s_etat_processus).systeme_axes == 0)
! 895: {
! 896: (*s_etat_processus).x_min = (*((complex16 *) (*s_objet).objet))
! 897: .partie_reelle;
! 898: (*s_etat_processus).y_min = (*((complex16 *) (*s_objet).objet))
! 899: .partie_imaginaire;
! 900: }
! 901: else
! 902: {
! 903: (*s_etat_processus).x2_min = (*((complex16 *) (*s_objet).objet))
! 904: .partie_reelle;
! 905: (*s_etat_processus).y2_min = (*((complex16 *) (*s_objet).objet))
! 906: .partie_imaginaire;
! 907: }
! 908: }
! 909: else
! 910: {
! 911: liberation(s_etat_processus, s_objet);
! 912:
! 913: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 914: return;
! 915: }
! 916:
! 917: liberation(s_etat_processus, s_objet);
! 918:
! 919: if (test_cfsf(s_etat_processus, 52) == d_faux)
! 920: {
! 921: if ((*s_etat_processus).fichiers_graphiques != NULL)
! 922: {
! 923: appel_gnuplot(s_etat_processus, 'N');
! 924: }
! 925: }
! 926:
! 927: return;
! 928: }
! 929:
! 930:
! 931: /*
! 932: ================================================================================
! 933: Fonction 'pmax'
! 934: ================================================================================
! 935: Entrées :
! 936: --------------------------------------------------------------------------------
! 937: Sorties :
! 938: --------------------------------------------------------------------------------
! 939: Effets de bord : néant
! 940: ================================================================================
! 941: */
! 942:
! 943: void
! 944: instruction_pmax(struct_processus *s_etat_processus)
! 945: {
! 946: struct_objet *s_objet;
! 947:
! 948: (*s_etat_processus).erreur_execution = d_ex;
! 949:
! 950: if ((*s_etat_processus).affichage_arguments == 'Y')
! 951: {
! 952: printf("\n PMAX ");
! 953:
! 954: if ((*s_etat_processus).langue == 'F')
! 955: {
! 956: printf("(maxima d'un graphique 2D)\n\n");
! 957: }
! 958: else
! 959: {
! 960: printf("(2D-graphic maxima)\n\n");
! 961: }
! 962:
! 963: printf(" 1: %s\n", d_CPL);
! 964:
! 965: return;
! 966: }
! 967: else if ((*s_etat_processus).test_instruction == 'Y')
! 968: {
! 969: (*s_etat_processus).nombre_arguments = -1;
! 970: return;
! 971: }
! 972:
! 973: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 974: {
! 975: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 976: {
! 977: return;
! 978: }
! 979: }
! 980:
! 981: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 982: &s_objet) == d_erreur)
! 983: {
! 984: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 985: return;
! 986: }
! 987:
! 988: if ((*s_objet).type == CPL)
! 989: {
! 990: if ((*s_etat_processus).systeme_axes == 0)
! 991: {
! 992: (*s_etat_processus).x_max = (*((complex16 *) (*s_objet).objet))
! 993: .partie_reelle;
! 994: (*s_etat_processus).y_max = (*((complex16 *) (*s_objet).objet))
! 995: .partie_imaginaire;
! 996: }
! 997: else
! 998: {
! 999: (*s_etat_processus).x2_max = (*((complex16 *) (*s_objet).objet))
! 1000: .partie_reelle;
! 1001: (*s_etat_processus).y2_max = (*((complex16 *) (*s_objet).objet))
! 1002: .partie_imaginaire;
! 1003: }
! 1004: }
! 1005: else
! 1006: {
! 1007: liberation(s_etat_processus, s_objet);
! 1008:
! 1009: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1010: return;
! 1011: }
! 1012:
! 1013: liberation(s_etat_processus, s_objet);
! 1014:
! 1015: if (test_cfsf(s_etat_processus, 52) == d_faux)
! 1016: {
! 1017: if ((*s_etat_processus).fichiers_graphiques != NULL)
! 1018: {
! 1019: appel_gnuplot(s_etat_processus, 'N');
! 1020: }
! 1021: }
! 1022:
! 1023: return;
! 1024: }
! 1025:
! 1026:
! 1027: /*
! 1028: ================================================================================
! 1029: Fonction 'persist'
! 1030: ================================================================================
! 1031: Entrées :
! 1032: --------------------------------------------------------------------------------
! 1033: Sorties :
! 1034: --------------------------------------------------------------------------------
! 1035: Effets de bord : néant
! 1036: ================================================================================
! 1037: */
! 1038:
! 1039: void
! 1040: instruction_persist(struct_processus *s_etat_processus)
! 1041: {
! 1042: (*s_etat_processus).erreur_execution = d_ex;
! 1043:
! 1044: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1045: {
! 1046: printf("\n PERSIST ");
! 1047:
! 1048: if ((*s_etat_processus).langue == 'F')
! 1049: {
! 1050: printf("(détachement d'un graphique)\n\n");
! 1051: printf(" Aucun argument\n");
! 1052: }
! 1053: else
! 1054: {
! 1055: printf("(spawn a graphic output)\n\n");
! 1056: printf(" No argument\n");
! 1057: }
! 1058:
! 1059: return;
! 1060: }
! 1061: else if ((*s_etat_processus).test_instruction == 'Y')
! 1062: {
! 1063: (*s_etat_processus).nombre_arguments = -1;
! 1064: return;
! 1065: }
! 1066:
! 1067: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1068: {
! 1069: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1070: {
! 1071: return;
! 1072: }
! 1073: }
! 1074:
! 1075: appel_gnuplot(s_etat_processus, 'E');
! 1076:
! 1077: return;
! 1078: }
! 1079:
! 1080:
! 1081: /*
! 1082: ================================================================================
! 1083: Fonction 'polar' (passe en mode d'affichage r=f(t))
! 1084: ================================================================================
! 1085: Entrées : structure processus
! 1086: --------------------------------------------------------------------------------
! 1087: Sorties :
! 1088: --------------------------------------------------------------------------------
! 1089: Effets de bord : néant
! 1090: ================================================================================
! 1091: */
! 1092:
! 1093: void
! 1094: instruction_polar(struct_processus *s_etat_processus)
! 1095: {
! 1096: (*s_etat_processus).erreur_execution = d_ex;
! 1097:
! 1098: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1099: {
! 1100: printf("\n POLAR ");
! 1101:
! 1102: if ((*s_etat_processus).langue == 'F')
! 1103: {
! 1104: printf("(tracé théta=f(r))\n\n");
! 1105: printf(" Aucun argument\n");
! 1106: }
! 1107: else
! 1108: {
! 1109: printf("(plot theta=f(r))\n\n");
! 1110: printf(" No argument\n");
! 1111: }
! 1112:
! 1113: return;
! 1114: }
! 1115: else if ((*s_etat_processus).test_instruction == 'Y')
! 1116: {
! 1117: (*s_etat_processus).nombre_arguments = -1;
! 1118: return;
! 1119: }
! 1120:
! 1121: strcpy((*s_etat_processus).type_trace_eq, "POLAIRE");
! 1122:
! 1123: return;
! 1124: }
! 1125:
! 1126:
! 1127: /*
! 1128: ================================================================================
! 1129: Fonction 'parametric' (passe en mode d'affichage r=f(t))
! 1130: ================================================================================
! 1131: Entrées : structure processus
! 1132: --------------------------------------------------------------------------------
! 1133: Sorties :
! 1134: --------------------------------------------------------------------------------
! 1135: Effets de bord : néant
! 1136: ================================================================================
! 1137: */
! 1138:
! 1139: void
! 1140: instruction_parametric(struct_processus *s_etat_processus)
! 1141: {
! 1142: (*s_etat_processus).erreur_execution = d_ex;
! 1143:
! 1144: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1145: {
! 1146: printf("\n PARAMETRIC ");
! 1147:
! 1148: if ((*s_etat_processus).langue == 'F')
! 1149: {
! 1150: printf("(tracé (x,y)=f(t)+i*g(t))\n\n");
! 1151: printf(" Aucun argument\n");
! 1152: }
! 1153: else
! 1154: {
! 1155: printf("(plot (x,y)=f(t)+i*g(t))\n\n");
! 1156: printf(" No argument\n");
! 1157: }
! 1158:
! 1159: return;
! 1160: }
! 1161: else if ((*s_etat_processus).test_instruction == 'Y')
! 1162: {
! 1163: (*s_etat_processus).nombre_arguments = -1;
! 1164: return;
! 1165: }
! 1166:
! 1167: strcpy((*s_etat_processus).type_trace_eq, "PARAMETRIQUE");
! 1168:
! 1169: return;
! 1170: }
! 1171:
! 1172:
! 1173: /*
! 1174: ================================================================================
! 1175: Fonction 'perm'
! 1176: ================================================================================
! 1177: Entrées :
! 1178: --------------------------------------------------------------------------------
! 1179: Sorties :
! 1180: --------------------------------------------------------------------------------
! 1181: Effets de bord : néant
! 1182: ================================================================================
! 1183: */
! 1184:
! 1185: void
! 1186: instruction_perm(struct_processus *s_etat_processus)
! 1187: {
! 1188: integer8 k;
! 1189: integer8 n;
! 1190: integer8 cint_max;
! 1191:
! 1192: real8 c;
! 1193:
! 1194: struct_objet *s_objet_argument_1;
! 1195: struct_objet *s_objet_argument_2;
! 1196: struct_objet *s_objet_resultat;
! 1197:
! 1198: unsigned long i;
! 1199:
! 1200: (*s_etat_processus).erreur_execution = d_ex;
! 1201:
! 1202: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1203: {
! 1204: printf("\n PERM ");
! 1205:
! 1206: if ((*s_etat_processus).langue == 'F')
! 1207: {
! 1208: printf("(permutation)\n\n");
! 1209: }
! 1210: else
! 1211: {
! 1212: printf("(permutation)\n\n");
! 1213: }
! 1214:
! 1215: printf(" 2: %s\n", d_INT);
! 1216: printf(" 1: %s\n", d_INT);
! 1217: printf("-> 1: %s, %s\n", d_INT, d_REL);
! 1218:
! 1219: return;
! 1220: }
! 1221: else if ((*s_etat_processus).test_instruction == 'Y')
! 1222: {
! 1223: (*s_etat_processus).nombre_arguments = 2;
! 1224: return;
! 1225: }
! 1226:
! 1227: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1228: {
! 1229: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 1230: {
! 1231: return;
! 1232: }
! 1233: }
! 1234:
! 1235: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1236: &s_objet_argument_1) == d_erreur)
! 1237: {
! 1238: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1239: return;
! 1240: }
! 1241:
! 1242: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1243: &s_objet_argument_2) == d_erreur)
! 1244: {
! 1245: liberation(s_etat_processus, s_objet_argument_1);
! 1246:
! 1247: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1248: return;
! 1249: }
! 1250:
! 1251: if (((*s_objet_argument_1).type == INT) &&
! 1252: ((*s_objet_argument_2).type == INT))
! 1253: {
! 1254: n = (*((integer8 *) (*s_objet_argument_2).objet));
! 1255: k = (*((integer8 *) (*s_objet_argument_1).objet));
! 1256:
! 1257: if ((n < 0) || (k < 0) || (k > n))
! 1258: {
! 1259: liberation(s_etat_processus, s_objet_argument_1);
! 1260: liberation(s_etat_processus, s_objet_argument_2);
! 1261:
! 1262: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 1263: return;
! 1264: }
! 1265:
! 1266: f90arrangement(&n, &k, &c);
! 1267:
! 1268: for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max =
! 1269: (cint_max << 1) + 1, i++);
! 1270:
! 1271: if (c > cint_max)
! 1272: {
! 1273: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 1274: == NULL)
! 1275: {
! 1276: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1277: return;
! 1278: }
! 1279:
! 1280: (*((real8 *) (*s_objet_resultat).objet)) = c;
! 1281: }
! 1282: else
! 1283: {
! 1284: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1285: == NULL)
! 1286: {
! 1287: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1288: return;
! 1289: }
! 1290:
! 1291: if (fabs(c - floor(c)) < fabs(ceil(c) - c))
! 1292: {
! 1293: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1294: (integer8) floor(c);
! 1295: }
! 1296: else
! 1297: {
! 1298: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1299: 1 + (integer8) floor(c);
! 1300: }
! 1301: }
! 1302: }
! 1303: else
! 1304: {
! 1305: liberation(s_etat_processus, s_objet_argument_1);
! 1306: liberation(s_etat_processus, s_objet_argument_2);
! 1307:
! 1308: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1309: return;
! 1310: }
! 1311:
! 1312: liberation(s_etat_processus, s_objet_argument_1);
! 1313: liberation(s_etat_processus, s_objet_argument_2);
! 1314:
! 1315: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1316: s_objet_resultat) == d_erreur)
! 1317: {
! 1318: return;
! 1319: }
! 1320:
! 1321: return;
! 1322: }
! 1323:
! 1324:
! 1325: /*
! 1326: ================================================================================
! 1327: Fonction 'psdev'
! 1328: ================================================================================
! 1329: Entrées :
! 1330: --------------------------------------------------------------------------------
! 1331: Sorties :
! 1332: --------------------------------------------------------------------------------
! 1333: Effets de bord : néant
! 1334: ================================================================================
! 1335: */
! 1336:
! 1337: void
! 1338: instruction_psdev(struct_processus *s_etat_processus)
! 1339: {
! 1340: logical1 presence_variable;
! 1341:
! 1342: long i;
! 1343:
! 1344: struct_objet *s_objet_statistique;
! 1345: struct_objet *s_objet_resultat;
! 1346: struct_objet *s_objet_temporaire;
! 1347:
! 1348: unsigned long nombre_colonnes;
! 1349:
! 1350: (*s_etat_processus).erreur_execution = d_ex;
! 1351:
! 1352: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1353: {
! 1354: printf("\n PSDEV ");
! 1355:
! 1356: if ((*s_etat_processus).langue == 'F')
! 1357: {
! 1358: printf("(écart-type d'une population)\n\n");
! 1359: }
! 1360: else
! 1361: {
! 1362: printf("(population standard deviation)\n\n");
! 1363: }
! 1364:
! 1365: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
! 1366:
! 1367: return;
! 1368: }
! 1369: else if ((*s_etat_processus).test_instruction == 'Y')
! 1370: {
! 1371: (*s_etat_processus).nombre_arguments = -1;
! 1372: return;
! 1373: }
! 1374:
! 1375: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1376: {
! 1377: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1378: {
! 1379: return;
! 1380: }
! 1381: }
! 1382:
! 1383: /*
! 1384: * Recherche d'une variable globale référencée par SIGMA
! 1385: */
! 1386:
! 1387: if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
! 1388: {
! 1389: /*
! 1390: * Aucune variable SIGMA
! 1391: */
! 1392:
! 1393: (*s_etat_processus).erreur_systeme = d_es;
! 1394: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
! 1395: return;
! 1396: }
! 1397: else
! 1398: {
! 1399: /*
! 1400: * Il existe une variable locale SIGMA. Reste à vérifier l'existence
! 1401: * d'une variable SIGMA globale...
! 1402: */
! 1403:
! 1404: i = (*s_etat_processus).position_variable_courante;
! 1405: presence_variable = d_faux;
! 1406:
! 1407: while(i >= 0)
! 1408: {
! 1409: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
! 1410: ds_sdat) == 0) && ((*s_etat_processus)
! 1411: .s_liste_variables[i].niveau == 1))
! 1412: {
! 1413: presence_variable = d_vrai;
! 1414: break;
! 1415: }
! 1416:
! 1417: i--;
! 1418: }
! 1419:
! 1420: if (presence_variable == d_faux)
! 1421: {
! 1422: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
! 1423: return;
! 1424: }
! 1425: else
! 1426: {
! 1427: (*s_etat_processus).position_variable_courante = i;
! 1428:
! 1429: if (((*s_etat_processus).s_liste_variables[i]).objet == NULL)
! 1430: {
! 1431: (*s_etat_processus).erreur_execution =
! 1432: d_ex_variable_partagee;
! 1433: return;
! 1434: }
! 1435:
! 1436: if (((*((*s_etat_processus).s_liste_variables
! 1437: [(*s_etat_processus).position_variable_courante].objet))
! 1438: .type != MIN) && ((*((*s_etat_processus)
! 1439: .s_liste_variables[(*s_etat_processus)
! 1440: .position_variable_courante].objet)).type != MRL))
! 1441: {
! 1442: (*s_etat_processus).erreur_execution =
! 1443: d_ex_matrice_statistique_invalide;
! 1444: return;
! 1445: }
! 1446:
! 1447: nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
! 1448: .s_liste_variables[(*s_etat_processus)
! 1449: .position_variable_courante].objet)).objet))
! 1450: .nombre_colonnes;
! 1451: }
! 1452: }
! 1453:
! 1454: s_objet_statistique = ((*s_etat_processus).s_liste_variables
! 1455: [(*s_etat_processus).position_variable_courante]).objet;
! 1456:
! 1457: if (((*s_objet_statistique).type == MIN) ||
! 1458: ((*s_objet_statistique).type == MRL))
! 1459: {
! 1460: if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
! 1461: {
! 1462: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1463: return;
! 1464: }
! 1465:
! 1466: if (((*s_objet_resultat).objet = ecart_type_statistique(
! 1467: (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)
! 1468: {
! 1469: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1470: return;
! 1471: }
! 1472:
! 1473: if (nombre_colonnes == 1)
! 1474: {
! 1475: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
! 1476: {
! 1477: (*s_objet_resultat).type = VIN;
! 1478: s_objet_temporaire = s_objet_resultat;
! 1479:
! 1480: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1481: == NULL)
! 1482: {
! 1483: (*s_etat_processus).erreur_systeme =
! 1484: d_es_allocation_memoire;
! 1485: return;
! 1486: }
! 1487:
! 1488: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1489: ((integer8 *) (*((struct_vecteur *)
! 1490: (*s_objet_temporaire).objet)).tableau)[0];
! 1491:
! 1492: liberation(s_etat_processus, s_objet_temporaire);
! 1493: }
! 1494: else
! 1495: {
! 1496: (*s_objet_resultat).type = VRL;
! 1497: s_objet_temporaire = s_objet_resultat;
! 1498:
! 1499: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 1500: == NULL)
! 1501: {
! 1502: (*s_etat_processus).erreur_systeme =
! 1503: d_es_allocation_memoire;
! 1504: return;
! 1505: }
! 1506:
! 1507: (*((real8 *) (*s_objet_resultat).objet)) =
! 1508: ((real8 *) (*((struct_vecteur *)
! 1509: (*s_objet_temporaire).objet)).tableau)[0];
! 1510:
! 1511: liberation(s_etat_processus, s_objet_temporaire);
! 1512: }
! 1513: }
! 1514: else
! 1515: {
! 1516: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
! 1517: {
! 1518: (*s_objet_resultat).type = VIN;
! 1519: }
! 1520: else
! 1521: {
! 1522: (*s_objet_resultat).type = VRL;
! 1523: }
! 1524: }
! 1525:
! 1526: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1527: s_objet_resultat) == d_erreur)
! 1528: {
! 1529: return;
! 1530: }
! 1531: }
! 1532: else
! 1533: {
! 1534: (*s_etat_processus).erreur_execution =
! 1535: d_ex_matrice_statistique_invalide;
! 1536: return;
! 1537: }
! 1538:
! 1539: return;
! 1540: }
! 1541:
! 1542:
! 1543: /*
! 1544: ================================================================================
! 1545: Fonction 'pvar'
! 1546: ================================================================================
! 1547: Entrées :
! 1548: --------------------------------------------------------------------------------
! 1549: Sorties :
! 1550: --------------------------------------------------------------------------------
! 1551: Effets de bord : néant
! 1552: ================================================================================
! 1553: */
! 1554:
! 1555: void
! 1556: instruction_pvar(struct_processus *s_etat_processus)
! 1557: {
! 1558: logical1 presence_variable;
! 1559:
! 1560: long i;
! 1561:
! 1562: struct_objet *s_objet_statistique;
! 1563: struct_objet *s_objet_resultat;
! 1564: struct_objet *s_objet_temporaire;
! 1565:
! 1566: unsigned long nombre_colonnes;
! 1567:
! 1568: (*s_etat_processus).erreur_execution = d_ex;
! 1569:
! 1570: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1571: {
! 1572: printf("\n PVAR ");
! 1573:
! 1574: if ((*s_etat_processus).langue == 'F')
! 1575: {
! 1576: printf("(variance d'une population)\n\n");
! 1577: }
! 1578: else
! 1579: {
! 1580: printf("(population variance)\n\n");
! 1581: }
! 1582:
! 1583: printf("-> 1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
! 1584:
! 1585: return;
! 1586: }
! 1587: else if ((*s_etat_processus).test_instruction == 'Y')
! 1588: {
! 1589: (*s_etat_processus).nombre_arguments = -1;
! 1590: return;
! 1591: }
! 1592:
! 1593: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1594: {
! 1595: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1596: {
! 1597: return;
! 1598: }
! 1599: }
! 1600:
! 1601: /*
! 1602: * Recherche d'une variable globale référencée par SIGMA
! 1603: */
! 1604:
! 1605: if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
! 1606: {
! 1607: /*
! 1608: * Aucune variable SIGMA
! 1609: */
! 1610:
! 1611: (*s_etat_processus).erreur_systeme = d_es;
! 1612: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
! 1613: return;
! 1614: }
! 1615: else
! 1616: {
! 1617: /*
! 1618: * Il existe une variable locale SIGMA. Reste à vérifier l'existence
! 1619: * d'une variable SIGMA globale...
! 1620: */
! 1621:
! 1622: i = (*s_etat_processus).position_variable_courante;
! 1623: presence_variable = d_faux;
! 1624:
! 1625: while(i >= 0)
! 1626: {
! 1627: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
! 1628: ds_sdat) == 0) && ((*s_etat_processus)
! 1629: .s_liste_variables[i].niveau == 1))
! 1630: {
! 1631: presence_variable = d_vrai;
! 1632: break;
! 1633: }
! 1634:
! 1635: i--;
! 1636: }
! 1637:
! 1638: if (presence_variable == d_faux)
! 1639: {
! 1640: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
! 1641: return;
! 1642: }
! 1643: else
! 1644: {
! 1645: (*s_etat_processus).position_variable_courante = i;
! 1646:
! 1647: if (((*s_etat_processus).s_liste_variables[i]).objet == NULL)
! 1648: {
! 1649: (*s_etat_processus).erreur_execution =
! 1650: d_ex_variable_partagee;
! 1651: return;
! 1652: }
! 1653:
! 1654: if (((*((*s_etat_processus).s_liste_variables
! 1655: [(*s_etat_processus).position_variable_courante].objet))
! 1656: .type != MIN) && ((*((*s_etat_processus)
! 1657: .s_liste_variables[(*s_etat_processus)
! 1658: .position_variable_courante].objet)).type != MRL))
! 1659: {
! 1660: (*s_etat_processus).erreur_execution =
! 1661: d_ex_matrice_statistique_invalide;
! 1662: return;
! 1663: }
! 1664:
! 1665: nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
! 1666: .s_liste_variables[(*s_etat_processus)
! 1667: .position_variable_courante].objet)).objet))
! 1668: .nombre_colonnes;
! 1669: }
! 1670: }
! 1671:
! 1672: s_objet_statistique = ((*s_etat_processus).s_liste_variables
! 1673: [(*s_etat_processus).position_variable_courante]).objet;
! 1674:
! 1675: if (((*s_objet_statistique).type == MIN) ||
! 1676: ((*s_objet_statistique).type == MRL))
! 1677: {
! 1678: if ((s_objet_resultat = allocation(s_etat_processus, NON))
! 1679: == NULL)
! 1680: {
! 1681: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1682: return;
! 1683: }
! 1684:
! 1685: if (((*s_objet_resultat).objet = variance_statistique((struct_matrice *)
! 1686: (*s_objet_statistique).objet, 'P')) == NULL)
! 1687: {
! 1688: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1689: return;
! 1690: }
! 1691:
! 1692: if (nombre_colonnes == 1)
! 1693: {
! 1694: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
! 1695: {
! 1696: (*s_objet_resultat).type = VIN;
! 1697: s_objet_temporaire = s_objet_resultat;
! 1698:
! 1699: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1700: == NULL)
! 1701: {
! 1702: (*s_etat_processus).erreur_systeme =
! 1703: d_es_allocation_memoire;
! 1704: return;
! 1705: }
! 1706:
! 1707: (*((integer8 *) (*s_objet_resultat).objet)) =
! 1708: ((integer8 *) (*((struct_vecteur *)
! 1709: (*s_objet_temporaire).objet)).tableau)[0];
! 1710:
! 1711: liberation(s_etat_processus, s_objet_temporaire);
! 1712: }
! 1713: else
! 1714: {
! 1715: (*s_objet_resultat).type = VRL;
! 1716: s_objet_temporaire = s_objet_resultat;
! 1717:
! 1718: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 1719: == NULL)
! 1720: {
! 1721: (*s_etat_processus).erreur_systeme =
! 1722: d_es_allocation_memoire;
! 1723: return;
! 1724: }
! 1725:
! 1726: (*((real8 *) (*s_objet_resultat).objet)) =
! 1727: ((real8 *) (*((struct_vecteur *)
! 1728: (*s_objet_temporaire).objet)).tableau)[0];
! 1729:
! 1730: liberation(s_etat_processus, s_objet_temporaire);
! 1731: }
! 1732: }
! 1733: else
! 1734: {
! 1735: if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
! 1736: {
! 1737: (*s_objet_resultat).type = VIN;
! 1738: }
! 1739: else
! 1740: {
! 1741: (*s_objet_resultat).type = VRL;
! 1742: }
! 1743: }
! 1744:
! 1745: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1746: s_objet_resultat) == d_erreur)
! 1747: {
! 1748: return;
! 1749: }
! 1750: }
! 1751: else
! 1752: {
! 1753: (*s_etat_processus).erreur_execution =
! 1754: d_ex_matrice_statistique_invalide;
! 1755: return;
! 1756: }
! 1757:
! 1758: return;
! 1759: }
! 1760:
! 1761: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_p4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src