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