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