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