1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.0
4: Copyright (C) 1989-2011 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 = 0;
134: (*(*s_etat_processus).l_base_pile_systeme).pointeur_adresse_retour = NULL;
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: integer8 i;
306: integer8 candidat;
307:
308: long delta;
309:
310: struct_liste_chainee *l_variable;
311: struct_liste_chainee *l_candidat;
312:
313: struct_liste_pile_systeme *l_element_courant;
314:
315: unsigned char *tampon;
316:
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: {
336: fprintf(flux, "%d : (%016X) D=", i--, l_element_courant);
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, "RTN ");
357:
358: if ((*l_element_courant).origine_routine_evaluation == 'Y')
359: {
360: fprintf(flux, "EVL ");
361: }
362: else
363: {
364: fprintf(flux, "SEQ ");
365:
366: if ((*l_element_courant).adresse_retour != 0)
367: {
368: fprintf(flux, "P=%016X", (*l_element_courant)
369: .adresse_retour);
370:
371: // Calcul de la routine de départ
372:
373: l_variable = (struct_liste_chainee *)
374: (*(*(*s_etat_processus)
375: .l_liste_variables_par_niveau).precedent).liste;
376: candidat = (*s_etat_processus)
377: .longueur_definitions_chainees;
378: l_candidat = NULL;
379:
380: // l_variable balaie les variables de niveau 0.
381:
382: while(l_variable != NULL)
383: {
384: if ((*(*((struct_variable *) (*l_variable).donnee))
385: .objet).type == ADR)
386: {
387: delta = (*l_element_courant).adresse_retour
388: - (*((unsigned long *)
389: (*(*((struct_variable *) (*l_variable)
390: .donnee)).objet).objet));
391:
392: if ((delta > 0) && (delta < candidat))
393: {
394: candidat = delta;
395: l_candidat = l_variable;
396: }
397: }
398:
399: l_variable = (*l_variable).suivant;
400: }
401:
402: if (l_candidat != NULL)
403: {
404: fprintf(flux, "\n Call from %s",
405: (*((struct_variable *) (*l_candidat).donnee))
406: .nom);
407: }
408: else
409: {
410: fprintf(flux, "\n Call from RPL/2 initialization");
411: }
412: }
413: else
414: {
415: fprintf(flux, "RPL/2 initialization");
416: }
417: }
418: }
419: else
420: {
421: fprintf(flux, "NONE ");
422:
423: if ((*l_element_courant).origine_routine_evaluation == 'Y')
424: {
425: fprintf(flux, "EVL ");
426: }
427: else
428: {
429: fprintf(flux, "SEQ ");
430:
431: if ((*l_element_courant).pointeur_adresse_retour != NULL)
432: {
433: fprintf(flux, "A=%016X ", (*l_element_courant)
434: .pointeur_adresse_retour);
435:
436: // Calcul de la routine de départ
437:
438: l_variable = (struct_liste_chainee *)
439: (*(*(*s_etat_processus)
440: .l_liste_variables_par_niveau).precedent).liste;
441: candidat = (*s_etat_processus)
442: .longueur_definitions_chainees;
443: l_candidat = NULL;
444:
445: // l_variable balaie les variables de niveau 0.
446:
447: while(l_variable != NULL)
448: {
449: if ( (*(*l_variable).donnee).objet ==
450: (*l_element_courant).pointeur_adresse_retour)
451: {
452: l_candidat = l_variable;
453: break;
454: }
455:
456: l_variable = (*l_variable).suivant;
457: }
458:
459: if (l_candidat != NULL)
460: {
461: fprintf(flux, "\n Branch to %s",
462: (*((struct_variable *) (*l_candidat).donnee))
463: .nom);
464: }
465: else
466: {
467: fprintf(flux, "\n Branch to evaluation subroutine");
468: }
469: }
470: }
471: }
472:
473: fprintf(flux, "\n");
474:
475: if ((*l_element_courant).indice_boucle != NULL)
476: {
477: tampon = formateur(s_etat_processus, 0,
478: (*l_element_courant).indice_boucle);
479: fprintf(flux, " Index = %s\n", tampon);
480: free(tampon);
481: }
482:
483: if ((*l_element_courant).limite_indice_boucle != NULL)
484: {
485: tampon = formateur(s_etat_processus, 0,
486: (*l_element_courant).limite_indice_boucle);
487: fprintf(flux, " Limit = %s\n", tampon);
488: free(tampon);
489: }
490:
491: if ((*l_element_courant).objet_de_test != NULL)
492: {
493: tampon = formateur(s_etat_processus, 0,
494: (*l_element_courant).objet_de_test);
495: fprintf(flux, " Test object = %s\n", tampon);
496: free(tampon);
497: }
498:
499: if ((*l_element_courant).nom_variable != NULL)
500: {
501: fprintf(flux, " Variable name = %s\n",
502: (*l_element_courant).nom_variable);
503: }
504:
505: l_element_courant = (*l_element_courant).suivant;
506: }
507:
508: fprintf(flux, "\n");
509: funlockfile(flux);
510:
511: return;
512: }
513:
514: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to gestion_pile_systeme.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src