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