Annotation of rpl/src/instructions_f4.c, revision 1.60
1.1 bertrand 1: /*
2: ================================================================================
1.60 ! bertrand 3: RPL/2 (R) version 4.1.24
1.55 bertrand 4: Copyright (C) 1989-2015 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.11 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction '->table'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_fleche_table(struct_processus *s_etat_processus)
40: {
41: struct_objet *s_objet;
42:
1.45 bertrand 43: integer8 i;
44: integer8 nombre_elements;
1.1 bertrand 45:
46: (*s_etat_processus).erreur_execution = d_ex;
47:
48: if ((*s_etat_processus).affichage_arguments == 'Y')
49: {
50: printf("\n ->TABLE ");
51:
52: if ((*s_etat_processus).langue == 'F')
53: {
54: printf("(création d'une table)\n\n");
55: }
56: else
57: {
58: printf("(create table)\n\n");
59: }
60:
61: printf(" n: %s, %s, %s, %s, %s, %s,\n"
62: " %s, %s, %s, %s, %s,\n"
63: " %s, %s, %s, %s, %s,\n"
64: " %s, %s\n",
65: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
66: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
67: printf(" ...\n");
68: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
69: " %s, %s, %s, %s, %s,\n"
70: " %s, %s, %s, %s, %s,\n"
71: " %s, %s\n",
72: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
73: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
74: printf(" 1: %s\n", d_INT);
75: printf("-> 1: %s\n", d_TAB);
76:
77: return;
78: }
79: else if ((*s_etat_processus).test_instruction == 'Y')
80: {
81: (*s_etat_processus).nombre_arguments = -1;
82: return;
83: }
84:
85: if (test_cfsf(s_etat_processus, 31) == d_vrai)
86: {
87: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
88: {
89: return;
90: }
91: }
92:
93: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
94: {
95: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
96: return;
97: }
98:
99: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
100: {
101: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
102: return;
103: }
104:
105: nombre_elements = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
106: .donnee).objet));
107:
108: if (nombre_elements < 0)
109: {
110:
111: /*
112: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
113: */
114:
115: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
116: return;
117: }
118:
1.44 bertrand 119: if (nombre_elements >= (*s_etat_processus).hauteur_pile_operationnelle)
1.1 bertrand 120: {
121: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
122: return;
123: }
124:
125: if (test_cfsf(s_etat_processus, 31) == d_vrai)
126: {
127: if (empilement_pile_last(s_etat_processus, nombre_elements + 1)
128: == d_erreur)
129: {
130: return;
131: }
132: }
133:
134: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
135: &s_objet) == d_erreur)
136: {
137: return;
138: }
139:
140: liberation(s_etat_processus, s_objet);
141:
142: if ((s_objet = allocation(s_etat_processus, TBL)) == NULL)
143: {
144: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
145: return;
146: }
147:
148: (*((struct_tableau *) (*s_objet).objet)).nombre_elements =
149: nombre_elements;
150:
1.44 bertrand 151: if (((*((struct_tableau *) (*s_objet).objet)).elements = malloc(((size_t)
152: nombre_elements) * sizeof(struct_objet *))) == NULL)
1.1 bertrand 153: {
154: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
155: return;
156: }
157:
158: for(i = 0; i < nombre_elements; i++)
159: {
160: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
161: &((*((struct_tableau *) (*s_objet).objet)).elements
162: [nombre_elements - (i + 1)])) == d_erreur)
163: {
164: return;
165: }
166: }
167:
168: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
169: s_objet) == d_erreur)
170: {
171: return;
172: }
173:
174: return;
175: }
176:
177:
178: /*
179: ================================================================================
180: Fonction '->diag'
181: ================================================================================
182: Entrées : pointeur sur une structure struct_processus
183: --------------------------------------------------------------------------------
184: Sorties :
185: --------------------------------------------------------------------------------
186: Effets de bord : néant
187: ================================================================================
188: */
189:
190: void
191: instruction_fleche_diag(struct_processus *s_etat_processus)
192: {
193: struct_objet *s_objet_argument;
194: struct_objet *s_objet_resultat;
195:
1.44 bertrand 196: integer8 i;
197: integer8 j;
1.1 bertrand 198:
199: (*s_etat_processus).erreur_execution = d_ex;
200:
201: if ((*s_etat_processus).affichage_arguments == 'Y')
202: {
203: printf("\n ->DIAG ");
204:
205: if ((*s_etat_processus).langue == 'F')
206: {
207: printf("(conversion d'un vecteur en matrice diaginale)\n\n");
208: }
209: else
210: {
211: printf("(vector to diagonal matrix conversion)\n\n");
212: }
213:
214: printf("-> 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
215: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
216:
217: return;
218: }
219: else if ((*s_etat_processus).test_instruction == 'Y')
220: {
221: (*s_etat_processus).nombre_arguments = -1;
222: return;
223: }
224:
225: if (test_cfsf(s_etat_processus, 31) == d_vrai)
226: {
227: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
228: {
229: return;
230: }
231: }
232:
233: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
234: &s_objet_argument) == d_erreur)
235: {
236: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
237: return;
238: }
239:
240: /*
241: * Conversion d'un vecteur
242: */
243:
244: if ((*s_objet_argument).type == VIN)
245: {
246: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
247: {
248: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
249: return;
250: }
251:
252: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
253: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
254: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
255: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
256:
257: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.44 bertrand 258: malloc(((size_t) (*((struct_matrice *)
259: (*s_objet_resultat).objet)).nombre_lignes)
260: * sizeof(integer8 *))) == NULL)
1.1 bertrand 261: {
262: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
263: return;
264: }
265:
266: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
267: .nombre_lignes; i++)
268: {
269: if ((((integer8 **) (*((struct_matrice *)
270: (*s_objet_resultat).objet)).tableau)[i] =
1.44 bertrand 271: malloc(((size_t) (*((struct_matrice *)
272: (*s_objet_resultat).objet)).nombre_colonnes) *
1.1 bertrand 273: sizeof(integer8))) == NULL)
274: {
275: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
276: return;
277: }
278:
279: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
280: .nombre_colonnes; j++)
281: {
282: if (i != j)
283: {
284: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
285: .objet)).tableau)[i][j] = 0;
286: }
287: else
288: {
289: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
290: .objet)).tableau)[i][j] = ((integer8 *)
291: (*((struct_vecteur *) (*s_objet_argument)
292: .objet)).tableau)[i];
293: }
294: }
295: }
296: }
297: else if ((*s_objet_argument).type == VRL)
298: {
299: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
300: {
301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
302: return;
303: }
304:
305: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
306: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
307: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
308: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
309:
310: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.44 bertrand 311: malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat)
312: .objet)).nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 313: {
314: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
315: return;
316: }
317:
318: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
319: .nombre_lignes; i++)
320: {
321: if ((((real8 **) (*((struct_matrice *)
322: (*s_objet_resultat).objet)).tableau)[i] =
1.44 bertrand 323: malloc(((size_t) (*((struct_matrice *)
324: (*s_objet_resultat).objet)).nombre_colonnes) *
1.1 bertrand 325: sizeof(real8))) == NULL)
326: {
327: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
328: return;
329: }
330:
331: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
332: .nombre_colonnes; j++)
333: {
334: if (i != j)
335: {
336: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
337: .objet)).tableau)[i][j] = 0;
338: }
339: else
340: {
341: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
342: .objet)).tableau)[i][j] = ((real8 *)
343: (*((struct_vecteur *) (*s_objet_argument)
344: .objet)).tableau)[i];
345: }
346: }
347: }
348: }
349: else if ((*s_objet_argument).type == VCX)
350: {
351: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
352: {
353: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
354: return;
355: }
356:
357: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
358: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
359: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
360: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
361:
362: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.44 bertrand 363: malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat)
364: .objet)).nombre_lignes) * sizeof(complex16 *))) == NULL)
1.1 bertrand 365: {
366: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
367: return;
368: }
369:
370: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
371: .nombre_lignes; i++)
372: {
373: if ((((complex16 **) (*((struct_matrice *)
374: (*s_objet_resultat).objet)).tableau)[i] =
1.44 bertrand 375: malloc(((size_t) (*((struct_matrice *)
376: (*s_objet_resultat).objet)).nombre_colonnes) *
1.1 bertrand 377: sizeof(complex16))) == NULL)
378: {
379: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
380: return;
381: }
382:
383: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
384: .nombre_colonnes; j++)
385: {
386: if (i != j)
387: {
388: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
389: .objet)).tableau)[i][j].partie_reelle = 0;
390: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
391: .objet)).tableau)[i][j].partie_imaginaire = 0;
392: }
393: else
394: {
395: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
396: .objet)).tableau)[i][j] = ((complex16 *)
397: (*((struct_vecteur *) (*s_objet_argument)
398: .objet)).tableau)[i];
399: }
400: }
401: }
402: }
403:
404: /*
405: * Conversion impossible impossible
406: */
407:
408: else
409: {
410: liberation(s_etat_processus, s_objet_argument);
411:
412: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
413: return;
414: }
415:
416: liberation(s_etat_processus, s_objet_argument);
417:
418: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
419: s_objet_resultat) == d_erreur)
420: {
421: return;
422: }
423:
424: return;
425: }
426:
1.36 bertrand 427:
428: /*
429: ================================================================================
430: Fonction 'forall'
431: ================================================================================
432: Entrées : structure processus
433: --------------------------------------------------------------------------------
434: Sorties :
435: --------------------------------------------------------------------------------
436: Effets de bord : néant
437: ================================================================================
438: */
439:
440: void
441: instruction_forall(struct_processus *s_etat_processus)
442: {
443: struct_objet *s_objet_1;
444: struct_objet *s_objet_2;
445:
446: struct_variable s_variable;
447:
448: unsigned char instruction_valide;
449: unsigned char *tampon;
450: unsigned char test_instruction;
451:
452: (*s_etat_processus).erreur_execution = d_ex;
453:
454: if ((*s_etat_processus).affichage_arguments == 'Y')
455: {
456: printf("\n FORALL ");
457:
458: if ((*s_etat_processus).langue == 'F')
459: {
460: printf("(boucle définie sur un objet)\n\n");
461: }
462: else
463: {
464: printf("(define a object-based loop)\n\n");
465: }
466:
467: if ((*s_etat_processus).langue == 'F')
468: {
469: printf(" Utilisation :\n\n");
470: }
471: else
472: {
473: printf(" Usage:\n\n");
474: }
475:
1.41 bertrand 476: printf(" %s FORALL (variable)\n", d_LST);
477: printf(" (expression)\n");
478: printf(" [EXIT]/[CYCLE]\n");
479: printf(" ...\n");
480: printf(" NEXT\n\n");
481:
482: printf(" %s FORALL (variable)\n", d_TAB);
1.36 bertrand 483: printf(" (expression)\n");
1.37 bertrand 484: printf(" [EXIT]/[CYCLE]\n");
485: printf(" ...\n");
1.36 bertrand 486: printf(" NEXT\n");
487: return;
488: }
489: else if ((*s_etat_processus).test_instruction == 'Y')
490: {
491: (*s_etat_processus).nombre_arguments = -1;
492: return;
493: }
494:
495: if ((*s_etat_processus).erreur_systeme != d_es)
496: {
497: return;
498: }
499:
500: if (test_cfsf(s_etat_processus, 31) == d_vrai)
501: {
502: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
503: {
504: return;
505: }
506: }
507:
508: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
509: &s_objet_1) == d_erreur)
510: {
511: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
512: return;
513: }
514:
515: if (((*s_objet_1).type != LST) && ((*s_objet_1).type != TBL))
516: {
517: liberation(s_etat_processus, s_objet_1);
518:
519: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
520: return;
521: }
522:
523: empilement_pile_systeme(s_etat_processus);
524:
525: if ((*s_etat_processus).erreur_systeme != d_es)
526: {
527: return;
528: }
529:
530: if ((*s_etat_processus).mode_execution_programme == 'Y')
531: {
1.50 bertrand 532: tampon = (*s_etat_processus).instruction_courante;
533: test_instruction = (*s_etat_processus).test_instruction;
534: instruction_valide = (*s_etat_processus).instruction_valide;
535: (*s_etat_processus).test_instruction = 'Y';
536:
1.36 bertrand 537: if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
538: {
539: return;
540: }
541:
542: analyse(s_etat_processus, NULL);
543:
544: if ((*s_etat_processus).instruction_valide == 'Y')
545: {
546: liberation(s_etat_processus, s_objet_1);
547: free((*s_etat_processus).instruction_courante);
548: (*s_etat_processus).instruction_courante = tampon;
1.50 bertrand 549: (*s_etat_processus).instruction_valide = instruction_valide;
550: (*s_etat_processus).test_instruction = test_instruction;
1.36 bertrand 551:
552: depilement_pile_systeme(s_etat_processus);
553:
554: (*s_etat_processus).erreur_execution = d_ex_nom_reserve;
555: return;
556: }
557:
1.54 bertrand 558: (*s_etat_processus).type_en_cours = NON;
1.36 bertrand 559: recherche_type(s_etat_processus);
560:
561: free((*s_etat_processus).instruction_courante);
562: (*s_etat_processus).instruction_courante = tampon;
1.50 bertrand 563: (*s_etat_processus).instruction_valide = instruction_valide;
564: (*s_etat_processus).test_instruction = test_instruction;
1.36 bertrand 565:
566: if ((*s_etat_processus).erreur_execution != d_ex)
567: {
568: depilement_pile_systeme(s_etat_processus);
569: liberation(s_etat_processus, s_objet_1);
570: return;
571: }
572:
573: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
574: &s_objet_2) == d_erreur)
575: {
576: liberation(s_etat_processus, s_objet_1);
577:
578: depilement_pile_systeme(s_etat_processus);
579: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
580: return;
581: }
582:
583: (*(*s_etat_processus).l_base_pile_systeme)
584: .origine_routine_evaluation = 'N';
585: }
586: else
587: {
588: if ((*s_etat_processus).expression_courante == NULL)
589: {
590: depilement_pile_systeme(s_etat_processus);
591:
592: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
593: return;
594: }
595:
596: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
597: .expression_courante).suivant;
598:
599: if ((s_objet_2 = copie_objet(s_etat_processus,
600: (*(*s_etat_processus).expression_courante)
601: .donnee, 'P')) == NULL)
602: {
603: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
604: return;
605: }
606:
607: (*(*s_etat_processus).l_base_pile_systeme)
608: .origine_routine_evaluation = 'Y';
609: }
610:
611: if ((*s_objet_2).type != NOM)
612: {
613: liberation(s_etat_processus, s_objet_1);
614: depilement_pile_systeme(s_etat_processus);
615:
616: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
617: return;
618: }
619: else if ((*((struct_nom *) (*s_objet_2).objet)).symbole == d_vrai)
620: {
621: liberation(s_etat_processus, s_objet_1);
622: depilement_pile_systeme(s_etat_processus);
623:
624: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
625: return;
626: }
627:
628: (*s_etat_processus).niveau_courant++;
629: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'A';
630:
631: if ((s_variable.nom = malloc((strlen(
632: (*((struct_nom *) (*s_objet_2).objet)).nom) + 1) *
633: sizeof(unsigned char))) == NULL)
634: {
635: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
636: return;
637: }
638:
639: strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_2).objet)).nom);
640: s_variable.niveau = (*s_etat_processus).niveau_courant;
641:
642: if ((*s_objet_1).type == LST)
643: {
644: if ((*s_objet_1).objet == NULL)
645: {
646: // La liste est vide. On doit sauter au NEXT correspondant.
647: liberation(s_etat_processus, s_objet_1);
648: liberation(s_etat_processus, s_objet_2);
649: free(s_variable.nom);
650:
651: if (((*(*s_etat_processus).l_base_pile_systeme)
652: .limite_indice_boucle = allocation(s_etat_processus, NON))
653: == NULL)
654: {
655: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
656: return;
657: }
658:
659: instruction_cycle(s_etat_processus);
660: return;
661: }
662:
663: if ((s_variable.objet = copie_objet(s_etat_processus,
664: (*((struct_liste_chainee *) (*s_objet_1).objet)).donnee, 'P'))
665: == NULL)
666: {
667: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
668: return;
669: }
670:
671: // Mémorisation de la position courante dans la liste
672:
673: if (((*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
674: allocation(s_etat_processus, NON)) == NULL)
675: {
676: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
677: return;
678: }
679:
680: (*(*(*s_etat_processus).l_base_pile_systeme).indice_boucle).objet =
681: (struct_objet *) (*s_objet_1).objet;
682: }
683: else
684: {
685: if ((*((struct_tableau *) (*s_objet_1).objet)).nombre_elements == 0)
686: {
687: // La table est vide, il convient de sauter au NEXT correspondant.
688: liberation(s_etat_processus, s_objet_1);
689: liberation(s_etat_processus, s_objet_2);
690: free(s_variable.nom);
691:
692: if (((*(*s_etat_processus).l_base_pile_systeme)
693: .limite_indice_boucle = allocation(s_etat_processus, NON))
694: == NULL)
695: {
696: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
697: return;
698: }
699:
700: instruction_cycle(s_etat_processus);
701: return;
702: }
703:
704: if ((s_variable.objet = copie_objet(s_etat_processus,
705: (*((struct_tableau *) (*s_objet_1).objet)).elements[0], 'P'))
706: == NULL)
707: {
708: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
709: return;
710: }
711:
712: // Création d'un objet de type entier contenant la position
713: // de l'élément courant dans la table.
714:
715: if (((*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
716: allocation(s_etat_processus, INT)) == NULL)
717: {
718: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
719: return;
720: }
721:
722: (*((integer8 *) (*(*(*s_etat_processus).l_base_pile_systeme)
723: .indice_boucle).objet)) = 0;
724: }
725:
726: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') == d_erreur)
727: {
728: return;
729: }
730:
731: liberation(s_etat_processus, s_objet_2);
732:
733: (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
734:
735: if ((*s_etat_processus).mode_execution_programme == 'Y')
736: {
737: (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
738: (*s_etat_processus).position_courante;
739: }
740: else
741: {
742: (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
743: (*s_etat_processus).expression_courante;
744: }
745:
746: if (((*(*s_etat_processus).l_base_pile_systeme).nom_variable =
747: malloc((strlen(s_variable.nom) + 1) *
748: sizeof(unsigned char))) == NULL)
749: {
750: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
751: return;
752: }
753:
754: strcpy((*(*s_etat_processus).l_base_pile_systeme).nom_variable,
755: s_variable.nom);
756:
757: return;
758: }
759:
1.1 bertrand 760: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_f4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src