Annotation of rpl/src/sequenceur.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: Boucle principale de l'interpréteur RPL/2
! 29: ================================================================================
! 30: Entrées : structure sur l'état du processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties : Néant
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: logical1
! 39: sequenceur(struct_processus *s_etat_processus)
! 40: {
! 41: struct_liste_chainee *l_element_courant;
! 42:
! 43: struct_objet *s_objet;
! 44: struct_objet *s_sous_objet;
! 45:
! 46: logical1 drapeau_appel_definition;
! 47: logical1 drapeau_fin;
! 48: logical1 drapeau_then;
! 49: logical1 erreur;
! 50:
! 51: static logical1 completion_valide = d_faux;
! 52:
! 53: struct sigaction action;
! 54: struct sigaction action_defaut;
! 55: struct sigaction action_defaut2;
! 56:
! 57: unsigned char *instruction_majuscule;
! 58: unsigned char *ligne;
! 59: unsigned char *message;
! 60: unsigned char *registre;
! 61: unsigned char *tampon;
! 62: unsigned char tampon_retour;
! 63: unsigned char *t_ligne;
! 64:
! 65: unsigned long i;
! 66: unsigned long j;
! 67: unsigned long niveau;
! 68: unsigned long position_courante;
! 69:
! 70: (*s_etat_processus).retour_routine_evaluation = 'N';
! 71:
! 72: if ((*s_etat_processus).debug == d_vrai)
! 73: if (((*s_etat_processus).type_debug &
! 74: d_debug_appels_fonctions) != 0)
! 75: {
! 76: if ((*s_etat_processus).niveau_recursivite != 0)
! 77: {
! 78: if ((*s_etat_processus).langue == 'F')
! 79: {
! 80: printf("[%d] Exécution récursive de niveau %lu\n",
! 81: (int) getpid(), (*s_etat_processus).niveau_recursivite);
! 82: }
! 83: else
! 84: {
! 85: printf("[%d] %lu level recursive execution\n",
! 86: (int) getpid(), (*s_etat_processus).niveau_recursivite);
! 87: }
! 88: }
! 89: else
! 90: {
! 91: if ((*s_etat_processus).langue == 'F')
! 92: {
! 93: printf("[%d] Exécution\n", (int) getpid());
! 94: }
! 95: else
! 96: {
! 97: printf("[%d] Execution\n", (int) getpid());
! 98: }
! 99: }
! 100:
! 101: fflush(stdout);
! 102: }
! 103:
! 104: /*
! 105: --------------------------------------------------------------------------------
! 106: Boucle de l'interpréteur RPL/2
! 107: On boucle tant qu'on n'a pas une bonne raison de sortir...
! 108: --------------------------------------------------------------------------------
! 109: */
! 110:
! 111: i = 0;
! 112: j = 0;
! 113:
! 114: do
! 115: {
! 116: drapeau_appel_definition = d_faux;
! 117:
! 118: /*
! 119: --------------------------------------------------------------------------------
! 120: Recherche de l'instruction suivante dans les définitions chaînées
! 121: --------------------------------------------------------------------------------
! 122: */
! 123:
! 124: if ((erreur = recherche_instruction_suivante(s_etat_processus))
! 125: == d_erreur)
! 126: {
! 127: return(d_erreur);
! 128: }
! 129:
! 130: if (((*s_etat_processus).debug_programme == d_vrai) &&
! 131: ((*s_etat_processus).niveau_recursivite == 0))
! 132: {
! 133: /*
! 134: * Traitement de la commande HALT (debug)
! 135: */
! 136:
! 137: action.sa_handler = SIG_IGN;
! 138: action.sa_flags = SA_NODEFER | SA_ONSTACK;
! 139:
! 140: (*s_etat_processus).execution_pas_suivant = d_faux;
! 141: (*s_etat_processus).traitement_instruction_halt = d_vrai;
! 142:
! 143: if (completion_valide == d_faux)
! 144: {
! 145: initialisation_completion();
! 146: completion_valide = d_vrai;
! 147: }
! 148:
! 149: while((*s_etat_processus).execution_pas_suivant == d_faux)
! 150: {
! 151: if ((*s_etat_processus).hauteur_pile_operationnelle != 0)
! 152: {
! 153: fprintf(stdout, "\n");
! 154: }
! 155:
! 156: affichage_pile(s_etat_processus, (*s_etat_processus)
! 157: .l_base_pile, 1);
! 158:
! 159: if ((*s_etat_processus).mode_interactif == 'N')
! 160: {
! 161: printf("[%d] Instruction : %s\n", (int) getpid(),
! 162: (*s_etat_processus).instruction_courante);
! 163: fflush(stdout);
! 164: }
! 165:
! 166: if (sigaction(SIGINT, &action, &action_defaut) != 0)
! 167: {
! 168: (*s_etat_processus).erreur_systeme = d_es_signal;
! 169: return(d_erreur);
! 170: }
! 171:
! 172: if (sigaction(SIGTSTP, &action, &action_defaut2) != 0)
! 173: {
! 174: (*s_etat_processus).erreur_systeme = d_es_signal;
! 175: return(d_erreur);
! 176: }
! 177:
! 178: (*s_etat_processus).var_volatile_requete_arret = 0;
! 179: (*s_etat_processus).var_volatile_requete_arret2 = 0;
! 180:
! 181: flockfile(stdin);
! 182: flockfile(stdout);
! 183:
! 184: ligne = readline("RPL/2> ");
! 185:
! 186: funlockfile(stdin);
! 187: funlockfile(stdout);
! 188:
! 189: if ((*s_etat_processus).var_volatile_requete_arret != 0)
! 190: {
! 191: (*s_etat_processus).requete_arret = 'Y';
! 192: break;
! 193: }
! 194:
! 195: if (ligne != NULL)
! 196: {
! 197: if ((t_ligne = transliteration(s_etat_processus, ligne,
! 198: (*s_etat_processus).localisation, d_locale))
! 199: == NULL)
! 200: {
! 201: return(d_erreur);
! 202: }
! 203:
! 204: free(ligne);
! 205: ligne = t_ligne;
! 206:
! 207: if ((ligne = compactage(ligne)) == NULL)
! 208: {
! 209: (*s_etat_processus).erreur_systeme =
! 210: d_es_allocation_memoire;
! 211: return(d_erreur);
! 212: }
! 213: }
! 214:
! 215: if (sigaction(SIGINT, &action_defaut, NULL) != 0)
! 216: {
! 217: (*s_etat_processus).erreur_systeme = d_es_signal;
! 218: return(d_erreur);
! 219: }
! 220:
! 221: if (sigaction(SIGTSTP, &action_defaut2, NULL) != 0)
! 222: {
! 223: (*s_etat_processus).erreur_systeme = d_es_signal;
! 224: return(d_erreur);
! 225: }
! 226:
! 227: if (ligne == NULL)
! 228: {
! 229: if ((ligne = (unsigned char *) malloc(6 *
! 230: sizeof(unsigned char))) == NULL)
! 231: {
! 232: (*s_etat_processus).erreur_systeme =
! 233: d_es_allocation_memoire;
! 234: return(d_erreur);
! 235: }
! 236:
! 237: sprintf(ligne, "abort");
! 238: fprintf(stdout, "%s\n", ligne);
! 239: }
! 240: else if (((*ligne) == d_code_fin_chaine) &&
! 241: ((*s_etat_processus).l_base_pile != NULL))
! 242: {
! 243: free(ligne);
! 244:
! 245: if ((ligne = (unsigned char *) malloc(4 *
! 246: sizeof(unsigned char))) == NULL)
! 247: {
! 248: (*s_etat_processus).erreur_systeme =
! 249: d_es_allocation_memoire;
! 250: return(d_erreur);
! 251: }
! 252:
! 253: sprintf(ligne, "dup");
! 254: }
! 255:
! 256: add_history(ligne);
! 257: stifle_history(ds_longueur_historique);
! 258:
! 259: position_courante = (*s_etat_processus).position_courante;
! 260: tampon = (*s_etat_processus).definitions_chainees;
! 261: registre = (*s_etat_processus).instruction_courante;
! 262: (*s_etat_processus).definitions_chainees = ligne;
! 263:
! 264: if (analyse_syntaxique(s_etat_processus) == d_absence_erreur)
! 265: {
! 266: (*s_etat_processus).instruction_courante = registre;
! 267: (*s_etat_processus).position_courante = position_courante;
! 268: (*s_etat_processus).definitions_chainees = tampon;
! 269:
! 270: if ((tampon = (unsigned char *) malloc((strlen(ligne) + 7) *
! 271: sizeof(unsigned char))) == NULL)
! 272: {
! 273: (*s_etat_processus).erreur_systeme =
! 274: d_es_allocation_memoire;
! 275: return(d_erreur);
! 276: }
! 277:
! 278: sprintf(tampon, "<< %s >>", ligne);
! 279:
! 280: free(ligne);
! 281: ligne = tampon;
! 282:
! 283: tampon = (*s_etat_processus).instruction_courante;
! 284: (*s_etat_processus).instruction_courante = ligne;
! 285: recherche_type(s_etat_processus);
! 286:
! 287: if ((((*s_etat_processus).erreur_execution != d_ex) ||
! 288: ((*s_etat_processus).erreur_systeme != d_es)) &&
! 289: ((*s_etat_processus).invalidation_message_erreur
! 290: == d_faux))
! 291: {
! 292: if ((*s_etat_processus).erreur_execution != d_ex)
! 293: {
! 294: (*s_etat_processus).erreur_scrutation = d_vrai;
! 295: }
! 296:
! 297: if (test_cfsf(s_etat_processus, 51) == d_faux)
! 298: {
! 299: printf("%s", ds_beep);
! 300: }
! 301:
! 302: if ((message = messages(s_etat_processus)) == NULL)
! 303: {
! 304: return(d_erreur);
! 305: }
! 306:
! 307: printf("%s [%d]\n", message, (int) getpid());
! 308:
! 309: free(message);
! 310:
! 311: (*s_etat_processus).erreur_execution = d_ex;
! 312:
! 313: if ((*s_etat_processus).erreur_systeme != d_es)
! 314: {
! 315: return(d_erreur);
! 316: }
! 317: }
! 318: else
! 319: {
! 320: tampon_retour = (*(*s_etat_processus)
! 321: .l_base_pile_systeme).retour_definition;
! 322: (*(*s_etat_processus).l_base_pile_systeme)
! 323: .retour_definition = 'Y';
! 324:
! 325: if (depilement(s_etat_processus, &((*s_etat_processus)
! 326: .l_base_pile), &s_objet) == d_erreur)
! 327: {
! 328: if (test_cfsf(s_etat_processus, 51) == d_faux)
! 329: {
! 330: printf("%s", ds_beep);
! 331: }
! 332:
! 333: if ((*s_etat_processus).langue == 'F')
! 334: {
! 335: printf("+++Erreur : Défaut d'argument\n");
! 336: }
! 337: else
! 338: {
! 339: printf("+++Error : Too few arguments\n");
! 340: }
! 341:
! 342: (*(*s_etat_processus).l_base_pile_systeme)
! 343: .retour_definition = tampon_retour;
! 344:
! 345: fflush(stdout);
! 346: }
! 347: else if (evaluation(s_etat_processus, s_objet, 'I') ==
! 348: d_erreur)
! 349: {
! 350: (*(*s_etat_processus).l_base_pile_systeme)
! 351: .retour_definition = tampon_retour;
! 352:
! 353: if ((*s_etat_processus).erreur_systeme != d_es)
! 354: {
! 355: if (test_cfsf(s_etat_processus, 51) == d_faux)
! 356: {
! 357: printf("%s", ds_beep);
! 358: }
! 359:
! 360: if ((message = messages(s_etat_processus))
! 361: == NULL)
! 362: {
! 363: return(d_erreur);
! 364: }
! 365:
! 366: printf("%s [%d]\n", message, (int) getpid());
! 367: free(message);
! 368:
! 369: return(d_erreur);
! 370: }
! 371: else if ((*s_etat_processus)
! 372: .invalidation_message_erreur == d_faux)
! 373: {
! 374: (*s_etat_processus).erreur_execution =
! 375: (*s_etat_processus)
! 376: .derniere_erreur_evaluation;
! 377:
! 378: if (test_cfsf(s_etat_processus, 51) == d_faux)
! 379: {
! 380: printf("%s", ds_beep);
! 381: }
! 382:
! 383: if ((message = messages(s_etat_processus))
! 384: == NULL)
! 385: {
! 386: return(d_erreur);
! 387: }
! 388:
! 389: printf("%s [%d]\n", message, (int) getpid());
! 390: free(message);
! 391:
! 392: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 393: {
! 394: l_element_courant = (*s_etat_processus)
! 395: .l_base_pile_last;
! 396:
! 397: while(l_element_courant != NULL)
! 398: {
! 399: if ((s_sous_objet = copie_objet(
! 400: s_etat_processus,
! 401: (*l_element_courant).donnee,
! 402: 'P')) == NULL)
! 403: {
! 404: (*s_etat_processus).erreur_systeme =
! 405: d_es_allocation_memoire;
! 406: return(d_erreur);
! 407: }
! 408:
! 409: if (empilement(s_etat_processus,
! 410: &((*s_etat_processus)
! 411: .l_base_pile),
! 412: s_sous_objet) == d_erreur)
! 413: {
! 414: return(d_erreur);
! 415: }
! 416:
! 417: l_element_courant = (*l_element_courant)
! 418: .suivant;
! 419: }
! 420: }
! 421:
! 422: (*s_etat_processus).erreur_execution = d_ex;
! 423: (*s_etat_processus).exception = d_ep;
! 424: }
! 425:
! 426: liberation(s_etat_processus, s_objet);
! 427: }
! 428: else
! 429: {
! 430: liberation(s_etat_processus, s_objet);
! 431: }
! 432:
! 433: (*(*s_etat_processus).l_base_pile_systeme)
! 434: .retour_definition = tampon_retour;
! 435: }
! 436:
! 437: (*s_etat_processus).instruction_courante = tampon;
! 438: }
! 439: else if ((*s_etat_processus).invalidation_message_erreur
! 440: == d_faux)
! 441: {
! 442: (*s_etat_processus).instruction_courante = registre;
! 443: (*s_etat_processus).position_courante = position_courante;
! 444: (*s_etat_processus).definitions_chainees = tampon;
! 445:
! 446: if (test_cfsf(s_etat_processus, 51) == d_faux)
! 447: {
! 448: printf("%s", ds_beep);
! 449: }
! 450:
! 451: if ((message = messages(s_etat_processus)) == NULL)
! 452: {
! 453: free(ligne);
! 454: return(d_erreur);
! 455: }
! 456:
! 457: free(message);
! 458:
! 459: if ((*s_etat_processus).langue == 'F')
! 460: {
! 461: printf("+++Erreur : Erreur de syntaxe\n");
! 462: }
! 463: else
! 464: {
! 465: printf("+++Error : Syntax error\n");
! 466: }
! 467:
! 468: fflush(stdout);
! 469: }
! 470:
! 471: free(ligne);
! 472: }
! 473:
! 474: (*s_etat_processus).traitement_instruction_halt = d_faux;
! 475: }
! 476:
! 477: if ((*s_etat_processus).debug == d_vrai)
! 478: if (((*s_etat_processus).type_debug &
! 479: d_debug_fonctions_intrinseques) != 0)
! 480: {
! 481: if ((*s_etat_processus).langue == 'F')
! 482: {
! 483: printf("[%d] Instruction %s\n",
! 484: (int) getpid(),
! 485: (*s_etat_processus).instruction_courante);
! 486: }
! 487: else
! 488: {
! 489: printf("[%d] %s instruction\n",
! 490: (int) getpid(),
! 491: (*s_etat_processus).instruction_courante);
! 492: }
! 493:
! 494: fflush(stdout);
! 495: }
! 496:
! 497: /*
! 498: --------------------------------------------------------------------------------
! 499: Dans le cas où une instruction est retournée, celle-ci est évaluée. Dans le
! 500: cas contraire, l'interpréteur renvoie un message d'erreur et s'interrompt.
! 501: --------------------------------------------------------------------------------
! 502: */
! 503:
! 504: if (erreur == d_absence_erreur)
! 505: {
! 506:
! 507: /*
! 508: --------------------------------------------------------------------------------
! 509: Scrutation des mots clef du langage RPL/2 et exécution le cas échéant
! 510: de l'action associée.
! 511: --------------------------------------------------------------------------------
! 512: */
! 513:
! 514: analyse(s_etat_processus, NULL);
! 515:
! 516: if ((*s_etat_processus).traitement_cycle_exit != 'N')
! 517: {
! 518: switch((*s_etat_processus).traitement_cycle_exit)
! 519: {
! 520: case 'C' :
! 521: {
! 522: instruction_cycle(s_etat_processus);
! 523: break;
! 524: }
! 525:
! 526: case 'E' :
! 527: {
! 528: instruction_exit(s_etat_processus);
! 529: break;
! 530: }
! 531: }
! 532: }
! 533:
! 534: if ((*s_etat_processus).instruction_valide == 'N')
! 535: {
! 536:
! 537: /*
! 538: --------------------------------------------------------------------------------
! 539: L'instruction ne correspond pas à l'un des mots clef du langage RPL/2.
! 540: --------------------------------------------------------------------------------
! 541: */
! 542:
! 543: if ((recherche_variable(s_etat_processus,
! 544: (*s_etat_processus).instruction_courante) ==
! 545: d_vrai) && ((*s_etat_processus)
! 546: .autorisation_evaluation_nom == 'Y'))
! 547: {
! 548: if (((*s_etat_processus).s_liste_variables
! 549: [(*s_etat_processus)
! 550: .position_variable_courante]).objet == NULL)
! 551: {
! 552:
! 553: /*
! 554: --------------------------------------------------------------------------------
! 555: L'instruction est une variable partagée
! 556: --------------------------------------------------------------------------------
! 557: */
! 558:
! 559: if ((*s_etat_processus).debug == d_vrai)
! 560: if (((*s_etat_processus).type_debug &
! 561: d_debug_variables) != 0)
! 562: {
! 563: if ((*s_etat_processus).langue == 'F')
! 564: {
! 565: printf("[%d] Empilement de la variable "
! 566: "partagée %s de type %d\n",
! 567: (int) getpid(),
! 568: (*s_etat_processus)
! 569: .instruction_courante,
! 570: (*((*s_etat_processus).s_liste_variables
! 571: [(*s_etat_processus)
! 572: .position_variable_courante]).objet)
! 573: .type);
! 574: }
! 575: else
! 576: {
! 577: printf("[%d] Pushing %s as %d type shared "
! 578: "variable \n", (int) getpid(),
! 579: (*s_etat_processus)
! 580: .instruction_courante,
! 581: (*((*s_etat_processus).s_liste_variables
! 582: [(*s_etat_processus)
! 583: .position_variable_courante]).objet)
! 584: .type);
! 585: }
! 586:
! 587: fflush(stdout);
! 588: }
! 589:
! 590: if (pthread_mutex_lock(&((*(*s_etat_processus)
! 591: .s_liste_variables_partagees).mutex)) != 0)
! 592: {
! 593: (*s_etat_processus).erreur_systeme =
! 594: d_es_processus;
! 595: return(d_erreur);
! 596: }
! 597:
! 598: if (recherche_variable_partagee(s_etat_processus,
! 599: ((*s_etat_processus).s_liste_variables
! 600: [(*s_etat_processus)
! 601: .position_variable_courante]).nom,
! 602: ((*s_etat_processus).s_liste_variables
! 603: [(*s_etat_processus)
! 604: .position_variable_courante])
! 605: .variable_partagee, 'P') == d_vrai)
! 606: {
! 607: // La variable existe.
! 608:
! 609: if ((s_objet = copie_objet(s_etat_processus,
! 610: (*(*s_etat_processus)
! 611: .s_liste_variables_partagees)
! 612: .table[(*(*s_etat_processus)
! 613: .s_liste_variables_partagees)
! 614: .position_variable].objet, 'P'))
! 615: == NULL)
! 616: {
! 617: (*s_etat_processus).erreur_systeme =
! 618: d_es_allocation_memoire;
! 619: return(d_erreur);
! 620: }
! 621:
! 622: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 623: .s_liste_variables_partagees).mutex))
! 624: != 0)
! 625: {
! 626: (*s_etat_processus).erreur_systeme =
! 627: d_es_processus;
! 628: return(d_erreur);
! 629: }
! 630:
! 631: if (empilement(s_etat_processus,
! 632: &((*s_etat_processus).l_base_pile),
! 633: s_objet) == d_erreur)
! 634: {
! 635: (*s_etat_processus).erreur_systeme =
! 636: d_es_allocation_memoire;
! 637: return(d_erreur);
! 638: }
! 639: }
! 640: else
! 641: {
! 642: // La variable n'existe plus.
! 643:
! 644: (*s_etat_processus).erreur_systeme = d_es;
! 645:
! 646: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 647: .s_liste_variables_partagees).mutex))
! 648: != 0)
! 649: {
! 650: (*s_etat_processus).erreur_systeme =
! 651: d_es_processus;
! 652: return(d_erreur);
! 653: }
! 654:
! 655: recherche_type(s_etat_processus);
! 656: }
! 657: }
! 658:
! 659: /*
! 660: --------------------------------------------------------------------------------
! 661: L'instruction est une variable automatique (évaluation lors de l'empilement).
! 662: --------------------------------------------------------------------------------
! 663: */
! 664:
! 665: else if ((*((*s_etat_processus).s_liste_variables
! 666: [(*s_etat_processus).position_variable_courante])
! 667: .objet).type == ADR)
! 668: {
! 669:
! 670: /*
! 671: --------------------------------------------------------------------------------
! 672: L'instruction est une variable de type 'adresse' pointant sur une
! 673: définition. Un branchement est effectué à cette adresse.
! 674: --------------------------------------------------------------------------------
! 675: */
! 676:
! 677: if ((*s_etat_processus).debug == d_vrai)
! 678: if (((*s_etat_processus).type_debug &
! 679: d_debug_appels_fonctions) != 0)
! 680: {
! 681: if ((*s_etat_processus).langue == 'F')
! 682: {
! 683: printf("[%d] Branchement à la"
! 684: " définition %s\n", (int) getpid(),
! 685: (*s_etat_processus)
! 686: .instruction_courante);
! 687: }
! 688: else
! 689: {
! 690: printf("[%d] Execution : "
! 691: "Branching at %s definition\n",
! 692: (int) getpid(), (*s_etat_processus)
! 693: .instruction_courante);
! 694: }
! 695:
! 696: fflush(stdout);
! 697: }
! 698:
! 699: (*s_etat_processus).autorisation_empilement_programme =
! 700: 'N';
! 701:
! 702: empilement_pile_systeme(s_etat_processus);
! 703:
! 704: if ((*s_etat_processus).erreur_systeme != d_es)
! 705: {
! 706: erreur = d_erreur;
! 707: }
! 708: else
! 709: {
! 710: if ((*s_etat_processus).profilage == d_vrai)
! 711: {
! 712: profilage(s_etat_processus,
! 713: (*s_etat_processus)
! 714: .instruction_courante);
! 715:
! 716: if ((*s_etat_processus).erreur_systeme != d_es)
! 717: {
! 718: return(d_erreur);
! 719: }
! 720: }
! 721:
! 722: (*(*s_etat_processus).l_base_pile_systeme)
! 723: .adresse_retour = (*s_etat_processus)
! 724: .position_courante;
! 725:
! 726: (*(*s_etat_processus).l_base_pile_systeme)
! 727: .retour_definition = 'Y';
! 728:
! 729: (*(*s_etat_processus).l_base_pile_systeme)
! 730: .niveau_courant = (*s_etat_processus)
! 731: .niveau_courant;
! 732:
! 733: (*s_etat_processus).position_courante =
! 734: (*((unsigned long *)
! 735: ((*((*s_etat_processus).s_liste_variables
! 736: [(*s_etat_processus)
! 737: .position_variable_courante]
! 738: .objet)).objet)));
! 739:
! 740: drapeau_appel_definition = d_vrai;
! 741: }
! 742: }
! 743: else
! 744: {
! 745: if ((*s_etat_processus).debug == d_vrai)
! 746: if (((*s_etat_processus).type_debug &
! 747: d_debug_variables) != 0)
! 748: {
! 749: if ((*s_etat_processus).langue == 'F')
! 750: {
! 751: printf("[%d] Empilement de la variable "
! 752: "%s de type %d\n",
! 753: (int) getpid(),
! 754: (*s_etat_processus)
! 755: .instruction_courante,
! 756: (*((*s_etat_processus).s_liste_variables
! 757: [(*s_etat_processus)
! 758: .position_variable_courante]).objet)
! 759: .type);
! 760: }
! 761: else
! 762: {
! 763: printf("[%d] Pushing %s as %d type variable "
! 764: "\n", (int) getpid(),
! 765: (*s_etat_processus)
! 766: .instruction_courante,
! 767: (*((*s_etat_processus).s_liste_variables
! 768: [(*s_etat_processus)
! 769: .position_variable_courante]).objet)
! 770: .type);
! 771: }
! 772:
! 773: fflush(stdout);
! 774: }
! 775:
! 776: if ((s_objet = copie_objet(s_etat_processus,
! 777: ((*s_etat_processus)
! 778: .s_liste_variables[(*s_etat_processus)
! 779: .position_variable_courante]).objet, 'P'))
! 780: == NULL)
! 781: {
! 782: (*s_etat_processus).erreur_systeme =
! 783: d_es_allocation_memoire;
! 784: return(d_erreur);
! 785: }
! 786:
! 787: if (empilement(s_etat_processus,
! 788: &((*s_etat_processus).l_base_pile),
! 789: s_objet) == d_erreur)
! 790: {
! 791: (*s_etat_processus).erreur_systeme =
! 792: d_es_allocation_memoire;
! 793: return(d_erreur);
! 794: }
! 795: }
! 796: }
! 797: else
! 798: {
! 799:
! 800: /*
! 801: --------------------------------------------------------------------------------
! 802: L'instruction est une donnée à empiler.
! 803: --------------------------------------------------------------------------------
! 804: */
! 805:
! 806: (*s_etat_processus).erreur_systeme = d_es;
! 807: recherche_type(s_etat_processus);
! 808: }
! 809: }
! 810: else if (((*s_etat_processus).test_instruction == 'Y') &&
! 811: ((*s_etat_processus).instruction_valide == 'Y'))
! 812: {
! 813:
! 814: /*
! 815: --------------------------------------------------------------------------------
! 816: Permet de traiter les fonctions dans les objets de type liste
! 817: --------------------------------------------------------------------------------
! 818: */
! 819:
! 820: if ((instruction_majuscule = conversion_majuscule(
! 821: (*s_etat_processus).instruction_courante)) == NULL)
! 822: {
! 823: (*s_etat_processus).erreur_systeme =
! 824: d_es_allocation_memoire;
! 825: return(d_erreur);
! 826: }
! 827:
! 828: if ((strcmp((*s_etat_processus).instruction_courante, "<<")
! 829: != 0) && (strcmp((*s_etat_processus)
! 830: .instruction_courante, ">>") != 0))
! 831: {
! 832: if ((s_objet = (struct_objet *) malloc(
! 833: sizeof(struct_objet))) == NULL)
! 834: {
! 835: (*s_etat_processus).erreur_systeme =
! 836: d_es_allocation_memoire;
! 837: return(d_erreur);
! 838: }
! 839:
! 840: initialisation_objet(s_objet);
! 841: (*s_objet).type = FCT;
! 842:
! 843: if (((*s_objet).objet = allocation(s_etat_processus, FCT))
! 844: == NULL)
! 845: {
! 846: (*s_etat_processus).erreur_systeme =
! 847: d_es_allocation_memoire;
! 848: return(d_erreur);
! 849: }
! 850:
! 851: (*((struct_fonction *) (*s_objet).objet))
! 852: .nombre_arguments = 0;
! 853:
! 854: if ((*s_etat_processus).instruction_intrinseque == 'Y')
! 855: {
! 856: if (((*((struct_fonction *) (*s_objet).objet))
! 857: .nom_fonction = conversion_majuscule(
! 858: (*s_etat_processus).instruction_courante))
! 859: == NULL)
! 860: {
! 861: (*s_etat_processus).erreur_systeme =
! 862: d_es_allocation_memoire;
! 863: return(d_erreur);
! 864: }
! 865: }
! 866: else
! 867: {
! 868: if (((*((struct_fonction *) (*s_objet).objet))
! 869: .nom_fonction = (unsigned char *) malloc(
! 870: (strlen((*s_etat_processus)
! 871: .instruction_courante)
! 872: + 1) * sizeof(unsigned char))) == NULL)
! 873: {
! 874: (*s_etat_processus).erreur_systeme =
! 875: d_es_allocation_memoire;
! 876: return(d_erreur);
! 877: }
! 878:
! 879: strcpy((*((struct_fonction *) (*s_objet).objet))
! 880: .nom_fonction, (*s_etat_processus)
! 881: .instruction_courante);
! 882: }
! 883:
! 884: (*((struct_fonction *) (*s_objet).objet)).fonction =
! 885: analyse_instruction(s_etat_processus,
! 886: (*s_etat_processus).instruction_courante);
! 887:
! 888: if (empilement(s_etat_processus,
! 889: &((*s_etat_processus).l_base_pile), s_objet) ==
! 890: d_erreur)
! 891: {
! 892: (*s_etat_processus).erreur_systeme =
! 893: d_es_allocation_memoire;
! 894: return(d_erreur);
! 895: }
! 896: }
! 897: else
! 898: {
! 899: (*s_etat_processus).test_instruction = 'N';
! 900: analyse(s_etat_processus, NULL);
! 901: (*s_etat_processus).test_instruction = 'Y';
! 902: }
! 903:
! 904: free(instruction_majuscule);
! 905: }
! 906:
! 907: erreur |= (((*s_etat_processus).erreur_execution != d_ex)
! 908: ? d_erreur : d_absence_erreur);
! 909: }
! 910: else
! 911: {
! 912: printf("\n");
! 913:
! 914: if ((*s_etat_processus).langue == 'F')
! 915: {
! 916: printf("+++Erreur : Argument %s invalide\n",
! 917: (*s_etat_processus).instruction_courante);
! 918: }
! 919: else
! 920: {
! 921: printf("+++Error : Invalid %s argument\n",
! 922: (*s_etat_processus).instruction_courante);
! 923: }
! 924:
! 925: fflush(stdout);
! 926:
! 927: return(d_erreur);
! 928: }
! 929:
! 930: /*
! 931: --------------------------------------------------------------------------------
! 932: Traitement des arrêts simples
! 933: --------------------------------------------------------------------------------
! 934: */
! 935:
! 936: if ((*s_etat_processus).var_volatile_requete_arret2 != 0)
! 937: {
! 938: if ((*s_etat_processus).debug_programme == d_vrai)
! 939: {
! 940: (*s_etat_processus).var_volatile_requete_arret2 = 0;
! 941: }
! 942: else
! 943: {
! 944: if ((*s_etat_processus).var_volatile_requete_arret2 == -1)
! 945: {
! 946: if (strncmp(getenv("LANG"), "fr", 2) == 0)
! 947: {
! 948: printf("[%d] Arrêt\n", (int) getpid());
! 949: }
! 950: else
! 951: {
! 952: printf("[%d] Break\n", (int) getpid());
! 953: }
! 954:
! 955: (*s_etat_processus).var_volatile_requete_arret2 = 1;
! 956:
! 957: fflush(stdout);
! 958: }
! 959:
! 960: if ((*s_etat_processus).niveau_recursivite == 0)
! 961: {
! 962: (*s_etat_processus).debug_programme = d_vrai;
! 963: (*s_etat_processus).var_volatile_requete_arret2 = 0;
! 964: }
! 965: }
! 966: }
! 967:
! 968: /*
! 969: * On ne sort pas du debugger en cas d'une erreur sur un programme
! 970: * en cours de débogage.
! 971: */
! 972:
! 973: if ((((*s_etat_processus).erreur_execution != d_ex) ||
! 974: ((*s_etat_processus).exception != d_ep)) &&
! 975: ((*s_etat_processus).debug_programme == d_vrai))
! 976: {
! 977: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 978: {
! 979: l_element_courant = (*s_etat_processus).l_base_pile_last;
! 980:
! 981: while(l_element_courant != NULL)
! 982: {
! 983: if ((s_objet = copie_objet(s_etat_processus,
! 984: (*l_element_courant).donnee, 'P')) == NULL)
! 985: {
! 986: (*s_etat_processus).erreur_systeme =
! 987: d_es_allocation_memoire;
! 988: return(d_erreur);
! 989: }
! 990:
! 991: if (empilement(s_etat_processus, &((*s_etat_processus)
! 992: .l_base_pile), s_objet) == d_erreur)
! 993: {
! 994: return(d_erreur);
! 995: }
! 996:
! 997: l_element_courant = (*l_element_courant).suivant;
! 998: }
! 999: }
! 1000:
! 1001: if (test_cfsf(s_etat_processus, 51) == d_faux)
! 1002: {
! 1003: printf("%s", ds_beep);
! 1004: }
! 1005:
! 1006: if ((message = messages(s_etat_processus)) == NULL)
! 1007: {
! 1008: return(d_erreur);
! 1009: }
! 1010:
! 1011: printf("%s [%d]\n", message, (int) getpid());
! 1012:
! 1013: free(message);
! 1014:
! 1015: (*s_etat_processus).erreur_execution = d_ex;
! 1016: (*s_etat_processus).exception = d_ep;
! 1017: erreur = d_absence_erreur;
! 1018:
! 1019: (*s_etat_processus).position_courante -=
! 1020: strlen((*s_etat_processus).instruction_courante);
! 1021: }
! 1022:
! 1023: /*
! 1024: --------------------------------------------------------------------------------
! 1025: Test de fin d'exécution du programme RPL/2
! 1026: --------------------------------------------------------------------------------
! 1027: */
! 1028:
! 1029: if (((*s_etat_processus).niveau_courant == 0) &&
! 1030: (drapeau_appel_definition != d_vrai))
! 1031: {
! 1032: drapeau_fin = d_vrai;
! 1033: }
! 1034: else if ((*s_etat_processus).requete_arret == 'Y')
! 1035: {
! 1036: drapeau_fin = d_vrai;
! 1037: }
! 1038: else if (((*s_etat_processus).var_volatile_requete_arret != 0)
! 1039: && ((*s_etat_processus).debug_programme == d_faux))
! 1040: {
! 1041: drapeau_fin = d_vrai;
! 1042:
! 1043: if ((*s_etat_processus).erreur_systeme == d_es)
! 1044: {
! 1045: erreur = d_absence_erreur;
! 1046: }
! 1047: }
! 1048: else if ((*s_etat_processus).arret_si_exception == d_vrai)
! 1049: {
! 1050: drapeau_fin = d_faux;
! 1051:
! 1052: if ((*s_etat_processus).exception != d_ep)
! 1053: {
! 1054: erreur = d_erreur;
! 1055: }
! 1056: else if ((*s_etat_processus).erreur_systeme != d_es)
! 1057: {
! 1058: erreur = d_erreur;
! 1059: }
! 1060: }
! 1061: else if ((*s_etat_processus).arret_si_exception == d_faux)
! 1062: {
! 1063: if ((message = messages(s_etat_processus)) == NULL)
! 1064: {
! 1065: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1066: return(d_erreur);
! 1067: }
! 1068:
! 1069: free(message);
! 1070:
! 1071: drapeau_fin = d_faux;
! 1072:
! 1073: /*
! 1074: --------------------------------------------------------------------------------
! 1075: Traitement des exceptions
! 1076: --------------------------------------------------------------------------------
! 1077: */
! 1078:
! 1079: if ((*s_etat_processus).erreur_systeme != d_es)
! 1080: {
! 1081: erreur = d_erreur;
! 1082: }
! 1083: else if (((*s_etat_processus).exception != d_ep) ||
! 1084: ((*s_etat_processus).erreur_execution != d_ex))
! 1085: {
! 1086: tampon = (*s_etat_processus).instruction_courante;
! 1087:
! 1088: while((*(*s_etat_processus).l_base_pile_systeme).clause != 'R')
! 1089: {
! 1090: erreur = recherche_instruction_suivante(s_etat_processus);
! 1091:
! 1092: if (erreur == d_erreur)
! 1093: {
! 1094: return(d_erreur);
! 1095: }
! 1096:
! 1097: if (recherche_variable(s_etat_processus,
! 1098: (*s_etat_processus).instruction_courante) == d_vrai)
! 1099: {
! 1100: if (((*s_etat_processus).s_liste_variables
! 1101: [(*s_etat_processus)
! 1102: .position_variable_courante]).objet == NULL)
! 1103: {
! 1104: // Variable partagée
! 1105: }
! 1106: else if ((*((*s_etat_processus).s_liste_variables
! 1107: [(*s_etat_processus)
! 1108: .position_variable_courante]).objet).type ==
! 1109: ADR)
! 1110: {
! 1111: empilement_pile_systeme(s_etat_processus);
! 1112:
! 1113: if ((*s_etat_processus).erreur_systeme != d_es)
! 1114: {
! 1115: return(d_erreur);
! 1116: }
! 1117:
! 1118: (*(*s_etat_processus).l_base_pile_systeme)
! 1119: .adresse_retour = (*s_etat_processus)
! 1120: .position_courante;
! 1121:
! 1122: (*(*s_etat_processus).l_base_pile_systeme)
! 1123: .retour_definition = 'Y';
! 1124:
! 1125: (*(*s_etat_processus).l_base_pile_systeme)
! 1126: .niveau_courant = (*s_etat_processus)
! 1127: .niveau_courant;
! 1128:
! 1129: (*s_etat_processus).position_courante =
! 1130: (*((unsigned long *)
! 1131: ((*((*s_etat_processus).s_liste_variables
! 1132: [(*s_etat_processus)
! 1133: .position_variable_courante]
! 1134: .objet)).objet)));
! 1135:
! 1136: (*s_etat_processus)
! 1137: .autorisation_empilement_programme = 'N';
! 1138: }
! 1139: }
! 1140: else
! 1141: {
! 1142: (*s_etat_processus).erreur_systeme = d_es;
! 1143: instruction_majuscule = conversion_majuscule(
! 1144: (*s_etat_processus).instruction_courante);
! 1145:
! 1146: if (instruction_majuscule == NULL)
! 1147: {
! 1148: return(d_erreur);
! 1149: }
! 1150:
! 1151: /*
! 1152: * Traitement de la pile système par les
! 1153: * différentes instructions.
! 1154: */
! 1155:
! 1156: if ((strcmp(instruction_majuscule, "IF") == 0) ||
! 1157: (strcmp(instruction_majuscule, "IFERR") == 0) ||
! 1158: (strcmp(instruction_majuscule, "DO") == 0) ||
! 1159: (strcmp(instruction_majuscule, "WHILE") == 0) ||
! 1160: (strcmp(instruction_majuscule, "FOR") == 0) ||
! 1161: (strcmp(instruction_majuscule, "START") == 0) ||
! 1162: (strcmp(instruction_majuscule, "SELECT") == 0)
! 1163: || (strcmp(instruction_majuscule, "CASE") == 0)
! 1164: || (strcmp(instruction_majuscule, "<<") == 0))
! 1165: {
! 1166: if (strcmp(instruction_majuscule, "<<") == 0)
! 1167: {
! 1168: analyse(s_etat_processus, NULL);
! 1169: }
! 1170: else
! 1171: {
! 1172: empilement_pile_systeme(s_etat_processus);
! 1173:
! 1174: if ((*s_etat_processus).erreur_systeme != d_es)
! 1175: {
! 1176: return(d_erreur);
! 1177: }
! 1178: }
! 1179: }
! 1180: else if ((strcmp(instruction_majuscule, "END") == 0) ||
! 1181: (strcmp(instruction_majuscule, "NEXT") == 0) ||
! 1182: (strcmp(instruction_majuscule, "STEP") == 0) ||
! 1183: (strcmp(instruction_majuscule, ">>") == 0))
! 1184: {
! 1185: if (strcmp(instruction_majuscule, ">>") == 0)
! 1186: {
! 1187: analyse(s_etat_processus, NULL);
! 1188:
! 1189: if ((*(*s_etat_processus).l_base_pile_systeme)
! 1190: .origine_routine_evaluation == 'Y')
! 1191: {
! 1192: free(instruction_majuscule);
! 1193: free((*s_etat_processus)
! 1194: .instruction_courante);
! 1195:
! 1196: (*s_etat_processus).instruction_courante =
! 1197: tampon;
! 1198:
! 1199: return(d_absence_erreur);
! 1200: }
! 1201: }
! 1202: else
! 1203: {
! 1204: depilement_pile_systeme(s_etat_processus);
! 1205:
! 1206: if ((*s_etat_processus).erreur_systeme != d_es)
! 1207: {
! 1208: return(d_erreur);
! 1209: }
! 1210: }
! 1211: }
! 1212:
! 1213: free(instruction_majuscule);
! 1214: }
! 1215:
! 1216: free((*s_etat_processus).instruction_courante);
! 1217: }
! 1218:
! 1219: drapeau_then = d_faux;
! 1220: niveau = 0;
! 1221:
! 1222: do
! 1223: {
! 1224: erreur = recherche_instruction_suivante(s_etat_processus);
! 1225:
! 1226: if (erreur == d_erreur)
! 1227: {
! 1228: return(d_erreur);
! 1229: }
! 1230:
! 1231: instruction_majuscule = conversion_majuscule(
! 1232: (*s_etat_processus).instruction_courante);
! 1233:
! 1234: if (instruction_majuscule == NULL)
! 1235: {
! 1236: return(d_erreur);
! 1237: }
! 1238:
! 1239: if ((strcmp(instruction_majuscule, "IF") == 0) ||
! 1240: (strcmp(instruction_majuscule, "IFERR") == 0) ||
! 1241: (strcmp(instruction_majuscule, "DO") == 0) ||
! 1242: (strcmp(instruction_majuscule, "WHILE") == 0) ||
! 1243: (strcmp(instruction_majuscule, "FOR") == 0) ||
! 1244: (strcmp(instruction_majuscule, "START") == 0) ||
! 1245: (strcmp(instruction_majuscule, "SELECT") == 0)
! 1246: || (strcmp(instruction_majuscule, "CASE") == 0)
! 1247: || (strcmp(instruction_majuscule, "<<") == 0))
! 1248: {
! 1249: niveau++;
! 1250: }
! 1251: else if ((strcmp(instruction_majuscule, "END") == 0) ||
! 1252: (strcmp(instruction_majuscule, "NEXT") == 0) ||
! 1253: (strcmp(instruction_majuscule, "STEP") == 0) ||
! 1254: (strcmp(instruction_majuscule, ">>") == 0))
! 1255: {
! 1256: niveau--;
! 1257: }
! 1258:
! 1259: drapeau_then = ((strcmp(instruction_majuscule, "THEN") == 0)
! 1260: && (niveau == 0)) ? d_vrai : d_faux;
! 1261:
! 1262: free(instruction_majuscule);
! 1263: free((*s_etat_processus).instruction_courante);
! 1264: } while(drapeau_then == d_faux);
! 1265:
! 1266: (*s_etat_processus).position_courante -= 5;
! 1267: (*s_etat_processus).instruction_courante = tampon;
! 1268: (*(*s_etat_processus).l_base_pile_systeme).clause = 'X';
! 1269:
! 1270: erreur = d_absence_erreur;
! 1271: (*s_etat_processus).exception = d_ep;
! 1272: (*s_etat_processus).erreur_execution = d_ex;
! 1273: }
! 1274: }
! 1275: else
! 1276: {
! 1277: drapeau_fin = d_faux;
! 1278: }
! 1279:
! 1280: if (erreur == d_absence_erreur)
! 1281: {
! 1282: free((*s_etat_processus).instruction_courante);
! 1283: }
! 1284: } while((erreur == d_absence_erreur) &&
! 1285: ((*s_etat_processus).position_courante <
! 1286: (*s_etat_processus).longueur_definitions_chainees) &&
! 1287: (drapeau_fin == d_faux) &&
! 1288: ((*s_etat_processus).retour_routine_evaluation == 'N'));
! 1289:
! 1290: /*
! 1291: --------------------------------------------------------------------------------
! 1292: Messages d'erreur à afficher le cas échéant
! 1293: --------------------------------------------------------------------------------
! 1294: */
! 1295:
! 1296: if ((erreur != d_absence_erreur) && ((*s_etat_processus)
! 1297: .invalidation_message_erreur == d_faux))
! 1298: {
! 1299: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1300: {
! 1301: l_element_courant = (*s_etat_processus).l_base_pile_last;
! 1302:
! 1303: while(l_element_courant != NULL)
! 1304: {
! 1305: if ((s_objet = copie_objet(s_etat_processus,
! 1306: (*l_element_courant).donnee, 'P')) == NULL)
! 1307: {
! 1308: (*s_etat_processus).erreur_systeme =
! 1309: d_es_allocation_memoire;
! 1310: return(d_erreur);
! 1311: }
! 1312:
! 1313: if (empilement(s_etat_processus, &((*s_etat_processus)
! 1314: .l_base_pile), s_objet) == d_erreur)
! 1315: {
! 1316: return(d_erreur);
! 1317: }
! 1318:
! 1319: l_element_courant = (*l_element_courant).suivant;
! 1320: }
! 1321: }
! 1322:
! 1323: if (test_cfsf(s_etat_processus, 51) == d_faux)
! 1324: {
! 1325: printf("%s", ds_beep);
! 1326: }
! 1327:
! 1328: if ((message = messages(s_etat_processus)) == NULL)
! 1329: {
! 1330: return(d_erreur);
! 1331: }
! 1332:
! 1333: printf("%s [%d]\n", message, (int) getpid());
! 1334:
! 1335: free(message);
! 1336: free((*s_etat_processus).instruction_courante);
! 1337:
! 1338: if ((*s_etat_processus).var_volatile_processus_pere == 0)
! 1339: {
! 1340: kill((*s_etat_processus).pid_processus_pere, SIGALRM);
! 1341: }
! 1342: else
! 1343: {
! 1344: (*s_etat_processus).var_volatile_alarme = -1;
! 1345: }
! 1346:
! 1347: return(d_erreur);
! 1348: }
! 1349:
! 1350: return(d_absence_erreur);
! 1351: }
! 1352:
! 1353: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>