Annotation of rpl/src/instructions_o2.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 'obsub'
! 29: ================================================================================
! 30: Entrées :
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_obsub(struct_processus *s_etat_processus)
! 40: {
! 41: integer8 position;
! 42:
! 43: struct_liste_chainee *l_element_courant;
! 44:
! 45: struct_objet *s_copie_argument_3;
! 46: struct_objet *s_objet_argument_1;
! 47: struct_objet *s_objet_argument_2;
! 48: struct_objet *s_objet_argument_3;
! 49:
! 50: unsigned char *registre_definitions_chainees;
! 51: unsigned char *registre_instruction_courante;
! 52:
! 53: unsigned long position_courante;
! 54:
! 55: (*s_etat_processus).erreur_execution = d_ex;
! 56:
! 57: if ((*s_etat_processus).affichage_arguments == 'Y')
! 58: {
! 59: printf("\n OBSUB ");
! 60:
! 61: if ((*s_etat_processus).langue == 'F')
! 62: {
! 63: printf("(substitution d'objet)\n\n");
! 64: }
! 65: else
! 66: {
! 67: printf("(objet substitution)\n\n");
! 68: }
! 69:
! 70: printf(" 3: %s\n", d_RPN);
! 71: printf(" 2: %s\n", d_INT);
! 72: printf(" 1: %s\n", d_LST);
! 73: printf("-> 1: %s\n\n", d_RPN);
! 74:
! 75: if ((*s_etat_processus).langue == 'F')
! 76: {
! 77: printf(" Utilisation :\n\n");
! 78: }
! 79: else
! 80: {
! 81: printf(" Usage:\n\n");
! 82: }
! 83:
! 84: printf(" << 1 4 + >> 3 { * } OBSUB\n");
! 85: printf(" << << X >> EVAL SIN >> 2 { << X 1 + >> } OBSUB\n");
! 86:
! 87: return;
! 88: }
! 89: else if ((*s_etat_processus).test_instruction == 'Y')
! 90: {
! 91: (*s_etat_processus).nombre_arguments = 3;
! 92: return;
! 93: }
! 94:
! 95: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 96: {
! 97: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
! 98: {
! 99: return;
! 100: }
! 101: }
! 102:
! 103: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 104: &s_objet_argument_1) == d_erreur)
! 105: {
! 106: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 107: return;
! 108: }
! 109:
! 110: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 111: &s_objet_argument_2) == d_erreur)
! 112: {
! 113: liberation(s_etat_processus, s_objet_argument_1);
! 114:
! 115: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 116: return;
! 117: }
! 118:
! 119: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 120: &s_objet_argument_3) == d_erreur)
! 121: {
! 122: liberation(s_etat_processus, s_objet_argument_1);
! 123: liberation(s_etat_processus, s_objet_argument_2);
! 124:
! 125: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 126: return;
! 127: }
! 128:
! 129: if (((*s_objet_argument_1).type == LST) &&
! 130: ((*s_objet_argument_2).type == INT) &&
! 131: ((*s_objet_argument_3).type == RPN))
! 132: {
! 133: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
! 134: s_objet_argument_3, 'N')) == NULL)
! 135: {
! 136: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 137: return;
! 138: }
! 139:
! 140: liberation(s_etat_processus, s_objet_argument_3);
! 141: s_objet_argument_3 = s_copie_argument_3;
! 142:
! 143: position = 0;
! 144: l_element_courant = (*s_objet_argument_1).objet;
! 145:
! 146: while(l_element_courant != NULL)
! 147: {
! 148: position++;
! 149: l_element_courant = (*l_element_courant).suivant;
! 150: }
! 151:
! 152: if (position != 1)
! 153: {
! 154: liberation(s_etat_processus, s_objet_argument_1);
! 155: liberation(s_etat_processus, s_objet_argument_2);
! 156: liberation(s_etat_processus, s_objet_argument_3);
! 157:
! 158: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 159: return;
! 160: }
! 161:
! 162: if ((*((integer8 *) (*s_objet_argument_2).objet)) <= 0)
! 163: {
! 164: liberation(s_etat_processus, s_objet_argument_1);
! 165: liberation(s_etat_processus, s_objet_argument_2);
! 166: liberation(s_etat_processus, s_objet_argument_3);
! 167:
! 168: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 169: return;
! 170: }
! 171:
! 172: l_element_courant = (*s_objet_argument_3).objet;
! 173: position = 1;
! 174:
! 175: while(l_element_courant != NULL)
! 176: {
! 177: if (position == (*((integer8 *) (*s_objet_argument_2).objet)))
! 178: {
! 179: /*
! 180: * Substitution
! 181: */
! 182:
! 183: liberation(s_etat_processus, (*l_element_courant).donnee);
! 184:
! 185: if (((*l_element_courant).donnee =
! 186: copie_objet(s_etat_processus,
! 187: (*((struct_liste_chainee *)
! 188: (*s_objet_argument_1).objet)).donnee, 'O')) == NULL)
! 189: {
! 190: (*s_etat_processus).erreur_systeme =
! 191: d_es_allocation_memoire;
! 192: return;
! 193: }
! 194:
! 195: /*
! 196: * Analyse de l'objet résultant de la substitution
! 197: */
! 198:
! 199: position_courante = (*s_etat_processus).position_courante;
! 200: registre_definitions_chainees = (*s_etat_processus)
! 201: .definitions_chainees;
! 202: registre_instruction_courante = (*s_etat_processus)
! 203: .instruction_courante;
! 204:
! 205: if (((*s_etat_processus).definitions_chainees =
! 206: formateur(s_etat_processus, 0, s_objet_argument_3))
! 207: == NULL)
! 208: {
! 209: (*s_etat_processus).erreur_systeme =
! 210: d_es_allocation_memoire;
! 211: return;
! 212: }
! 213:
! 214: if (analyse_syntaxique(s_etat_processus) == d_erreur)
! 215: {
! 216: free((*s_etat_processus).definitions_chainees);
! 217:
! 218: (*s_etat_processus).definitions_chainees =
! 219: registre_definitions_chainees;
! 220: (*s_etat_processus).instruction_courante =
! 221: registre_instruction_courante;
! 222: (*s_etat_processus).position_courante =
! 223: position_courante;
! 224:
! 225: liberation(s_etat_processus, s_objet_argument_1);
! 226: liberation(s_etat_processus, s_objet_argument_2);
! 227: liberation(s_etat_processus, s_objet_argument_3);
! 228:
! 229: (*s_etat_processus).erreur_execution =
! 230: d_ex_argument_invalide;
! 231: return;
! 232: }
! 233:
! 234: free((*s_etat_processus).definitions_chainees);
! 235:
! 236: (*s_etat_processus).definitions_chainees =
! 237: registre_definitions_chainees;
! 238: (*s_etat_processus).instruction_courante =
! 239: registre_instruction_courante;
! 240: (*s_etat_processus).position_courante =
! 241: position_courante;
! 242:
! 243: break;
! 244: }
! 245:
! 246: position++;
! 247: l_element_courant = (*l_element_courant).suivant;
! 248: }
! 249:
! 250: if (l_element_courant == NULL)
! 251: {
! 252: liberation(s_etat_processus, s_objet_argument_1);
! 253: liberation(s_etat_processus, s_objet_argument_2);
! 254: liberation(s_etat_processus, s_objet_argument_3);
! 255:
! 256: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 257: return;
! 258: }
! 259: }
! 260: else
! 261: {
! 262: liberation(s_etat_processus, s_objet_argument_1);
! 263: liberation(s_etat_processus, s_objet_argument_2);
! 264: liberation(s_etat_processus, s_objet_argument_3);
! 265:
! 266: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 267: return;
! 268: }
! 269:
! 270: liberation(s_etat_processus, s_objet_argument_1);
! 271: liberation(s_etat_processus, s_objet_argument_2);
! 272:
! 273: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 274: s_objet_argument_3) == d_erreur)
! 275: {
! 276: return;
! 277: }
! 278:
! 279: return;
! 280: }
! 281:
! 282:
! 283: /*
! 284: ================================================================================
! 285: Fonction 'obget'
! 286: ================================================================================
! 287: Entrées :
! 288: --------------------------------------------------------------------------------
! 289: Sorties :
! 290: --------------------------------------------------------------------------------
! 291: Effets de bord : néant
! 292: ================================================================================
! 293: */
! 294:
! 295: void
! 296: instruction_obget(struct_processus *s_etat_processus)
! 297: {
! 298: struct_liste_chainee *l_element_courant;
! 299:
! 300: struct_objet *s_objet_argument_1;
! 301: struct_objet *s_objet_argument_2;
! 302: struct_objet *s_objet_resultat;
! 303:
! 304: unsigned long position;
! 305:
! 306: (*s_etat_processus).erreur_execution = d_ex;
! 307:
! 308: if ((*s_etat_processus).affichage_arguments == 'Y')
! 309: {
! 310: printf("\n OBGET ");
! 311:
! 312: if ((*s_etat_processus).langue == 'F')
! 313: {
! 314: printf("(extraction d'un objet)\n\n");
! 315: }
! 316: else
! 317: {
! 318: printf("(get objet)\n\n");
! 319: }
! 320:
! 321: printf(" 2: %s\n", d_RPN);
! 322: printf(" 1: %s\n", d_INT);
! 323: printf("-> 1: %s\n", d_LST);
! 324:
! 325: return;
! 326: }
! 327: else if ((*s_etat_processus).test_instruction == 'Y')
! 328: {
! 329: (*s_etat_processus).nombre_arguments = 2;
! 330: return;
! 331: }
! 332:
! 333: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 334: {
! 335: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 336: {
! 337: return;
! 338: }
! 339: }
! 340:
! 341: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 342: &s_objet_argument_1) == d_erreur)
! 343: {
! 344: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 345: return;
! 346: }
! 347:
! 348: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 349: &s_objet_argument_2) == d_erreur)
! 350: {
! 351: liberation(s_etat_processus, s_objet_argument_1);
! 352:
! 353: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 354: return;
! 355: }
! 356:
! 357: if (((*s_objet_argument_1).type == INT) &&
! 358: ((*s_objet_argument_2).type == RPN))
! 359: {
! 360: if ((*((integer8 *) (*s_objet_argument_1).objet)) <= 0)
! 361: {
! 362: liberation(s_etat_processus, s_objet_argument_1);
! 363: liberation(s_etat_processus, s_objet_argument_2);
! 364:
! 365: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 366: return;
! 367: }
! 368:
! 369: l_element_courant = (*s_objet_argument_2).objet;
! 370: position = 1;
! 371:
! 372: while(l_element_courant != NULL)
! 373: {
! 374: if (position == (unsigned long) (*((integer8 *)
! 375: (*s_objet_argument_1).objet)))
! 376: {
! 377: /*
! 378: * Récupération de l'objet
! 379: */
! 380:
! 381: if ((s_objet_resultat = allocation(s_etat_processus, LST))
! 382: == NULL)
! 383: {
! 384: (*s_etat_processus).erreur_systeme =
! 385: d_es_allocation_memoire;
! 386: return;
! 387: }
! 388:
! 389: if (((*s_objet_resultat).objet =
! 390: allocation_maillon(s_etat_processus)) == NULL)
! 391: {
! 392: (*s_etat_processus).erreur_systeme =
! 393: d_es_allocation_memoire;
! 394: return;
! 395: }
! 396:
! 397: (*((struct_liste_chainee *) (*s_objet_resultat).objet))
! 398: .suivant = NULL;
! 399:
! 400: if (((*((struct_liste_chainee *) (*s_objet_resultat).objet))
! 401: .donnee = copie_objet(s_etat_processus,
! 402: (*l_element_courant).donnee, 'O')) == NULL)
! 403: {
! 404: (*s_etat_processus).erreur_systeme =
! 405: d_es_allocation_memoire;
! 406: return;
! 407: }
! 408:
! 409: break;
! 410: }
! 411:
! 412: position++;
! 413: l_element_courant = (*l_element_courant).suivant;
! 414: }
! 415:
! 416: if (l_element_courant == NULL)
! 417: {
! 418: liberation(s_etat_processus, s_objet_argument_1);
! 419: liberation(s_etat_processus, s_objet_argument_2);
! 420:
! 421: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 422: return;
! 423: }
! 424:
! 425: /*
! 426: * Vérification de la cohérence de l'élément. Nous ne devons avoir
! 427: * ni '<<' ni '>>'.
! 428: */
! 429:
! 430: if ((*(*((struct_liste_chainee *) (*s_objet_resultat).objet))
! 431: .donnee).type == FCT)
! 432: {
! 433: if ((strcmp((*((struct_fonction *) (*(*((struct_liste_chainee *)
! 434: (*s_objet_resultat).objet)).donnee).objet)).nom_fonction,
! 435: "<<") == 0) || (strcmp((*((struct_fonction *)
! 436: (*(*((struct_liste_chainee *) (*s_objet_resultat).objet))
! 437: .donnee).objet)).nom_fonction, ">>") == 0))
! 438: {
! 439: liberation(s_etat_processus, s_objet_argument_1);
! 440: liberation(s_etat_processus, s_objet_argument_2);
! 441: liberation(s_etat_processus, s_objet_resultat);
! 442:
! 443: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 444: return;
! 445: }
! 446: }
! 447: }
! 448: else
! 449: {
! 450: liberation(s_etat_processus, s_objet_argument_1);
! 451: liberation(s_etat_processus, s_objet_argument_2);
! 452:
! 453: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 454: return;
! 455: }
! 456:
! 457: liberation(s_etat_processus, s_objet_argument_1);
! 458: liberation(s_etat_processus, s_objet_argument_2);
! 459:
! 460: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 461: s_objet_resultat) == d_erreur)
! 462: {
! 463: return;
! 464: }
! 465:
! 466: return;
! 467: }
! 468:
! 469: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>