Annotation of rpl/src/instructions_g2.c, revision 1.65
1.1 bertrand 1: /*
2: ================================================================================
1.64 bertrand 3: RPL/2 (R) version 4.1.29
4: Copyright (C) 1989-2018 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 'get'
29: ================================================================================
30: Entrées :
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
1.65 ! bertrand 38: static int
! 39: fonction_comparaison(const void *argument_1, const void *argument_2)
! 40: {
! 41: /*
! 42: uprintf("%p->%s\n",(unsigned char *) (**((struct_objet **) argument_2)).objet, (unsigned char *) (**((struct_objet **) argument_2)).objet);
! 43: uprintf("%p->%s\n",(unsigned char *) (**((struct_objet **) argument_1)).objet, (unsigned char *) (**((struct_objet **) argument_1)).objet);
! 44: */
! 45: return(strcmp((unsigned char *) (**((struct_objet **) argument_1)).objet,
! 46: (unsigned char *) (**((struct_objet **) argument_2)).objet));
! 47: }
! 48:
! 49:
1.1 bertrand 50: void
51: instruction_get(struct_processus *s_etat_processus)
52: {
53: logical1 variable_partagee;
54:
55: struct_liste_chainee *l_element_courant;
56:
57: struct_objet *s_objet_1;
58: struct_objet *s_objet_2;
59: struct_objet *s_objet_3;
60: struct_objet *s_objet_element;
1.65 ! bertrand 61: struct_objet *s_objet_noms;
1.1 bertrand 62: struct_objet *s_objet_resultat;
63:
1.44 bertrand 64: integer8 indice_i;
65: integer8 indice_j;
66: integer8 nombre_dimensions;
1.1 bertrand 67:
1.58 bertrand 68: unsigned char *registre_instruction_courante;
69: unsigned char registre_instruction_valide;
70: unsigned char registre_test;
71:
1.1 bertrand 72: (*s_etat_processus).erreur_execution = d_ex;
73:
74: if ((*s_etat_processus).affichage_arguments == 'Y')
75: {
76: printf("\n GET ");
77:
78: if ((*s_etat_processus).langue == 'F')
79: {
80: printf("(prend un élément)\n\n");
81: }
82: else
83: {
84: printf("(get element)\n\n");
85: }
86:
87: printf(" 2: %s, %s, %s, %s\n", d_VIN, d_VRL, d_VCX, d_NOM);
88: printf(" 1: %s\n", d_LST);
89: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
90:
91: printf(" 2: %s, %s, %s, %s\n", d_MIN, d_MRL, d_MCX, d_NOM);
92: printf(" 1: %s\n", d_LST);
93: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
94:
95: printf(" 2: %s, %s\n", d_TAB, d_NOM);
96: printf(" 1: %s\n", d_LST);
97: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
98: " %s, %s, %s, %s, %s,\n"
99: " %s, %s, %s, %s, %s,\n"
100: " %s, %s, %s, %s,\n"
101: " %s, %s\n\n",
102: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
103: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
104: d_SQL, d_SLB, d_PRC, d_MTX);
105:
1.65 ! bertrand 106: printf(" 2: %s\n", d_REC);
! 107: printf(" 1: %s\n", d_CHN);
! 108: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
! 109: " %s, %s, %s, %s, %s,\n"
! 110: " %s, %s, %s, %s, %s,\n"
! 111: " %s, %s, %s, %s,\n"
! 112: " %s, %s\n\n",
! 113: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 114: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 115: d_SQL, d_SLB, d_PRC, d_MTX);
! 116:
1.1 bertrand 117: printf(" 2: %s, %s\n", d_LST, d_NOM);
118: printf(" 1: %s\n", d_INT);
119: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
120: " %s, %s, %s, %s, %s,\n"
121: " %s, %s, %s, %s, %s,\n"
122: " %s, %s, %s, %s,\n"
123: " %s, %s\n",
124: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
125: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
126: d_SQL, d_SLB, d_PRC, d_MTX);
127:
128: return;
129: }
130: else if ((*s_etat_processus).test_instruction == 'Y')
131: {
132: (*s_etat_processus).nombre_arguments = -1;
133: return;
134: }
135:
136: if (test_cfsf(s_etat_processus, 31) == d_vrai)
137: {
138: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
139: {
140: return;
141: }
142: }
143:
144: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
145: &s_objet_1) == d_erreur)
146: {
147: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
148: return;
149: }
150:
151: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
152: &s_objet_2) == d_erreur)
153: {
154: liberation(s_etat_processus, s_objet_1);
155:
156: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
157: return;
158: }
159:
160: /*
161: --------------------------------------------------------------------------------
162: Traitement des éléments des vecteurs
163: --------------------------------------------------------------------------------
164: */
165:
166: if (((*s_objet_2).type == VIN) ||
167: ((*s_objet_2).type == VRL) ||
168: ((*s_objet_2).type == VCX))
169: {
170: if ((*s_objet_1).type != LST)
171: {
172: liberation(s_etat_processus, s_objet_1);
173: liberation(s_etat_processus, s_objet_2);
174:
175: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
176: return;
177: }
178:
179: l_element_courant = (*s_objet_1).objet;
180: nombre_dimensions = 0;
181:
182: while(l_element_courant != NULL)
183: {
184: nombre_dimensions++;
185: l_element_courant = (*l_element_courant).suivant;
186: }
187:
188: if (nombre_dimensions != 1)
189: {
190: liberation(s_etat_processus, s_objet_1);
191: liberation(s_etat_processus, s_objet_2);
192:
193: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
194: return;
195: }
196:
197: l_element_courant = (*s_objet_1).objet;
198:
199: if ((*(*l_element_courant).donnee).type != INT)
200: {
201: liberation(s_etat_processus, s_objet_1);
202: liberation(s_etat_processus, s_objet_2);
203:
204: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
205: return;
206: }
207:
208: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
209: {
210: liberation(s_etat_processus, s_objet_1);
211: liberation(s_etat_processus, s_objet_2);
212:
213: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
214: return;
215: }
216: else if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) >
217: (integer8) (*((struct_vecteur *) (*s_objet_2).objet)).taille)
218: {
219: liberation(s_etat_processus, s_objet_1);
220: liberation(s_etat_processus, s_objet_2);
221:
222: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
223: return;
224: }
225:
226: indice_i = (*((integer8 *) (*(*l_element_courant).donnee).objet));
227:
228: if ((*s_objet_2).type == VIN)
229: {
230: /*
231: * Vecteur d'entiers
232: */
233:
234: if ((s_objet_resultat = allocation(s_etat_processus, INT))
235: == NULL)
236: {
237: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
238: return;
239: }
240:
241: (*((integer8 *) (*s_objet_resultat).objet)) =
242: ((integer8 *) (*((struct_vecteur *) (*s_objet_2).objet))
243: .tableau)[indice_i - 1];
244: }
245: else if ((*s_objet_2).type == VRL)
246: {
247: /*
248: * Vecteur de réels
249: */
250:
251: if ((s_objet_resultat = allocation(s_etat_processus, REL))
252: == NULL)
253: {
254: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
255: return;
256: }
257:
258: (*((real8 *) (*s_objet_resultat).objet)) =
259: ((real8 *) (*((struct_vecteur *) (*s_objet_2).objet))
260: .tableau)[indice_i - 1];
261: }
262: else
263: {
264: /*
265: * Vecteur de complexes
266: */
267:
268: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
269: == NULL)
270: {
271: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
272: return;
273: }
274:
275: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle =
276: ((struct_complexe16 *) (*((struct_vecteur *)
277: (*s_objet_2).objet)).tableau)[indice_i - 1].partie_reelle;
278: (*((struct_complexe16 *) (*s_objet_resultat).objet))
279: .partie_imaginaire = ((struct_complexe16 *)
280: (*((struct_vecteur *) (*s_objet_2).objet)).tableau)
281: [indice_i - 1].partie_imaginaire;
282: }
283: }
284:
285: /*
286: --------------------------------------------------------------------------------
287: Traitement des éléments des matrices
288: --------------------------------------------------------------------------------
289: */
290:
291: else if (((*s_objet_2).type == MIN) ||
292: ((*s_objet_2).type == MRL) ||
293: ((*s_objet_2).type == MCX))
294: {
295: if ((*s_objet_1).type != LST)
296: {
297: liberation(s_etat_processus, s_objet_1);
298: liberation(s_etat_processus, s_objet_2);
299:
300: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
301: return;
302: }
303:
304: l_element_courant = (*s_objet_1).objet;
305: nombre_dimensions = 0;
306:
307: while(l_element_courant != NULL)
308: {
309: nombre_dimensions++;
310: l_element_courant = (*l_element_courant).suivant;
311: }
312:
313: if (nombre_dimensions != 2)
314: {
315: liberation(s_etat_processus, s_objet_1);
316: liberation(s_etat_processus, s_objet_2);
317:
318: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
319: return;
320: }
321:
322: l_element_courant = (*s_objet_1).objet;
323:
324: indice_i = 0;
325: indice_j = 0;
326:
327: while(l_element_courant != NULL)
328: {
329: if ((*(*l_element_courant).donnee).type != INT)
330: {
331: liberation(s_etat_processus, s_objet_1);
332: liberation(s_etat_processus, s_objet_2);
333:
334: (*s_etat_processus).erreur_execution =
335: d_ex_erreur_type_argument;
336: return;
337: }
338:
339: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
340: {
341: liberation(s_etat_processus, s_objet_1);
342: liberation(s_etat_processus, s_objet_2);
343:
344: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
345: return;
346: }
347:
348: if (indice_i == 0)
349: {
350: indice_i = (*((integer8 *)
351: (*(*l_element_courant).donnee).objet));
352: }
353: else
354: {
355: indice_j = (*((integer8 *)
356: (*(*l_element_courant).donnee).objet));
357: }
358:
359: l_element_courant = (*l_element_courant).suivant;
360: }
361:
362: if ((indice_i > (*((struct_matrice *) (*s_objet_2).objet))
363: .nombre_lignes) || (indice_j > (*((struct_matrice *)
364: (*s_objet_2).objet)).nombre_colonnes))
365: {
366: liberation(s_etat_processus, s_objet_1);
367: liberation(s_etat_processus, s_objet_2);
368:
369: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
370: return;
371: }
372:
373: if ((*s_objet_2).type == MIN)
374: {
375: /*
376: * Matrice d'entiers
377: */
378:
379: if ((s_objet_resultat = allocation(s_etat_processus, INT))
380: == NULL)
381: {
382: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
383: return;
384: }
385:
386: (*((integer8 *) (*s_objet_resultat).objet)) =
387: ((integer8 **) (*((struct_matrice *) (*s_objet_2).objet))
388: .tableau)[indice_i - 1][indice_j - 1];
389: }
390: else if ((*s_objet_2).type == MRL)
391: {
392: /*
393: * Matrice de réels
394: */
395:
396: if ((s_objet_resultat = allocation(s_etat_processus, REL))
397: == NULL)
398: {
399: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
400: return;
401: }
402:
403: (*((real8 *) (*s_objet_resultat).objet)) =
404: ((real8 **) (*((struct_matrice *) (*s_objet_2).objet))
405: .tableau)[indice_i - 1][indice_j - 1];
406: }
407: else
408: {
409: /*
410: * Matrices de complexes
411: */
412:
413: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
414: == NULL)
415: {
416: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
417: return;
418: }
419:
420: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle =
421: ((struct_complexe16 **) (*((struct_matrice *)
422: (*s_objet_2).objet)).tableau)[indice_i - 1]
423: [indice_j - 1].partie_reelle;
424: (*((struct_complexe16 *) (*s_objet_resultat).objet))
425: .partie_imaginaire = ((struct_complexe16 **)
426: (*((struct_matrice *) (*s_objet_2).objet)).tableau)
427: [indice_i - 1][indice_j - 1].partie_imaginaire;
428: }
429: }
430:
431: /*
432: --------------------------------------------------------------------------------
433: Traitement des listes
434: --------------------------------------------------------------------------------
435: */
436:
437: else if ((*s_objet_2).type == LST)
438: {
439: if ((*s_objet_1).type != INT)
440: {
441: liberation(s_etat_processus, s_objet_1);
442: liberation(s_etat_processus, s_objet_2);
443:
444: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
445: return;
446: }
447:
448: indice_i = (*((integer8 *) (*s_objet_1).objet));
449: indice_j = 1;
450:
451: l_element_courant = (*s_objet_2).objet;
452:
453: while((l_element_courant != NULL) && (indice_j != indice_i))
454: {
455: l_element_courant = (*l_element_courant).suivant;
456: indice_j++;
457: }
458:
459: if (l_element_courant != NULL)
460: {
461: if ((s_objet_resultat = copie_objet(s_etat_processus,
462: (*l_element_courant).donnee, 'P')) == NULL)
463: {
464: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
465: return;
466: }
467: }
468: else
469: {
470: liberation(s_etat_processus, s_objet_1);
471: liberation(s_etat_processus, s_objet_2);
472:
473: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
474: return;
475: }
476: }
477:
478: /*
479: --------------------------------------------------------------------------------
480: Traitement des tables
481: --------------------------------------------------------------------------------
482: */
483:
484: else if ((*s_objet_2).type == TBL)
485: {
486: if ((*s_objet_1).type != LST)
487: {
488: liberation(s_etat_processus, s_objet_1);
489: liberation(s_etat_processus, s_objet_2);
490:
491: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
492: return;
493: }
494:
495: l_element_courant = (*s_objet_1).objet;
496: s_objet_element = s_objet_2;
497:
498: while(l_element_courant != NULL)
499: {
500: if ((*(*l_element_courant).donnee).type != INT)
501: {
502: liberation(s_etat_processus, s_objet_1);
503: liberation(s_etat_processus, s_objet_2);
504:
505: (*s_etat_processus).erreur_execution =
506: d_ex_erreur_type_argument;
507: return;
508: }
509:
510: if ((*s_objet_element).type != TBL)
511: {
512: liberation(s_etat_processus, s_objet_1);
513: liberation(s_etat_processus, s_objet_2);
514:
515: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
516: return;
517: }
518:
519: indice_i = (*((integer8 *) (*(*l_element_courant).donnee).objet));
520:
521: if ((indice_i < 1) || (indice_i > (*((struct_tableau *)
522: (*s_objet_element).objet)).nombre_elements))
523: {
524: liberation(s_etat_processus, s_objet_1);
525: liberation(s_etat_processus, s_objet_2);
526:
527: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
528: return;
529: }
530:
531: s_objet_element = (*((struct_tableau *) (*s_objet_element)
532: .objet)).elements[indice_i - 1];
533: l_element_courant = (*l_element_courant).suivant;
534: }
535:
536: if ((s_objet_resultat = copie_objet(s_etat_processus,
537: s_objet_element, 'P')) == NULL)
538: {
539: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
540: return;
541: }
542: }
543:
544: /*
545: --------------------------------------------------------------------------------
1.65 ! bertrand 546: Traitement des enregistrements
! 547: --------------------------------------------------------------------------------
! 548: */
! 549:
! 550: else if ((*s_objet_2).type == REC)
! 551: {
! 552: if ((*s_objet_1).type != CHN)
! 553: {
! 554: liberation(s_etat_processus, s_objet_1);
! 555: liberation(s_etat_processus, s_objet_2);
! 556:
! 557: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 558: return;
! 559: }
! 560:
! 561: s_objet_noms = (*((struct_record *) (*s_objet_2).objet)).noms;
! 562:
! 563: int i;
! 564: for(i = 0; i < (*((struct_tableau *) (*s_objet_noms).objet)).nombre_elements; uprintf("%d->%p (%s)\n", i,
! 565: (unsigned char *) (*(*((struct_tableau *) (*s_objet_noms).objet)).elements[i]).objet,
! 566: (unsigned char *) (*(*((struct_tableau *) (*s_objet_noms).objet)).elements[i]).objet), i++);
! 567:
! 568: s_objet_element = bsearch((unsigned char *) (*s_objet_1).objet,
! 569: (*((struct_tableau *) (*s_objet_noms).objet)).elements,
! 570: (size_t) (*((struct_tableau *) (*s_objet_noms).objet))
! 571: .nombre_elements, sizeof(struct_objet *), fonction_comparaison);
! 572:
! 573: uprintf("%d\n", s_objet_element - (*((struct_tableau *) (*s_objet_2).objet)).elements[0]);
! 574:
! 575: /*
! 576: l_element_courant = (*s_objet_1).objet;
! 577: s_objet_element = s_objet_2;
! 578:
! 579:
! 580: while(l_element_courant != NULL)
! 581: {
! 582: if ((*(*l_element_courant).donnee).type != INT)
! 583: {
! 584: liberation(s_etat_processus, s_objet_1);
! 585: liberation(s_etat_processus, s_objet_2);
! 586:
! 587: (*s_etat_processus).erreur_execution =
! 588: d_ex_erreur_type_argument;
! 589: return;
! 590: }
! 591:
! 592: if ((*s_objet_element).type != TBL)
! 593: {
! 594: liberation(s_etat_processus, s_objet_1);
! 595: liberation(s_etat_processus, s_objet_2);
! 596:
! 597: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 598: return;
! 599: }
! 600:
! 601: indice_i = (*((integer8 *) (*(*l_element_courant).donnee).objet));
! 602:
! 603: if ((indice_i < 1) || (indice_i > (*((struct_tableau *)
! 604: (*s_objet_element).objet)).nombre_elements))
! 605: {
! 606: liberation(s_etat_processus, s_objet_1);
! 607: liberation(s_etat_processus, s_objet_2);
! 608:
! 609: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
! 610: return;
! 611: }
! 612:
! 613: s_objet_element = (*((struct_tableau *) (*s_objet_element)
! 614: .objet)).elements[indice_i - 1];
! 615: l_element_courant = (*l_element_courant).suivant;
! 616: }
! 617: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 618: s_objet_element, 'P')) == NULL)
! 619: {
! 620: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 621: return;
! 622: }
! 623: */
! 624: }
! 625: /*
! 626: --------------------------------------------------------------------------------
1.1 bertrand 627: Traitement des variables
628: --------------------------------------------------------------------------------
629: */
630:
631: else if ((*s_objet_2).type == NOM)
632: {
633: variable_partagee = d_faux;
634:
635: if (recherche_variable(s_etat_processus, (*((struct_nom *)
636: (*s_objet_2).objet)).nom) == d_faux)
637: {
638: (*s_etat_processus).erreur_systeme = d_es;
639: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
640:
641: liberation(s_etat_processus, s_objet_1);
642: liberation(s_etat_processus, s_objet_2);
643:
644: return;
645: }
646:
1.19 bertrand 647: s_objet_3 = (*(*s_etat_processus).pointeur_variable_courante).objet;
1.1 bertrand 648:
649: if (s_objet_3 == NULL)
650: {
651: if (recherche_variable_partagee(s_etat_processus,
1.19 bertrand 652: (*(*s_etat_processus).pointeur_variable_courante).nom,
653: (*(*s_etat_processus).pointeur_variable_courante)
654: .variable_partagee, (*(*s_etat_processus)
1.39 bertrand 655: .pointeur_variable_courante).origine) == NULL)
1.1 bertrand 656: {
657: (*s_etat_processus).erreur_systeme = d_es;
658: (*s_etat_processus).erreur_execution =
659: d_ex_variable_non_definie;
660:
661: liberation(s_etat_processus, s_objet_1);
662: liberation(s_etat_processus, s_objet_2);
663:
664: return;
665: }
666:
1.38 bertrand 667: s_objet_3 = (*(*s_etat_processus)
668: .pointeur_variable_partagee_courante).objet;
1.1 bertrand 669: variable_partagee = d_vrai;
670: }
671:
672: if (((*s_objet_3).type == VIN) ||
673: ((*s_objet_3).type == VRL) ||
674: ((*s_objet_3).type == VCX))
675: {
676: if ((*s_objet_1).type != LST)
677: {
678: if (variable_partagee == d_vrai)
679: {
680: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 681: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 682: {
683: (*s_etat_processus).erreur_systeme = d_es_processus;
684: return;
685: }
686: }
687:
688: liberation(s_etat_processus, s_objet_1);
689: liberation(s_etat_processus, s_objet_2);
690:
691: (*s_etat_processus).erreur_execution =
692: d_ex_erreur_type_argument;
693: return;
694: }
695:
696: l_element_courant = (*s_objet_1).objet;
697: nombre_dimensions = 0;
698:
699: while(l_element_courant != NULL)
700: {
701: nombre_dimensions++;
702: l_element_courant = (*l_element_courant).suivant;
703: }
704:
705: if (nombre_dimensions != 1)
706: {
707: if (variable_partagee == d_vrai)
708: {
709: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 710: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 711: {
712: (*s_etat_processus).erreur_systeme = d_es_processus;
713: return;
714: }
715: }
716:
717: liberation(s_etat_processus, s_objet_1);
718: liberation(s_etat_processus, s_objet_2);
719:
720: (*s_etat_processus).erreur_execution =
721: d_ex_dimensions_invalides;
722: return;
723: }
724:
725: l_element_courant = (*s_objet_1).objet;
726:
727: if ((*(*l_element_courant).donnee).type != INT)
728: {
729: if (variable_partagee == d_vrai)
730: {
731: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 732: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 733: {
734: (*s_etat_processus).erreur_systeme = d_es_processus;
735: return;
736: }
737: }
738:
739: liberation(s_etat_processus, s_objet_1);
740: liberation(s_etat_processus, s_objet_2);
741:
742: (*s_etat_processus).erreur_execution =
743: d_ex_erreur_type_argument;
744: return;
745: }
746:
747: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
748: {
749: if (variable_partagee == d_vrai)
750: {
751: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 752: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 753: {
754: (*s_etat_processus).erreur_systeme = d_es_processus;
755: return;
756: }
757: }
758:
759: liberation(s_etat_processus, s_objet_1);
760: liberation(s_etat_processus, s_objet_2);
761:
762: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
763: return;
764: }
765: else if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) >
766: (integer8) (*((struct_vecteur *) (*s_objet_3).objet))
767: .taille)
768: {
769: if (variable_partagee == d_vrai)
770: {
771: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 772: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 773: {
774: (*s_etat_processus).erreur_systeme = d_es_processus;
775: return;
776: }
777: }
778:
779: liberation(s_etat_processus, s_objet_1);
780: liberation(s_etat_processus, s_objet_2);
781:
782: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
783: return;
784: }
785:
786: indice_i = (*((integer8 *) (*(*l_element_courant).donnee).objet));
787:
788: if ((*s_objet_3).type == VIN)
789: {
790: /*
791: * Vecteur d'entiers
792: */
793:
794: if ((s_objet_resultat = allocation(s_etat_processus, INT))
795: == NULL)
796: {
797: if (variable_partagee == d_vrai)
798: {
799: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 800: .pointeur_variable_partagee_courante).mutex))
801: != 0)
1.1 bertrand 802: {
803: (*s_etat_processus).erreur_systeme = d_es_processus;
804: return;
805: }
806: }
807:
808: (*s_etat_processus).erreur_systeme
809: = d_es_allocation_memoire;
810: return;
811: }
812:
813: (*((integer8 *) (*s_objet_resultat).objet)) =
814: ((integer8 *) (*((struct_vecteur *)
815: (*s_objet_3).objet)).tableau)[indice_i - 1];
816: }
817: else if ((*s_objet_3).type == VRL)
818: {
819: /*
820: * Vecteur de réels
821: */
822:
823: if ((s_objet_resultat = allocation(s_etat_processus, REL))
824: == NULL)
825: {
826: if (variable_partagee == d_vrai)
827: {
828: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 829: .pointeur_variable_partagee_courante).mutex))
830: != 0)
1.1 bertrand 831: {
832: (*s_etat_processus).erreur_systeme = d_es_processus;
833: return;
834: }
835: }
836:
837: (*s_etat_processus).erreur_systeme
838: = d_es_allocation_memoire;
839: return;
840: }
841:
842: (*((real8 *) (*s_objet_resultat).objet)) =
843: ((real8 *) (*((struct_vecteur *) (*s_objet_3).objet))
844: .tableau)[indice_i - 1];
845: }
846: else
847: {
848: /*
849: * Vecteur de complexes
850: */
851:
852: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
853: == NULL)
854: {
855: if (variable_partagee == d_vrai)
856: {
857: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 858: .pointeur_variable_partagee_courante).mutex))
859: != 0)
1.1 bertrand 860: {
861: (*s_etat_processus).erreur_systeme = d_es_processus;
862: return;
863: }
864: }
865:
866: (*s_etat_processus).erreur_systeme
867: = d_es_allocation_memoire;
868: return;
869: }
870:
871: (*((struct_complexe16 *) (*s_objet_resultat).objet))
872: .partie_reelle = ((struct_complexe16 *)
873: (*((struct_vecteur *) (*s_objet_3).objet))
874: .tableau)[indice_i - 1].partie_reelle;
875: (*((struct_complexe16 *) (*s_objet_resultat).objet))
876: .partie_imaginaire = ((struct_complexe16 *)
877: (*((struct_vecteur *) (*s_objet_3).objet)).tableau)
878: [indice_i - 1].partie_imaginaire;
879: }
880: }
881: else if (((*s_objet_3).type == MIN) ||
882: ((*s_objet_3).type == MRL) ||
883: ((*s_objet_3).type == MCX))
884: {
885: if ((*s_objet_1).type != LST)
886: {
887: if (variable_partagee == d_vrai)
888: {
889: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 890: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 891: {
892: (*s_etat_processus).erreur_systeme = d_es_processus;
893: return;
894: }
895: }
896:
897: liberation(s_etat_processus, s_objet_1);
898: liberation(s_etat_processus, s_objet_2);
899:
900: (*s_etat_processus).erreur_execution =
901: d_ex_erreur_type_argument;
902: return;
903: }
904:
905: l_element_courant = (*s_objet_1).objet;
906: nombre_dimensions = 0;
907:
908: while(l_element_courant != NULL)
909: {
910: nombre_dimensions++;
911: l_element_courant = (*l_element_courant).suivant;
912: }
913:
914: if (nombre_dimensions != 2)
915: {
916: if (variable_partagee == d_vrai)
917: {
918: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 919: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 920: {
921: (*s_etat_processus).erreur_systeme = d_es_processus;
922: return;
923: }
924: }
925:
926: liberation(s_etat_processus, s_objet_1);
927: liberation(s_etat_processus, s_objet_2);
928:
929: (*s_etat_processus).erreur_execution =
930: d_ex_dimensions_invalides;
931: return;
932: }
933:
934: l_element_courant = (*s_objet_1).objet;
935:
936: indice_i = 0;
937: indice_j = 0;
938:
939: while(l_element_courant != NULL)
940: {
941: if ((*(*l_element_courant).donnee).type != INT)
942: {
943: if (variable_partagee == d_vrai)
944: {
945: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 946: .pointeur_variable_partagee_courante).mutex))
947: != 0)
1.1 bertrand 948: {
949: (*s_etat_processus).erreur_systeme = d_es_processus;
950: return;
951: }
952: }
953:
954: liberation(s_etat_processus, s_objet_1);
955: liberation(s_etat_processus, s_objet_2);
956:
957: (*s_etat_processus).erreur_execution =
958: d_ex_erreur_type_argument;
959: return;
960: }
961:
962: if ((*((integer8 *) (*(*l_element_courant)
963: .donnee).objet)) <= 0)
964: {
965: if (variable_partagee == d_vrai)
966: {
967: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 968: .pointeur_variable_partagee_courante).mutex))
969: != 0)
1.1 bertrand 970: {
971: (*s_etat_processus).erreur_systeme = d_es_processus;
972: return;
973: }
974: }
975:
976: liberation(s_etat_processus, s_objet_1);
977: liberation(s_etat_processus, s_objet_2);
978:
979: (*s_etat_processus).erreur_execution =
980: d_ex_argument_invalide;
981: return;
982: }
983:
984: if (indice_i == 0)
985: {
986: indice_i = (*((integer8 *)
987: (*(*l_element_courant).donnee).objet));
988: }
989: else
990: {
991: indice_j = (*((integer8 *)
992: (*(*l_element_courant).donnee).objet));
993: }
994:
995: l_element_courant = (*l_element_courant).suivant;
996: }
997:
998: if ((indice_i > (*((struct_matrice *) (*s_objet_3).objet))
999: .nombre_lignes) || (indice_j > (*((struct_matrice *)
1000: (*s_objet_3).objet)).nombre_colonnes))
1001: {
1002: if (variable_partagee == d_vrai)
1003: {
1004: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1005: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1006: {
1007: (*s_etat_processus).erreur_systeme = d_es_processus;
1008: return;
1009: }
1010: }
1011:
1012: liberation(s_etat_processus, s_objet_1);
1013: liberation(s_etat_processus, s_objet_2);
1014:
1015: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
1016: return;
1017: }
1018:
1019: if ((*s_objet_3).type == MIN)
1020: {
1021: /*
1022: * Matrice d'entiers
1023: */
1024:
1025: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1026: == NULL)
1027: {
1028: if (variable_partagee == d_vrai)
1029: {
1030: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1031: .pointeur_variable_partagee_courante).mutex))
1032: != 0)
1.1 bertrand 1033: {
1034: (*s_etat_processus).erreur_systeme = d_es_processus;
1035: return;
1036: }
1037: }
1038:
1039: (*s_etat_processus).erreur_systeme =
1040: d_es_allocation_memoire;
1041: return;
1042: }
1043:
1044: (*((integer8 *) (*s_objet_resultat).objet)) =
1045: ((integer8 **) (*((struct_matrice *)
1046: (*s_objet_3).objet))
1047: .tableau)[indice_i - 1][indice_j - 1];
1048: }
1049: else if ((*s_objet_3).type == MRL)
1050: {
1051: /*
1052: * Matrice de réels
1053: */
1054:
1055: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1056: == NULL)
1057: {
1058: if (variable_partagee == d_vrai)
1059: {
1060: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1061: .pointeur_variable_partagee_courante).mutex))
1062: != 0)
1.1 bertrand 1063: {
1064: (*s_etat_processus).erreur_systeme = d_es_processus;
1065: return;
1066: }
1067: }
1068:
1069: (*s_etat_processus).erreur_systeme =
1070: d_es_allocation_memoire;
1071: return;
1072: }
1073:
1074: (*((real8 *) (*s_objet_resultat).objet)) =
1075: ((real8 **) (*((struct_matrice *) (*s_objet_3).objet))
1076: .tableau)[indice_i - 1][indice_j - 1];
1077: }
1078: else
1079: {
1080: /*
1081: * Matrices de complexes
1082: */
1083:
1084: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
1085: == NULL)
1086: {
1087: if (variable_partagee == d_vrai)
1088: {
1089: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1090: .pointeur_variable_partagee_courante).mutex))
1091: != 0)
1.1 bertrand 1092: {
1093: (*s_etat_processus).erreur_systeme = d_es_processus;
1094: return;
1095: }
1096: }
1097:
1098: (*s_etat_processus).erreur_systeme =
1099: d_es_allocation_memoire;
1100: return;
1101: }
1102:
1103: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1104: .partie_reelle = ((struct_complexe16 **)
1105: (*((struct_matrice *)
1106: (*s_objet_3).objet)).tableau)[indice_i - 1]
1107: [indice_j - 1].partie_reelle;
1108: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1109: .partie_imaginaire = ((struct_complexe16 **)
1110: (*((struct_matrice *) (*s_objet_3).objet)).tableau)
1111: [indice_i - 1][indice_j - 1].partie_imaginaire;
1112: }
1113: }
1114: else if ((*s_objet_3).type == LST)
1115: {
1116: if ((*s_objet_1).type != INT)
1117: {
1118: if (variable_partagee == d_vrai)
1119: {
1120: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1121: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1122: {
1123: (*s_etat_processus).erreur_systeme = d_es_processus;
1124: return;
1125: }
1126: }
1127:
1128: liberation(s_etat_processus, s_objet_1);
1129: liberation(s_etat_processus, s_objet_2);
1130:
1131: (*s_etat_processus).erreur_execution =
1132: d_ex_erreur_type_argument;
1133: return;
1134: }
1135:
1136: indice_i = (*((integer8 *) (*s_objet_1).objet));
1137: indice_j = 1;
1138:
1139: l_element_courant = (*s_objet_3).objet;
1140:
1141: while((l_element_courant != NULL) && (indice_j != indice_i))
1142: {
1143: l_element_courant = (*l_element_courant).suivant;
1144: indice_j++;
1145: }
1146:
1147: if (l_element_courant != NULL)
1148: {
1149: if ((s_objet_resultat = copie_objet(s_etat_processus,
1150: (*l_element_courant).donnee, 'P')) == NULL)
1151: {
1152: if (variable_partagee == d_vrai)
1153: {
1154: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1155: .pointeur_variable_partagee_courante).mutex))
1156: != 0)
1.1 bertrand 1157: {
1158: (*s_etat_processus).erreur_systeme = d_es_processus;
1159: return;
1160: }
1161: }
1162:
1163: (*s_etat_processus).erreur_systeme =
1164: d_es_allocation_memoire;
1165: return;
1166: }
1167: }
1168: else
1169: {
1170: if (variable_partagee == d_vrai)
1171: {
1172: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1173: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1174: {
1175: (*s_etat_processus).erreur_systeme = d_es_processus;
1176: return;
1177: }
1178: }
1179:
1180: liberation(s_etat_processus, s_objet_1);
1181: liberation(s_etat_processus, s_objet_2);
1182:
1183: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
1184: return;
1185: }
1186: }
1187: else if ((*s_objet_3).type == TBL)
1188: {
1189: if ((*s_objet_1).type != LST)
1190: {
1191: if (variable_partagee == d_vrai)
1192: {
1193: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1194: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1195: {
1196: (*s_etat_processus).erreur_systeme = d_es_processus;
1197: return;
1198: }
1199: }
1200:
1201: liberation(s_etat_processus, s_objet_1);
1202: liberation(s_etat_processus, s_objet_2);
1203:
1204: (*s_etat_processus).erreur_execution =
1205: d_ex_erreur_type_argument;
1206: return;
1207: }
1208:
1209: l_element_courant = (*s_objet_1).objet;
1210: s_objet_element = s_objet_3;
1211:
1212: while(l_element_courant != NULL)
1213: {
1214: if ((*(*l_element_courant).donnee).type != INT)
1215: {
1216: if (variable_partagee == d_vrai)
1217: {
1218: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1219: .pointeur_variable_partagee_courante).mutex))
1220: != 0)
1.1 bertrand 1221: {
1222: (*s_etat_processus).erreur_systeme = d_es_processus;
1223: return;
1224: }
1225: }
1226:
1227: liberation(s_etat_processus, s_objet_1);
1228: liberation(s_etat_processus, s_objet_2);
1229:
1230: (*s_etat_processus).erreur_execution =
1231: d_ex_erreur_type_argument;
1232: return;
1233: }
1234:
1235: if ((*s_objet_element).type != TBL)
1236: {
1237: if (variable_partagee == d_vrai)
1238: {
1239: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1240: .pointeur_variable_partagee_courante).mutex))
1241: != 0)
1.1 bertrand 1242: {
1243: (*s_etat_processus).erreur_systeme = d_es_processus;
1244: return;
1245: }
1246: }
1247:
1248: liberation(s_etat_processus, s_objet_1);
1249: liberation(s_etat_processus, s_objet_2);
1250:
1251: (*s_etat_processus).erreur_execution =
1252: d_ex_element_inexistant;
1253: return;
1254: }
1255:
1256: indice_i = (*((integer8 *) (*(*l_element_courant)
1257: .donnee).objet));
1258:
1259: if ((indice_i < 1) || (indice_i > (*((struct_tableau *)
1260: (*s_objet_element).objet)).nombre_elements))
1261: {
1262: if (variable_partagee == d_vrai)
1263: {
1264: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1265: .pointeur_variable_partagee_courante).mutex))
1266: != 0)
1.1 bertrand 1267: {
1268: (*s_etat_processus).erreur_systeme = d_es_processus;
1269: return;
1270: }
1271: }
1272:
1273: liberation(s_etat_processus, s_objet_1);
1274: liberation(s_etat_processus, s_objet_2);
1275:
1276: (*s_etat_processus).erreur_execution =
1277: d_ex_element_inexistant;
1278: return;
1279: }
1280:
1281: s_objet_element = (*((struct_tableau *) (*s_objet_element)
1282: .objet)).elements[indice_i - 1];
1283: l_element_courant = (*l_element_courant).suivant;
1284: }
1285:
1286: if ((s_objet_resultat = copie_objet(s_etat_processus,
1287: s_objet_element, 'P')) == NULL)
1288: {
1289: if (variable_partagee == d_vrai)
1290: {
1291: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1292: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1293: {
1294: (*s_etat_processus).erreur_systeme = d_es_processus;
1295: return;
1296: }
1297: }
1298:
1299: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1300: return;
1301: }
1302: }
1303: else
1304: {
1305: if (variable_partagee == d_vrai)
1306: {
1307: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1308: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1309: {
1310: (*s_etat_processus).erreur_systeme = d_es_processus;
1311: return;
1312: }
1313: }
1314:
1315: liberation(s_etat_processus, s_objet_1);
1316: liberation(s_etat_processus, s_objet_2);
1317:
1318: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1319: return;
1320: }
1321:
1322: if (variable_partagee == d_vrai)
1323: {
1324: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1325: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1326: {
1327: (*s_etat_processus).erreur_systeme = d_es_processus;
1328: return;
1329: }
1330: }
1331: }
1332:
1333: /*
1334: --------------------------------------------------------------------------------
1335: Type incompatible avec la fonction GET
1336: --------------------------------------------------------------------------------
1337: */
1338:
1339: else
1340: {
1341: liberation(s_etat_processus, s_objet_1);
1342: liberation(s_etat_processus, s_objet_2);
1343:
1344: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1345: return;
1346: }
1347:
1.58 bertrand 1348: liberation(s_etat_processus, s_objet_1);
1349: liberation(s_etat_processus, s_objet_2);
1350:
1351: if ((*s_objet_resultat).type == NOM)
1.1 bertrand 1352: {
1.58 bertrand 1353: if ((*((struct_nom *) (*s_objet_resultat).objet)).symbole == d_faux)
1354: {
1355: if (evaluation(s_etat_processus, s_objet_resultat, 'E') == d_erreur)
1356: {
1357: return;
1358: }
1359: }
1360: else
1361: {
1362: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1363: s_objet_resultat) == d_erreur)
1364: {
1365: return;
1366: }
1367: }
1.1 bertrand 1368: }
1.58 bertrand 1369: else if ((*s_objet_resultat).type == FCT)
1370: {
1371: registre_test = (*s_etat_processus).test_instruction;
1372: registre_instruction_courante = (*s_etat_processus)
1373: .instruction_courante;
1374: registre_instruction_valide = (*s_etat_processus)
1375: .instruction_valide;
1376:
1377: (*s_etat_processus).test_instruction = 'Y';
1378: (*s_etat_processus).instruction_courante =
1379: (*((struct_fonction *) (*s_objet_resultat).objet)).nom_fonction;
1380:
1381: analyse(s_etat_processus, NULL);
1.1 bertrand 1382:
1.58 bertrand 1383: (*s_etat_processus).test_instruction = registre_test;
1384: (*s_etat_processus).instruction_courante =
1385: registre_instruction_courante;
1386:
1387: if (((*s_etat_processus).instruction_valide == 'Y') &&
1388: (*s_etat_processus).constante_symbolique == 'Y')
1389: {
1390: if (evaluation(s_etat_processus, s_objet_resultat, 'E') == d_erreur)
1391: {
1392: (*s_etat_processus).instruction_valide =
1393: registre_instruction_valide;
1394: return;
1395: }
1396: }
1397: else
1398: {
1399: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1400: s_objet_resultat) == d_erreur)
1401: {
1402: (*s_etat_processus).instruction_valide =
1403: registre_instruction_valide;
1404: return;
1405: }
1406: }
1407:
1408: (*s_etat_processus).instruction_valide = registre_instruction_valide;
1409: }
1410: else
1411: {
1412: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1413: s_objet_resultat) == d_erreur)
1414: {
1415: return;
1416: }
1417: }
1.1 bertrand 1418:
1419: return;
1420: }
1421:
1422:
1423: /*
1424: ================================================================================
1425: Fonction 'geti'
1426: ================================================================================
1427: Entrées :
1428: --------------------------------------------------------------------------------
1429: Sorties :
1430: --------------------------------------------------------------------------------
1431: Effets de bord : néant
1432: ================================================================================
1433: */
1434:
1435: void
1436: instruction_geti(struct_processus *s_etat_processus)
1437: {
1438: logical1 variable_partagee;
1439:
1440: struct_liste_chainee *l_element_courant;
1441:
1442: struct_objet *s_copie_1;
1443: struct_objet *s_objet_1;
1444: struct_objet *s_objet_2;
1445: struct_objet *s_objet_3;
1446: struct_objet *s_objet_resultat;
1447:
1.44 bertrand 1448: integer8 indice_i;
1449: integer8 indice_j;
1450: integer8 nombre_dimensions;
1451: integer8 nombre_elements;
1.1 bertrand 1452:
1.58 bertrand 1453: unsigned char *registre_instruction_courante;
1454: unsigned char registre_instruction_valide;
1455: unsigned char registre_test;
1456:
1.1 bertrand 1457: (*s_etat_processus).erreur_execution = d_ex;
1458:
1459: if ((*s_etat_processus).affichage_arguments == 'Y')
1460: {
1461: printf("\n GETI ");
1462:
1463: if ((*s_etat_processus).langue == 'F')
1464: {
1465: printf("(prend un élément)\n\n");
1466: }
1467: else
1468: {
1469: printf("(get element)\n\n");
1470: }
1471:
1472: printf(" 2: %s, %s, %s, %s\n", d_VIN, d_VRL, d_VCX, d_NOM);
1473: printf(" 1: %s\n", d_LST);
1474: printf("-> 3: %s, %s, %s, %s\n", d_VIN, d_VRL, d_VCX, d_NOM);
1475: printf(" 2: %s\n", d_LST);
1476: printf(" 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
1477:
1478: printf(" 2: %s, %s, %s, %s\n", d_MIN, d_MRL, d_MCX, d_NOM);
1479: printf(" 1: %s\n", d_LST);
1480: printf("-> 3: %s, %s, %s, %s\n", d_MIN, d_MRL, d_MCX, d_NOM);
1481: printf(" 2: %s\n", d_LST);
1482: printf(" 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
1483:
1484: printf(" 2: %s, %s\n", d_LST, d_NOM);
1485: printf(" 1: %s\n", d_INT);
1486: printf("-> 3: %s, %s\n", d_LST, d_NOM);
1487: printf(" 2: %s\n", d_INT);
1488: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
1489: " %s, %s, %s, %s, %s,\n"
1490: " %s, %s, %s, %s, %s,\n"
1491: " %s, %s, %s, %s,\n"
1492: " %s, %s\n",
1493: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1494: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
1495: d_SQL, d_SLB, d_PRC, d_MTX);
1496:
1497: return;
1498: }
1499: else if ((*s_etat_processus).test_instruction == 'Y')
1500: {
1501: (*s_etat_processus).nombre_arguments = -1;
1502: return;
1503: }
1504:
1505: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1506: {
1507: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1508: {
1509: return;
1510: }
1511: }
1512:
1513: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1514: &s_objet_1) == d_erreur)
1515: {
1516: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1517: return;
1518: }
1519:
1520: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1521: &s_objet_2) == d_erreur)
1522: {
1523: liberation(s_etat_processus, s_objet_1);
1524:
1525: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1526: return;
1527: }
1528:
1529: if ((s_copie_1 = copie_objet(s_etat_processus, s_objet_1, 'O')) == NULL)
1530: {
1531: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1532: return;
1533: }
1534:
1535: liberation(s_etat_processus, s_objet_1);
1536: s_objet_1 = s_copie_1;
1537:
1538: /*
1539: --------------------------------------------------------------------------------
1540: Traitement des éléments des vecteurs
1541: --------------------------------------------------------------------------------
1542: */
1543:
1544: if (((*s_objet_2).type == VIN) ||
1545: ((*s_objet_2).type == VRL) ||
1546: ((*s_objet_2).type == VCX))
1547: {
1548: if ((*s_objet_1).type != LST)
1549: {
1550: liberation(s_etat_processus, s_objet_1);
1551: liberation(s_etat_processus, s_objet_2);
1552:
1553: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1554: return;
1555: }
1556:
1557: l_element_courant = (*s_objet_1).objet;
1558: nombre_dimensions = 0;
1559:
1560: while(l_element_courant != NULL)
1561: {
1562: nombre_dimensions++;
1563: l_element_courant = (*l_element_courant).suivant;
1564: }
1565:
1566: if (nombre_dimensions != 1)
1567: {
1568: liberation(s_etat_processus, s_objet_1);
1569: liberation(s_etat_processus, s_objet_2);
1570:
1571: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1572: return;
1573: }
1574:
1575: l_element_courant = (*s_objet_1).objet;
1576:
1577: if ((*(*l_element_courant).donnee).type != INT)
1578: {
1579: liberation(s_etat_processus, s_objet_1);
1580: liberation(s_etat_processus, s_objet_2);
1581:
1582: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1583: return;
1584: }
1585:
1586: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
1587: {
1588: liberation(s_etat_processus, s_objet_1);
1589: liberation(s_etat_processus, s_objet_2);
1590:
1591: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1592: return;
1593: }
1594: else if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) >
1595: (integer8) (*((struct_vecteur *) (*s_objet_2).objet)).taille)
1596: {
1597: liberation(s_etat_processus, s_objet_1);
1598: liberation(s_etat_processus, s_objet_2);
1599:
1600: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
1601: return;
1602: }
1603:
1604: indice_i = (*((integer8 *) (*(*l_element_courant).donnee).objet));
1605:
1606: if ((*s_objet_2).type == VIN)
1607: {
1608: /*
1609: * Vecteur d'entiers
1610: */
1611:
1612: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1613: == NULL)
1614: {
1615: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1616: return;
1617: }
1618:
1619: (*((integer8 *) (*s_objet_resultat).objet)) =
1620: ((integer8 *) (*((struct_vecteur *) (*s_objet_2).objet))
1621: .tableau)[indice_i - 1];
1622: }
1623: else if ((*s_objet_2).type == VRL)
1624: {
1625: /*
1626: * Vecteur de réels
1627: */
1628:
1629: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1630: == NULL)
1631: {
1632: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1633: return;
1634: }
1635:
1636: (*((real8 *) (*s_objet_resultat).objet)) =
1637: ((real8 *) (*((struct_vecteur *) (*s_objet_2).objet))
1638: .tableau)[indice_i - 1];
1639: }
1640: else
1641: {
1642: /*
1643: * Vecteur de complexes
1644: */
1645:
1646: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
1647: == NULL)
1648: {
1649: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1650: return;
1651: }
1652:
1653: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle =
1654: ((struct_complexe16 *) (*((struct_vecteur *)
1655: (*s_objet_2).objet)).tableau)[indice_i - 1].partie_reelle;
1656: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1657: .partie_imaginaire = ((struct_complexe16 *)
1658: (*((struct_vecteur *) (*s_objet_2).objet)).tableau)
1659: [indice_i - 1].partie_imaginaire;
1660: }
1661:
1662: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
1663: (indice_i % (*((struct_vecteur *) (*s_objet_2).objet)).taille)
1664: + 1;
1665: }
1666:
1667: /*
1668: --------------------------------------------------------------------------------
1669: Traitement des éléments des matrices
1670: --------------------------------------------------------------------------------
1671: */
1672:
1673: else if (((*s_objet_2).type == MIN) ||
1674: ((*s_objet_2).type == MRL) ||
1675: ((*s_objet_2).type == MCX))
1676: {
1677: if ((*s_objet_1).type != LST)
1678: {
1679: liberation(s_etat_processus, s_objet_1);
1680: liberation(s_etat_processus, s_objet_2);
1681:
1682: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1683: return;
1684: }
1685:
1686: l_element_courant = (*s_objet_1).objet;
1687: nombre_dimensions = 0;
1688:
1689: while(l_element_courant != NULL)
1690: {
1691: nombre_dimensions++;
1692: l_element_courant = (*l_element_courant).suivant;
1693: }
1694:
1695: if (nombre_dimensions != 2)
1696: {
1697: liberation(s_etat_processus, s_objet_1);
1698: liberation(s_etat_processus, s_objet_2);
1699:
1700: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1701: return;
1702: }
1703:
1704: l_element_courant = (*s_objet_1).objet;
1705:
1706: indice_i = 0;
1707: indice_j = 0;
1708:
1709: while(l_element_courant != NULL)
1710: {
1711: if ((*(*l_element_courant).donnee).type != INT)
1712: {
1713: liberation(s_etat_processus, s_objet_1);
1714: liberation(s_etat_processus, s_objet_2);
1715:
1716: (*s_etat_processus).erreur_execution =
1717: d_ex_erreur_type_argument;
1718: return;
1719: }
1720:
1721: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
1722: {
1723: liberation(s_etat_processus, s_objet_1);
1724: liberation(s_etat_processus, s_objet_2);
1725:
1726: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1727: return;
1728: }
1729:
1730: if (indice_i == 0)
1731: {
1732: indice_i = (*((integer8 *)
1733: (*(*l_element_courant).donnee).objet));
1734: }
1735: else
1736: {
1737: indice_j = (*((integer8 *)
1738: (*(*l_element_courant).donnee).objet));
1739: }
1740:
1741: l_element_courant = (*l_element_courant).suivant;
1742: }
1743:
1744: if ((indice_i > (*((struct_matrice *) (*s_objet_2).objet))
1745: .nombre_lignes) || (indice_j > (*((struct_matrice *)
1746: (*s_objet_2).objet)).nombre_colonnes))
1747: {
1748: liberation(s_etat_processus, s_objet_1);
1749: liberation(s_etat_processus, s_objet_2);
1750:
1751: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
1752: return;
1753: }
1754:
1755: if ((*s_objet_2).type == MIN)
1756: {
1757: /*
1758: * Matrice d'entiers
1759: */
1760:
1761: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1762: == NULL)
1763: {
1764: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1765: return;
1766: }
1767:
1768: (*((integer8 *) (*s_objet_resultat).objet)) =
1769: ((integer8 **) (*((struct_matrice *) (*s_objet_2).objet))
1770: .tableau)[indice_i - 1][indice_j - 1];
1771: }
1772: else if ((*s_objet_2).type == MRL)
1773: {
1774: /*
1775: * Matrice de réels
1776: */
1777:
1778: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1779: == NULL)
1780: {
1781: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1782: return;
1783: }
1784:
1785: (*((real8 *) (*s_objet_resultat).objet)) =
1786: ((real8 **) (*((struct_matrice *) (*s_objet_2).objet))
1787: .tableau)[indice_i - 1][indice_j - 1];
1788: }
1789: else
1790: {
1791: /*
1792: * Matrices de complexes
1793: */
1794:
1795: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
1796: == NULL)
1797: {
1798: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1799: return;
1800: }
1801:
1802: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle =
1803: ((struct_complexe16 **) (*((struct_matrice *)
1804: (*s_objet_2).objet)).tableau)[indice_i - 1]
1805: [indice_j - 1].partie_reelle;
1806: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1807: .partie_imaginaire = ((struct_complexe16 **)
1808: (*((struct_matrice *) (*s_objet_2).objet)).tableau)
1809: [indice_i - 1][indice_j - 1].partie_imaginaire;
1810: }
1811:
1812:
1813: if ((++(*((integer8 *) (*(*(*((struct_liste_chainee *)
1814: (*s_objet_1).objet)).suivant).donnee).objet))) >
1815: (integer8) (*((struct_matrice *) (*s_objet_2).objet))
1816: .nombre_colonnes)
1817: {
1818: (*((integer8 *) (*(*(*((struct_liste_chainee *) (*s_objet_1)
1819: .objet)).suivant).donnee).objet)) = 1;
1820:
1821: if ((++(*((integer8 *) (*(*((struct_liste_chainee *)
1822: (*s_objet_1).objet)).donnee).objet))) >
1823: (integer8) (*((struct_matrice *) (*s_objet_2).objet))
1824: .nombre_lignes)
1825: {
1826: (*((integer8 *) (*(*((struct_liste_chainee *)
1827: (*s_objet_1).objet)).donnee).objet)) = 1;
1828: }
1829: }
1830: }
1831:
1832: /*
1833: --------------------------------------------------------------------------------
1834: Traitement des listes
1835: --------------------------------------------------------------------------------
1836: */
1837:
1838: else if ((*s_objet_2).type == LST)
1839: {
1840: if ((*s_objet_1).type != INT)
1841: {
1842: liberation(s_etat_processus, s_objet_1);
1843: liberation(s_etat_processus, s_objet_2);
1844:
1845: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1846: return;
1847: }
1848:
1849: nombre_elements = 0;
1850: l_element_courant = (*s_objet_2).objet;
1851:
1852: while(l_element_courant != NULL)
1853: {
1854: l_element_courant = (*l_element_courant).suivant;
1855: nombre_elements++;
1856: }
1857:
1858: indice_i = (*((integer8 *) (*s_objet_1).objet));
1859: indice_j = 1;
1860: l_element_courant = (*s_objet_2).objet;
1861:
1862: while((l_element_courant != NULL) && (indice_j != indice_i))
1863: {
1864: l_element_courant = (*l_element_courant).suivant;
1865: indice_j++;
1866: }
1867:
1868: if (l_element_courant != NULL)
1869: {
1870: if ((s_objet_resultat = copie_objet(s_etat_processus,
1871: (*l_element_courant).donnee, 'O')) == NULL)
1872: {
1873: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1874: return;
1875: }
1876: }
1877: else
1878: {
1879: liberation(s_etat_processus, s_objet_1);
1880: liberation(s_etat_processus, s_objet_2);
1881:
1882: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
1883: return;
1884: }
1885:
1886: (*((integer8 *) (*s_objet_1).objet)) =
1887: (indice_i % nombre_elements) + 1;
1888: }
1889:
1890: /*
1891: --------------------------------------------------------------------------------
1892: Traitement des variables
1893: --------------------------------------------------------------------------------
1894: */
1895:
1896: else if ((*s_objet_2).type == NOM)
1897: {
1898: variable_partagee = d_faux;
1899:
1900: if (recherche_variable(s_etat_processus, (*((struct_nom *)
1901: (*s_objet_2).objet)).nom) == d_faux)
1902: {
1903: (*s_etat_processus).erreur_systeme = d_es;
1904: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
1905:
1906: liberation(s_etat_processus, s_objet_1);
1907: liberation(s_etat_processus, s_objet_2);
1908:
1909: return;
1910: }
1911:
1.19 bertrand 1912: s_objet_3 = (*(*s_etat_processus).pointeur_variable_courante).objet;
1.1 bertrand 1913:
1914: if (s_objet_3 == NULL)
1915: {
1916: if (recherche_variable_partagee(s_etat_processus,
1.19 bertrand 1917: (*(*s_etat_processus).pointeur_variable_courante).nom,
1918: (*(*s_etat_processus).pointeur_variable_courante)
1919: .variable_partagee, (*(*s_etat_processus)
1.39 bertrand 1920: .pointeur_variable_courante).origine) == NULL)
1.1 bertrand 1921: {
1922: (*s_etat_processus).erreur_systeme = d_es;
1923: (*s_etat_processus).erreur_execution =
1924: d_ex_variable_non_definie;
1925:
1926: liberation(s_etat_processus, s_objet_1);
1927: liberation(s_etat_processus, s_objet_2);
1928:
1929: return;
1930: }
1931:
1.38 bertrand 1932: s_objet_3 = (*(*s_etat_processus)
1933: .pointeur_variable_partagee_courante).objet;
1.1 bertrand 1934: variable_partagee = d_vrai;
1935: }
1936:
1937: if (((*s_objet_3).type == VIN) ||
1938: ((*s_objet_3).type == VRL) ||
1939: ((*s_objet_3).type == VCX))
1940: {
1941: if ((*s_objet_1).type != LST)
1942: {
1943: if (variable_partagee == d_vrai)
1944: {
1945: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1946: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1947: {
1948: (*s_etat_processus).erreur_systeme = d_es_processus;
1949: return;
1950: }
1951: }
1952:
1953: liberation(s_etat_processus, s_objet_1);
1954: liberation(s_etat_processus, s_objet_2);
1955:
1956: (*s_etat_processus).erreur_execution =
1957: d_ex_erreur_type_argument;
1958: return;
1959: }
1960:
1961: l_element_courant = (*s_objet_1).objet;
1962: nombre_dimensions = 0;
1963:
1964: while(l_element_courant != NULL)
1965: {
1966: nombre_dimensions++;
1967: l_element_courant = (*l_element_courant).suivant;
1968: }
1969:
1970: if (nombre_dimensions != 1)
1971: {
1972: if (variable_partagee == d_vrai)
1973: {
1974: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1975: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1976: {
1977: (*s_etat_processus).erreur_systeme = d_es_processus;
1978: return;
1979: }
1980: }
1981:
1982: liberation(s_etat_processus, s_objet_1);
1983: liberation(s_etat_processus, s_objet_2);
1984:
1985: (*s_etat_processus).erreur_execution =
1986: d_ex_dimensions_invalides;
1987: return;
1988: }
1989:
1990: l_element_courant = (*s_objet_1).objet;
1991:
1992: if ((*(*l_element_courant).donnee).type != INT)
1993: {
1994: if (variable_partagee == d_vrai)
1995: {
1996: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 1997: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 1998: {
1999: (*s_etat_processus).erreur_systeme = d_es_processus;
2000: return;
2001: }
2002: }
2003:
2004: liberation(s_etat_processus, s_objet_1);
2005: liberation(s_etat_processus, s_objet_2);
2006:
2007: (*s_etat_processus).erreur_execution =
2008: d_ex_erreur_type_argument;
2009: return;
2010: }
2011:
2012: if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) <= 0)
2013: {
2014: if (variable_partagee == d_vrai)
2015: {
2016: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2017: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 2018: {
2019: (*s_etat_processus).erreur_systeme = d_es_processus;
2020: return;
2021: }
2022: }
2023:
2024: liberation(s_etat_processus, s_objet_1);
2025: liberation(s_etat_processus, s_objet_2);
2026:
2027: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2028: return;
2029: }
2030: else if ((*((integer8 *) (*(*l_element_courant).donnee).objet)) >
2031: (integer8) (*((struct_vecteur *) (*s_objet_3).objet))
2032: .taille)
2033: {
2034: if (variable_partagee == d_vrai)
2035: {
2036: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2037: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 2038: {
2039: (*s_etat_processus).erreur_systeme = d_es_processus;
2040: return;
2041: }
2042: }
2043:
2044: liberation(s_etat_processus, s_objet_1);
2045: liberation(s_etat_processus, s_objet_2);
2046:
2047: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
2048: return;
2049: }
2050:
2051: indice_i = (*((integer8 *) (*(*l_element_courant).donnee).objet));
2052:
2053: if ((*s_objet_3).type == VIN)
2054: {
2055: /*
2056: * Vecteur d'entiers
2057: */
2058:
2059: if ((s_objet_resultat = allocation(s_etat_processus, INT))
2060: == NULL)
2061: {
2062: if (variable_partagee == d_vrai)
2063: {
2064: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2065: .pointeur_variable_partagee_courante).mutex))
2066: != 0)
1.1 bertrand 2067: {
2068: (*s_etat_processus).erreur_systeme = d_es_processus;
2069: return;
2070: }
2071: }
2072:
2073: (*s_etat_processus).erreur_systeme
2074: = d_es_allocation_memoire;
2075: return;
2076: }
2077:
2078: (*((integer8 *) (*s_objet_resultat).objet)) =
2079: ((integer8 *) (*((struct_vecteur *)
2080: (*s_objet_3).objet)).tableau)[indice_i - 1];
2081: }
2082: else if ((*s_objet_3).type == VRL)
2083: {
2084: /*
2085: * Vecteur de réels
2086: */
2087:
2088: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2089: == NULL)
2090: {
2091: if (variable_partagee == d_vrai)
2092: {
2093: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2094: .pointeur_variable_partagee_courante).mutex))
2095: != 0)
1.1 bertrand 2096: {
2097: (*s_etat_processus).erreur_systeme = d_es_processus;
2098: return;
2099: }
2100: }
2101:
2102: (*s_etat_processus).erreur_systeme
2103: = d_es_allocation_memoire;
2104: return;
2105: }
2106:
2107: (*((real8 *) (*s_objet_resultat).objet)) =
2108: ((real8 *) (*((struct_vecteur *) (*s_objet_3).objet))
2109: .tableau)[indice_i - 1];
2110: }
2111: else
2112: {
2113: /*
2114: * Vecteur de complexes
2115: */
2116:
2117: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2118: == NULL)
2119: {
2120: if (variable_partagee == d_vrai)
2121: {
2122: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2123: .pointeur_variable_partagee_courante).mutex))
2124: != 0)
1.1 bertrand 2125: {
2126: (*s_etat_processus).erreur_systeme = d_es_processus;
2127: return;
2128: }
2129: }
2130:
2131: (*s_etat_processus).erreur_systeme
2132: = d_es_allocation_memoire;
2133: return;
2134: }
2135:
2136: (*((struct_complexe16 *) (*s_objet_resultat).objet))
2137: .partie_reelle = ((struct_complexe16 *)
2138: (*((struct_vecteur *) (*s_objet_3).objet))
2139: .tableau)[indice_i - 1].partie_reelle;
2140: (*((struct_complexe16 *) (*s_objet_resultat).objet))
2141: .partie_imaginaire = ((struct_complexe16 *)
2142: (*((struct_vecteur *) (*s_objet_3).objet)).tableau)
2143: [indice_i - 1].partie_imaginaire;
2144: }
2145:
2146: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
2147: (indice_i % (*((struct_vecteur *) (*s_objet_3).objet))
2148: .taille) + 1;
2149: }
2150: else if (((*s_objet_3).type == MIN) ||
2151: ((*s_objet_3).type == MRL) ||
2152: ((*s_objet_3).type == MCX))
2153: {
2154: if ((*s_objet_1).type != LST)
2155: {
2156: if (variable_partagee == d_vrai)
2157: {
2158: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2159: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 2160: {
2161: (*s_etat_processus).erreur_systeme = d_es_processus;
2162: return;
2163: }
2164: }
2165:
2166: liberation(s_etat_processus, s_objet_1);
2167: liberation(s_etat_processus, s_objet_2);
2168:
2169: (*s_etat_processus).erreur_execution =
2170: d_ex_erreur_type_argument;
2171: return;
2172: }
2173:
2174: l_element_courant = (*s_objet_1).objet;
2175: nombre_dimensions = 0;
2176:
2177: while(l_element_courant != NULL)
2178: {
2179: nombre_dimensions++;
2180: l_element_courant = (*l_element_courant).suivant;
2181: }
2182:
2183: if (nombre_dimensions != 2)
2184: {
2185: if (variable_partagee == d_vrai)
2186: {
2187: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2188: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 2189: {
2190: (*s_etat_processus).erreur_systeme = d_es_processus;
2191: return;
2192: }
2193: }
2194:
2195: liberation(s_etat_processus, s_objet_1);
2196: liberation(s_etat_processus, s_objet_2);
2197:
2198: (*s_etat_processus).erreur_execution =
2199: d_ex_dimensions_invalides;
2200: return;
2201: }
2202:
2203: l_element_courant = (*s_objet_1).objet;
2204:
2205: indice_i = 0;
2206: indice_j = 0;
2207:
2208: while(l_element_courant != NULL)
2209: {
2210: if ((*(*l_element_courant).donnee).type != INT)
2211: {
2212: if (variable_partagee == d_vrai)
2213: {
2214: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2215: .pointeur_variable_partagee_courante).mutex))
2216: != 0)
1.1 bertrand 2217: {
2218: (*s_etat_processus).erreur_systeme = d_es_processus;
2219: return;
2220: }
2221: }
2222:
2223: liberation(s_etat_processus, s_objet_1);
2224: liberation(s_etat_processus, s_objet_2);
2225:
2226: (*s_etat_processus).erreur_execution =
2227: d_ex_erreur_type_argument;
2228: return;
2229: }
2230:
2231: if ((*((integer8 *) (*(*l_element_courant)
2232: .donnee).objet)) <= 0)
2233: {
2234: if (variable_partagee == d_vrai)
2235: {
2236: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2237: .pointeur_variable_partagee_courante).mutex))
2238: != 0)
1.1 bertrand 2239: {
2240: (*s_etat_processus).erreur_systeme = d_es_processus;
2241: return;
2242: }
2243: }
2244:
2245: liberation(s_etat_processus, s_objet_1);
2246: liberation(s_etat_processus, s_objet_2);
2247:
2248: (*s_etat_processus).erreur_execution =
2249: d_ex_argument_invalide;
2250: return;
2251: }
2252:
2253: if (indice_i == 0)
2254: {
2255: indice_i = (*((integer8 *)
2256: (*(*l_element_courant).donnee).objet));
2257: }
2258: else
2259: {
2260: indice_j = (*((integer8 *)
2261: (*(*l_element_courant).donnee).objet));
2262: }
2263:
2264: l_element_courant = (*l_element_courant).suivant;
2265: }
2266:
2267: if ((indice_i > (*((struct_matrice *) (*s_objet_3).objet))
2268: .nombre_lignes) || (indice_j > (*((struct_matrice *)
2269: (*s_objet_3).objet)).nombre_colonnes))
2270: {
2271: if (variable_partagee == d_vrai)
2272: {
2273: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2274: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 2275: {
2276: (*s_etat_processus).erreur_systeme = d_es_processus;
2277: return;
2278: }
2279: }
2280:
2281: liberation(s_etat_processus, s_objet_1);
2282: liberation(s_etat_processus, s_objet_2);
2283:
2284: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
2285: return;
2286: }
2287:
2288: if ((*s_objet_3).type == MIN)
2289: {
2290: /*
2291: * Matrice d'entiers
2292: */
2293:
2294: if ((s_objet_resultat = allocation(s_etat_processus, INT))
2295: == NULL)
2296: {
2297: if (variable_partagee == d_vrai)
2298: {
2299: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2300: .pointeur_variable_partagee_courante).mutex))
2301: != 0)
1.1 bertrand 2302: {
2303: (*s_etat_processus).erreur_systeme = d_es_processus;
2304: return;
2305: }
2306: }
2307:
2308: (*s_etat_processus).erreur_systeme =
2309: d_es_allocation_memoire;
2310: return;
2311: }
2312:
2313: (*((integer8 *) (*s_objet_resultat).objet)) =
2314: ((integer8 **) (*((struct_matrice *)
2315: (*s_objet_3).objet))
2316: .tableau)[indice_i - 1][indice_j - 1];
2317: }
2318: else if ((*s_objet_3).type == MRL)
2319: {
2320: /*
2321: * Matrice de réels
2322: */
2323:
2324: if ((s_objet_resultat = allocation(s_etat_processus, REL))
2325: == NULL)
2326: {
2327: if (variable_partagee == d_vrai)
2328: {
2329: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2330: .pointeur_variable_partagee_courante).mutex))
2331: != 0)
1.1 bertrand 2332: {
2333: (*s_etat_processus).erreur_systeme = d_es_processus;
2334: return;
2335: }
2336: }
2337:
2338: (*s_etat_processus).erreur_systeme =
2339: d_es_allocation_memoire;
2340: return;
2341: }
2342:
2343: (*((real8 *) (*s_objet_resultat).objet)) =
2344: ((real8 **) (*((struct_matrice *) (*s_objet_3).objet))
2345: .tableau)[indice_i - 1][indice_j - 1];
2346: }
2347: else
2348: {
2349: /*
2350: * Matrices de complexes
2351: */
2352:
2353: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2354: == NULL)
2355: {
2356: if (variable_partagee == d_vrai)
2357: {
2358: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2359: .pointeur_variable_partagee_courante).mutex))
2360: != 0)
1.1 bertrand 2361: {
2362: (*s_etat_processus).erreur_systeme = d_es_processus;
2363: return;
2364: }
2365: }
2366:
2367: (*s_etat_processus).erreur_systeme =
2368: d_es_allocation_memoire;
2369: return;
2370: }
2371:
2372: (*((struct_complexe16 *) (*s_objet_resultat).objet))
2373: .partie_reelle = ((struct_complexe16 **)
2374: (*((struct_matrice *)
2375: (*s_objet_3).objet)).tableau)[indice_i - 1]
2376: [indice_j - 1].partie_reelle;
2377: (*((struct_complexe16 *) (*s_objet_resultat).objet))
2378: .partie_imaginaire = ((struct_complexe16 **)
2379: (*((struct_matrice *) (*s_objet_3).objet)).tableau)
2380: [indice_i - 1][indice_j - 1].partie_imaginaire;
2381: }
2382:
2383: if ((++(*((integer8 *) (*(*(*((struct_liste_chainee *)
2384: (*s_objet_1).objet)).suivant).donnee).objet))) >
2385: (integer8) (*((struct_matrice *) (*s_objet_3).objet))
2386: .nombre_colonnes)
2387: {
2388: (*((integer8 *) (*(*(*((struct_liste_chainee *) (*s_objet_1)
2389: .objet)).suivant).donnee).objet)) = 1;
2390:
2391: if ((++(*((integer8 *) (*(*((struct_liste_chainee *)
2392: (*s_objet_1).objet)).donnee).objet))) >
2393: (integer8) (*((struct_matrice *) (*s_objet_3).objet))
2394: .nombre_lignes)
2395: {
2396: (*((integer8 *) (*(*((struct_liste_chainee *)
2397: (*s_objet_1).objet)).donnee).objet)) = 1;
2398: }
2399: }
2400: }
2401: else if ((*s_objet_3).type == LST)
2402: {
2403: if ((*s_objet_1).type != INT)
2404: {
2405: if (variable_partagee == d_vrai)
2406: {
2407: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2408: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 2409: {
2410: (*s_etat_processus).erreur_systeme = d_es_processus;
2411: return;
2412: }
2413: }
2414:
2415: liberation(s_etat_processus, s_objet_1);
2416: liberation(s_etat_processus, s_objet_2);
2417:
2418: (*s_etat_processus).erreur_execution =
2419: d_ex_erreur_type_argument;
2420: return;
2421: }
2422:
2423: nombre_elements = 0;
2424: l_element_courant = (*s_objet_3).objet;
2425:
2426: while(l_element_courant != NULL)
2427: {
2428: l_element_courant = (*l_element_courant).suivant;
2429: nombre_elements++;
2430: }
2431:
2432: indice_i = (*((integer8 *) (*s_objet_1).objet));
2433: indice_j = 1;
2434: l_element_courant = (*s_objet_3).objet;
2435:
2436: while((l_element_courant != NULL) && (indice_j != indice_i))
2437: {
2438: l_element_courant = (*l_element_courant).suivant;
2439: indice_j++;
2440: }
2441:
2442: if (l_element_courant != NULL)
2443: {
2444: if ((s_objet_resultat = copie_objet(s_etat_processus,
2445: (*l_element_courant).donnee, 'O')) == NULL)
2446: {
2447: if (variable_partagee == d_vrai)
2448: {
2449: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2450: .pointeur_variable_partagee_courante).mutex))
2451: != 0)
1.1 bertrand 2452: {
2453: (*s_etat_processus).erreur_systeme = d_es_processus;
2454: return;
2455: }
2456: }
2457:
2458: (*s_etat_processus).erreur_systeme =
2459: d_es_allocation_memoire;
2460: return;
2461: }
2462: }
2463: else
2464: {
2465: if (variable_partagee == d_vrai)
2466: {
2467: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2468: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 2469: {
2470: (*s_etat_processus).erreur_systeme = d_es_processus;
2471: return;
2472: }
2473: }
2474:
2475: liberation(s_etat_processus, s_objet_1);
2476: liberation(s_etat_processus, s_objet_2);
2477:
2478: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
2479: return;
2480: }
2481:
2482: (*((integer8 *) (*s_objet_1).objet)) =
2483: (indice_i % nombre_elements) + 1;
2484: }
2485: else
2486: {
2487: if (variable_partagee == d_vrai)
2488: {
2489: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2490: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 2491: {
2492: (*s_etat_processus).erreur_systeme = d_es_processus;
2493: return;
2494: }
2495: }
2496:
2497: liberation(s_etat_processus, s_objet_1);
2498: liberation(s_etat_processus, s_objet_2);
2499:
2500: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2501: return;
2502: }
2503:
2504: if (variable_partagee == d_vrai)
2505: {
2506: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.38 bertrand 2507: .pointeur_variable_partagee_courante).mutex)) != 0)
1.1 bertrand 2508: {
2509: (*s_etat_processus).erreur_systeme = d_es_processus;
2510: return;
2511: }
2512: }
2513: }
2514:
2515: /*
2516: --------------------------------------------------------------------------------
2517: Type incompatible avec la fonction GETI
2518: --------------------------------------------------------------------------------
2519: */
2520:
2521: else
2522: {
2523: liberation(s_etat_processus, s_objet_1);
2524: liberation(s_etat_processus, s_objet_2);
2525:
2526: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2527: return;
2528: }
2529:
2530: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2531: s_objet_2) == d_erreur)
2532: {
2533: return;
2534: }
2535:
2536: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2537: s_objet_1) == d_erreur)
2538: {
2539: return;
2540: }
2541:
1.58 bertrand 2542: if ((*s_objet_resultat).type == NOM)
2543: {
2544: if ((*((struct_nom *) (*s_objet_resultat).objet)).symbole == d_faux)
2545: {
2546: if (evaluation(s_etat_processus, s_objet_resultat, 'E') == d_erreur)
2547: {
2548: return;
2549: }
2550: }
2551: else
2552: {
2553: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2554: s_objet_resultat) == d_erreur)
2555: {
2556: return;
2557: }
2558: }
2559: }
2560: else if ((*s_objet_resultat).type == FCT)
2561: {
2562: registre_test = (*s_etat_processus).test_instruction;
2563: registre_instruction_courante = (*s_etat_processus)
2564: .instruction_courante;
2565: registre_instruction_valide = (*s_etat_processus)
2566: .instruction_valide;
2567:
2568: (*s_etat_processus).test_instruction = 'Y';
2569: (*s_etat_processus).instruction_courante =
2570: (*((struct_fonction *) (*s_objet_resultat).objet)).nom_fonction;
2571:
2572: analyse(s_etat_processus, NULL);
2573:
2574: (*s_etat_processus).test_instruction = registre_test;
2575: (*s_etat_processus).instruction_courante =
2576: registre_instruction_courante;
2577:
2578: if (((*s_etat_processus).instruction_valide == 'Y') &&
2579: (*s_etat_processus).constante_symbolique == 'Y')
2580: {
2581: if (evaluation(s_etat_processus, s_objet_resultat, 'E') == d_erreur)
2582: {
2583: (*s_etat_processus).instruction_valide =
2584: registre_instruction_valide;
2585: return;
2586: }
2587: }
2588: else
2589: {
2590: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2591: s_objet_resultat) == d_erreur)
2592: {
2593: (*s_etat_processus).instruction_valide =
2594: registre_instruction_valide;
2595: return;
2596: }
2597: }
2598:
2599: (*s_etat_processus).instruction_valide = registre_instruction_valide;
2600: }
2601: else
1.1 bertrand 2602: {
1.58 bertrand 2603: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2604: s_objet_resultat) == d_erreur)
2605: {
2606: return;
2607: }
1.1 bertrand 2608: }
2609:
2610: return;
2611: }
2612:
2613: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>