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