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