Annotation of rpl/src/instructions_f4.c, revision 1.36
1.1 bertrand 1: /*
2: ================================================================================
1.35 bertrand 3: RPL/2 (R) version 4.1.10
1.30 bertrand 4: Copyright (C) 1989-2012 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:
43: signed long i;
44: signed long nombre_elements;
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:
119: if ((unsigned long) nombre_elements >=
120: (*s_etat_processus).hauteur_pile_operationnelle)
121: {
122: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
123: return;
124: }
125:
126: if (test_cfsf(s_etat_processus, 31) == d_vrai)
127: {
128: if (empilement_pile_last(s_etat_processus, nombre_elements + 1)
129: == d_erreur)
130: {
131: return;
132: }
133: }
134:
135: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
136: &s_objet) == d_erreur)
137: {
138: return;
139: }
140:
141: liberation(s_etat_processus, s_objet);
142:
143: if ((s_objet = allocation(s_etat_processus, TBL)) == NULL)
144: {
145: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
146: return;
147: }
148:
149: (*((struct_tableau *) (*s_objet).objet)).nombre_elements =
150: nombre_elements;
151:
152: if (((*((struct_tableau *) (*s_objet).objet)).elements = malloc(
153: nombre_elements * sizeof(struct_objet *))) == NULL)
154: {
155: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
156: return;
157: }
158:
159: for(i = 0; i < nombre_elements; i++)
160: {
161: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
162: &((*((struct_tableau *) (*s_objet).objet)).elements
163: [nombre_elements - (i + 1)])) == d_erreur)
164: {
165: return;
166: }
167: }
168:
169: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
170: s_objet) == d_erreur)
171: {
172: return;
173: }
174:
175: return;
176: }
177:
178:
179: /*
180: ================================================================================
181: Fonction '->diag'
182: ================================================================================
183: Entrées : pointeur sur une structure struct_processus
184: --------------------------------------------------------------------------------
185: Sorties :
186: --------------------------------------------------------------------------------
187: Effets de bord : néant
188: ================================================================================
189: */
190:
191: void
192: instruction_fleche_diag(struct_processus *s_etat_processus)
193: {
194: struct_objet *s_objet_argument;
195: struct_objet *s_objet_resultat;
196:
197: unsigned long i;
198: unsigned long j;
199:
200: (*s_etat_processus).erreur_execution = d_ex;
201:
202: if ((*s_etat_processus).affichage_arguments == 'Y')
203: {
204: printf("\n ->DIAG ");
205:
206: if ((*s_etat_processus).langue == 'F')
207: {
208: printf("(conversion d'un vecteur en matrice diaginale)\n\n");
209: }
210: else
211: {
212: printf("(vector to diagonal matrix conversion)\n\n");
213: }
214:
215: printf("-> 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
216: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
217:
218: return;
219: }
220: else if ((*s_etat_processus).test_instruction == 'Y')
221: {
222: (*s_etat_processus).nombre_arguments = -1;
223: return;
224: }
225:
226: if (test_cfsf(s_etat_processus, 31) == d_vrai)
227: {
228: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
229: {
230: return;
231: }
232: }
233:
234: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
235: &s_objet_argument) == d_erreur)
236: {
237: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
238: return;
239: }
240:
241: /*
242: * Conversion d'un vecteur
243: */
244:
245: if ((*s_objet_argument).type == VIN)
246: {
247: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
248: {
249: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
250: return;
251: }
252:
253: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
254: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
255: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
256: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
257:
258: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
259: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
260: .nombre_lignes * sizeof(integer8 *))) == NULL)
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] =
271: malloc((*((struct_matrice *)
272: (*s_objet_resultat).objet)).nombre_colonnes *
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 =
311: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
312: .nombre_lignes * sizeof(real8 *))) == NULL)
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] =
323: malloc((*((struct_matrice *)
324: (*s_objet_resultat).objet)).nombre_colonnes *
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 =
363: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
364: .nombre_lignes * sizeof(complex16 *))) == NULL)
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] =
375: malloc((*((struct_matrice *)
376: (*s_objet_resultat).objet)).nombre_colonnes *
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:
! 476: printf(" %s/%s FORALL (variable)\n", d_LST, d_TAB);
! 477: printf(" (expression)\n");
! 478: printf(" NEXT\n");
! 479: return;
! 480: }
! 481: else if ((*s_etat_processus).test_instruction == 'Y')
! 482: {
! 483: (*s_etat_processus).nombre_arguments = -1;
! 484: return;
! 485: }
! 486:
! 487: if ((*s_etat_processus).erreur_systeme != d_es)
! 488: {
! 489: return;
! 490: }
! 491:
! 492: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 493: {
! 494: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 495: {
! 496: return;
! 497: }
! 498: }
! 499:
! 500: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 501: &s_objet_1) == d_erreur)
! 502: {
! 503: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 504: return;
! 505: }
! 506:
! 507: if (((*s_objet_1).type != LST) && ((*s_objet_1).type != TBL))
! 508: {
! 509: liberation(s_etat_processus, s_objet_1);
! 510:
! 511: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
! 512: return;
! 513: }
! 514:
! 515: tampon = (*s_etat_processus).instruction_courante;
! 516: test_instruction = (*s_etat_processus).test_instruction;
! 517: instruction_valide = (*s_etat_processus).instruction_valide;
! 518: (*s_etat_processus).test_instruction = 'Y';
! 519:
! 520: empilement_pile_systeme(s_etat_processus);
! 521:
! 522: if ((*s_etat_processus).erreur_systeme != d_es)
! 523: {
! 524: return;
! 525: }
! 526:
! 527: if ((*s_etat_processus).mode_execution_programme == 'Y')
! 528: {
! 529: if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
! 530: {
! 531: return;
! 532: }
! 533:
! 534: analyse(s_etat_processus, NULL);
! 535:
! 536: if ((*s_etat_processus).instruction_valide == 'Y')
! 537: {
! 538: liberation(s_etat_processus, s_objet_1);
! 539: free((*s_etat_processus).instruction_courante);
! 540: (*s_etat_processus).instruction_courante = tampon;
! 541:
! 542: depilement_pile_systeme(s_etat_processus);
! 543:
! 544: (*s_etat_processus).erreur_execution = d_ex_nom_reserve;
! 545: return;
! 546: }
! 547:
! 548: recherche_type(s_etat_processus);
! 549:
! 550: free((*s_etat_processus).instruction_courante);
! 551: (*s_etat_processus).instruction_courante = tampon;
! 552:
! 553: if ((*s_etat_processus).erreur_execution != d_ex)
! 554: {
! 555: depilement_pile_systeme(s_etat_processus);
! 556: liberation(s_etat_processus, s_objet_1);
! 557: return;
! 558: }
! 559:
! 560: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 561: &s_objet_2) == d_erreur)
! 562: {
! 563: liberation(s_etat_processus, s_objet_1);
! 564:
! 565: depilement_pile_systeme(s_etat_processus);
! 566: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 567: return;
! 568: }
! 569:
! 570: (*(*s_etat_processus).l_base_pile_systeme)
! 571: .origine_routine_evaluation = 'N';
! 572: }
! 573: else
! 574: {
! 575: if ((*s_etat_processus).expression_courante == NULL)
! 576: {
! 577: depilement_pile_systeme(s_etat_processus);
! 578:
! 579: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 580: return;
! 581: }
! 582:
! 583: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
! 584: .expression_courante).suivant;
! 585:
! 586: if ((s_objet_2 = copie_objet(s_etat_processus,
! 587: (*(*s_etat_processus).expression_courante)
! 588: .donnee, 'P')) == NULL)
! 589: {
! 590: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 591: return;
! 592: }
! 593:
! 594: (*(*s_etat_processus).l_base_pile_systeme)
! 595: .origine_routine_evaluation = 'Y';
! 596: }
! 597:
! 598: if ((*s_objet_2).type != NOM)
! 599: {
! 600: liberation(s_etat_processus, s_objet_1);
! 601: depilement_pile_systeme(s_etat_processus);
! 602:
! 603: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
! 604: return;
! 605: }
! 606: else if ((*((struct_nom *) (*s_objet_2).objet)).symbole == d_vrai)
! 607: {
! 608: liberation(s_etat_processus, s_objet_1);
! 609: depilement_pile_systeme(s_etat_processus);
! 610:
! 611: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
! 612: return;
! 613: }
! 614:
! 615: (*s_etat_processus).niveau_courant++;
! 616: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'A';
! 617:
! 618: if ((s_variable.nom = malloc((strlen(
! 619: (*((struct_nom *) (*s_objet_2).objet)).nom) + 1) *
! 620: sizeof(unsigned char))) == NULL)
! 621: {
! 622: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 623: return;
! 624: }
! 625:
! 626: strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_2).objet)).nom);
! 627: s_variable.niveau = (*s_etat_processus).niveau_courant;
! 628:
! 629: if ((*s_objet_1).type == LST)
! 630: {
! 631: if ((*s_objet_1).objet == NULL)
! 632: {
! 633: // La liste est vide. On doit sauter au NEXT correspondant.
! 634: liberation(s_etat_processus, s_objet_1);
! 635: liberation(s_etat_processus, s_objet_2);
! 636: free(s_variable.nom);
! 637:
! 638: if (((*(*s_etat_processus).l_base_pile_systeme)
! 639: .limite_indice_boucle = allocation(s_etat_processus, NON))
! 640: == NULL)
! 641: {
! 642: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 643: return;
! 644: }
! 645:
! 646: (*s_etat_processus).test_instruction = test_instruction;
! 647: (*s_etat_processus).instruction_valide = instruction_valide;
! 648:
! 649: instruction_cycle(s_etat_processus);
! 650: return;
! 651: }
! 652:
! 653: if ((s_variable.objet = copie_objet(s_etat_processus,
! 654: (*((struct_liste_chainee *) (*s_objet_1).objet)).donnee, 'P'))
! 655: == NULL)
! 656: {
! 657: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 658: return;
! 659: }
! 660:
! 661: // Mémorisation de la position courante dans la liste
! 662:
! 663: if (((*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
! 664: allocation(s_etat_processus, NON)) == NULL)
! 665: {
! 666: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 667: return;
! 668: }
! 669:
! 670: (*(*(*s_etat_processus).l_base_pile_systeme).indice_boucle).objet =
! 671: (struct_objet *) (*s_objet_1).objet;
! 672: }
! 673: else
! 674: {
! 675: if ((*((struct_tableau *) (*s_objet_1).objet)).nombre_elements == 0)
! 676: {
! 677: // La table est vide, il convient de sauter au NEXT correspondant.
! 678: liberation(s_etat_processus, s_objet_1);
! 679: liberation(s_etat_processus, s_objet_2);
! 680: free(s_variable.nom);
! 681:
! 682: if (((*(*s_etat_processus).l_base_pile_systeme)
! 683: .limite_indice_boucle = allocation(s_etat_processus, NON))
! 684: == NULL)
! 685: {
! 686: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 687: return;
! 688: }
! 689:
! 690: (*s_etat_processus).test_instruction = test_instruction;
! 691: (*s_etat_processus).instruction_valide = instruction_valide;
! 692:
! 693: instruction_cycle(s_etat_processus);
! 694: return;
! 695: }
! 696:
! 697: if ((s_variable.objet = copie_objet(s_etat_processus,
! 698: (*((struct_tableau *) (*s_objet_1).objet)).elements[0], 'P'))
! 699: == NULL)
! 700: {
! 701: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 702: return;
! 703: }
! 704:
! 705: // Création d'un objet de type entier contenant la position
! 706: // de l'élément courant dans la table.
! 707:
! 708: if (((*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
! 709: allocation(s_etat_processus, INT)) == NULL)
! 710: {
! 711: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 712: return;
! 713: }
! 714:
! 715: (*((integer8 *) (*(*(*s_etat_processus).l_base_pile_systeme)
! 716: .indice_boucle).objet)) = 0;
! 717: }
! 718:
! 719: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') == d_erreur)
! 720: {
! 721: return;
! 722: }
! 723:
! 724: liberation(s_etat_processus, s_objet_2);
! 725:
! 726: (*s_etat_processus).test_instruction = test_instruction;
! 727: (*s_etat_processus).instruction_valide = instruction_valide;
! 728:
! 729: (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
! 730:
! 731: if ((*s_etat_processus).mode_execution_programme == 'Y')
! 732: {
! 733: (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
! 734: (*s_etat_processus).position_courante;
! 735: }
! 736: else
! 737: {
! 738: (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
! 739: (*s_etat_processus).expression_courante;
! 740: }
! 741:
! 742: if (((*(*s_etat_processus).l_base_pile_systeme).nom_variable =
! 743: malloc((strlen(s_variable.nom) + 1) *
! 744: sizeof(unsigned char))) == NULL)
! 745: {
! 746: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 747: return;
! 748: }
! 749:
! 750: strcpy((*(*s_etat_processus).l_base_pile_systeme).nom_variable,
! 751: s_variable.nom);
! 752:
! 753: return;
! 754: }
! 755:
1.1 bertrand 756: // 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