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