1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.13
4: Copyright (C) 1989-2013 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:
22:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Procédure d'estimation de la longueur du tampon
29: ================================================================================
30: Entrée :
31: --------------------------------------------------------------------------------
32: Sortie :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: static inline void
39: estimation_taille_pile_systeme(struct_processus *s_etat_processus)
40: {
41: (*s_etat_processus).estimation_taille_pile_systeme_tampon =
42: ((*s_etat_processus).estimation_taille_pile_systeme_tampon *
43: ((double) 0.9)) + ((*s_etat_processus)
44: .hauteur_pile_systeme * ((double) 0.1));
45: return;
46: }
47:
48:
49: /*
50: ================================================================================
51: Procédure d'empilement d'un nouvel élément
52: ================================================================================
53: Entrée :
54: --------------------------------------------------------------------------------
55: Sortie :
56: --------------------------------------------------------------------------------
57: Effets de bord : néant
58: ================================================================================
59: */
60:
61: void
62: empilement_pile_systeme(struct_processus *s_etat_processus)
63: {
64: struct_liste_pile_systeme *l_ancienne_base_liste;
65: struct_liste_pile_systeme *l_nouvelle_base_liste;
66:
67: l_ancienne_base_liste = (*s_etat_processus).l_base_pile_systeme;
68:
69: if ((*s_etat_processus).debug == d_vrai)
70: if (((*s_etat_processus).type_debug &
71: d_debug_pile_systeme) != 0)
72: {
73: if (strlen((*s_etat_processus).instruction_courante) != 0)
74: {
75: if ((*s_etat_processus).langue == 'F')
76: {
77: printf("[%d] Empilement sur la pile système à la suite de "
78: "l'instruction %s\n", (int) getpid(),
79: (*s_etat_processus).instruction_courante);
80: }
81: else
82: {
83: printf("[%d] Pushing on system stack (instruction %s)\n",
84: (int) getpid(),
85: (*s_etat_processus).instruction_courante);
86: }
87: }
88: else
89: {
90: if ((*s_etat_processus).langue == 'F')
91: {
92: printf("[%d] Empilement sur la pile système\n",
93: (int) getpid());
94: }
95: else
96: {
97: printf("[%d] Pushing on system stack\n", (int) getpid());
98: }
99: }
100:
101: fflush(stdout);
102: }
103:
104: if ((*s_etat_processus).pile_systeme_tampon == NULL)
105: {
106: // Tampon vide, on alloue un élément.
107:
108: if ((l_nouvelle_base_liste = malloc(sizeof(struct_liste_pile_systeme)))
109: == NULL)
110: {
111: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
112: return;
113: }
114: }
115: else
116: {
117: // Tampon utilisable, on retire un élément du tampon.
118:
119: l_nouvelle_base_liste = (*s_etat_processus).pile_systeme_tampon;
120: (*s_etat_processus).pile_systeme_tampon =
121: (*l_nouvelle_base_liste).suivant;
122: (*s_etat_processus).taille_pile_systeme_tampon--;
123: }
124:
125: (*s_etat_processus).hauteur_pile_systeme++;
126: (*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste;
127: (*(*s_etat_processus).l_base_pile_systeme).suivant =
128: l_ancienne_base_liste;
129:
130: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = ' ';
131: (*(*s_etat_processus).l_base_pile_systeme).clause = ' ';
132: (*(*s_etat_processus).l_base_pile_systeme).adresse_retour = 0;
133: (*(*s_etat_processus).l_base_pile_systeme).niveau_courant =
134: (*s_etat_processus).niveau_courant;
135: (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'N';
136: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
137: (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = NULL;
138: (*(*s_etat_processus).l_base_pile_systeme).objet_de_test = NULL;
139: (*(*s_etat_processus).l_base_pile_systeme).nom_variable = NULL;
140: (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour = NULL;
141: (*(*s_etat_processus).l_base_pile_systeme)
142: .origine_routine_evaluation = 'N';
143: (*(*s_etat_processus).l_base_pile_systeme).arret_si_exception =
144: (*s_etat_processus).arret_si_exception;
145: (*(*s_etat_processus).l_base_pile_systeme).creation_variables_statiques
146: = (*s_etat_processus).creation_variables_statiques;
147: (*(*s_etat_processus).l_base_pile_systeme).creation_variables_partagees
148: = (*s_etat_processus).creation_variables_partagees;
149: (*(*s_etat_processus).l_base_pile_systeme).evaluation_expression =
150: d_faux;
151:
152: (*s_etat_processus).erreur_systeme = d_es;
153: (*s_etat_processus).creation_variables_statiques = d_faux;
154: (*s_etat_processus).creation_variables_partagees = d_faux;
155:
156: return;
157: }
158:
159:
160: /*
161: ================================================================================
162: Procédure de dépilement d'un élément
163: ================================================================================
164: Entrée :
165: --------------------------------------------------------------------------------
166: Sortie :
167: --------------------------------------------------------------------------------
168: Effets de bord : néant
169: ================================================================================
170: */
171:
172: void
173: depilement_pile_systeme(struct_processus *s_etat_processus)
174: {
175: struct_liste_pile_systeme *l_ancienne_base_liste;
176: struct_liste_pile_systeme *l_nouvelle_base_liste;
177:
178: if ((*s_etat_processus).debug == d_vrai)
179: if (((*s_etat_processus).type_debug &
180: d_debug_pile_systeme) != 0)
181: {
182: if (strlen((*s_etat_processus).instruction_courante) != 0)
183: {
184: if ((*s_etat_processus).langue == 'F')
185: {
186: printf("[%d] Dépilement de la pile système à la suite "
187: "de l'instruction %s\n", (int) getpid(),
188: (*s_etat_processus).instruction_courante);
189: }
190: else
191: {
192: printf("[%d] Pulling from system stack (instruction %s)\n",
193: (int) getpid(),
194: (*s_etat_processus).instruction_courante);
195: }
196: }
197: else
198: {
199: if ((*s_etat_processus).langue == 'F')
200: {
201: printf("[%d] Dépilement de la pile système\n",
202: (int) getpid());
203: }
204: else
205: {
206: printf("[%d] Pulling from system stack\n", (int) getpid());
207: }
208: }
209:
210: fflush(stdout);
211: }
212:
213: if ((*s_etat_processus).l_base_pile_systeme == NULL)
214: {
215: (*s_etat_processus).erreur_systeme = d_es_pile_vide;
216: }
217: else
218: {
219: (*s_etat_processus).hauteur_pile_systeme--;
220: l_ancienne_base_liste = (*s_etat_processus).l_base_pile_systeme;
221: l_nouvelle_base_liste = (*l_ancienne_base_liste).suivant;
222:
223: (*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste;
224: (*s_etat_processus).erreur_systeme = d_es;
225:
226: // On positionne le drapeau de création des variables statiques.
227:
228: (*s_etat_processus).creation_variables_statiques =
229: (*l_ancienne_base_liste).creation_variables_statiques;
230: (*s_etat_processus).creation_variables_partagees =
231: (*l_ancienne_base_liste).creation_variables_partagees;
232:
233: if ((*l_ancienne_base_liste).nom_variable != NULL)
234: {
235: free((*l_ancienne_base_liste).nom_variable);
236: }
237:
238: liberation(s_etat_processus, (*l_ancienne_base_liste).indice_boucle);
239: liberation(s_etat_processus,
240: (*l_ancienne_base_liste).limite_indice_boucle);
241: liberation(s_etat_processus, (*l_ancienne_base_liste).objet_de_test);
242:
243: if ((*s_etat_processus).taille_pile_systeme_tampon <= (10 *
244: ((*s_etat_processus).estimation_taille_pile_systeme_tampon
245: + 1)))
246: {
247: // Enregistrement de la structure pour un usage ultérieur.
248:
249: (*l_ancienne_base_liste).suivant =
250: (*s_etat_processus).pile_systeme_tampon;
251: (*s_etat_processus).pile_systeme_tampon = l_ancienne_base_liste;
252: (*s_etat_processus).taille_pile_systeme_tampon++;
253: }
254: else
255: {
256: // Libération car le tampon est plein.
257:
258: free(l_ancienne_base_liste);
259: }
260: }
261:
262: return;
263: }
264:
265:
266: /*
267: ================================================================================
268: Procédure d'effacement de la pile système
269: ================================================================================
270: Entrée :
271: --------------------------------------------------------------------------------
272: Sortie :
273: --------------------------------------------------------------------------------
274: Effets de bord : néant
275: ================================================================================
276: */
277:
278: void
279: effacement_pile_systeme(struct_processus *s_etat_processus)
280: {
281: while((*s_etat_processus).l_base_pile_systeme != NULL)
282: {
283: depilement_pile_systeme(s_etat_processus);
284: }
285:
286: return;
287: }
288:
289:
290: /*
291: ================================================================================
292: Procédure d'affichage de la pile système
293: ================================================================================
294: Entrée :
295: --------------------------------------------------------------------------------
296: Sortie :
297: --------------------------------------------------------------------------------
298: Effets de bord : néant
299: ================================================================================
300: */
301:
302: void
303: trace(struct_processus *s_etat_processus, FILE *flux)
304: {
305: int candidat;
306: int j;
307: int nb_variables;
308:
309: integer8 i;
310: integer8 candidat8;
311: integer8 delta;
312:
313: struct_liste_chainee *l_element_expression;
314:
315: struct_liste_pile_systeme *l_element_courant;
316:
317: struct_tableau_variables *tableau;
318:
319: unsigned char *tampon;
320:
321: l_element_courant = (*s_etat_processus).l_base_pile_systeme;
322: i = 0;
323:
324: while(l_element_courant != NULL)
325: {
326: i++;
327: l_element_courant = (*l_element_courant).suivant;
328: }
329:
330: l_element_courant = (*s_etat_processus).l_base_pile_systeme;
331: flockfile(flux);
332:
333: nb_variables = nombre_variables(s_etat_processus);
334:
335: if ((tableau = malloc(nb_variables * sizeof(struct_tableau_variables)))
336: == NULL)
337: {
338: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
339: return;
340: }
341:
342: liste_variables(s_etat_processus, tableau);
343:
344: if ((flux == stderr) || (flux == stdout))
345: {
346: fprintf(flux, "+++Backtrace\n");
347: }
348:
349: while(l_element_courant != NULL)
350: {
351: fprintf(flux, "%lld : address # %016Xh\n", i--, l_element_courant);
352:
353: if ((*l_element_courant).creation_variables_statiques == d_vrai)
354: {
355: fprintf(flux, " Variables = static\n");
356: }
357: else if ((*l_element_courant).creation_variables_partagees == d_vrai)
358: {
359: fprintf(flux, " Variables = shared\n");
360: }
361: else
362: {
363: fprintf(flux, " Variables = automatic\n");
364: }
365:
366: if ((*l_element_courant).arret_si_exception == d_vrai)
367: {
368: fprintf(flux, " In exception = abort\n");
369: }
370: else
371: {
372: fprintf(flux, " In exception = catch\n");
373: }
374:
375: if ((*l_element_courant).clause != ' ')
376: {
377: fprintf(flux, " Structure = ");
378:
379: switch((*l_element_courant).clause)
380: {
381: case 'I':
382: fprintf(flux, "IF\n");
383: break;
384:
385: case 'R':
386: fprintf(flux, "IFERR\n");
387: break;
388:
389: case 'X':
390: fprintf(flux, "exception caught by IFERR\n");
391: break;
392:
393: case 'T':
394: fprintf(flux, "THEN\n");
395: break;
396:
397: case 'E':
398: fprintf(flux, "ELSE\n");
399: break;
400:
401: case 'Z':
402: fprintf(flux, "ELSE (false condition)\n");
403: break;
404:
405: case 'D':
406: fprintf(flux, "DO\n");
407: break;
408:
409: case 'U':
410: fprintf(flux, "UNTIL\n");
411: break;
412:
413: case 'W':
414: fprintf(flux, "WHILE\n");
415: break;
416:
417: case 'M':
418: fprintf(flux, "WHILE (false condition)\n");
419: break;
420:
421: case 'S':
422: fprintf(flux, "SELECT\n");
423: break;
424:
425: case 'K':
426: fprintf(flux, "CASE (no true condition)\n");
427: break;
428:
429: case 'C':
430: fprintf(flux, "CASE (one or more true conditions)\n");
431: break;
432:
433: case 'Q':
434: fprintf(flux, "CASE (treatment of a true condition)\n");
435: break;
436:
437: case 'F':
438: fprintf(flux, "CASE (treatment of default case)\n");
439: break;
440: }
441: }
442:
443: if ((*l_element_courant).type_cloture != ' ')
444: {
445: fprintf(flux, " Next close = ");
446:
447: switch((*l_element_courant).type_cloture)
448: {
449: case 'C':
450: fprintf(flux, "SELECT\n");
451: break;
452:
453: case 'D':
454: fprintf(flux, "DO\n");
455: break;
456:
457: case 'I':
458: fprintf(flux, "IF\n");
459: break;
460:
461: case 'J':
462: fprintf(flux, "IFERR\n");
463: break;
464:
465: case 'K':
466: fprintf(flux, "CASE\n");
467: break;
468:
469: case 'W':
470: fprintf(flux, "WHILE\n");
471: break;
472:
473: case 'Q':
474: fprintf(flux, "CRITICAL\n");
475: break;
476:
477: case 'F':
478: fprintf(flux, "FOR\n");
479: break;
480:
481: case 'S':
482: fprintf(flux, "START\n");
483: break;
484:
485: case 'L':
486: fprintf(flux, "internal loop\n");
487: break;
488:
489: case 'A':
490: fprintf(flux, "FORALL\n");
491: break;
492: }
493: }
494:
495: fprintf(flux, " Level = %d\n",
496: (*l_element_courant).niveau_courant);
497:
498: if (((*l_element_courant).retour_definition == 'Y') ||
499: ((*l_element_courant).origine_routine_evaluation == 'Y'))
500: {
501: fprintf(flux, " Return = yes\n");
502:
503: if ((*l_element_courant).origine_routine_evaluation == 'Y')
504: {
505: if ((*l_element_courant).pointeur_objet_retour != NULL)
506: {
507: fprintf(flux, " Come from = compiled code ");
508: fprintf(flux, "(address # %016Xh)\n", (*l_element_courant)
509: .pointeur_objet_retour);
510:
511: // Calcul de la routine de départ
512:
513: candidat = -1;
514:
515: for(j = 0; j < nb_variables; j++)
516: {
517: if (((*(tableau[j].objet)).type == RPN) ||
518: ((*(tableau[j].objet)).type == ALG))
519: {
520: l_element_expression = (*(tableau[j].objet)).objet;
521:
522: while(l_element_expression != NULL)
523: {
524: if (l_element_expression == (*l_element_courant)
525: .pointeur_objet_retour)
526: {
527: candidat = j;
528: break;
529: }
530:
531: l_element_expression =
532: (*l_element_expression).suivant;
533: }
534:
535: if (candidat != -1)
536: {
537: break;
538: }
539: }
540: }
541:
542: if (candidat != -1)
543: {
544: fprintf(flux, " = %s [",
545: tableau[candidat].nom);
546:
547: if ((*(tableau[candidat].objet)).type == RPN)
548: {
549: fprintf(flux, "definition");
550: }
551: else if ((*(tableau[candidat].objet)).type == ALG)
552: {
553: fprintf(flux, "algebraic");
554: }
555: else if ((*(tableau[candidat].objet)).type == NOM)
556: {
557: fprintf(flux, "name");
558: }
559: else
560: {
561: fprintf(flux, "unknown");
562: }
563:
564: fprintf(flux, "]\n");
565: }
566: else
567: {
568: fprintf(flux, " = "
569: "optimized definition\n");
570: }
571: }
572: else
573: {
574: fprintf(flux, " Come from = compiled code\n");
575: fprintf(flux, " = "
576: "optimized definition\n");
577: }
578: }
579: else
580: {
581: fprintf(flux, " Come from = interpreted code ");
582:
583: if ((*l_element_courant).adresse_retour != 0)
584: {
585: fprintf(flux, "(offset # %016Xh)\n", (*l_element_courant)
586: .adresse_retour);
587:
588: // Calcul de la routine de départ
589:
590: candidat8 = (*s_etat_processus)
591: .longueur_definitions_chainees;
592: candidat = -1;
593:
594: for(j = 0; j < nb_variables; j++)
595: {
596: if ((*(tableau[j].objet)).type == ADR)
597: {
598: delta = (*l_element_courant).adresse_retour
599: - (*((unsigned long *)
600: (*(tableau[j].objet)).objet));
601:
602: if ((delta >= 0) && (delta < candidat8))
603: {
604: candidat8 = delta;
605: candidat = j;
606: }
607: }
608: }
609:
610: if (candidat != -1)
611: {
612: fprintf(flux, " = %s\n",
613: tableau[candidat].nom);
614: }
615: else
616: {
617: fprintf(flux, " = "
618: "unknown definition\n");
619: }
620: }
621: else
622: {
623: fprintf(flux, "\n");
624: fprintf(flux, " = RPL/2 "
625: "initialization\n");
626: }
627: }
628: }
629: else
630: {
631: fprintf(flux, " Return = no\n");
632: }
633:
634: if ((*l_element_courant).indice_boucle != NULL)
635: {
636: tampon = formateur(s_etat_processus, 24,
637: (*l_element_courant).indice_boucle);
638: fprintf(flux, " Index = %s\n", tampon);
639: free(tampon);
640: }
641:
642: if ((*l_element_courant).limite_indice_boucle != NULL)
643: {
644: tampon = formateur(s_etat_processus, 24,
645: (*l_element_courant).limite_indice_boucle);
646: fprintf(flux, " Limit = %s\n", tampon);
647: free(tampon);
648: }
649:
650: if ((*l_element_courant).objet_de_test != NULL)
651: {
652: tampon = formateur(s_etat_processus, 24,
653: (*l_element_courant).objet_de_test);
654: fprintf(flux, " Test object = %s\n", tampon);
655: free(tampon);
656: }
657:
658: if ((*l_element_courant).nom_variable != NULL)
659: {
660: fprintf(flux, " Variable name = %s\n",
661: (*l_element_courant).nom_variable);
662: }
663:
664: fprintf(flux, "\n");
665:
666: l_element_courant = (*l_element_courant).suivant;
667: }
668:
669: funlockfile(flux);
670:
671: free(tableau);
672:
673: return;
674: }
675:
676: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>