Annotation of rpl/src/instructions_r1.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 'rad'
! 29: ================================================================================
! 30: Entrées : structure processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_rad(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 RAD ");
! 46:
! 47: if ((*s_etat_processus).langue == 'F')
! 48: {
! 49: printf("(arguments en radians)\n\n");
! 50: printf(" Aucun argument\n");
! 51: }
! 52: else
! 53: {
! 54: printf("(radians)\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: sf(s_etat_processus, 60);
! 67:
! 68: return;
! 69: }
! 70:
! 71:
! 72: /*
! 73: ================================================================================
! 74: Fonction 'roll'
! 75: ================================================================================
! 76: Entrées : structure processus
! 77: --------------------------------------------------------------------------------
! 78: Sorties :
! 79: --------------------------------------------------------------------------------
! 80: Effets de bord : néant
! 81: ================================================================================
! 82: */
! 83:
! 84: void
! 85: instruction_roll(struct_processus *s_etat_processus)
! 86: {
! 87: struct_liste_chainee *l_liste1;
! 88: struct_liste_chainee *l_liste2;
! 89:
! 90: struct_objet *s_objet;
! 91:
! 92: unsigned long i;
! 93:
! 94: (*s_etat_processus).erreur_execution = d_ex;
! 95:
! 96: if ((*s_etat_processus).affichage_arguments == 'Y')
! 97: {
! 98: printf("\n ROLL ");
! 99:
! 100: if ((*s_etat_processus).langue == 'F')
! 101: {
! 102: printf("(défilement d'un objet vers le haut)\n\n");
! 103: }
! 104: else
! 105: {
! 106: printf("(roll up objects on stack)\n\n");
! 107: }
! 108:
! 109: printf(" n+1: %s, %s, %s, %s, %s, %s,\n"
! 110: " %s, %s, %s, %s, %s,\n"
! 111: " %s, %s, %s, %s, %s,\n"
! 112: " %s, %s, %s, %s,\n"
! 113: " %s, %s\n",
! 114: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 115: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 116: d_SQL, d_SLB, d_PRC, d_MTX);
! 117: printf(" ...\n");
! 118: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 119: " %s, %s, %s, %s, %s,\n"
! 120: " %s, %s, %s, %s, %s,\n"
! 121: " %s, %s, %s, %s,\n"
! 122: " %s, %s\n",
! 123: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 124: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 125: d_SQL, d_SLB, d_PRC, d_MTX);
! 126: printf(" 1: %s\n", d_INT);
! 127: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
! 128: " %s, %s, %s, %s, %s,\n"
! 129: " %s, %s, %s, %s, %s,\n"
! 130: " %s, %s, %s, %s,\n"
! 131: " %s, %s\n",
! 132: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 133: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 134: d_SQL, d_SLB, d_PRC, d_MTX);
! 135: printf(" ...\n");
! 136: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 137: " %s, %s, %s, %s, %s,\n"
! 138: " %s, %s, %s, %s, %s,\n"
! 139: " %s, %s, %s, %s,\n"
! 140: " %s, %s\n",
! 141: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 142: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 143: d_SQL, d_SLB, d_PRC, d_MTX);
! 144:
! 145: return;
! 146: }
! 147: else if ((*s_etat_processus).test_instruction == 'Y')
! 148: {
! 149: (*s_etat_processus).nombre_arguments = -1;
! 150: return;
! 151: }
! 152:
! 153: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 154: {
! 155: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 156: {
! 157: return;
! 158: }
! 159: }
! 160:
! 161: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 162: &s_objet) == d_erreur)
! 163: {
! 164: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 165: return;
! 166: }
! 167:
! 168: if ((*s_objet).type != INT)
! 169: {
! 170: liberation(s_etat_processus, s_objet);
! 171:
! 172: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 173: return;
! 174: }
! 175:
! 176: if ((*((integer8 *) (*s_objet).objet)) <= 0)
! 177: {
! 178:
! 179: /*
! 180: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
! 181: */
! 182:
! 183: liberation(s_etat_processus, s_objet);
! 184:
! 185: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 186: return;
! 187: }
! 188:
! 189: if ((*((integer8 *) (*s_objet).objet)) > (integer8) (*s_etat_processus)
! 190: .hauteur_pile_operationnelle)
! 191: {
! 192: liberation(s_etat_processus, s_objet);
! 193:
! 194: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 195: return;
! 196: }
! 197:
! 198: if ((*((integer8 *) (*s_objet).objet)) > 1)
! 199: {
! 200: l_liste1 = (*s_etat_processus).l_base_pile;
! 201:
! 202: for(i = 2; i < (unsigned long) (*((integer8 *) (*s_objet).objet)); i++)
! 203: {
! 204: l_liste1 = (*l_liste1).suivant;
! 205: }
! 206:
! 207: l_liste2 = (*l_liste1).suivant;
! 208: (*l_liste1).suivant = (*l_liste2).suivant;
! 209: (*l_liste2).suivant = (*s_etat_processus).l_base_pile;
! 210: (*s_etat_processus).l_base_pile = l_liste2;
! 211: }
! 212:
! 213: liberation(s_etat_processus, s_objet);
! 214:
! 215: return;
! 216: }
! 217:
! 218:
! 219: /*
! 220: ================================================================================
! 221: Fonction 'rolld'
! 222: ================================================================================
! 223: Entrées : structure processus
! 224: --------------------------------------------------------------------------------
! 225: Sorties :
! 226: --------------------------------------------------------------------------------
! 227: Effets de bord : néant
! 228: ================================================================================
! 229: */
! 230:
! 231: void
! 232: instruction_rolld(struct_processus *s_etat_processus)
! 233: {
! 234: struct_liste_chainee *l_liste1;
! 235: struct_liste_chainee *l_liste2;
! 236:
! 237: struct_objet *s_objet;
! 238:
! 239: unsigned long i;
! 240:
! 241: (*s_etat_processus).erreur_execution = d_ex;
! 242:
! 243: if ((*s_etat_processus).affichage_arguments == 'Y')
! 244: {
! 245: printf("\n ROLLD ");
! 246:
! 247: if ((*s_etat_processus).langue == 'F')
! 248: {
! 249: printf("(défilement d'un objet vers le bas)\n\n");
! 250: }
! 251: else
! 252: {
! 253: printf("(roll down objects on stack)\n\n");
! 254: }
! 255:
! 256: printf(" n+1: %s, %s, %s, %s, %s, %s,\n"
! 257: " %s, %s, %s, %s, %s,\n"
! 258: " %s, %s, %s, %s, %s,\n"
! 259: " %s, %s, %s, %s,\n"
! 260: " %s, %s\n",
! 261: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 262: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 263: d_SQL, d_SLB, d_PRC, d_MTX);
! 264: printf(" ...\n");
! 265: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 266: " %s, %s, %s, %s, %s,\n"
! 267: " %s, %s, %s, %s, %s,\n"
! 268: " %s, %s, %s, %s,\n"
! 269: " %s, %s\n",
! 270: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 271: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 272: d_SQL, d_SLB, d_PRC, d_MTX);
! 273: printf(" 1: %s\n", d_INT);
! 274: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
! 275: " %s, %s, %s, %s, %s,\n"
! 276: " %s, %s, %s, %s, %s,\n"
! 277: " %s, %s, %s, %s,\n"
! 278: " %s, %s\n",
! 279: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 280: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 281: d_SQL, d_SLB, d_PRC, d_MTX);
! 282: printf(" ...\n");
! 283: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 284: " %s, %s, %s, %s, %s,\n"
! 285: " %s, %s, %s, %s, %s,\n"
! 286: " %s, %s, %s, %s,\n"
! 287: " %s, %s\n",
! 288: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 289: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 290: d_SQL, d_SLB, d_PRC, d_MTX);
! 291:
! 292: return;
! 293: }
! 294: else if ((*s_etat_processus).test_instruction == 'Y')
! 295: {
! 296: (*s_etat_processus).nombre_arguments = -1;
! 297: return;
! 298: }
! 299:
! 300: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 301: {
! 302: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 303: {
! 304: return;
! 305: }
! 306: }
! 307:
! 308: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 309: &s_objet) == d_erreur)
! 310: {
! 311: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 312: return;
! 313: }
! 314:
! 315: if ((*s_objet).type != INT)
! 316: {
! 317: liberation(s_etat_processus, s_objet);
! 318:
! 319: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 320: return;
! 321: }
! 322:
! 323: if ((*((integer8 *) (*s_objet).objet)) <= 0)
! 324: {
! 325:
! 326: /*
! 327: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
! 328: */
! 329:
! 330: liberation(s_etat_processus, s_objet);
! 331:
! 332: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 333: return;
! 334: }
! 335:
! 336: if ((*((integer8 *) (*s_objet).objet)) > (integer8) (*s_etat_processus)
! 337: .hauteur_pile_operationnelle)
! 338: {
! 339: liberation(s_etat_processus, s_objet);
! 340:
! 341: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 342: return;
! 343: }
! 344:
! 345: if ((*((integer8 *) (*s_objet).objet)) > 1)
! 346: {
! 347: l_liste1 = (*s_etat_processus).l_base_pile;
! 348:
! 349: for(i = 1; i < (unsigned long) (*((integer8 *) (*s_objet).objet)); i++)
! 350: {
! 351: l_liste1 = (*l_liste1).suivant;
! 352: }
! 353:
! 354: l_liste2 = (*s_etat_processus).l_base_pile;
! 355: (*s_etat_processus).l_base_pile = (*(*s_etat_processus)
! 356: .l_base_pile).suivant;
! 357: (*l_liste2).suivant = (*l_liste1).suivant;
! 358: (*l_liste1).suivant = l_liste2;
! 359: }
! 360:
! 361: liberation(s_etat_processus, s_objet);
! 362:
! 363: return;
! 364: }
! 365:
! 366:
! 367: /*
! 368: ================================================================================
! 369: Fonction 'rot'
! 370: ================================================================================
! 371: Entrées : structure processus
! 372: --------------------------------------------------------------------------------
! 373: Sorties :
! 374: --------------------------------------------------------------------------------
! 375: Effets de bord : néant
! 376: ================================================================================
! 377: */
! 378:
! 379: void
! 380: instruction_rot(struct_processus *s_etat_processus)
! 381: {
! 382: struct_liste_chainee *l_liste1;
! 383: struct_liste_chainee *l_liste2;
! 384:
! 385: (*s_etat_processus).erreur_execution = d_ex;
! 386:
! 387: if ((*s_etat_processus).affichage_arguments == 'Y')
! 388: {
! 389: printf("\n ROT ");
! 390:
! 391: if ((*s_etat_processus).langue == 'F')
! 392: {
! 393: printf("(rotation)\n\n");
! 394: }
! 395: else
! 396: {
! 397: printf("(rotation)\n");
! 398: }
! 399:
! 400: printf(" 3: %s, %s, %s, %s, %s, %s,\n"
! 401: " %s, %s, %s, %s, %s,\n"
! 402: " %s, %s, %s, %s, %s,\n"
! 403: " %s, %s, %s, %s,\n"
! 404: " %s, %s\n",
! 405: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 406: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 407: d_SQL, d_SLB, d_PRC, d_MTX);
! 408: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 409: " %s, %s, %s, %s, %s,\n"
! 410: " %s, %s, %s, %s, %s,\n"
! 411: " %s, %s, %s, %s,\n"
! 412: " %s, %s\n",
! 413: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 414: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 415: d_SQL, d_SLB, d_PRC, d_MTX);
! 416: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 417: " %s, %s, %s, %s, %s,\n"
! 418: " %s, %s, %s, %s, %s,\n"
! 419: " %s, %s, %s, %s,\n"
! 420: " %s, %s\n",
! 421: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 422: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 423: d_SQL, d_SLB, d_PRC, d_MTX);
! 424: printf("-> 3: %s, %s, %s, %s, %s, %s,\n"
! 425: " %s, %s, %s, %s, %s,\n"
! 426: " %s, %s, %s, %s, %s,\n"
! 427: " %s, %s, %s, %s,\n"
! 428: " %s, %s\n",
! 429: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 430: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 431: d_SQL, d_SLB, d_PRC, d_MTX);
! 432: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 433: " %s, %s, %s, %s, %s,\n"
! 434: " %s, %s, %s, %s, %s,\n"
! 435: " %s, %s, %s, %s,\n"
! 436: " %s, %s\n",
! 437: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 438: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 439: d_SQL, d_SLB, d_PRC, d_MTX);
! 440: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 441: " %s, %s, %s, %s, %s,\n"
! 442: " %s, %s, %s, %s, %s,\n"
! 443: " %s, %s, %s, %s,\n"
! 444: " %s, %s\n",
! 445: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 446: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 447: d_SQL, d_SLB, d_PRC, d_MTX);
! 448:
! 449: return;
! 450: }
! 451: else if ((*s_etat_processus).test_instruction == 'Y')
! 452: {
! 453: (*s_etat_processus).nombre_arguments = -1;
! 454: return;
! 455: }
! 456:
! 457: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 458: {
! 459: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
! 460: {
! 461: return;
! 462: }
! 463: }
! 464:
! 465: if ((*s_etat_processus).hauteur_pile_operationnelle < 3)
! 466: {
! 467: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 468: return;
! 469: }
! 470:
! 471: l_liste1 = (*(*s_etat_processus).l_base_pile).suivant;
! 472: l_liste2 = (*l_liste1).suivant;
! 473: (*l_liste1).suivant = (*l_liste2).suivant;
! 474: (*l_liste2).suivant = (*s_etat_processus).l_base_pile;
! 475: (*s_etat_processus).l_base_pile = l_liste2;
! 476:
! 477: return;
! 478: }
! 479:
! 480:
! 481: /*
! 482: ================================================================================
! 483: Fonction 'repeat'
! 484: ================================================================================
! 485: Entrées : structure processus
! 486: --------------------------------------------------------------------------------
! 487: Sorties :
! 488: --------------------------------------------------------------------------------
! 489: Effets de bord : néant
! 490: ================================================================================
! 491: */
! 492:
! 493: void
! 494: instruction_repeat(struct_processus *s_etat_processus)
! 495: {
! 496: struct_objet *s_objet;
! 497:
! 498: logical1 condition;
! 499: logical1 drapeau_fin;
! 500: logical1 execution;
! 501:
! 502: struct_liste_chainee *s_registre;
! 503:
! 504: unsigned char *instruction_majuscule;
! 505: unsigned char *tampon;
! 506:
! 507: unsigned long niveau;
! 508:
! 509: void (*fonction)();
! 510:
! 511: (*s_etat_processus).erreur_execution = d_ex;
! 512:
! 513: if ((*s_etat_processus).affichage_arguments == 'Y')
! 514: {
! 515: printf("\n REPEAT ");
! 516:
! 517: if ((*s_etat_processus).langue == 'F')
! 518: {
! 519: printf("(structure de contrôle)\n\n");
! 520: printf(" Utilisation :\n\n");
! 521: }
! 522: else
! 523: {
! 524: printf("(control statement)\n\n");
! 525: printf(" Usage:\n\n");
! 526: }
! 527:
! 528: printf(" WHILE\n");
! 529: printf(" (clause)\n");
! 530: printf(" REPEAT\n");
! 531: printf(" (expression 1)\n");
! 532: printf(" EXIT\n");
! 533: printf(" (expression 2)\n");
! 534: printf(" END\n\n");
! 535:
! 536: printf(" WHILE\n");
! 537: printf(" (clause)\n");
! 538: printf(" REPEAT\n");
! 539: printf(" (expression)\n");
! 540: printf(" END\n");
! 541:
! 542: return;
! 543: }
! 544: else if ((*s_etat_processus).test_instruction == 'Y')
! 545: {
! 546: (*s_etat_processus).nombre_arguments = -1;
! 547: return;
! 548: }
! 549:
! 550: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 551: &s_objet) == d_erreur)
! 552: {
! 553: return;
! 554: }
! 555:
! 556: if (((*s_objet).type == INT) ||
! 557: ((*s_objet).type == REL))
! 558: {
! 559: if ((*s_objet).type == INT)
! 560: {
! 561: condition = ((*((integer8 *) (*s_objet).objet)) == 0)
! 562: ? d_faux : d_vrai;
! 563: }
! 564: else
! 565: {
! 566: condition = ((*((real8 *) (*s_objet).objet)) == 0)
! 567: ? d_faux : d_vrai;
! 568: }
! 569:
! 570: if (condition == d_faux)
! 571: {
! 572: niveau = 0;
! 573: (*(*s_etat_processus).l_base_pile_systeme).clause = 'M';
! 574: drapeau_fin = d_faux;
! 575:
! 576: if ((*s_etat_processus).mode_execution_programme == 'Y')
! 577: {
! 578: tampon = (*s_etat_processus).instruction_courante;
! 579:
! 580: do
! 581: {
! 582: if (recherche_instruction_suivante(s_etat_processus) !=
! 583: d_absence_erreur)
! 584: {
! 585: liberation(s_etat_processus, s_objet);
! 586:
! 587: if ((*s_etat_processus).instruction_courante != NULL)
! 588: {
! 589: free((*s_etat_processus).instruction_courante);
! 590: }
! 591:
! 592: (*s_etat_processus).instruction_courante = tampon;
! 593: (*s_etat_processus).erreur_execution =
! 594: d_ex_erreur_traitement_condition;
! 595: return;
! 596: }
! 597:
! 598: if ((instruction_majuscule = conversion_majuscule(
! 599: (*s_etat_processus).instruction_courante)) == NULL)
! 600: {
! 601: liberation(s_etat_processus, s_objet);
! 602:
! 603: free((*s_etat_processus).instruction_courante);
! 604: (*s_etat_processus).instruction_courante = tampon;
! 605: (*s_etat_processus).erreur_systeme =
! 606: d_es_allocation_memoire;
! 607: return;
! 608: }
! 609:
! 610:
! 611: if (niveau == 0)
! 612: {
! 613: if ((strcmp(instruction_majuscule, "END") == 0)
! 614: || (strcmp(instruction_majuscule, "ELSE") == 0)
! 615: || (strcmp(instruction_majuscule, "ELSEIF")
! 616: == 0))
! 617: {
! 618: (*s_etat_processus).position_courante -= (strlen(
! 619: instruction_majuscule) + 1);
! 620: drapeau_fin = d_vrai;
! 621: }
! 622: else
! 623: {
! 624: drapeau_fin = d_faux;
! 625: }
! 626: }
! 627: else
! 628: {
! 629: drapeau_fin = d_faux;
! 630: }
! 631:
! 632: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
! 633: (strcmp(instruction_majuscule, "DO") == 0) ||
! 634: (strcmp(instruction_majuscule, "IF") == 0) ||
! 635: (strcmp(instruction_majuscule, "IFERR") == 0) ||
! 636: (strcmp(instruction_majuscule, "SELECT") == 0)
! 637: || (strcmp(instruction_majuscule, "WHILE")
! 638: == 0))
! 639: {
! 640: niveau++;
! 641: }
! 642: else if (strcmp(instruction_majuscule, "END") == 0)
! 643: {
! 644: niveau--;
! 645: }
! 646:
! 647: free(instruction_majuscule);
! 648: free((*s_etat_processus).instruction_courante);
! 649: } while(drapeau_fin == d_faux);
! 650:
! 651: (*s_etat_processus).instruction_courante = tampon;
! 652: }
! 653: else
! 654: {
! 655: /*
! 656: * Vérification du pointeur de prédiction de saut
! 657: */
! 658:
! 659: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
! 660: .expression_courante).donnee).mutex)) != 0)
! 661: {
! 662: (*s_etat_processus).erreur_systeme = d_es_processus;
! 663: return;
! 664: }
! 665:
! 666: if ((*((struct_fonction *) (*(*(*s_etat_processus)
! 667: .expression_courante).donnee).objet)).prediction_saut
! 668: != NULL)
! 669: {
! 670: s_registre = (*s_etat_processus).expression_courante;
! 671:
! 672: (*s_etat_processus).expression_courante =
! 673: (struct_liste_chainee *)
! 674: (*((struct_fonction *) (*(*(*s_etat_processus)
! 675: .expression_courante).donnee).objet))
! 676: .prediction_saut;
! 677: fonction = (*((struct_fonction *)
! 678: (*(*(*s_etat_processus).expression_courante)
! 679: .donnee).objet)).fonction;
! 680: execution = (*((struct_fonction *)
! 681: (*(*s_registre).donnee).objet))
! 682: .prediction_execution;
! 683:
! 684: if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex))
! 685: != 0)
! 686: {
! 687: (*s_etat_processus).erreur_systeme = d_es_processus;
! 688: return;
! 689: }
! 690:
! 691: if (execution == d_vrai)
! 692: {
! 693: fonction(s_etat_processus);
! 694: }
! 695: }
! 696: else
! 697: {
! 698: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
! 699: .expression_courante).donnee).mutex)) != 0)
! 700: {
! 701: (*s_etat_processus).erreur_systeme = d_es_processus;
! 702: return;
! 703: }
! 704:
! 705: s_registre = (*s_etat_processus).expression_courante;
! 706: execution = d_faux;
! 707:
! 708: do
! 709: {
! 710: if (((*s_etat_processus).expression_courante =
! 711: (*(*s_etat_processus)
! 712: .expression_courante).suivant) == NULL)
! 713: {
! 714: liberation(s_etat_processus, s_objet);
! 715:
! 716: (*s_etat_processus).erreur_execution =
! 717: d_ex_erreur_traitement_condition;
! 718: return;
! 719: }
! 720:
! 721: if ((*(*(*s_etat_processus).expression_courante)
! 722: .donnee).type == FCT)
! 723: {
! 724: fonction = (*((struct_fonction *)
! 725: (*(*(*s_etat_processus).expression_courante)
! 726: .donnee).objet)).fonction;
! 727:
! 728: if (niveau == 0)
! 729: {
! 730: if ((fonction == instruction_end) ||
! 731: (fonction == instruction_else) ||
! 732: (fonction == instruction_elseif))
! 733: {
! 734: fonction(s_etat_processus);
! 735: execution = d_vrai;
! 736: drapeau_fin = d_vrai;
! 737: }
! 738: else
! 739: {
! 740: drapeau_fin = d_faux;
! 741: }
! 742: }
! 743: else
! 744: {
! 745: drapeau_fin = d_faux;
! 746: }
! 747:
! 748: if ((fonction == instruction_case) ||
! 749: (fonction == instruction_do) ||
! 750: (fonction == instruction_if) ||
! 751: (fonction == instruction_iferr) ||
! 752: (fonction == instruction_select) ||
! 753: (fonction == instruction_while))
! 754: {
! 755: niveau++;
! 756: }
! 757: else if (fonction == instruction_end)
! 758: {
! 759: niveau--;
! 760: }
! 761: }
! 762: } while(drapeau_fin == d_faux);
! 763:
! 764: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
! 765: .expression_courante).donnee).mutex)) != 0)
! 766: {
! 767: (*s_etat_processus).erreur_systeme = d_es_processus;
! 768: return;
! 769: }
! 770:
! 771: (*((struct_fonction *) (*(*s_registre).donnee).objet))
! 772: .prediction_saut = (*s_etat_processus)
! 773: .expression_courante;
! 774: (*((struct_fonction *) (*(*s_registre).donnee).objet))
! 775: .prediction_execution = execution;
! 776:
! 777: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
! 778: .expression_courante).donnee).mutex)) != 0)
! 779: {
! 780: (*s_etat_processus).erreur_systeme = d_es_processus;
! 781: return;
! 782: }
! 783: }
! 784: }
! 785: }
! 786: }
! 787: else
! 788: {
! 789: liberation(s_etat_processus, s_objet);
! 790:
! 791: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 792: return;
! 793: }
! 794:
! 795: liberation(s_etat_processus, s_objet);
! 796:
! 797: return;
! 798: }
! 799:
! 800:
! 801: /*
! 802: ================================================================================
! 803: Fonction 'rclf'
! 804: ================================================================================
! 805: Entrées : structure processus
! 806: --------------------------------------------------------------------------------
! 807: Sorties :
! 808: --------------------------------------------------------------------------------
! 809: Effets de bord : néant
! 810: ================================================================================
! 811: */
! 812:
! 813: void
! 814: instruction_rclf(struct_processus *s_etat_processus)
! 815: {
! 816: struct_objet *s_objet_resultat;
! 817:
! 818: t_8_bits masque;
! 819:
! 820: unsigned char indice_bit;
! 821: unsigned char indice_bloc;
! 822: unsigned char indice_drapeau;
! 823: unsigned char taille_bloc;
! 824:
! 825: unsigned long i;
! 826:
! 827: (*s_etat_processus).erreur_execution = d_ex;
! 828:
! 829: if ((*s_etat_processus).affichage_arguments == 'Y')
! 830: {
! 831: printf("\n RCLF ");
! 832:
! 833: if ((*s_etat_processus).langue == 'F')
! 834: {
! 835: printf("(renvoie les drapeaux d'état)\n\n");
! 836: }
! 837: else
! 838: {
! 839: printf("(recall flags)\n\n");
! 840: }
! 841:
! 842: printf("-> 1: %s\n", d_BIN);
! 843:
! 844: return;
! 845: }
! 846: else if ((*s_etat_processus).test_instruction == 'Y')
! 847: {
! 848: (*s_etat_processus).nombre_arguments = -1;
! 849: return;
! 850: }
! 851:
! 852: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 853: {
! 854: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 855: {
! 856: return;
! 857: }
! 858: }
! 859:
! 860: if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL)
! 861: {
! 862: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 863: return;
! 864: }
! 865:
! 866: (*((logical8 *) (*s_objet_resultat).objet)) = 0;
! 867: taille_bloc = sizeof(t_8_bits) * 8;
! 868:
! 869: for(i = 1; i <= 64; i++)
! 870: {
! 871: indice_drapeau = i - 1;
! 872: indice_bloc = indice_drapeau / taille_bloc;
! 873: indice_bit = indice_drapeau % taille_bloc;
! 874: masque = ((t_8_bits) 1) << (taille_bloc - indice_bit - 1);
! 875:
! 876: if (((*s_etat_processus).drapeaux_etat[indice_bloc] & masque) != 0)
! 877: {
! 878: (*((logical8 *) (*s_objet_resultat).objet)) |=
! 879: ((logical8) 1) << indice_drapeau;
! 880: }
! 881: }
! 882:
! 883: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 884: s_objet_resultat) == d_erreur)
! 885: {
! 886: return;
! 887: }
! 888:
! 889: return;
! 890: }
! 891:
! 892:
! 893: /*
! 894: ================================================================================
! 895: Fonction 'rcl'
! 896: ================================================================================
! 897: Entrées : structure processus
! 898: -------------------------------------------------------------------------------
! 899: Sorties :
! 900: --------------------------------------------------------------------------------
! 901: Effets de bord : néant
! 902: ================================================================================
! 903: */
! 904:
! 905: void
! 906: instruction_rcl(struct_processus *s_etat_processus)
! 907: {
! 908: logical1 presence_variable;
! 909:
! 910: long i;
! 911:
! 912: struct_objet *s_objet;
! 913: struct_objet *s_objet_variable;
! 914:
! 915: (*s_etat_processus).erreur_execution = d_ex;
! 916:
! 917: if ((*s_etat_processus).affichage_arguments == 'Y')
! 918: {
! 919: printf("\n RCL ");
! 920:
! 921: if ((*s_etat_processus).langue == 'F')
! 922: {
! 923: printf("(renvoie le contenu d'une variable globale)\n\n");
! 924: }
! 925: else
! 926: {
! 927: printf("(recall global variable)\n\n");
! 928: }
! 929:
! 930: printf(" 1: %s\n", d_NOM);
! 931: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
! 932: " %s, %s, %s, %s, %s,\n"
! 933: " %s, %s, %s, %s, %s,\n"
! 934: " %s, %s, %s, %s,\n"
! 935: " %s, %s\n",
! 936: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 937: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 938: d_SQL, d_SLB, d_PRC, d_MTX);
! 939:
! 940: return;
! 941: }
! 942: else if ((*s_etat_processus).test_instruction == 'Y')
! 943: {
! 944: (*s_etat_processus).nombre_arguments = -1;
! 945: return;
! 946: }
! 947:
! 948: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 949: {
! 950: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 951: {
! 952: return;
! 953: }
! 954: }
! 955:
! 956: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 957: &s_objet) == d_erreur)
! 958: {
! 959: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 960: return;
! 961: }
! 962:
! 963: if ((*s_objet).type != NOM)
! 964: {
! 965: liberation(s_etat_processus, s_objet);
! 966:
! 967: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 968: return;
! 969: }
! 970:
! 971: if (recherche_variable(s_etat_processus, (*((struct_nom *)
! 972: (*s_objet).objet)).nom) == d_faux)
! 973: {
! 974: liberation(s_etat_processus, s_objet);
! 975:
! 976: (*s_etat_processus).erreur_systeme = d_es;
! 977: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
! 978: return;
! 979: }
! 980:
! 981: i = (*s_etat_processus).position_variable_courante;
! 982: presence_variable = d_faux;
! 983:
! 984: while(i >= 0)
! 985: {
! 986: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
! 987: (*((struct_nom *) (*s_objet).objet)).nom) == 0) &&
! 988: ((*s_etat_processus).s_liste_variables[i].niveau == 1))
! 989: {
! 990: presence_variable = d_vrai;
! 991: break;
! 992: }
! 993:
! 994: i--;
! 995: }
! 996:
! 997: (*s_etat_processus).position_variable_courante = i;
! 998:
! 999: if (presence_variable == d_faux)
! 1000: {
! 1001: liberation(s_etat_processus, s_objet);
! 1002:
! 1003: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
! 1004: return;
! 1005: }
! 1006:
! 1007: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 1008: .position_variable_courante].objet == NULL)
! 1009: {
! 1010: liberation(s_etat_processus, s_objet);
! 1011:
! 1012: (*s_etat_processus).erreur_systeme = d_es;
! 1013: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
! 1014: return;
! 1015: }
! 1016:
! 1017: if ((s_objet_variable = copie_objet(s_etat_processus,
! 1018: ((*s_etat_processus).s_liste_variables)
! 1019: [(*s_etat_processus).position_variable_courante].objet, 'P'))
! 1020: == NULL)
! 1021: {
! 1022: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1023: return;
! 1024: }
! 1025:
! 1026: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1027: s_objet_variable) == d_erreur)
! 1028: {
! 1029: return;
! 1030: }
! 1031:
! 1032: liberation(s_etat_processus, s_objet);
! 1033:
! 1034: return;
! 1035: }
! 1036:
! 1037:
! 1038: /*
! 1039: ================================================================================
! 1040: Fonction 'rand'
! 1041: ================================================================================
! 1042: Entrées : structure processus
! 1043: -------------------------------------------------------------------------------
! 1044: Sorties :
! 1045: --------------------------------------------------------------------------------
! 1046: Effets de bord : néant
! 1047: ================================================================================
! 1048: */
! 1049:
! 1050: void
! 1051: instruction_rand(struct_processus *s_etat_processus)
! 1052: {
! 1053: struct_objet *s_objet;
! 1054:
! 1055: (*s_etat_processus).erreur_execution = d_ex;
! 1056:
! 1057: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1058: {
! 1059: printf("\n RAND ");
! 1060:
! 1061: if ((*s_etat_processus).langue == 'F')
! 1062: {
! 1063: printf("(variable aléatoire uniforme)\n\n");
! 1064: }
! 1065: else
! 1066: {
! 1067: printf("(uniform random number)\n\n");
! 1068: }
! 1069:
! 1070: printf("-> 1: %s\n", d_REL);
! 1071:
! 1072: return;
! 1073: }
! 1074: else if ((*s_etat_processus).test_instruction == 'Y')
! 1075: {
! 1076: (*s_etat_processus).nombre_arguments = -1;
! 1077: return;
! 1078: }
! 1079:
! 1080: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1081: {
! 1082: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1083: {
! 1084: return;
! 1085: }
! 1086: }
! 1087:
! 1088: if ((*s_etat_processus).generateur_aleatoire == NULL)
! 1089: {
! 1090: initialisation_generateur_aleatoire(s_etat_processus, d_vrai, 0);
! 1091: }
! 1092:
! 1093: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
! 1094: {
! 1095: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1096: return;
! 1097: }
! 1098:
! 1099: (*((real8 *) (*s_objet).objet)) = gsl_rng_uniform(
! 1100: (*s_etat_processus).generateur_aleatoire);
! 1101:
! 1102: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1103: s_objet) == d_erreur)
! 1104: {
! 1105: return;
! 1106: }
! 1107:
! 1108: return;
! 1109: }
! 1110:
! 1111:
! 1112: /*
! 1113: ================================================================================
! 1114: Fonction 'rdz'
! 1115: ================================================================================
! 1116: Entrées : structure processus
! 1117: -------------------------------------------------------------------------------
! 1118: Sorties :
! 1119: --------------------------------------------------------------------------------
! 1120: Effets de bord : néant
! 1121: ================================================================================
! 1122: */
! 1123:
! 1124: void
! 1125: instruction_rdz(struct_processus *s_etat_processus)
! 1126: {
! 1127: struct_objet *s_objet;
! 1128:
! 1129: (*s_etat_processus).erreur_execution = d_ex;
! 1130:
! 1131: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1132: {
! 1133: printf("\n RDZ ");
! 1134:
! 1135: if ((*s_etat_processus).langue == 'F')
! 1136: {
! 1137: printf("(racine des nombres aléatoires)\n\n");
! 1138: }
! 1139: else
! 1140: {
! 1141: printf("(random seed)\n\n");
! 1142: }
! 1143:
! 1144: printf(" 1: %s\n", d_INT);
! 1145:
! 1146: return;
! 1147: }
! 1148: else if ((*s_etat_processus).test_instruction == 'Y')
! 1149: {
! 1150: (*s_etat_processus).nombre_arguments = -1;
! 1151: return;
! 1152: }
! 1153:
! 1154: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1155: {
! 1156: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1157: {
! 1158: return;
! 1159: }
! 1160: }
! 1161:
! 1162: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1163: &s_objet) == d_erreur)
! 1164: {
! 1165: return;
! 1166: }
! 1167:
! 1168: if ((*s_objet).type == INT)
! 1169: {
! 1170: initialisation_generateur_aleatoire(s_etat_processus, d_faux,
! 1171: (unsigned long int) (*((integer8 *) (*s_objet).objet)));
! 1172: }
! 1173: else
! 1174: {
! 1175: liberation(s_etat_processus, s_objet);
! 1176:
! 1177: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1178: return;
! 1179: }
! 1180:
! 1181: liberation(s_etat_processus, s_objet);
! 1182: }
! 1183:
! 1184:
! 1185: /*
! 1186: ================================================================================
! 1187: Fonction 'rnd'
! 1188: ================================================================================
! 1189: Entrées : structure processus
! 1190: --------------------------------------------------------------------------------
! 1191: Sorties :
! 1192: --------------------------------------------------------------------------------
! 1193: Effets de bord : néant
! 1194: ================================================================================
! 1195: */
! 1196:
! 1197: void
! 1198: instruction_rnd(struct_processus *s_etat_processus)
! 1199: {
! 1200: struct_objet *s_objet_argument;
! 1201:
! 1202: unsigned char *instruction_courante;
! 1203:
! 1204: (*s_etat_processus).erreur_execution = d_ex;
! 1205:
! 1206: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1207: {
! 1208: printf("\n RND ");
! 1209:
! 1210: if ((*s_etat_processus).langue == 'F')
! 1211: {
! 1212: printf("(arrondi)\n\n");
! 1213: }
! 1214: else
! 1215: {
! 1216: printf("(rounding)\n\n");
! 1217: }
! 1218:
! 1219: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 1220: " %s, %s, %s\n",
! 1221: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX);
! 1222: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
! 1223: " %s, %s, %s\n",
! 1224: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX);
! 1225:
! 1226: return;
! 1227: }
! 1228: else if ((*s_etat_processus).test_instruction == 'Y')
! 1229: {
! 1230: (*s_etat_processus).nombre_arguments = 1;
! 1231: return;
! 1232: }
! 1233:
! 1234: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1235: {
! 1236: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1237: {
! 1238: return;
! 1239: }
! 1240: }
! 1241:
! 1242: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1243: &s_objet_argument) == d_erreur)
! 1244: {
! 1245: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1246: return;
! 1247: }
! 1248:
! 1249: if (((*s_objet_argument).type == INT) ||
! 1250: ((*s_objet_argument).type == REL) ||
! 1251: ((*s_objet_argument).type == CPL) ||
! 1252: ((*s_objet_argument).type == VIN) ||
! 1253: ((*s_objet_argument).type == VRL) ||
! 1254: ((*s_objet_argument).type == VCX) ||
! 1255: ((*s_objet_argument).type == MIN) ||
! 1256: ((*s_objet_argument).type == MRL) ||
! 1257: ((*s_objet_argument).type == MCX))
! 1258: {
! 1259: instruction_courante = (*s_etat_processus).instruction_courante;
! 1260:
! 1261: if (((*s_etat_processus).instruction_courante =
! 1262: formateur(s_etat_processus, 0, s_objet_argument)) == NULL)
! 1263: {
! 1264: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1265: (*s_etat_processus).instruction_courante = instruction_courante;
! 1266: return;
! 1267: }
! 1268:
! 1269: recherche_type(s_etat_processus);
! 1270:
! 1271: free((*s_etat_processus).instruction_courante);
! 1272: (*s_etat_processus).instruction_courante = instruction_courante;
! 1273:
! 1274: if ((*s_etat_processus).erreur_systeme != d_es)
! 1275: {
! 1276: return;
! 1277: }
! 1278:
! 1279: if ((*s_etat_processus).erreur_execution != d_ex)
! 1280: {
! 1281: liberation(s_etat_processus, s_objet_argument);
! 1282: return;
! 1283: }
! 1284: }
! 1285: else
! 1286: {
! 1287: liberation(s_etat_processus, s_objet_argument);
! 1288:
! 1289: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1290: return;
! 1291: }
! 1292:
! 1293: liberation(s_etat_processus, s_objet_argument);
! 1294:
! 1295: return;
! 1296: }
! 1297:
! 1298:
! 1299: /*
! 1300: ================================================================================
! 1301: Fonction 'r->c'
! 1302: ================================================================================
! 1303: Entrées : structure processus
! 1304: --------------------------------------------------------------------------------
! 1305: Sorties :
! 1306: --------------------------------------------------------------------------------
! 1307: Effets de bord : néant
! 1308: ================================================================================
! 1309: */
! 1310:
! 1311: void
! 1312: instruction_r_vers_c(struct_processus *s_etat_processus)
! 1313: {
! 1314: struct_objet *s_objet_argument_1;
! 1315: struct_objet *s_objet_argument_2;
! 1316: struct_objet *s_objet_resultat;
! 1317:
! 1318: unsigned long i;
! 1319: unsigned long j;
! 1320:
! 1321: (*s_etat_processus).erreur_execution = d_ex;
! 1322:
! 1323: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1324: {
! 1325: printf("\n R->C ");
! 1326:
! 1327: if ((*s_etat_processus).langue == 'F')
! 1328: {
! 1329: printf("(réel vers complexe)\n\n");
! 1330: }
! 1331: else
! 1332: {
! 1333: printf("(real to complex)\n\n");
! 1334: }
! 1335:
! 1336: printf(" 2: %s, %s\n", d_INT, d_REL);
! 1337: printf(" 1: %s, %s\n", d_INT, d_REL);
! 1338: printf("-> 1: %s\n\n", d_CPL);
! 1339:
! 1340: printf(" 2: %s, %s\n", d_VIN, d_VRL);
! 1341: printf(" 1: %s, %s\n", d_VIN, d_VRL);
! 1342: printf("-> 1: %s\n\n", d_VCX);
! 1343:
! 1344: printf(" 2: %s, %s\n", d_MIN, d_MRL);
! 1345: printf(" 1: %s, %s\n", d_MIN, d_MRL);
! 1346: printf("-> 1: %s\n", d_MCX);
! 1347:
! 1348: return;
! 1349: }
! 1350: else if ((*s_etat_processus).test_instruction == 'Y')
! 1351: {
! 1352: (*s_etat_processus).nombre_arguments = -1;
! 1353: return;
! 1354: }
! 1355:
! 1356: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1357: {
! 1358: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 1359: {
! 1360: return;
! 1361: }
! 1362: }
! 1363:
! 1364: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1365: &s_objet_argument_1) == d_erreur)
! 1366: {
! 1367: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1368: return;
! 1369: }
! 1370:
! 1371: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1372: &s_objet_argument_2) == d_erreur)
! 1373: {
! 1374: liberation(s_etat_processus, s_objet_argument_1);
! 1375:
! 1376: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1377: return;
! 1378: }
! 1379:
! 1380: /*
! 1381: --------------------------------------------------------------------------------
! 1382: Formation d'un complexe à partir de deux réels
! 1383: --------------------------------------------------------------------------------
! 1384: */
! 1385:
! 1386: if ((((*s_objet_argument_1).type == INT) ||
! 1387: ((*s_objet_argument_1).type == REL)) &&
! 1388: (((*s_objet_argument_2).type == INT) ||
! 1389: ((*s_objet_argument_2).type == REL)))
! 1390: {
! 1391: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
! 1392: {
! 1393: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1394: return;
! 1395: }
! 1396:
! 1397: if ((*s_objet_argument_1).type == INT)
! 1398: {
! 1399: (*((struct_complexe16 *) (*s_objet_resultat).objet))
! 1400: .partie_imaginaire =
! 1401: (*((integer8 *) (*s_objet_argument_1).objet));
! 1402: }
! 1403: else
! 1404: {
! 1405: (*((struct_complexe16 *) (*s_objet_resultat).objet))
! 1406: .partie_imaginaire =
! 1407: (*((real8 *) (*s_objet_argument_1).objet));
! 1408: }
! 1409:
! 1410: if ((*s_objet_argument_2).type == INT)
! 1411: {
! 1412: (*((struct_complexe16 *) (*s_objet_resultat).objet))
! 1413: .partie_reelle =
! 1414: (*((integer8 *) (*s_objet_argument_2).objet));
! 1415: }
! 1416: else
! 1417: {
! 1418: (*((struct_complexe16 *) (*s_objet_resultat).objet))
! 1419: .partie_reelle =
! 1420: (*((real8 *) (*s_objet_argument_2).objet));
! 1421: }
! 1422: }
! 1423:
! 1424: /*
! 1425: --------------------------------------------------------------------------------
! 1426: Formation à partir de deux vecteurs
! 1427: --------------------------------------------------------------------------------
! 1428: */
! 1429:
! 1430: else if ((((*s_objet_argument_1).type == VIN) ||
! 1431: ((*s_objet_argument_1).type == VRL)) &&
! 1432: (((*s_objet_argument_2).type == VIN) ||
! 1433: ((*s_objet_argument_2).type == VRL)))
! 1434: {
! 1435: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
! 1436: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
! 1437: {
! 1438: liberation(s_etat_processus, s_objet_argument_1);
! 1439: liberation(s_etat_processus, s_objet_argument_2);
! 1440:
! 1441: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 1442: return;
! 1443: }
! 1444:
! 1445: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
! 1446: {
! 1447: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1448: return;
! 1449: }
! 1450:
! 1451: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 1452: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
! 1453:
! 1454: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 1455: malloc((*(((struct_vecteur *) (*s_objet_resultat)
! 1456: .objet))).taille * sizeof(struct_complexe16))) == NULL)
! 1457: {
! 1458: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1459: return;
! 1460: }
! 1461:
! 1462: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument_1).objet)))
! 1463: .taille; i++)
! 1464: {
! 1465: if ((*s_objet_argument_1).type == VIN)
! 1466: {
! 1467: ((struct_complexe16 *) (*((struct_vecteur *)
! 1468: (*s_objet_resultat).objet)).tableau)[i]
! 1469: .partie_imaginaire = ((integer8 *)
! 1470: (*((struct_vecteur *) (*s_objet_argument_1).objet))
! 1471: .tableau)[i];
! 1472: }
! 1473: else
! 1474: {
! 1475: ((struct_complexe16 *) (*((struct_vecteur *)
! 1476: (*s_objet_resultat).objet)).tableau)[i]
! 1477: .partie_imaginaire = ((real8 *)
! 1478: (*((struct_vecteur *) (*s_objet_argument_1).objet))
! 1479: .tableau)[i];
! 1480: }
! 1481:
! 1482: if ((*s_objet_argument_2).type == VIN)
! 1483: {
! 1484: ((struct_complexe16 *) (*((struct_vecteur *)
! 1485: (*s_objet_resultat).objet)).tableau)[i]
! 1486: .partie_reelle = ((integer8 *)
! 1487: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 1488: .tableau)[i];
! 1489: }
! 1490: else
! 1491: {
! 1492: ((struct_complexe16 *) (*((struct_vecteur *)
! 1493: (*s_objet_resultat).objet)).tableau)[i]
! 1494: .partie_reelle = ((real8 *)
! 1495: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 1496: .tableau)[i];
! 1497: }
! 1498: }
! 1499: }
! 1500:
! 1501: /*
! 1502: --------------------------------------------------------------------------------
! 1503: Formation à partir de deux matrices
! 1504: --------------------------------------------------------------------------------
! 1505: */
! 1506:
! 1507: else if ((((*s_objet_argument_1).type == MIN) ||
! 1508: ((*s_objet_argument_1).type == MRL)) &&
! 1509: (((*s_objet_argument_2).type == MIN) ||
! 1510: ((*s_objet_argument_2).type == MRL)))
! 1511: {
! 1512: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 1513: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
! 1514: .objet))).nombre_lignes) || ((*(((struct_matrice *)
! 1515: (*s_objet_argument_1).objet))).nombre_colonnes !=
! 1516: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
! 1517: .nombre_lignes))
! 1518: {
! 1519: liberation(s_etat_processus, s_objet_argument_1);
! 1520: liberation(s_etat_processus, s_objet_argument_2);
! 1521:
! 1522: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 1523: return;
! 1524: }
! 1525:
! 1526: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 1527: {
! 1528: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1529: return;
! 1530: }
! 1531:
! 1532: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 1533: (*((struct_matrice *) (*s_objet_argument_1).objet))
! 1534: .nombre_lignes;
! 1535: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 1536: (*((struct_matrice *) (*s_objet_argument_1).objet))
! 1537: .nombre_colonnes;
! 1538:
! 1539: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 1540: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 1541: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
! 1542: {
! 1543: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1544: return;
! 1545: }
! 1546:
! 1547: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 1548: .nombre_lignes; i++)
! 1549: {
! 1550: if ((((struct_complexe16 **) (*((struct_matrice *)
! 1551: (*s_objet_resultat).objet)).tableau)[i] =
! 1552: malloc((*((struct_matrice *)
! 1553: (*s_objet_resultat).objet)).nombre_colonnes *
! 1554: sizeof(struct_complexe16))) == NULL)
! 1555: {
! 1556: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1557: return;
! 1558: }
! 1559:
! 1560: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 1561: .nombre_colonnes; j++)
! 1562: {
! 1563: if ((*s_objet_argument_1).type == MIN)
! 1564: {
! 1565: ((struct_complexe16 **) (*((struct_matrice *)
! 1566: (*s_objet_resultat).objet)).tableau)[i][j]
! 1567: .partie_imaginaire = ((integer8 **)
! 1568: (*((struct_matrice *) (*s_objet_argument_1).objet))
! 1569: .tableau)[i][j];
! 1570: }
! 1571: else
! 1572: {
! 1573: ((struct_complexe16 **) (*((struct_matrice *)
! 1574: (*s_objet_resultat).objet)).tableau)[i][j]
! 1575: .partie_imaginaire = ((real8 **)
! 1576: (*((struct_matrice *) (*s_objet_argument_1).objet))
! 1577: .tableau)[i][j];
! 1578: }
! 1579:
! 1580: if ((*s_objet_argument_2).type == MIN)
! 1581: {
! 1582: ((struct_complexe16 **) (*((struct_matrice *)
! 1583: (*s_objet_resultat).objet)).tableau)[i][j]
! 1584: .partie_reelle = ((integer8 **)
! 1585: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 1586: .tableau)[i][j];
! 1587: }
! 1588: else
! 1589: {
! 1590: ((struct_complexe16 **) (*((struct_matrice *)
! 1591: (*s_objet_resultat).objet)).tableau)[i][j]
! 1592: .partie_reelle = ((real8 **)
! 1593: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 1594: .tableau)[i][j];
! 1595: }
! 1596: }
! 1597: }
! 1598: }
! 1599:
! 1600: /*
! 1601: --------------------------------------------------------------------------------
! 1602: Formation impossible
! 1603: --------------------------------------------------------------------------------
! 1604: */
! 1605:
! 1606: else
! 1607: {
! 1608: liberation(s_etat_processus, s_objet_argument_1);
! 1609: liberation(s_etat_processus, s_objet_argument_2);
! 1610:
! 1611: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1612: return;
! 1613: }
! 1614:
! 1615: liberation(s_etat_processus, s_objet_argument_1);
! 1616: liberation(s_etat_processus, s_objet_argument_2);
! 1617:
! 1618: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1619: s_objet_resultat) == d_erreur)
! 1620: {
! 1621: return;
! 1622: }
! 1623:
! 1624: return;
! 1625: }
! 1626:
! 1627:
! 1628: /*
! 1629: ================================================================================
! 1630: Fonction 're'
! 1631: ================================================================================
! 1632: Entrées : structure processus
! 1633: --------------------------------------------------------------------------------
! 1634: Sorties :
! 1635: --------------------------------------------------------------------------------
! 1636: Effets de bord : néant
! 1637: ================================================================================
! 1638: */
! 1639:
! 1640: void
! 1641: instruction_re(struct_processus *s_etat_processus)
! 1642: {
! 1643: struct_liste_chainee *l_element_courant;
! 1644: struct_liste_chainee *l_element_precedent;
! 1645:
! 1646: struct_objet *s_copie_argument;
! 1647: struct_objet *s_objet_argument;
! 1648: struct_objet *s_objet_resultat;
! 1649:
! 1650: unsigned long i;
! 1651: unsigned long j;
! 1652:
! 1653: (*s_etat_processus).erreur_execution = d_ex;
! 1654:
! 1655: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1656: {
! 1657: printf("\n RE ");
! 1658:
! 1659: if ((*s_etat_processus).langue == 'F')
! 1660: {
! 1661: printf("(partie réelle)\n\n");
! 1662: }
! 1663: else
! 1664: {
! 1665: printf("(real part)\n\n");
! 1666: }
! 1667:
! 1668: printf(" 1: %s, %s\n", d_INT, d_REL);
! 1669: printf("-> 1: %s\n\n", d_INT);
! 1670:
! 1671: printf(" 1: %s\n", d_CPL);
! 1672: printf("-> 1: %s\n\n", d_REL);
! 1673:
! 1674: printf(" 1: %s, %s\n", d_VIN, d_VRL);
! 1675: printf("-> 1: %s\n\n", d_VIN);
! 1676:
! 1677: printf(" 1: %s\n", d_VCX);
! 1678: printf("-> 1: %s\n\n", d_VRL);
! 1679:
! 1680: printf(" 1: %s, %s\n", d_MIN, d_MRL);
! 1681: printf("-> 1: %s\n\n", d_MIN);
! 1682:
! 1683: printf(" 1: %s\n", d_MCX);
! 1684: printf("-> 1: %s\n\n", d_MRL);
! 1685:
! 1686: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 1687: printf("-> 1: %s\n\n", d_ALG);
! 1688:
! 1689: printf(" 1: %s\n", d_RPN);
! 1690: printf("-> 1: %s\n", d_RPN);
! 1691:
! 1692: return;
! 1693: }
! 1694: else if ((*s_etat_processus).test_instruction == 'Y')
! 1695: {
! 1696: (*s_etat_processus).nombre_arguments = 1;
! 1697: return;
! 1698: }
! 1699:
! 1700: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1701: {
! 1702: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1703: {
! 1704: return;
! 1705: }
! 1706: }
! 1707:
! 1708: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1709: &s_objet_argument) == d_erreur)
! 1710: {
! 1711: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1712: return;
! 1713: }
! 1714:
! 1715: /*
! 1716: --------------------------------------------------------------------------------
! 1717: Partie réelle d'un entier ou d'un réel
! 1718: --------------------------------------------------------------------------------
! 1719: */
! 1720:
! 1721: if (((*s_objet_argument).type == INT) ||
! 1722: ((*s_objet_argument).type == REL))
! 1723: {
! 1724: s_objet_resultat = s_objet_argument;
! 1725: s_objet_argument = NULL;
! 1726: }
! 1727:
! 1728: /*
! 1729: --------------------------------------------------------------------------------
! 1730: Partie réelle d'un complexe
! 1731: --------------------------------------------------------------------------------
! 1732: */
! 1733:
! 1734: else if ((*s_objet_argument).type == CPL)
! 1735: {
! 1736: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
! 1737: {
! 1738: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1739: return;
! 1740: }
! 1741:
! 1742: (*((real8 *) (*s_objet_resultat).objet)) =
! 1743: (*((struct_complexe16 *) (*s_objet_argument).objet))
! 1744: .partie_reelle;
! 1745: }
! 1746:
! 1747: /*
! 1748: --------------------------------------------------------------------------------
! 1749: Partie réelle d'un vecteur
! 1750: --------------------------------------------------------------------------------
! 1751: */
! 1752:
! 1753: else if (((*s_objet_argument).type == VIN) ||
! 1754: ((*s_objet_argument).type == VRL))
! 1755: {
! 1756: s_objet_resultat = s_objet_argument;
! 1757: s_objet_argument = NULL;
! 1758: }
! 1759: else if ((*s_objet_argument).type == VCX)
! 1760: {
! 1761: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
! 1762: {
! 1763: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1764: return;
! 1765: }
! 1766:
! 1767: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 1768: malloc((*(((struct_vecteur *) (*s_objet_argument)
! 1769: .objet))).taille * sizeof(real8))) == NULL)
! 1770: {
! 1771: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1772: return;
! 1773: }
! 1774:
! 1775: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 1776: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
! 1777:
! 1778: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
! 1779: .taille; i++)
! 1780: {
! 1781: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
! 1782: .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
! 1783: (*s_objet_argument).objet)).tableau)[i].partie_reelle;
! 1784: }
! 1785: }
! 1786:
! 1787: /*
! 1788: --------------------------------------------------------------------------------
! 1789: Partie réelle d'une matrice
! 1790: --------------------------------------------------------------------------------
! 1791: */
! 1792:
! 1793: else if (((*s_objet_argument).type == MIN) ||
! 1794: ((*s_objet_argument).type == MRL))
! 1795: {
! 1796: s_objet_resultat = s_objet_argument;
! 1797: s_objet_argument = NULL;
! 1798: }
! 1799: else if ((*s_objet_argument).type == MCX)
! 1800: {
! 1801: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
! 1802: {
! 1803: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1804: return;
! 1805: }
! 1806:
! 1807: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 1808: malloc((*(((struct_matrice *) (*s_objet_argument)
! 1809: .objet))).nombre_lignes * sizeof(real8 *))) == NULL)
! 1810: {
! 1811: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1812: return;
! 1813: }
! 1814:
! 1815: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 1816: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
! 1817: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 1818: (*((struct_matrice *) (*s_objet_argument).objet))
! 1819: .nombre_colonnes;
! 1820:
! 1821: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
! 1822: .nombre_lignes; i++)
! 1823: {
! 1824: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 1825: .objet)).tableau)[i] = malloc(
! 1826: (*(((struct_matrice *) (*s_objet_argument).objet)))
! 1827: .nombre_colonnes * sizeof(real8))) == NULL)
! 1828: {
! 1829: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1830: return;
! 1831: }
! 1832:
! 1833: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
! 1834: .nombre_colonnes; j++)
! 1835: {
! 1836: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
! 1837: .tableau)[i][j] = ((struct_complexe16 **)
! 1838: (*((struct_matrice *) (*s_objet_argument).objet))
! 1839: .tableau)[i][j].partie_reelle;
! 1840: }
! 1841: }
! 1842: }
! 1843:
! 1844: /*
! 1845: --------------------------------------------------------------------------------
! 1846: Partie réelle d'un nom
! 1847: --------------------------------------------------------------------------------
! 1848: */
! 1849:
! 1850: else if ((*s_objet_argument).type == NOM)
! 1851: {
! 1852: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 1853: {
! 1854: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1855: return;
! 1856: }
! 1857:
! 1858: if (((*s_objet_resultat).objet =
! 1859: allocation_maillon(s_etat_processus)) == NULL)
! 1860: {
! 1861: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1862: return;
! 1863: }
! 1864:
! 1865: l_element_courant = (*s_objet_resultat).objet;
! 1866:
! 1867: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1868: == NULL)
! 1869: {
! 1870: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1871: return;
! 1872: }
! 1873:
! 1874: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1875: .nombre_arguments = 0;
! 1876: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1877: .fonction = instruction_vers_niveau_superieur;
! 1878:
! 1879: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1880: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1881: {
! 1882: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1883: return;
! 1884: }
! 1885:
! 1886: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1887: .nom_fonction, "<<");
! 1888:
! 1889: if (((*l_element_courant).suivant =
! 1890: allocation_maillon(s_etat_processus)) == NULL)
! 1891: {
! 1892: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1893: return;
! 1894: }
! 1895:
! 1896: l_element_courant = (*l_element_courant).suivant;
! 1897: (*l_element_courant).donnee = s_objet_argument;
! 1898:
! 1899: if (((*l_element_courant).suivant =
! 1900: allocation_maillon(s_etat_processus)) == NULL)
! 1901: {
! 1902: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1903: return;
! 1904: }
! 1905:
! 1906: l_element_courant = (*l_element_courant).suivant;
! 1907:
! 1908: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1909: == NULL)
! 1910: {
! 1911: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1912: return;
! 1913: }
! 1914:
! 1915: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1916: .nombre_arguments = 1;
! 1917: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1918: .fonction = instruction_re;
! 1919:
! 1920: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1921: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1922: {
! 1923: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1924: return;
! 1925: }
! 1926:
! 1927: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1928: .nom_fonction, "RE");
! 1929:
! 1930: if (((*l_element_courant).suivant =
! 1931: allocation_maillon(s_etat_processus)) == NULL)
! 1932: {
! 1933: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1934: return;
! 1935: }
! 1936:
! 1937: l_element_courant = (*l_element_courant).suivant;
! 1938:
! 1939: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1940: == NULL)
! 1941: {
! 1942: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1943: return;
! 1944: }
! 1945:
! 1946: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1947: .nombre_arguments = 0;
! 1948: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1949: .fonction = instruction_vers_niveau_inferieur;
! 1950:
! 1951: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1952: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1953: {
! 1954: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1955: return;
! 1956: }
! 1957:
! 1958: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1959: .nom_fonction, ">>");
! 1960:
! 1961: (*l_element_courant).suivant = NULL;
! 1962: s_objet_argument = NULL;
! 1963: }
! 1964:
! 1965: /*
! 1966: --------------------------------------------------------------------------------
! 1967: Partie réelle d'une expression
! 1968: --------------------------------------------------------------------------------
! 1969: */
! 1970:
! 1971: else if (((*s_objet_argument).type == ALG) ||
! 1972: ((*s_objet_argument).type == RPN))
! 1973: {
! 1974: if ((s_copie_argument = copie_objet(s_etat_processus,
! 1975: s_objet_argument, 'N')) == NULL)
! 1976: {
! 1977: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1978: return;
! 1979: }
! 1980:
! 1981: l_element_courant = (struct_liste_chainee *)
! 1982: (*s_copie_argument).objet;
! 1983: l_element_precedent = l_element_courant;
! 1984:
! 1985: while((*l_element_courant).suivant != NULL)
! 1986: {
! 1987: l_element_precedent = l_element_courant;
! 1988: l_element_courant = (*l_element_courant).suivant;
! 1989: }
! 1990:
! 1991: if (((*l_element_precedent).suivant =
! 1992: allocation_maillon(s_etat_processus)) == NULL)
! 1993: {
! 1994: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1995: return;
! 1996: }
! 1997:
! 1998: if (((*(*l_element_precedent).suivant).donnee =
! 1999: allocation(s_etat_processus, FCT)) == NULL)
! 2000: {
! 2001: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2002: return;
! 2003: }
! 2004:
! 2005: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2006: .donnee).objet)).nombre_arguments = 1;
! 2007: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2008: .donnee).objet)).fonction = instruction_re;
! 2009:
! 2010: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 2011: .suivant).donnee).objet)).nom_fonction =
! 2012: malloc(3 * sizeof(unsigned char))) == NULL)
! 2013: {
! 2014: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2015: return;
! 2016: }
! 2017:
! 2018: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 2019: .suivant).donnee).objet)).nom_fonction, "RE");
! 2020:
! 2021: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 2022:
! 2023: s_objet_resultat = s_copie_argument;
! 2024: }
! 2025:
! 2026: /*
! 2027: --------------------------------------------------------------------------------
! 2028: Réalisation impossible de la fonction partie réelle
! 2029: --------------------------------------------------------------------------------
! 2030: */
! 2031:
! 2032: else
! 2033: {
! 2034: liberation(s_etat_processus, s_objet_argument);
! 2035:
! 2036: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 2037: return;
! 2038: }
! 2039:
! 2040: liberation(s_etat_processus, s_objet_argument);
! 2041:
! 2042: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2043: s_objet_resultat) == d_erreur)
! 2044: {
! 2045: return;
! 2046: }
! 2047:
! 2048: return;
! 2049: }
! 2050:
! 2051:
! 2052: /*
! 2053: ================================================================================
! 2054: Fonction 'r->p'
! 2055: ================================================================================
! 2056: Entrées : pointeur sur une structure struct_processus
! 2057: --------------------------------------------------------------------------------
! 2058: Sorties :
! 2059: --------------------------------------------------------------------------------
! 2060: Effets de bord : néant
! 2061: ================================================================================
! 2062: */
! 2063:
! 2064: void
! 2065: instruction_r_vers_p(struct_processus *s_etat_processus)
! 2066: {
! 2067: struct_liste_chainee *l_element_courant;
! 2068: struct_liste_chainee *l_element_precedent;
! 2069:
! 2070: struct_objet *s_copie_argument;
! 2071: struct_objet *s_objet_argument;
! 2072: struct_objet *s_objet_resultat;
! 2073:
! 2074: (*s_etat_processus).erreur_execution = d_ex;
! 2075:
! 2076: if ((*s_etat_processus).affichage_arguments == 'Y')
! 2077: {
! 2078: printf("\n P->R ");
! 2079:
! 2080: if ((*s_etat_processus).langue == 'F')
! 2081: {
! 2082: printf("(coordonnées polaires vers cartésiennes)\n\n");
! 2083: }
! 2084: else
! 2085: {
! 2086: printf("(polar to cartesian coordinates)\n\n");
! 2087: }
! 2088:
! 2089: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 2090: printf("-> 1: %s\n\n", d_CPL);
! 2091:
! 2092: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 2093: printf("-> 1: %s\n\n", d_ALG);
! 2094:
! 2095: printf(" 1: %s\n", d_RPN);
! 2096: printf("-> 1: %s\n", d_RPN);
! 2097:
! 2098: return;
! 2099: }
! 2100: else if ((*s_etat_processus).test_instruction == 'Y')
! 2101: {
! 2102: (*s_etat_processus).nombre_arguments = -1;
! 2103: return;
! 2104: }
! 2105:
! 2106: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 2107: {
! 2108: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 2109: {
! 2110: return;
! 2111: }
! 2112: }
! 2113:
! 2114: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2115: &s_objet_argument) == d_erreur)
! 2116: {
! 2117: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 2118: return;
! 2119: }
! 2120:
! 2121: /*
! 2122: --------------------------------------------------------------------------------
! 2123: Conversion d'un entier ou d'un réel
! 2124: --------------------------------------------------------------------------------
! 2125: */
! 2126:
! 2127: if (((*s_objet_argument).type == INT) ||
! 2128: ((*s_objet_argument).type == REL))
! 2129: {
! 2130: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 2131: == NULL)
! 2132: {
! 2133: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2134: return;
! 2135: }
! 2136:
! 2137: if ((*s_objet_argument).type == INT)
! 2138: {
! 2139: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle
! 2140: = (*((integer8 *) (*s_objet_argument).objet));
! 2141: }
! 2142: else
! 2143: {
! 2144: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle
! 2145: = (*((real8 *) (*s_objet_argument).objet));
! 2146: }
! 2147:
! 2148: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_imaginaire
! 2149: = 0;
! 2150: }
! 2151:
! 2152: /*
! 2153: --------------------------------------------------------------------------------
! 2154: Conversion d'un complexe
! 2155: --------------------------------------------------------------------------------
! 2156: */
! 2157:
! 2158: else if ((*s_objet_argument).type == CPL)
! 2159: {
! 2160: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 2161: == NULL)
! 2162: {
! 2163: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2164: return;
! 2165: }
! 2166:
! 2167: f77absc_(((struct_complexe16 *) (*s_objet_argument).objet),
! 2168: &((*((struct_complexe16 *) (*s_objet_resultat).objet))
! 2169: .partie_reelle));
! 2170:
! 2171: (*((struct_complexe16 *) (*s_objet_resultat).objet))
! 2172: .partie_imaginaire = atan2((*((struct_complexe16 *)
! 2173: (*s_objet_argument).objet)).partie_imaginaire,
! 2174: (*((struct_complexe16 *) (*s_objet_argument).objet))
! 2175: .partie_reelle);
! 2176:
! 2177: if (test_cfsf(s_etat_processus, 60) == d_faux)
! 2178: {
! 2179: conversion_radians_vers_degres(&((*((struct_complexe16 *)
! 2180: (*s_objet_resultat).objet)).partie_imaginaire));
! 2181: }
! 2182: }
! 2183:
! 2184: /*
! 2185: --------------------------------------------------------------------------------
! 2186: Conversion d'un nom
! 2187: --------------------------------------------------------------------------------
! 2188: */
! 2189:
! 2190: else if ((*s_objet_argument).type == NOM)
! 2191: {
! 2192: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 2193: == NULL)
! 2194: {
! 2195: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2196: return;
! 2197: }
! 2198:
! 2199: if (((*s_objet_resultat).objet =
! 2200: allocation_maillon(s_etat_processus)) == NULL)
! 2201: {
! 2202: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2203: return;
! 2204: }
! 2205:
! 2206: l_element_courant = (*s_objet_resultat).objet;
! 2207:
! 2208: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 2209: == NULL)
! 2210: {
! 2211: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2212: return;
! 2213: }
! 2214:
! 2215: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2216: .nombre_arguments = 0;
! 2217: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2218: .fonction = instruction_vers_niveau_superieur;
! 2219:
! 2220: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2221: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2222: {
! 2223: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2224: return;
! 2225: }
! 2226:
! 2227: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2228: .nom_fonction, "<<");
! 2229:
! 2230: if (((*l_element_courant).suivant =
! 2231: allocation_maillon(s_etat_processus)) == NULL)
! 2232: {
! 2233: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2234: return;
! 2235: }
! 2236:
! 2237: l_element_courant = (*l_element_courant).suivant;
! 2238: (*l_element_courant).donnee = s_objet_argument;
! 2239:
! 2240: if (((*l_element_courant).suivant =
! 2241: allocation_maillon(s_etat_processus)) == NULL)
! 2242: {
! 2243: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2244: return;
! 2245: }
! 2246:
! 2247: l_element_courant = (*l_element_courant).suivant;
! 2248:
! 2249: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 2250: == NULL)
! 2251: {
! 2252: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2253: return;
! 2254: }
! 2255:
! 2256: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2257: .nombre_arguments = 1;
! 2258: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2259: .fonction = instruction_r_vers_p;
! 2260:
! 2261: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2262: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
! 2263: {
! 2264: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2265: return;
! 2266: }
! 2267:
! 2268: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2269: .nom_fonction, "R->P");
! 2270:
! 2271: if (((*l_element_courant).suivant =
! 2272: allocation_maillon(s_etat_processus)) == NULL)
! 2273: {
! 2274: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2275: return;
! 2276: }
! 2277:
! 2278: l_element_courant = (*l_element_courant).suivant;
! 2279:
! 2280: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 2281: == NULL)
! 2282: {
! 2283: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2284: return;
! 2285: }
! 2286:
! 2287: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2288: .nombre_arguments = 0;
! 2289: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2290: .fonction = instruction_vers_niveau_inferieur;
! 2291:
! 2292: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2293: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 2294: {
! 2295: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2296: return;
! 2297: }
! 2298:
! 2299: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 2300: .nom_fonction, ">>");
! 2301:
! 2302: (*l_element_courant).suivant = NULL;
! 2303: s_objet_argument = NULL;
! 2304: }
! 2305:
! 2306: /*
! 2307: --------------------------------------------------------------------------------
! 2308: Conversion d'une expression
! 2309: --------------------------------------------------------------------------------
! 2310: */
! 2311:
! 2312: else if (((*s_objet_argument).type == ALG) ||
! 2313: ((*s_objet_argument).type == RPN))
! 2314: {
! 2315: if ((s_copie_argument = copie_objet(s_etat_processus,
! 2316: s_objet_argument, 'N')) == NULL)
! 2317: {
! 2318: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2319: return;
! 2320: }
! 2321:
! 2322: l_element_courant = (struct_liste_chainee *)
! 2323: (*s_copie_argument).objet;
! 2324: l_element_precedent = l_element_courant;
! 2325:
! 2326: while((*l_element_courant).suivant != NULL)
! 2327: {
! 2328: l_element_precedent = l_element_courant;
! 2329: l_element_courant = (*l_element_courant).suivant;
! 2330: }
! 2331:
! 2332: if (((*l_element_precedent).suivant =
! 2333: allocation_maillon(s_etat_processus)) == NULL)
! 2334: {
! 2335: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2336: return;
! 2337: }
! 2338:
! 2339: if (((*(*l_element_precedent).suivant).donnee =
! 2340: allocation(s_etat_processus, FCT)) == NULL)
! 2341: {
! 2342: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2343: return;
! 2344: }
! 2345:
! 2346: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2347: .donnee).objet)).nombre_arguments = 1;
! 2348: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 2349: .donnee).objet)).fonction = instruction_r_vers_p;
! 2350:
! 2351: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 2352: .suivant).donnee).objet)).nom_fonction =
! 2353: malloc(5 * sizeof(unsigned char))) == NULL)
! 2354: {
! 2355: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2356: return;
! 2357: }
! 2358:
! 2359: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 2360: .suivant).donnee).objet)).nom_fonction, "R->P");
! 2361:
! 2362: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 2363:
! 2364: s_objet_resultat = s_copie_argument;
! 2365: }
! 2366:
! 2367: /*
! 2368: --------------------------------------------------------------------------------
! 2369: Réalisation impossible de la fonction R->P
! 2370: --------------------------------------------------------------------------------
! 2371: */
! 2372:
! 2373: else
! 2374: {
! 2375: liberation(s_etat_processus, s_objet_argument);
! 2376:
! 2377: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 2378: return;
! 2379: }
! 2380:
! 2381: liberation(s_etat_processus, s_objet_argument);
! 2382:
! 2383: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 2384: s_objet_resultat) == d_erreur)
! 2385: {
! 2386: return;
! 2387: }
! 2388:
! 2389: return;
! 2390: }
! 2391:
! 2392: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_r1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src