Annotation of rpl/src/instructions_e4.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 'exsub'
! 29: ================================================================================
! 30: Entrées :
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_exsub(struct_processus *s_etat_processus)
! 40: {
! 41: integer8 position;
! 42:
! 43: struct_liste_chainee *l_element_courant;
! 44: struct_liste_chainee *ptr_1;
! 45: struct_liste_chainee *ptr_2;
! 46: struct_liste_chainee *ptr_3;
! 47:
! 48: struct_objet *s_copie_argument_1;
! 49: struct_objet *s_copie_argument_4;
! 50: struct_objet *s_objet_argument_1;
! 51: struct_objet *s_objet_argument_2;
! 52: struct_objet *s_objet_argument_3;
! 53: struct_objet *s_objet_argument_4;
! 54:
! 55: unsigned char *registre_definitions_chainees;
! 56: unsigned char *registre_instruction_courante;
! 57:
! 58: unsigned long position_courante;
! 59:
! 60: (*s_etat_processus).erreur_execution = d_ex;
! 61:
! 62: if ((*s_etat_processus).affichage_arguments == 'Y')
! 63: {
! 64: printf("\n EXSUB ");
! 65:
! 66: if ((*s_etat_processus).langue == 'F')
! 67: {
! 68: printf("(substitution d'expression)\n\n");
! 69: }
! 70: else
! 71: {
! 72: printf("(expression substitution)\n\n");
! 73: }
! 74:
! 75: printf(" 4: %s\n", d_RPN);
! 76: printf(" 3: %s\n", d_INT);
! 77: printf(" 2: %s\n", d_INT);
! 78: printf(" 1: %s\n", d_LST);
! 79: printf("-> 1: %s\n", d_RPN);
! 80:
! 81: return;
! 82: }
! 83: else if ((*s_etat_processus).test_instruction == 'Y')
! 84: {
! 85: (*s_etat_processus).nombre_arguments = 4;
! 86: return;
! 87: }
! 88:
! 89: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 90: {
! 91: if (empilement_pile_last(s_etat_processus, 4) == d_erreur)
! 92: {
! 93: return;
! 94: }
! 95: }
! 96:
! 97: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 98: &s_objet_argument_1) == d_erreur)
! 99: {
! 100: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 101: return;
! 102: }
! 103:
! 104: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 105: &s_objet_argument_2) == d_erreur)
! 106: {
! 107: liberation(s_etat_processus, s_objet_argument_1);
! 108:
! 109: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 110: return;
! 111: }
! 112:
! 113: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 114: &s_objet_argument_3) == d_erreur)
! 115: {
! 116: liberation(s_etat_processus, s_objet_argument_1);
! 117: liberation(s_etat_processus, s_objet_argument_2);
! 118:
! 119: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 120: return;
! 121: }
! 122:
! 123: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 124: &s_objet_argument_4) == d_erreur)
! 125: {
! 126: liberation(s_etat_processus, s_objet_argument_1);
! 127: liberation(s_etat_processus, s_objet_argument_2);
! 128: liberation(s_etat_processus, s_objet_argument_3);
! 129:
! 130: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 131: return;
! 132: }
! 133:
! 134: if (((*s_objet_argument_1).type == LST) &&
! 135: ((*s_objet_argument_2).type == INT) &&
! 136: ((*s_objet_argument_3).type == INT) &&
! 137: ((*s_objet_argument_4).type == RPN))
! 138: {
! 139: if ((*((integer8 *) (*s_objet_argument_3).objet)) <= 0)
! 140: {
! 141: liberation(s_etat_processus, s_objet_argument_1);
! 142: liberation(s_etat_processus, s_objet_argument_2);
! 143: liberation(s_etat_processus, s_objet_argument_3);
! 144: liberation(s_etat_processus, s_objet_argument_4);
! 145:
! 146: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 147: return;
! 148: }
! 149:
! 150: if ((*((integer8 *) (*s_objet_argument_3).objet)) >
! 151: (*((integer8 *) (*s_objet_argument_2).objet)))
! 152: {
! 153: liberation(s_etat_processus, s_objet_argument_1);
! 154: liberation(s_etat_processus, s_objet_argument_2);
! 155: liberation(s_etat_processus, s_objet_argument_3);
! 156: liberation(s_etat_processus, s_objet_argument_4);
! 157:
! 158: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 159: return;
! 160: }
! 161:
! 162: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
! 163: s_objet_argument_1, 'N')) == NULL)
! 164: {
! 165: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 166: return;
! 167: }
! 168:
! 169: liberation(s_etat_processus, s_objet_argument_1);
! 170: s_objet_argument_1 = s_copie_argument_1;
! 171:
! 172: if ((s_copie_argument_4 = copie_objet(s_etat_processus,
! 173: s_objet_argument_4, 'N')) == NULL)
! 174: {
! 175: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 176: return;
! 177: }
! 178:
! 179: liberation(s_etat_processus, s_objet_argument_4);
! 180: s_objet_argument_4 = s_copie_argument_4;
! 181:
! 182: l_element_courant = (*s_objet_argument_4).objet;
! 183: position = 1;
! 184:
! 185: /*
! 186: * ptr_1 : premier élément à substituer
! 187: * ptr_2 : dernier élément à substituer
! 188: */
! 189:
! 190: ptr_1 = NULL;
! 191: ptr_2 = NULL;
! 192:
! 193: while(l_element_courant != NULL)
! 194: {
! 195: if (position == (*((integer8 *) (*s_objet_argument_3).objet)))
! 196: {
! 197: ptr_1 = l_element_courant;
! 198: }
! 199:
! 200: if (position == (*((integer8 *) (*s_objet_argument_2).objet)))
! 201: {
! 202: ptr_2 = (*l_element_courant).suivant;
! 203: (*l_element_courant).suivant = NULL;
! 204: break;
! 205: }
! 206:
! 207: position++;
! 208: l_element_courant = (*l_element_courant).suivant;
! 209: }
! 210:
! 211: if (l_element_courant != NULL)
! 212: {
! 213: /*
! 214: * Substitution
! 215: */
! 216:
! 217: /*
! 218: * ptr_3 : objet de substitution
! 219: * ptr_1 : contient maintenant l'objet allant être substitué
! 220: * et terminé par un NULL donc libérable par liberation().
! 221: */
! 222:
! 223: ptr_3 = (*s_objet_argument_1).objet;
! 224: (*s_objet_argument_1).objet = ptr_1;
! 225:
! 226: l_element_courant = (*s_objet_argument_4).objet;
! 227:
! 228: if (l_element_courant == NULL)
! 229: {
! 230: (*s_objet_argument_4).objet = ptr_3;
! 231:
! 232: if ((*s_objet_argument_4).objet == NULL)
! 233: {
! 234: (*s_objet_argument_4).objet = ptr_2;
! 235: }
! 236: else
! 237: {
! 238: l_element_courant = (*s_objet_argument_4).objet;
! 239:
! 240: while((*l_element_courant).suivant != NULL)
! 241: {
! 242: l_element_courant = (*l_element_courant).suivant;
! 243: }
! 244:
! 245: (*l_element_courant).suivant = ptr_2;
! 246: }
! 247: }
! 248: else
! 249: {
! 250: if ((*((integer8 *) (*s_objet_argument_3).objet)) == 1)
! 251: {
! 252: (*s_objet_argument_4).objet = ptr_3;
! 253: l_element_courant = (*s_objet_argument_4).objet;
! 254: }
! 255: else
! 256: {
! 257: position = 1;
! 258:
! 259: while((*l_element_courant).suivant != NULL)
! 260: {
! 261: position++;
! 262:
! 263: if (position == (*((integer8 *) (*s_objet_argument_3)
! 264: .objet)))
! 265: {
! 266: break;
! 267: }
! 268:
! 269: l_element_courant = (*l_element_courant).suivant;
! 270: }
! 271:
! 272: (*l_element_courant).suivant = ptr_3;
! 273: }
! 274:
! 275: if ((*l_element_courant).suivant == NULL)
! 276: {
! 277: (*l_element_courant).suivant = ptr_2;
! 278: }
! 279: else
! 280: {
! 281: while((*l_element_courant).suivant != NULL)
! 282: {
! 283: l_element_courant = (*l_element_courant).suivant;
! 284: }
! 285:
! 286: (*l_element_courant).suivant = ptr_2;
! 287: }
! 288: }
! 289:
! 290: /*
! 291: * Analyse de l'objet résultant de la substitution
! 292: */
! 293:
! 294: // Recherche de la présence d'un '<<' initial
! 295:
! 296: l_element_courant = (*s_objet_argument_4).objet;
! 297:
! 298: while(l_element_courant != NULL)
! 299: {
! 300: if ((*(*l_element_courant).donnee).type == FCT)
! 301: {
! 302: if (strcmp((*((struct_fonction *) (*(*l_element_courant)
! 303: .donnee).objet)).nom_fonction, "<<") == 0)
! 304: {
! 305: break;
! 306: }
! 307: }
! 308:
! 309: l_element_courant = (*l_element_courant).suivant;
! 310: }
! 311:
! 312: if (l_element_courant != (*s_objet_argument_4).objet)
! 313: {
! 314: liberation(s_etat_processus, s_objet_argument_1);
! 315: liberation(s_etat_processus, s_objet_argument_2);
! 316: liberation(s_etat_processus, s_objet_argument_3);
! 317: liberation(s_etat_processus, s_objet_argument_4);
! 318:
! 319: (*s_etat_processus).erreur_execution =
! 320: d_ex_argument_invalide;
! 321: return;
! 322: }
! 323:
! 324: // Analyse syntaxique
! 325:
! 326: position_courante = (*s_etat_processus).position_courante;
! 327: registre_definitions_chainees = (*s_etat_processus)
! 328: .definitions_chainees;
! 329: registre_instruction_courante = (*s_etat_processus)
! 330: .instruction_courante;
! 331:
! 332: if (((*s_etat_processus).definitions_chainees =
! 333: formateur(s_etat_processus, 0, s_objet_argument_4))
! 334: == NULL)
! 335: {
! 336: (*s_etat_processus).erreur_systeme =
! 337: d_es_allocation_memoire;
! 338: return;
! 339: }
! 340:
! 341: if (analyse_syntaxique(s_etat_processus) == d_erreur)
! 342: {
! 343: free((*s_etat_processus).definitions_chainees);
! 344:
! 345: (*s_etat_processus).definitions_chainees =
! 346: registre_definitions_chainees;
! 347: (*s_etat_processus).instruction_courante =
! 348: registre_instruction_courante;
! 349: (*s_etat_processus).position_courante =
! 350: position_courante;
! 351:
! 352: liberation(s_etat_processus, s_objet_argument_1);
! 353: liberation(s_etat_processus, s_objet_argument_2);
! 354: liberation(s_etat_processus, s_objet_argument_3);
! 355: liberation(s_etat_processus, s_objet_argument_4);
! 356:
! 357: (*s_etat_processus).erreur_execution =
! 358: d_ex_argument_invalide;
! 359: return;
! 360: }
! 361:
! 362: free((*s_etat_processus).definitions_chainees);
! 363:
! 364: (*s_etat_processus).definitions_chainees =
! 365: registre_definitions_chainees;
! 366: (*s_etat_processus).instruction_courante =
! 367: registre_instruction_courante;
! 368: (*s_etat_processus).position_courante =
! 369: position_courante;
! 370: }
! 371: else
! 372: {
! 373: liberation(s_etat_processus, s_objet_argument_1);
! 374: liberation(s_etat_processus, s_objet_argument_2);
! 375: liberation(s_etat_processus, s_objet_argument_3);
! 376: liberation(s_etat_processus, s_objet_argument_4);
! 377:
! 378: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 379: return;
! 380: }
! 381: }
! 382: else
! 383: {
! 384: liberation(s_etat_processus, s_objet_argument_1);
! 385: liberation(s_etat_processus, s_objet_argument_2);
! 386: liberation(s_etat_processus, s_objet_argument_3);
! 387: liberation(s_etat_processus, s_objet_argument_4);
! 388:
! 389: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 390: return;
! 391: }
! 392:
! 393: liberation(s_etat_processus, s_objet_argument_1);
! 394: liberation(s_etat_processus, s_objet_argument_2);
! 395: liberation(s_etat_processus, s_objet_argument_3);
! 396:
! 397: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 398: s_objet_argument_4) == d_erreur)
! 399: {
! 400: return;
! 401: }
! 402:
! 403: return;
! 404: }
! 405:
! 406:
! 407: /*
! 408: ================================================================================
! 409: Fonction 'exget'
! 410: ================================================================================
! 411: Entrées :
! 412: --------------------------------------------------------------------------------
! 413: Sorties :
! 414: --------------------------------------------------------------------------------
! 415: Effets de bord : néant
! 416: ================================================================================
! 417: */
! 418:
! 419: void
! 420: instruction_exget(struct_processus *s_etat_processus)
! 421: {
! 422: struct_liste_chainee *l_element_courant;
! 423: struct_liste_chainee *l_element_suivant;
! 424:
! 425: struct_objet *s_copie_argument_3;
! 426: struct_objet *s_objet_argument_1;
! 427: struct_objet *s_objet_argument_2;
! 428: struct_objet *s_objet_argument_3;
! 429:
! 430: signed long position;
! 431:
! 432: (*s_etat_processus).erreur_execution = d_ex;
! 433:
! 434: if ((*s_etat_processus).affichage_arguments == 'Y')
! 435: {
! 436: printf("\n EXGET ");
! 437:
! 438: if ((*s_etat_processus).langue == 'F')
! 439: {
! 440: printf("(extraction d'une expression)\n\n");
! 441: }
! 442: else
! 443: {
! 444: printf("(get expression)\n\n");
! 445: }
! 446:
! 447: printf(" 3: %s\n", d_RPN);
! 448: printf(" 2: %s\n", d_INT);
! 449: printf(" 1: %s\n", d_INT);
! 450: printf("-> 1: %s\n", d_LST);
! 451:
! 452: return;
! 453: }
! 454: else if ((*s_etat_processus).test_instruction == 'Y')
! 455: {
! 456: (*s_etat_processus).nombre_arguments = 3;
! 457: return;
! 458: }
! 459:
! 460: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 461: {
! 462: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
! 463: {
! 464: return;
! 465: }
! 466: }
! 467:
! 468: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 469: &s_objet_argument_1) == d_erreur)
! 470: {
! 471: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 472: return;
! 473: }
! 474:
! 475: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 476: &s_objet_argument_2) == d_erreur)
! 477: {
! 478: liberation(s_etat_processus, s_objet_argument_1);
! 479:
! 480: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 481: return;
! 482: }
! 483:
! 484: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 485: &s_objet_argument_3) == d_erreur)
! 486: {
! 487: liberation(s_etat_processus, s_objet_argument_1);
! 488: liberation(s_etat_processus, s_objet_argument_2);
! 489:
! 490: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 491: return;
! 492: }
! 493:
! 494: if (((*s_objet_argument_1).type == INT) &&
! 495: ((*s_objet_argument_2).type == INT) &&
! 496: ((*s_objet_argument_3).type == RPN))
! 497: {
! 498: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
! 499: s_objet_argument_3, 'N')) == NULL)
! 500: {
! 501: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 502: return;
! 503: }
! 504:
! 505: liberation(s_etat_processus, s_objet_argument_3);
! 506: s_objet_argument_3 = s_copie_argument_3;
! 507:
! 508: if ((*((integer8 *) (*s_objet_argument_2).objet)) <= 0)
! 509: {
! 510: liberation(s_etat_processus, s_objet_argument_1);
! 511: liberation(s_etat_processus, s_objet_argument_2);
! 512: liberation(s_etat_processus, s_objet_argument_3);
! 513:
! 514: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 515: return;
! 516: }
! 517:
! 518: if ((*((integer8 *) (*s_objet_argument_2).objet)) >
! 519: (*((integer8 *) (*s_objet_argument_1).objet)))
! 520: {
! 521: liberation(s_etat_processus, s_objet_argument_1);
! 522: liberation(s_etat_processus, s_objet_argument_2);
! 523: liberation(s_etat_processus, s_objet_argument_3);
! 524:
! 525: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 526: return;
! 527: }
! 528:
! 529: (*s_objet_argument_3).type = LST;
! 530: l_element_courant = (*s_objet_argument_3).objet;
! 531: position = 1;
! 532:
! 533: while(l_element_courant != NULL)
! 534: {
! 535: if (position == (*((integer8 *) (*s_objet_argument_2).objet)))
! 536: {
! 537: (*s_objet_argument_3).objet = l_element_courant;
! 538: break;
! 539: }
! 540:
! 541: l_element_suivant = (*l_element_courant).suivant;
! 542: liberation(s_etat_processus, (*l_element_courant).donnee);
! 543: free(l_element_courant);
! 544: l_element_courant = l_element_suivant;
! 545:
! 546: position++;
! 547: }
! 548:
! 549: if (position != (*((integer8 *) (*s_objet_argument_2).objet)))
! 550: {
! 551: liberation(s_etat_processus, s_objet_argument_1);
! 552: liberation(s_etat_processus, s_objet_argument_2);
! 553: liberation(s_etat_processus, s_objet_argument_3);
! 554:
! 555: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 556: return;
! 557: }
! 558:
! 559: while(l_element_courant != NULL)
! 560: {
! 561: l_element_suivant = (*l_element_courant).suivant;
! 562:
! 563: if (position == (*((integer8 *) (*s_objet_argument_1).objet)))
! 564: {
! 565: (*l_element_courant).suivant = NULL;
! 566: l_element_courant = l_element_suivant;
! 567:
! 568: while(l_element_courant != NULL)
! 569: {
! 570: l_element_suivant = (*l_element_courant).suivant;
! 571: liberation(s_etat_processus, (*l_element_courant).donnee);
! 572: free(l_element_courant);
! 573: l_element_courant = l_element_suivant;
! 574: }
! 575:
! 576: break;
! 577: }
! 578:
! 579: l_element_courant = l_element_suivant;
! 580: position++;
! 581: }
! 582:
! 583: if (position != (*((integer8 *) (*s_objet_argument_1).objet)))
! 584: {
! 585: liberation(s_etat_processus, s_objet_argument_1);
! 586: liberation(s_etat_processus, s_objet_argument_2);
! 587: liberation(s_etat_processus, s_objet_argument_3);
! 588:
! 589: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 590: return;
! 591: }
! 592:
! 593: /*
! 594: * Vérification de la cohérence de l'expression. Nous ne devons avoir
! 595: * ni '<<' ni '>>.
! 596: */
! 597:
! 598: l_element_courant = (*s_objet_argument_3).objet;
! 599:
! 600: while(l_element_courant != NULL)
! 601: {
! 602: if ((*(*l_element_courant).donnee).type == FCT)
! 603: {
! 604: if ((strcmp((*((struct_fonction *) (*(*l_element_courant)
! 605: .donnee).objet)).nom_fonction, "<<") == 0) ||
! 606: (strcmp((*((struct_fonction *) (*(*l_element_courant)
! 607: .donnee).objet)).nom_fonction, ">>") == 0))
! 608: {
! 609: liberation(s_etat_processus, s_objet_argument_1);
! 610: liberation(s_etat_processus, s_objet_argument_2);
! 611: liberation(s_etat_processus, s_objet_argument_3);
! 612:
! 613: (*s_etat_processus).erreur_execution =
! 614: d_ex_argument_invalide;
! 615: return;
! 616: }
! 617: }
! 618:
! 619: l_element_courant = (*l_element_courant).suivant;
! 620: }
! 621: }
! 622: else
! 623: {
! 624: liberation(s_etat_processus, s_objet_argument_1);
! 625: liberation(s_etat_processus, s_objet_argument_2);
! 626: liberation(s_etat_processus, s_objet_argument_3);
! 627:
! 628: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 629: return;
! 630: }
! 631:
! 632: liberation(s_etat_processus, s_objet_argument_1);
! 633: liberation(s_etat_processus, s_objet_argument_2);
! 634:
! 635: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 636: s_objet_argument_3) == d_erreur)
! 637: {
! 638: return;
! 639: }
! 640:
! 641: return;
! 642: }
! 643:
! 644: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_e4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src