![[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.14 ! bertrand 3: RPL/2 (R) version 4.0.15
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;
1.12 bertrand 853: ////////////////////////////////////////////////////////////////////////////////
1.4 bertrand 854: return(d_erreur);
855: }
856:
857: if (evaluation(s_etat_processus, s_objet_evaluation,
858: 'N') == d_erreur)
859: {
860: liberation(s_etat_processus, s_objet_evaluation);
861: return(d_erreur);
862: }
863:
864: liberation(s_etat_processus, s_objet_evaluation);
865: }
1.1 bertrand 866: }
867: }
868: else if (((*s_etat_processus).test_instruction == 'Y') &&
869: ((*s_etat_processus).instruction_valide == 'Y'))
870: {
871:
872: /*
873: --------------------------------------------------------------------------------
874: Permet de traiter les fonctions dans les objets de type liste
875: --------------------------------------------------------------------------------
876: */
877:
878: if ((instruction_majuscule = conversion_majuscule(
879: (*s_etat_processus).instruction_courante)) == NULL)
880: {
881: (*s_etat_processus).erreur_systeme =
882: d_es_allocation_memoire;
883: return(d_erreur);
884: }
885:
886: if ((strcmp((*s_etat_processus).instruction_courante, "<<")
887: != 0) && (strcmp((*s_etat_processus)
888: .instruction_courante, ">>") != 0))
889: {
1.12 bertrand 890: if ((s_objet = allocation(s_etat_processus, FCT)) == NULL)
1.1 bertrand 891: {
892: (*s_etat_processus).erreur_systeme =
893: d_es_allocation_memoire;
894: return(d_erreur);
895: }
896:
897: (*((struct_fonction *) (*s_objet).objet))
898: .nombre_arguments = 0;
899:
900: if ((*s_etat_processus).instruction_intrinseque == 'Y')
901: {
902: if (((*((struct_fonction *) (*s_objet).objet))
903: .nom_fonction = conversion_majuscule(
904: (*s_etat_processus).instruction_courante))
905: == NULL)
906: {
907: (*s_etat_processus).erreur_systeme =
908: d_es_allocation_memoire;
909: return(d_erreur);
910: }
911: }
912: else
913: {
914: if (((*((struct_fonction *) (*s_objet).objet))
915: .nom_fonction = (unsigned char *) malloc(
916: (strlen((*s_etat_processus)
917: .instruction_courante)
918: + 1) * sizeof(unsigned char))) == NULL)
919: {
920: (*s_etat_processus).erreur_systeme =
921: d_es_allocation_memoire;
922: return(d_erreur);
923: }
924:
925: strcpy((*((struct_fonction *) (*s_objet).objet))
926: .nom_fonction, (*s_etat_processus)
927: .instruction_courante);
928: }
929:
930: (*((struct_fonction *) (*s_objet).objet)).fonction =
931: analyse_instruction(s_etat_processus,
932: (*s_etat_processus).instruction_courante);
933:
934: if (empilement(s_etat_processus,
935: &((*s_etat_processus).l_base_pile), s_objet) ==
936: d_erreur)
937: {
938: (*s_etat_processus).erreur_systeme =
939: d_es_allocation_memoire;
940: return(d_erreur);
941: }
942: }
943: else
944: {
945: (*s_etat_processus).test_instruction = 'N';
946: analyse(s_etat_processus, NULL);
947: (*s_etat_processus).test_instruction = 'Y';
948: }
949:
950: free(instruction_majuscule);
951: }
952:
953: erreur |= (((*s_etat_processus).erreur_execution != d_ex)
954: ? d_erreur : d_absence_erreur);
955: }
956: else
957: {
958: printf("\n");
959:
960: if ((*s_etat_processus).langue == 'F')
961: {
962: printf("+++Erreur : Argument %s invalide\n",
963: (*s_etat_processus).instruction_courante);
964: }
965: else
966: {
967: printf("+++Error : Invalid %s argument\n",
968: (*s_etat_processus).instruction_courante);
969: }
970:
971: fflush(stdout);
972:
973: return(d_erreur);
974: }
975:
976: /*
977: --------------------------------------------------------------------------------
978: Traitement des arrêts simples
979: --------------------------------------------------------------------------------
980: */
981:
982: if ((*s_etat_processus).var_volatile_requete_arret2 != 0)
983: {
984: if ((*s_etat_processus).debug_programme == d_vrai)
985: {
986: (*s_etat_processus).var_volatile_requete_arret2 = 0;
987: }
988: else
989: {
990: if ((*s_etat_processus).var_volatile_requete_arret2 == -1)
991: {
992: if (strncmp(getenv("LANG"), "fr", 2) == 0)
993: {
994: printf("[%d] Arrêt\n", (int) getpid());
995: }
996: else
997: {
998: printf("[%d] Break\n", (int) getpid());
999: }
1000:
1001: (*s_etat_processus).var_volatile_requete_arret2 = 1;
1002:
1003: fflush(stdout);
1004: }
1005:
1006: if ((*s_etat_processus).niveau_recursivite == 0)
1007: {
1008: (*s_etat_processus).debug_programme = d_vrai;
1009: (*s_etat_processus).var_volatile_requete_arret2 = 0;
1010: }
1011: }
1012: }
1013:
1014: /*
1015: * On ne sort pas du debugger en cas d'une erreur sur un programme
1016: * en cours de débogage.
1017: */
1018:
1019: if ((((*s_etat_processus).erreur_execution != d_ex) ||
1020: ((*s_etat_processus).exception != d_ep)) &&
1021: ((*s_etat_processus).debug_programme == d_vrai))
1022: {
1023: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1024: {
1025: l_element_courant = (*s_etat_processus).l_base_pile_last;
1026:
1027: while(l_element_courant != NULL)
1028: {
1029: if ((s_objet = copie_objet(s_etat_processus,
1030: (*l_element_courant).donnee, 'P')) == NULL)
1031: {
1032: (*s_etat_processus).erreur_systeme =
1033: d_es_allocation_memoire;
1034: return(d_erreur);
1035: }
1036:
1037: if (empilement(s_etat_processus, &((*s_etat_processus)
1038: .l_base_pile), s_objet) == d_erreur)
1039: {
1040: return(d_erreur);
1041: }
1042:
1043: l_element_courant = (*l_element_courant).suivant;
1044: }
1045: }
1046:
1047: if (test_cfsf(s_etat_processus, 51) == d_faux)
1048: {
1049: printf("%s", ds_beep);
1050: }
1051:
1052: if ((message = messages(s_etat_processus)) == NULL)
1053: {
1054: return(d_erreur);
1055: }
1056:
1057: printf("%s [%d]\n", message, (int) getpid());
1058:
1059: free(message);
1060:
1061: (*s_etat_processus).erreur_execution = d_ex;
1062: (*s_etat_processus).exception = d_ep;
1063: erreur = d_absence_erreur;
1064:
1065: (*s_etat_processus).position_courante -=
1066: strlen((*s_etat_processus).instruction_courante);
1067: }
1068:
1069: /*
1070: --------------------------------------------------------------------------------
1071: Test de fin d'exécution du programme RPL/2
1072: --------------------------------------------------------------------------------
1073: */
1074:
1075: if (((*s_etat_processus).niveau_courant == 0) &&
1076: (drapeau_appel_definition != d_vrai))
1077: {
1078: drapeau_fin = d_vrai;
1079: }
1080: else if ((*s_etat_processus).requete_arret == 'Y')
1081: {
1082: drapeau_fin = d_vrai;
1083: }
1084: else if (((*s_etat_processus).var_volatile_requete_arret != 0)
1085: && ((*s_etat_processus).debug_programme == d_faux))
1086: {
1087: drapeau_fin = d_vrai;
1088:
1089: if ((*s_etat_processus).erreur_systeme == d_es)
1090: {
1091: erreur = d_absence_erreur;
1092: }
1093: }
1094: else if ((*s_etat_processus).arret_si_exception == d_vrai)
1095: {
1096: drapeau_fin = d_faux;
1097:
1098: if ((*s_etat_processus).exception != d_ep)
1099: {
1100: erreur = d_erreur;
1101: }
1102: else if ((*s_etat_processus).erreur_systeme != d_es)
1103: {
1104: erreur = d_erreur;
1105: }
1106: }
1107: else if ((*s_etat_processus).arret_si_exception == d_faux)
1108: {
1109: if ((message = messages(s_etat_processus)) == NULL)
1110: {
1111: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1112: return(d_erreur);
1113: }
1114:
1115: free(message);
1116:
1117: drapeau_fin = d_faux;
1118:
1119: /*
1120: --------------------------------------------------------------------------------
1121: Traitement des exceptions
1122: --------------------------------------------------------------------------------
1123: */
1124:
1125: if ((*s_etat_processus).erreur_systeme != d_es)
1126: {
1127: erreur = d_erreur;
1128: }
1129: else if (((*s_etat_processus).exception != d_ep) ||
1130: ((*s_etat_processus).erreur_execution != d_ex))
1131: {
1132: tampon = (*s_etat_processus).instruction_courante;
1133:
1134: while((*(*s_etat_processus).l_base_pile_systeme).clause != 'R')
1135: {
1136: erreur = recherche_instruction_suivante(s_etat_processus);
1137:
1138: if (erreur == d_erreur)
1139: {
1140: return(d_erreur);
1141: }
1142:
1143: if (recherche_variable(s_etat_processus,
1144: (*s_etat_processus).instruction_courante) == d_vrai)
1145: {
1146: if (((*s_etat_processus).s_liste_variables
1147: [(*s_etat_processus)
1148: .position_variable_courante]).objet == NULL)
1149: {
1150: // Variable partagée
1151: }
1152: else if ((*((*s_etat_processus).s_liste_variables
1153: [(*s_etat_processus)
1154: .position_variable_courante]).objet).type ==
1155: ADR)
1156: {
1157: empilement_pile_systeme(s_etat_processus);
1158:
1159: if ((*s_etat_processus).erreur_systeme != d_es)
1160: {
1161: return(d_erreur);
1162: }
1163:
1164: (*(*s_etat_processus).l_base_pile_systeme)
1165: .adresse_retour = (*s_etat_processus)
1166: .position_courante;
1167:
1168: (*(*s_etat_processus).l_base_pile_systeme)
1169: .retour_definition = 'Y';
1170:
1171: (*(*s_etat_processus).l_base_pile_systeme)
1172: .niveau_courant = (*s_etat_processus)
1173: .niveau_courant;
1174:
1175: (*s_etat_processus).position_courante =
1176: (*((unsigned long *)
1177: ((*((*s_etat_processus).s_liste_variables
1178: [(*s_etat_processus)
1179: .position_variable_courante]
1180: .objet)).objet)));
1181:
1182: (*s_etat_processus)
1183: .autorisation_empilement_programme = 'N';
1184: }
1185: }
1186: else
1187: {
1188: (*s_etat_processus).erreur_systeme = d_es;
1189: instruction_majuscule = conversion_majuscule(
1190: (*s_etat_processus).instruction_courante);
1191:
1192: if (instruction_majuscule == NULL)
1193: {
1194: return(d_erreur);
1195: }
1196:
1197: /*
1198: * Traitement de la pile système par les
1199: * différentes instructions.
1200: */
1201:
1202: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1203: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1204: (strcmp(instruction_majuscule, "DO") == 0) ||
1205: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1206: (strcmp(instruction_majuscule, "FOR") == 0) ||
1207: (strcmp(instruction_majuscule, "START") == 0) ||
1208: (strcmp(instruction_majuscule, "SELECT") == 0)
1209: || (strcmp(instruction_majuscule, "CASE") == 0)
1210: || (strcmp(instruction_majuscule, "<<") == 0))
1211: {
1212: if (strcmp(instruction_majuscule, "<<") == 0)
1213: {
1214: analyse(s_etat_processus, NULL);
1215: }
1216: else
1217: {
1218: empilement_pile_systeme(s_etat_processus);
1219:
1220: if ((*s_etat_processus).erreur_systeme != d_es)
1221: {
1222: return(d_erreur);
1223: }
1224: }
1225: }
1226: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1227: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1228: (strcmp(instruction_majuscule, "STEP") == 0) ||
1229: (strcmp(instruction_majuscule, ">>") == 0))
1230: {
1231: if (strcmp(instruction_majuscule, ">>") == 0)
1232: {
1233: analyse(s_etat_processus, NULL);
1234:
1235: if ((*(*s_etat_processus).l_base_pile_systeme)
1236: .origine_routine_evaluation == 'Y')
1237: {
1238: free(instruction_majuscule);
1239: free((*s_etat_processus)
1240: .instruction_courante);
1241:
1242: (*s_etat_processus).instruction_courante =
1243: tampon;
1244:
1245: return(d_absence_erreur);
1246: }
1247: }
1248: else
1249: {
1250: depilement_pile_systeme(s_etat_processus);
1251:
1252: if ((*s_etat_processus).erreur_systeme != d_es)
1253: {
1254: return(d_erreur);
1255: }
1256: }
1257: }
1258:
1259: free(instruction_majuscule);
1260: }
1261:
1262: free((*s_etat_processus).instruction_courante);
1263: }
1264:
1265: drapeau_then = d_faux;
1266: niveau = 0;
1267:
1268: do
1269: {
1270: erreur = recherche_instruction_suivante(s_etat_processus);
1271:
1272: if (erreur == d_erreur)
1273: {
1274: return(d_erreur);
1275: }
1276:
1277: instruction_majuscule = conversion_majuscule(
1278: (*s_etat_processus).instruction_courante);
1279:
1280: if (instruction_majuscule == NULL)
1281: {
1282: return(d_erreur);
1283: }
1284:
1285: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1286: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1287: (strcmp(instruction_majuscule, "DO") == 0) ||
1288: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1289: (strcmp(instruction_majuscule, "FOR") == 0) ||
1290: (strcmp(instruction_majuscule, "START") == 0) ||
1291: (strcmp(instruction_majuscule, "SELECT") == 0)
1292: || (strcmp(instruction_majuscule, "CASE") == 0)
1293: || (strcmp(instruction_majuscule, "<<") == 0))
1294: {
1295: niveau++;
1296: }
1297: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1298: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1299: (strcmp(instruction_majuscule, "STEP") == 0) ||
1300: (strcmp(instruction_majuscule, ">>") == 0))
1301: {
1302: niveau--;
1303: }
1304:
1305: drapeau_then = ((strcmp(instruction_majuscule, "THEN") == 0)
1306: && (niveau == 0)) ? d_vrai : d_faux;
1307:
1308: free(instruction_majuscule);
1309: free((*s_etat_processus).instruction_courante);
1310: } while(drapeau_then == d_faux);
1311:
1312: (*s_etat_processus).position_courante -= 5;
1313: (*s_etat_processus).instruction_courante = tampon;
1314: (*(*s_etat_processus).l_base_pile_systeme).clause = 'X';
1315:
1316: erreur = d_absence_erreur;
1317: (*s_etat_processus).exception = d_ep;
1318: (*s_etat_processus).erreur_execution = d_ex;
1319: }
1320: }
1321: else
1322: {
1323: drapeau_fin = d_faux;
1324: }
1325:
1326: if (erreur == d_absence_erreur)
1327: {
1328: free((*s_etat_processus).instruction_courante);
1329: }
1330: } while((erreur == d_absence_erreur) &&
1331: ((*s_etat_processus).position_courante <
1332: (*s_etat_processus).longueur_definitions_chainees) &&
1333: (drapeau_fin == d_faux) &&
1334: ((*s_etat_processus).retour_routine_evaluation == 'N'));
1335:
1336: /*
1337: --------------------------------------------------------------------------------
1338: Messages d'erreur à afficher le cas échéant
1339: --------------------------------------------------------------------------------
1340: */
1341:
1342: if ((erreur != d_absence_erreur) && ((*s_etat_processus)
1343: .invalidation_message_erreur == d_faux))
1344: {
1345: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1346: {
1347: l_element_courant = (*s_etat_processus).l_base_pile_last;
1348:
1349: while(l_element_courant != NULL)
1350: {
1351: if ((s_objet = copie_objet(s_etat_processus,
1352: (*l_element_courant).donnee, 'P')) == NULL)
1353: {
1354: (*s_etat_processus).erreur_systeme =
1355: d_es_allocation_memoire;
1356: return(d_erreur);
1357: }
1358:
1359: if (empilement(s_etat_processus, &((*s_etat_processus)
1360: .l_base_pile), s_objet) == d_erreur)
1361: {
1362: return(d_erreur);
1363: }
1364:
1365: l_element_courant = (*l_element_courant).suivant;
1366: }
1367: }
1368:
1369: if (test_cfsf(s_etat_processus, 51) == d_faux)
1370: {
1371: printf("%s", ds_beep);
1372: }
1373:
1374: if ((message = messages(s_etat_processus)) == NULL)
1375: {
1376: return(d_erreur);
1377: }
1378:
1379: printf("%s [%d]\n", message, (int) getpid());
1380:
1381: free(message);
1382: free((*s_etat_processus).instruction_courante);
1383:
1384: if ((*s_etat_processus).var_volatile_processus_pere == 0)
1385: {
1386: kill((*s_etat_processus).pid_processus_pere, SIGALRM);
1387: }
1388: else
1389: {
1390: (*s_etat_processus).var_volatile_alarme = -1;
1391: }
1392:
1393: return(d_erreur);
1394: }
1395:
1396: return(d_absence_erreur);
1397: }
1398:
1399: // vim: ts=4