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