Annotation of rpl/src/gestion_pile_systeme.c, revision 1.24.2.2
1.1 bertrand 1: /*
2: ================================================================================
1.24.2.2! bertrand 3: RPL/2 (R) version 4.0.23
1.23 bertrand 4: Copyright (C) 1989-2011 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:
22:
1.19 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 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 = 0;
1.16 bertrand 134: (*(*s_etat_processus).l_base_pile_systeme).pointeur_adresse_retour = NULL;
1.1 bertrand 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:
1.7 bertrand 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:
1.12 bertrand 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: {
1.15 bertrand 305: integer8 i;
1.16 bertrand 306: integer8 candidat;
307:
308: long delta;
1.15 bertrand 309:
1.12 bertrand 310: struct_liste_pile_systeme *l_element_courant;
311:
1.15 bertrand 312: unsigned char *tampon;
1.12 bertrand 313:
1.16 bertrand 314: unsigned long p;
315: unsigned long v;
316:
1.12 bertrand 317: l_element_courant = (*s_etat_processus).l_base_pile_systeme;
318: i = 0;
319:
320: while(l_element_courant != NULL)
321: {
322: i++;
323: l_element_courant = (*l_element_courant).suivant;
324: }
325:
326: l_element_courant = (*s_etat_processus).l_base_pile_systeme;
327: flockfile(flux);
328:
329: if ((flux == stderr) || (flux == stdout))
330: {
331: fprintf(flux, "+++Backtrace\n");
332: }
333:
334: while(l_element_courant != NULL)
335: {
1.16 bertrand 336: fprintf(flux, "%d : (%016X) D=", i--, l_element_courant);
1.12 bertrand 337:
338: fprintf(flux, ((*l_element_courant).creation_variables_statiques
339: == d_vrai) ? "1" : "0");
340: fprintf(flux, ((*l_element_courant).creation_variables_partagees
341: == d_vrai) ? "1" : "0");
342: fprintf(flux, ((*l_element_courant).arret_si_exception == d_vrai)
343: ? "1" : "0");
344: fprintf(flux, ((*l_element_courant).evaluation_expression == d_vrai)
345: ? "1" : "0");
346:
347: fprintf(flux, " F=%c%c L=%lu ",
348: ((*l_element_courant).clause == ' ') ? '-' :
349: (*l_element_courant).clause,
350: ((*l_element_courant).type_cloture == ' ') ? '-' :
351: (*l_element_courant).type_cloture,
352: (*l_element_courant).niveau_courant);
353:
354: if ((*l_element_courant).retour_definition == 'Y')
355: {
356: fprintf(flux, "RTRN ");
357:
358: if ((*l_element_courant).origine_routine_evaluation == 'Y')
359: {
360: fprintf(flux, "EVL ");
1.16 bertrand 361: }
362: else
363: {
364: fprintf(flux, "SEQ ");
1.12 bertrand 365:
366: if ((*l_element_courant).adresse_retour != 0)
367: {
1.16 bertrand 368: fprintf(flux, "P=%016X", (*l_element_courant)
1.12 bertrand 369: .adresse_retour);
1.16 bertrand 370:
371: // Calcul de la routine de départ
372:
373: candidat = (*s_etat_processus)
374: .longueur_definitions_chainees;
375: p = 0;
376:
377: for(v = 0; v < (*s_etat_processus).nombre_variables; v++)
378: {
379: if ((*s_etat_processus).s_liste_variables[v].niveau
380: == 0)
381: {
382: delta = (*l_element_courant).adresse_retour
383: - (*((unsigned long *)
384: ((*(*s_etat_processus)
385: .s_liste_variables[v].objet).objet)));
386:
387: if ((delta > 0) && (delta < candidat))
388: {
389: candidat = delta;
390: p = v + 1;
391: }
392: }
393: }
394:
395: if (p > 0)
396: {
397: fprintf(flux, "\n Call from %s", (*s_etat_processus)
398: .s_liste_variables[p - 1].nom);
399: }
400: else
401: {
402: fprintf(flux, "\n Call from RPL/2 initialization");
403: }
1.12 bertrand 404: }
1.16 bertrand 405: else
1.12 bertrand 406: {
1.16 bertrand 407: fprintf(flux, "RPL/2 initialization");
1.12 bertrand 408: }
409: }
410: }
411: else
412: {
413: fprintf(flux, "NONE ");
414:
415: if ((*l_element_courant).origine_routine_evaluation == 'Y')
416: {
417: fprintf(flux, "EVL ");
418: }
419: else
420: {
421: fprintf(flux, "SEQ ");
422:
1.16 bertrand 423: if ((*l_element_courant).pointeur_adresse_retour != NULL)
1.12 bertrand 424: {
1.16 bertrand 425: fprintf(flux, "A=%016X ", (*l_element_courant)
426: .pointeur_adresse_retour);
427:
428: // Calcul de la routine de départ
429:
430: p = 0;
431:
432: for(v = 0; v < (*s_etat_processus).nombre_variables; v++)
433: {
434: if ((*s_etat_processus).s_liste_variables[v].niveau
435: == 0)
436: {
437: if ((*s_etat_processus).s_liste_variables[v].objet
438: == (*l_element_courant)
439: .pointeur_adresse_retour)
440: {
441: p = v + 1;
442: break;
443: }
444: }
445: }
446:
447: if (p > 0)
448: {
449: fprintf(flux, "\n Branch to %s", (*s_etat_processus)
450: .s_liste_variables[p - 1].nom);
451: }
452: else
453: {
1.17 bertrand 454: fprintf(flux, "\n Branch to evaluation subroutine");
1.16 bertrand 455: }
1.12 bertrand 456: }
457: }
458: }
459:
460: fprintf(flux, "\n");
461:
1.15 bertrand 462: if ((*l_element_courant).indice_boucle != NULL)
463: {
464: tampon = formateur(s_etat_processus, 0,
465: (*l_element_courant).indice_boucle);
466: fprintf(flux, " Index = %s\n", tampon);
467: free(tampon);
468: }
469:
470: if ((*l_element_courant).limite_indice_boucle != NULL)
471: {
472: tampon = formateur(s_etat_processus, 0,
473: (*l_element_courant).limite_indice_boucle);
474: fprintf(flux, " Limit = %s\n", tampon);
475: free(tampon);
476: }
477:
478: if ((*l_element_courant).objet_de_test != NULL)
479: {
480: tampon = formateur(s_etat_processus, 0,
481: (*l_element_courant).objet_de_test);
482: fprintf(flux, " Test object = %s\n", tampon);
483: free(tampon);
484: }
485:
486: if ((*l_element_courant).nom_variable != NULL)
487: {
488: fprintf(flux, " Variable name = %s\n",
489: (*l_element_courant).nom_variable);
490: }
491:
1.12 bertrand 492: l_element_courant = (*l_element_courant).suivant;
493: }
494:
495: fprintf(flux, "\n");
496: funlockfile(flux);
497:
498: return;
499: }
500:
1.1 bertrand 501: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>