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