1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.12
4: Copyright (C) 1989-2012 Dr. BERTRAND Joël
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:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction 'FORMAT'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_format(struct_processus *s_etat_processus)
40: {
41: struct_objet *s_copie_argument_1;
42: struct_objet *s_objet_argument_1;
43: struct_objet *s_objet_argument_2;
44:
45: (*s_etat_processus).erreur_execution = d_ex;
46:
47: if ((*s_etat_processus).affichage_arguments == 'Y')
48: {
49: printf("\n FORMAT ");
50:
51: if ((*s_etat_processus).langue == 'F')
52: {
53: printf("(associe un format à un descripteur de fichier "
54: "ou à une socket)\n\n");
55: }
56: else
57: {
58: printf("(associate a format to a file or socket descriptor)\n\n");
59: }
60:
61: printf(" 2: %s\n", d_LST);
62: printf(" 1: %s, %s\n", d_FCH, d_SCK);
63: printf("-> 1: %s, %s\n\n", d_FCH, d_SCK);
64:
65: if ((*s_etat_processus).langue == 'F')
66: {
67: printf(" Utilisation :\n\n");
68: }
69: else
70: {
71: printf(" Usage:\n\n");
72: }
73:
74: printf(" { \"STANDARD*(*)\" }\n");
75: printf(" { { \"NAME\" \"lambda\" } \"SEQUENTIAL\" \"NEW\""
76: "\"WRITEONLY\" \"FORMATTED\" } OPEN\n FORMAT\n\n");
77:
78: if ((*s_etat_processus).langue == 'F')
79: {
80: printf(" Formats autorisés :\n\n");
81: }
82: else
83: {
84: printf(" Authorized formats:\n\n");
85: }
86:
87: printf(" FORMATTED\n");
88: printf(" { \"STANDARD*(*)\" }\n");
89: printf(" { \"STANDARD*(%s)\" }\n", d_INT);
90: printf(" { \"FIXED*%s(*)\" }\n", d_INT);
91: printf(" { \"FIXED*%s(%s)}\n", d_INT, d_INT);
92: printf(" { \"SCIENTIFIC*%s(*)\" }\n", d_INT);
93: printf(" { \"SCIENTIFIC*%s(%s)\" }\n", d_INT, d_INT);
94: printf(" { \"ENGINEER*%s(*)\" }\n", d_INT);
95: printf(" { \"ENGINEER*%s(%s)\" }\n", d_INT, d_INT);
96: printf(" { \"CHARACTER*(*)\" }\n");
97: printf(" { \"CHARACTER*(%s)\" }\n", d_INT);
98: printf(" { \"BINARY*%s(*)\" }\n", d_INT);
99: printf(" { \"BINARY*%s(%s)\" }\n\n", d_INT, d_INT);
100:
101: printf(" UNFORMATTED\n");
102: printf(" { \"INTEGER*1\", \"INTEGER*2\", \"INTEGER*4\", "
103: "\"INTEGER*8\" }\n");
104: printf(" { \"LOGICAL*1\", \"LOGICAL*2\", \"LOGICAL*4\", "
105: "\"LOGICAL*8\" }\n");
106: printf(" { \"REAL*4\", \"REAL*8\" }\n");
107: printf(" { \"COMPLEX*8\", \"COMPLEX*16\" }\n");
108: printf(" { \"CHARACTER\" }\n\n");
109:
110: printf(" FLOW\n");
111: printf(" { \"LENGTH*(*)\" }\n");
112: printf(" { \"LENGTH*(%s)\" }\n", d_INT);
113:
114: return;
115: }
116: else if ((*s_etat_processus).test_instruction == 'Y')
117: {
118: (*s_etat_processus).nombre_arguments = -1;
119: return;
120: }
121:
122: if (test_cfsf(s_etat_processus, 31) == d_vrai)
123: {
124: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
125: {
126: return;
127: }
128: }
129:
130: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
131: &s_objet_argument_1) == d_erreur)
132: {
133: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
134: return;
135: }
136:
137: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
138: &s_objet_argument_2) == d_erreur)
139: {
140: liberation(s_etat_processus, s_objet_argument_1);
141:
142: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
143: return;
144: }
145:
146: if (((*s_objet_argument_1).type == FCH) &&
147: ((*s_objet_argument_2).type == LST))
148: {
149: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
150: s_objet_argument_1, 'N')) == NULL)
151: {
152: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
153: return;
154: }
155:
156: liberation(s_etat_processus, s_objet_argument_1);
157: s_objet_argument_1 = s_copie_argument_1;
158:
159: liberation(s_etat_processus, (*((struct_fichier *)
160: (*s_objet_argument_1).objet)).format);
161:
162: (*((struct_fichier *) (*s_objet_argument_1).objet)).format =
163: s_objet_argument_2;
164: }
165: else if (((*s_objet_argument_1).type == SCK) &&
166: ((*s_objet_argument_2).type == LST))
167: {
168: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
169: s_objet_argument_1, 'N')) == NULL)
170: {
171: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
172: return;
173: }
174:
175: liberation(s_etat_processus, s_objet_argument_1);
176: s_objet_argument_1 = s_copie_argument_1;
177:
178: liberation(s_etat_processus, (*((struct_socket *)
179: (*s_objet_argument_1).objet)).format);
180:
181: (*((struct_socket *) (*s_objet_argument_1).objet)).format =
182: s_objet_argument_2;
183: }
184: else
185: {
186: liberation(s_etat_processus, s_objet_argument_1);
187: liberation(s_etat_processus, s_objet_argument_2);
188:
189: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
190: return;
191: }
192:
193: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
194: s_objet_argument_1) == d_erreur)
195: {
196: return;
197: }
198:
199: return;
200: }
201:
202:
203: /*
204: ================================================================================
205: Fonction '->LCD'
206: ================================================================================
207: Entrées : structure processus
208: --------------------------------------------------------------------------------
209: Sorties :
210: --------------------------------------------------------------------------------
211: Effets de bord : néant
212: ================================================================================
213: */
214:
215: void
216: instruction_fleche_lcd(struct_processus *s_etat_processus)
217: {
218: file *fichier_destination;
219: file *fichier_source;
220:
221: int caractere;
222: int dimensions;
223:
224: integer8 systeme_axes;
225:
226: logical1 axes;
227:
228: struct_fichier_graphique *l_fichier_courant;
229:
230: struct_objet *s_objet_argument;
231:
232: unsigned char drapeau_axes;
233: unsigned char *nom_fichier;
234: unsigned char type[21];
235:
236: (*s_etat_processus).erreur_execution = d_ex;
237:
238: if ((*s_etat_processus).affichage_arguments == 'Y')
239: {
240: printf("\n ->LCD ");
241:
242: if ((*s_etat_processus).langue == 'F')
243: {
244: printf("(lecture d'un fichier graphique)\n\n");
245: }
246: else
247: {
248: printf("(read a graphical file)\n\n");
249: }
250:
251: printf(" 1: %s\n", d_CHN);
252:
253: return;
254: }
255: else if ((*s_etat_processus).test_instruction == 'Y')
256: {
257: (*s_etat_processus).nombre_arguments = -1;
258: return;
259: }
260:
261: if (test_cfsf(s_etat_processus, 31) == d_vrai)
262: {
263: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
264: {
265: return;
266: }
267: }
268:
269: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
270: &s_objet_argument) == d_erreur)
271: {
272: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
273: return;
274: }
275:
276: if ((*s_objet_argument).type == CHN)
277: {
278: if (fflush(NULL) != 0)
279: {
280: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
281: return;
282: }
283:
284: if ((fichier_source = fopen((unsigned char *) (*s_objet_argument).objet,
285: "r")) == NULL)
286: {
287: liberation(s_etat_processus, s_objet_argument);
288:
289: (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
290: return;
291: }
292:
293: fichier_destination = NULL;
294:
295: while((caractere = getc(fichier_source)) != EOF)
296: {
297: if (caractere == '@')
298: {
299: /* Création d'un nouveau fichier */
300:
301: if (fichier_destination != NULL)
302: {
303: if (fclose(fichier_destination) != 0)
304: {
305: (*s_etat_processus).erreur_systeme =
306: d_es_erreur_fichier;
307: return;
308: }
309: }
310:
311: if (fscanf(fichier_source, " %c %d %lld %s",
312: &drapeau_axes, &dimensions, &systeme_axes, type) != 4)
313: {
314: (*s_etat_processus).erreur_systeme =
315: d_es_erreur_fichier;
316: return;
317: }
318:
319: axes = (drapeau_axes == 'T') ? d_vrai : d_faux;
320:
321: if ((nom_fichier = creation_nom_fichier(s_etat_processus,
322: (*s_etat_processus).chemin_fichiers_temporaires))
323: == NULL)
324: {
325: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
326: return;
327: }
328:
329: if ((fichier_destination = fopen(nom_fichier, "w")) == NULL)
330: {
331: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
332: return;
333: }
334:
335: /* Chaînage */
336:
337: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
338:
339: if (l_fichier_courant == NULL)
340: {
341: if (((*s_etat_processus).fichiers_graphiques =
342: malloc(sizeof(struct_fichier_graphique))) == NULL)
343: {
344: (*s_etat_processus).erreur_systeme =
345: d_es_allocation_memoire;
346: return;
347: }
348:
349: (*(*s_etat_processus).fichiers_graphiques).suivant = NULL;
350: (*(*s_etat_processus).fichiers_graphiques).nom =
351: nom_fichier;
352: (*(*s_etat_processus).fichiers_graphiques).legende =
353: NULL;
354: (*(*s_etat_processus).fichiers_graphiques).presence_axes =
355: axes;
356: (*(*s_etat_processus).fichiers_graphiques).dimensions =
357: dimensions;
358: (*(*s_etat_processus).fichiers_graphiques).systeme_axes =
359: systeme_axes;
360: strcpy((*(*s_etat_processus).fichiers_graphiques).type,
361: type);
362: }
363: else
364: {
365: while((*l_fichier_courant).suivant != NULL)
366: {
367: l_fichier_courant = (*l_fichier_courant).suivant;
368: }
369:
370: if (((*l_fichier_courant).suivant =
371: malloc(sizeof(struct_fichier_graphique))) == NULL)
372: {
373: (*s_etat_processus).erreur_systeme =
374: d_es_allocation_memoire;
375: return;
376: }
377:
378: l_fichier_courant = (*l_fichier_courant).suivant;
379:
380: (*l_fichier_courant).suivant = NULL;
381: (*l_fichier_courant).nom = nom_fichier;
382: (*l_fichier_courant).legende = NULL;
383: (*l_fichier_courant).presence_axes = axes;
384: (*l_fichier_courant).dimensions = dimensions;
385: (*l_fichier_courant).systeme_axes = systeme_axes;
386: strcpy((*l_fichier_courant).type, type);
387: }
388: }
389: else
390: {
391: if (putc(caractere, fichier_destination) == EOF)
392: {
393: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
394: return;
395: }
396: }
397: }
398:
399: if (fichier_destination != NULL)
400: {
401: if (fclose(fichier_destination) != 0)
402: {
403: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
404: return;
405: }
406: }
407:
408: if (fclose(fichier_source) != 0)
409: {
410: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
411: return;
412: }
413: }
414: else
415: {
416: liberation(s_etat_processus, s_objet_argument);
417:
418: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
419: return;
420: }
421:
422: liberation(s_etat_processus, s_objet_argument);
423:
424: appel_gnuplot(s_etat_processus, 'N');
425:
426: return;
427: }
428:
429:
430: /*
431: ================================================================================
432: Fonction '->Q'
433: ================================================================================
434: Entrées : structure processus
435: --------------------------------------------------------------------------------
436: Sorties :
437: --------------------------------------------------------------------------------
438: Effets de bord : néant
439: ================================================================================
440: */
441:
442: void
443: instruction_fleche_q(struct_processus *s_etat_processus)
444: {
445: double epsilon;
446:
447: struct_liste_chainee *l_element_courant;
448:
449: struct_objet *s_objet_argument;
450: struct_objet *s_objet_argument_1;
451: struct_objet *s_objet_argument_2;
452: struct_objet *s_objet_resultat;
453:
454: real8 f;
455: real8 objectif;
456: real8 r1;
457: real8 r2;
458: real8 s1;
459: real8 s2;
460: real8 t1;
461: real8 t2;
462: real8 x;
463: real8 y;
464: real8 z;
465:
466: (*s_etat_processus).erreur_execution = d_ex;
467:
468: if ((*s_etat_processus).affichage_arguments == 'Y')
469: {
470: printf("\n ->Q ");
471:
472: if ((*s_etat_processus).langue == 'F')
473: {
474: printf("(transformation d'un réel en rationnel)\n\n");
475: }
476: else
477: {
478: printf("(transform a real into a rational)\n\n");
479: }
480:
481: printf(" 1: %s\n", d_INT);
482: printf("-> 1: %s\n\n", d_INT);
483:
484: printf(" 1: %s\n", d_REL);
485: printf("-> 1: %s\n", d_ALG);
486:
487: return;
488: }
489: else if ((*s_etat_processus).test_instruction == 'Y')
490: {
491: (*s_etat_processus).nombre_arguments = -1;
492: return;
493: }
494:
495: if (test_cfsf(s_etat_processus, 31) == d_vrai)
496: {
497: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
498: {
499: return;
500: }
501: }
502:
503: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
504: &s_objet_argument) == d_erreur)
505: {
506: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
507: return;
508: }
509:
510: if ((*s_objet_argument).type == INT)
511: {
512: s_objet_resultat = s_objet_argument;
513: s_objet_argument = NULL;
514: }
515: else if ((*s_objet_argument).type == REL)
516: {
517: x = (*((real8 *) (*s_objet_argument).objet));
518: objectif = x;
519: epsilon = nextafter(-abs(x), 0) + abs(x);
520:
521: r1 = 1;
522: r2 = 0;
523: s1 = 0;
524: s2 = 1;
525:
526: do
527: {
528: f = floor(x);
529:
530: t1 = r1;
531: t2 = r2;
532:
533: r1 = (f * r1) + s1;
534: r2 = (f * r2) + s2;
535:
536: s1 = t1;
537: s2 = t2;
538:
539: y = x - f;
540:
541: if (y != 0)
542: {
543: z = fabs(objectif - (r1 / r2));
544: x = ((real8) 1) / y;
545: }
546: else
547: {
548: z = 0;
549: }
550: } while(z > epsilon);
551:
552: if (r2 != ((real8) ((integer8) r2)))
553: {
554: if ((s_objet_argument_1 = allocation(s_etat_processus, REL))
555: == NULL)
556: {
557: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
558: return;
559: }
560:
561: (*((real8 *) (*s_objet_argument_1).objet)) = r2;
562: }
563: else
564: {
565: if ((s_objet_argument_1 = allocation(s_etat_processus, INT))
566: == NULL)
567: {
568: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
569: return;
570: }
571:
572: (*((integer8 *) (*s_objet_argument_1).objet)) = (integer8) r2;
573: }
574:
575: if (r1 != ((real8) ((integer8) r1)))
576: {
577: if ((s_objet_argument_2 = allocation(s_etat_processus, REL))
578: == NULL)
579: {
580: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
581: return;
582: }
583:
584: (*((real8 *) (*s_objet_argument_2).objet)) = r1;
585: }
586: else
587: {
588: if ((s_objet_argument_2 = allocation(s_etat_processus, INT))
589: == NULL)
590: {
591: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
592: return;
593: }
594:
595: (*((integer8 *) (*s_objet_argument_2).objet)) = (integer8) r1;
596: }
597:
598: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
599: {
600: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
601: return;
602: }
603:
604: if (((*s_objet_resultat).objet =
605: allocation_maillon(s_etat_processus)) == NULL)
606: {
607: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
608: return;
609: }
610:
611: l_element_courant = (*s_objet_resultat).objet;
612:
613: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
614: == NULL)
615: {
616: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
617: return;
618: }
619:
620: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
621: .nombre_arguments = 0;
622: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
623: .fonction = instruction_vers_niveau_superieur;
624:
625: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
626: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
627: {
628: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
629: return;
630: }
631:
632: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
633: .nom_fonction, "<<");
634:
635: if (((*l_element_courant).suivant =
636: allocation_maillon(s_etat_processus)) == NULL)
637: {
638: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
639: return;
640: }
641:
642: l_element_courant = (*l_element_courant).suivant;
643: (*l_element_courant).donnee = s_objet_argument_2;
644:
645: if (((*l_element_courant).suivant =
646: allocation_maillon(s_etat_processus)) == NULL)
647: {
648: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
649: return;
650: }
651:
652: l_element_courant = (*l_element_courant).suivant;
653: (*l_element_courant).donnee = s_objet_argument_1;
654:
655: if (((*l_element_courant).suivant =
656: allocation_maillon(s_etat_processus)) == NULL)
657: {
658: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
659: return;
660: }
661:
662: l_element_courant = (*l_element_courant).suivant;
663:
664: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
665: == NULL)
666: {
667: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
668: return;
669: }
670:
671: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
672: .nombre_arguments = 0;
673: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
674: .fonction = instruction_division;
675:
676: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
677: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
678: {
679: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
680: return;
681: }
682:
683: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
684: .nom_fonction, "/");
685:
686: if (((*l_element_courant).suivant =
687: allocation_maillon(s_etat_processus)) == NULL)
688: {
689: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
690: return;
691: }
692:
693: l_element_courant = (*l_element_courant).suivant;
694:
695: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
696: == NULL)
697: {
698: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
699: return;
700: }
701:
702: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
703: .nombre_arguments = 0;
704: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
705: .fonction = instruction_vers_niveau_inferieur;
706:
707: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
708: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
709: {
710: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
711: return;
712: }
713:
714: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
715: .nom_fonction, ">>");
716:
717: (*l_element_courant).suivant = NULL;
718:
719: s_objet_argument_1 = NULL;
720: s_objet_argument_2 = NULL;
721:
722: liberation(s_etat_processus, s_objet_argument_1);
723: liberation(s_etat_processus, s_objet_argument_2);
724: }
725: else
726: {
727: liberation(s_etat_processus, s_objet_argument);
728:
729: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
730: return;
731: }
732:
733: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
734: s_objet_resultat) == d_erreur)
735: {
736: return;
737: }
738:
739: liberation(s_etat_processus, s_objet_argument);
740:
741: return;
742: }
743:
744:
745: /*
746: ================================================================================
747: Fonction '->ROW'
748: ================================================================================
749: Entrées : structure processus
750: --------------------------------------------------------------------------------
751: Sorties :
752: --------------------------------------------------------------------------------
753: Effets de bord : néant
754: ================================================================================
755: */
756:
757: void
758: instruction_fleche_row(struct_processus *s_etat_processus)
759: {
760: integer8 i;
761: integer8 j;
762: integer8 nombre_colonnes;
763: integer8 nombre_lignes;
764:
765: struct_liste_chainee *l_element_courant;
766:
767: struct_objet *s_objet;
768: struct_objet *s_objet_resultat;
769:
770: unsigned char type;
771:
772: (*s_etat_processus).erreur_execution = d_ex;
773:
774: if ((*s_etat_processus).affichage_arguments == 'Y')
775: {
776: printf("\n ->ROW ");
777:
778: if ((*s_etat_processus).langue == 'F')
779: {
780: printf("(construction d'une matrice à partir de ses lignes)\n\n");
781: }
782: else
783: {
784: printf("(build a matrix from rows)\n\n");
785: }
786:
787: printf(" n: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
788: printf(" ...\n");
789: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
790: printf(" 1: %s\n", d_INT);
791: printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
792:
793: return;
794: }
795: else if ((*s_etat_processus).test_instruction == 'Y')
796: {
797: (*s_etat_processus).nombre_arguments = -1;
798: return;
799: }
800:
801: if (test_cfsf(s_etat_processus, 31) == d_vrai)
802: {
803: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
804: {
805: return;
806: }
807: }
808:
809: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
810: {
811: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
812: return;
813: }
814:
815: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
816: {
817: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
818: return;
819: }
820:
821: nombre_lignes = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
822: .donnee).objet));
823:
824: if (nombre_lignes <= 0)
825: {
826: /*
827: * Nombre lignes négatif ou nul, l'opération est absurde.
828: */
829:
830: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
831: return;
832: }
833:
834: if (nombre_lignes >= (integer8) (*s_etat_processus)
835: .hauteur_pile_operationnelle)
836: {
837: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
838: return;
839: }
840:
841: /*
842: * Traitement de la pile last le cas échéant.
843: */
844:
845: if (test_cfsf(s_etat_processus, 31) == d_vrai)
846: {
847: if (empilement_pile_last(s_etat_processus, nombre_lignes + 1)
848: == d_erreur)
849: {
850: return;
851: }
852: }
853:
854: /*
855: * Retrait de l'objet indiquant le nombre de lignes.
856: */
857:
858: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
859: &s_objet) == d_erreur)
860: {
861: return;
862: }
863:
864: liberation(s_etat_processus, s_objet);
865:
866: /*
867: * Recherche du type de la matrice finale.
868: */
869:
870: type = 'I';
871: l_element_courant = (*s_etat_processus).l_base_pile;
872: nombre_colonnes = 0;
873:
874: for(i = 0; i < nombre_lignes; i++)
875: {
876: if (((*(*l_element_courant).donnee).type != MIN) &&
877: ((*(*l_element_courant).donnee).type != MRL) &&
878: ((*(*l_element_courant).donnee).type != MCX))
879: {
880: /*
881: * Problème : on vient de tirer autre chose qu'une matrice
882: * dans la pile.
883: */
884:
885: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
886: return;
887: }
888:
889: if ((*((struct_matrice *) (*(*l_element_courant).donnee).objet))
890: .nombre_lignes != 1)
891: {
892: /*
893: * La matrice n'est pas une matrice ligne.
894: */
895:
896: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
897: return;
898: }
899:
900: if (i == 0)
901: {
902: nombre_colonnes = (*((struct_matrice *) (*(*l_element_courant)
903: .donnee).objet)).nombre_colonnes;
904: }
905: else
906: {
907: if (nombre_colonnes != (integer8) (*((struct_matrice *)
908: (*(*l_element_courant).donnee).objet)).nombre_colonnes)
909: {
910: /*
911: * La dernière matrice observée n'a pas les mêmes dimensions
912: * (nombre de colonnes) que les précédentes.
913: */
914:
915: (*s_etat_processus).erreur_execution =
916: d_ex_dimensions_invalides;
917: return;
918: }
919: }
920:
921: if (type == 'I')
922: {
923: if ((*(*l_element_courant).donnee).type == MRL)
924: {
925: type = 'R';
926: }
927: else if ((*(*l_element_courant).donnee).type == MCX)
928: {
929: type = 'C';
930: }
931: }
932: else if (type == 'R')
933: {
934: if ((*(*l_element_courant).donnee).type == MCX)
935: {
936: type = 'C';
937: }
938: }
939:
940: l_element_courant = (*l_element_courant).suivant;
941: }
942:
943: if (type == 'I')
944: {
945: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
946: {
947: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
948: return;
949: }
950:
951: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
952: nombre_colonnes;
953: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
954: nombre_lignes;
955:
956: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
957: malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
958: {
959: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
960: return;
961: }
962:
963: for(i = nombre_lignes - 1; i >= 0; i--)
964: {
965: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
966: &s_objet) == d_erreur)
967: {
968: return;
969: }
970:
971: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
972: .objet)).tableau)[i] = malloc(nombre_colonnes *
973: sizeof(integer8))) == NULL)
974: {
975: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
976: return;
977: }
978:
979: for(j = 0; j < nombre_colonnes; j++)
980: {
981: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
982: .objet)).tableau)[i][j] = ((integer8 **)
983: (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j];
984: }
985:
986: liberation(s_etat_processus, s_objet);
987: }
988: }
989: else if (type == 'R')
990: {
991: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
992: {
993: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
994: return;
995: }
996:
997: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
998: nombre_colonnes;
999: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1000: nombre_lignes;
1001:
1002: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1003: malloc(nombre_lignes * sizeof(real8 *))) == NULL)
1004: {
1005: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1006: return;
1007: }
1008:
1009: for(i = nombre_lignes - 1; i >= 0; i--)
1010: {
1011: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1012: &s_objet) == d_erreur)
1013: {
1014: return;
1015: }
1016:
1017: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1018: .objet)).tableau)[i] = malloc(nombre_colonnes *
1019: sizeof(real8))) == NULL)
1020: {
1021: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1022: return;
1023: }
1024:
1025: if ((*s_objet).type == MIN)
1026: {
1027: for(j = 0; j < nombre_colonnes; j++)
1028: {
1029: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1030: .objet)).tableau)[i][j] = ((integer8 **)
1031: (*((struct_matrice *) (*s_objet).objet))
1032: .tableau)[0][j];
1033: }
1034: }
1035: else
1036: {
1037: for(j = 0; j < nombre_colonnes; j++)
1038: {
1039: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1040: .objet)).tableau)[i][j] = ((real8 **)
1041: (*((struct_matrice *) (*s_objet).objet))
1042: .tableau)[0][j];
1043: }
1044: }
1045:
1046: liberation(s_etat_processus, s_objet);
1047: }
1048: }
1049: else
1050: {
1051: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
1052: {
1053: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1054: return;
1055: }
1056:
1057: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1058: nombre_colonnes;
1059: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1060: nombre_lignes;
1061:
1062: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1063: malloc(nombre_lignes * sizeof(complex16 *))) == NULL)
1064: {
1065: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1066: return;
1067: }
1068:
1069: for(i = nombre_lignes - 1; i >= 0; i--)
1070: {
1071: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1072: &s_objet) == d_erreur)
1073: {
1074: return;
1075: }
1076:
1077: if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1078: .objet)).tableau)[i] = malloc(nombre_colonnes *
1079: sizeof(complex16))) == NULL)
1080: {
1081: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1082: return;
1083: }
1084:
1085: if ((*s_objet).type == MIN)
1086: {
1087: for(j = 0; j < nombre_colonnes; j++)
1088: {
1089: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1090: .objet)).tableau)[i][j]).partie_reelle =
1091: ((integer8 **) (*((struct_matrice *)
1092: (*s_objet).objet)).tableau)[0][j];
1093: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1094: .objet)).tableau)[i][j]).partie_imaginaire = 0;
1095: }
1096: }
1097: else if ((*s_objet).type == MRL)
1098: {
1099: for(j = 0; j < nombre_colonnes; j++)
1100: {
1101: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1102: .objet)).tableau)[i][j]).partie_reelle =
1103: ((real8 **) (*((struct_matrice *)
1104: (*s_objet).objet)).tableau)[0][j];
1105: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1106: .objet)).tableau)[i][j]).partie_imaginaire = 0;
1107: }
1108: }
1109: else
1110: {
1111: for(j = 0; j < nombre_colonnes; j++)
1112: {
1113: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1114: .objet)).tableau)[i][j]).partie_reelle =
1115: (((complex16 **) (*((struct_matrice *)
1116: (*s_objet).objet)).tableau)[0][j])
1117: .partie_reelle;
1118: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1119: .objet)).tableau)[i][j]).partie_imaginaire =
1120: (((complex16 **) (*((struct_matrice *)
1121: (*s_objet).objet)).tableau)[0][j])
1122: .partie_imaginaire;
1123: }
1124: }
1125:
1126: liberation(s_etat_processus, s_objet);
1127: }
1128: }
1129:
1130: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1131: s_objet_resultat) == d_erreur)
1132: {
1133: return;
1134: }
1135:
1136: return;
1137: }
1138:
1139:
1140: /*
1141: ================================================================================
1142: Fonction '->COL'
1143: ================================================================================
1144: Entrées : structure processus
1145: --------------------------------------------------------------------------------
1146: Sorties :
1147: --------------------------------------------------------------------------------
1148: Effets de bord : néant
1149: ================================================================================
1150: */
1151:
1152: void
1153: instruction_fleche_col(struct_processus *s_etat_processus)
1154: {
1155: integer8 i;
1156: integer8 j;
1157: integer8 nombre_colonnes;
1158: integer8 nombre_lignes;
1159:
1160: struct_liste_chainee *l_element_courant;
1161:
1162: struct_objet *s_objet;
1163: struct_objet *s_objet_resultat;
1164:
1165: unsigned char type;
1166:
1167: (*s_etat_processus).erreur_execution = d_ex;
1168:
1169: if ((*s_etat_processus).affichage_arguments == 'Y')
1170: {
1171: printf("\n ->COL ");
1172:
1173: if ((*s_etat_processus).langue == 'F')
1174: {
1175: printf("(construction d'une matrice à partir de ses colonnes)\n\n");
1176: }
1177: else
1178: {
1179: printf("(build a matrix from columns)\n\n");
1180: }
1181:
1182: printf(" n: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1183: printf(" ...\n");
1184: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1185: printf(" 1: %s\n", d_INT);
1186: printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1187:
1188: return;
1189: }
1190: else if ((*s_etat_processus).test_instruction == 'Y')
1191: {
1192: (*s_etat_processus).nombre_arguments = -1;
1193: return;
1194: }
1195:
1196: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1197: {
1198: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1199: {
1200: return;
1201: }
1202: }
1203:
1204: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
1205: {
1206: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1207: return;
1208: }
1209:
1210: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
1211: {
1212: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1213: return;
1214: }
1215:
1216: nombre_colonnes = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
1217: .donnee).objet));
1218:
1219: if (nombre_colonnes <= 0)
1220: {
1221: /*
1222: * Nombre lignes négatif ou nul, l'opération est absurde.
1223: */
1224:
1225: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1226: return;
1227: }
1228:
1229: if (nombre_colonnes >= (integer8) (*s_etat_processus)
1230: .hauteur_pile_operationnelle)
1231: {
1232: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1233: return;
1234: }
1235:
1236: /*
1237: * Traitement de la pile last le cas échéant.
1238: */
1239:
1240: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1241: {
1242: if (empilement_pile_last(s_etat_processus, nombre_colonnes + 1)
1243: == d_erreur)
1244: {
1245: return;
1246: }
1247: }
1248:
1249: /*
1250: * Retrait de l'objet indiquant le nombre de lignes.
1251: */
1252:
1253: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1254: &s_objet) == d_erreur)
1255: {
1256: return;
1257: }
1258:
1259: liberation(s_etat_processus, s_objet);
1260:
1261: /*
1262: * Recherche du type de la matrice finale.
1263: */
1264:
1265: type = 'I';
1266: l_element_courant = (*s_etat_processus).l_base_pile;
1267: nombre_lignes = 0;
1268:
1269: for(i = 0; i < nombre_colonnes; i++)
1270: {
1271: if (((*(*l_element_courant).donnee).type != MIN) &&
1272: ((*(*l_element_courant).donnee).type != MRL) &&
1273: ((*(*l_element_courant).donnee).type != MCX))
1274: {
1275: /*
1276: * Problème : on vient de tirer autre chose qu'une matrice
1277: * dans la pile.
1278: */
1279:
1280: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1281: return;
1282: }
1283:
1284: if ((*((struct_matrice *) (*(*l_element_courant).donnee).objet))
1285: .nombre_colonnes != 1)
1286: {
1287: /*
1288: * La matrice n'est pas une matrice colonne.
1289: */
1290:
1291: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1292: return;
1293: }
1294:
1295: if (i == 0)
1296: {
1297: nombre_lignes = (*((struct_matrice *) (*(*l_element_courant)
1298: .donnee).objet)).nombre_lignes;
1299: }
1300: else
1301: {
1302: if (nombre_lignes != (integer8) (*((struct_matrice *)
1303: (*(*l_element_courant).donnee).objet)).nombre_lignes)
1304: {
1305: /*
1306: * La dernière matrice observée n'a pas les mêmes dimensions
1307: * (nombre de colonnes) que les précédentes.
1308: */
1309:
1310: (*s_etat_processus).erreur_execution =
1311: d_ex_dimensions_invalides;
1312: return;
1313: }
1314: }
1315:
1316: if (type == 'I')
1317: {
1318: if ((*(*l_element_courant).donnee).type == MRL)
1319: {
1320: type = 'R';
1321: }
1322: else if ((*(*l_element_courant).donnee).type == MCX)
1323: {
1324: type = 'C';
1325: }
1326: }
1327: else if (type == 'R')
1328: {
1329: if ((*(*l_element_courant).donnee).type == MCX)
1330: {
1331: type = 'C';
1332: }
1333: }
1334:
1335: l_element_courant = (*l_element_courant).suivant;
1336: }
1337:
1338: if (type == 'I')
1339: {
1340: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
1341: {
1342: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1343: return;
1344: }
1345:
1346: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1347: nombre_colonnes;
1348: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1349: nombre_lignes;
1350:
1351: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1352: malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
1353: {
1354: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1355: return;
1356: }
1357:
1358: for(i = 0; i < nombre_lignes; i++)
1359: {
1360: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
1361: .objet)).tableau)[i] = malloc(nombre_colonnes *
1362: sizeof(integer8))) == NULL)
1363: {
1364: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1365: return;
1366: }
1367: }
1368:
1369: for(j = nombre_colonnes - 1; j >= 0; j--)
1370: {
1371: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1372: &s_objet) == d_erreur)
1373: {
1374: return;
1375: }
1376:
1377: for(i = 0; i < nombre_lignes; i++)
1378: {
1379: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
1380: .objet)).tableau)[i][j] = ((integer8 **)
1381: (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0];
1382: }
1383:
1384: liberation(s_etat_processus, s_objet);
1385: }
1386: }
1387: else if (type == 'R')
1388: {
1389: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
1390: {
1391: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1392: return;
1393: }
1394:
1395: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1396: nombre_colonnes;
1397: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1398: nombre_lignes;
1399:
1400: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1401: malloc(nombre_lignes * sizeof(real8 *))) == NULL)
1402: {
1403: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1404: return;
1405: }
1406:
1407: for(i = 0; i < nombre_lignes; i++)
1408: {
1409: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1410: .objet)).tableau)[i] = malloc(nombre_colonnes *
1411: sizeof(real8))) == NULL)
1412: {
1413: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1414: return;
1415: }
1416: }
1417:
1418: for(j = nombre_colonnes - 1; j >= 0; j--)
1419: {
1420: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1421: &s_objet) == d_erreur)
1422: {
1423: return;
1424: }
1425:
1426: if ((*s_objet).type == MIN)
1427: {
1428: for(i = 0; i < nombre_lignes; i++)
1429: {
1430: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1431: .objet)).tableau)[i][j] = ((integer8 **)
1432: (*((struct_matrice *) (*s_objet).objet))
1433: .tableau)[i][0];
1434: }
1435: }
1436: else
1437: {
1438: for(i = 0; i < nombre_lignes; i++)
1439: {
1440: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1441: .objet)).tableau)[i][j] = ((real8 **)
1442: (*((struct_matrice *) (*s_objet).objet))
1443: .tableau)[i][0];
1444: }
1445: }
1446:
1447: liberation(s_etat_processus, s_objet);
1448: }
1449: }
1450: else
1451: {
1452: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
1453: {
1454: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1455: return;
1456: }
1457:
1458: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1459: nombre_colonnes;
1460: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1461: nombre_lignes;
1462:
1463: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1464: malloc(nombre_lignes * sizeof(complex16 *))) == NULL)
1465: {
1466: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1467: return;
1468: }
1469:
1470: for(i = 0; i < nombre_lignes; i++)
1471: {
1472: if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1473: .objet)).tableau)[i] = malloc(nombre_colonnes *
1474: sizeof(complex16))) == NULL)
1475: {
1476: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1477: return;
1478: }
1479: }
1480:
1481: for(j = nombre_colonnes - 1; j >= 0; j--)
1482: {
1483: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1484: &s_objet) == d_erreur)
1485: {
1486: return;
1487: }
1488:
1489: if ((*s_objet).type == MIN)
1490: {
1491: for(i = 0; i < nombre_lignes; i++)
1492: {
1493: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1494: .objet)).tableau)[i][j]).partie_reelle =
1495: ((integer8 **) (*((struct_matrice *)
1496: (*s_objet).objet)).tableau)[i][0];
1497: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1498: .objet)).tableau)[i][j]).partie_imaginaire = 0;
1499: }
1500: }
1501: else if ((*s_objet).type == MRL)
1502: {
1503: for(i = 0; i < nombre_lignes; i++)
1504: {
1505: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1506: .objet)).tableau)[i][j]).partie_reelle =
1507: ((real8 **) (*((struct_matrice *)
1508: (*s_objet).objet)).tableau)[i][0];
1509: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1510: .objet)).tableau)[i][j]).partie_imaginaire = 0;
1511: }
1512: }
1513: else
1514: {
1515: for(i = 0; i < nombre_lignes; i++)
1516: {
1517: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1518: .objet)).tableau)[i][j]).partie_reelle =
1519: (((complex16 **) (*((struct_matrice *)
1520: (*s_objet).objet)).tableau)[i][0]).partie_reelle;
1521: (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
1522: .objet)).tableau)[i][j]).partie_imaginaire =
1523: (((complex16 **) (*((struct_matrice *)
1524: (*s_objet).objet)).tableau)[i][0])
1525: .partie_imaginaire;
1526: }
1527: }
1528:
1529: liberation(s_etat_processus, s_objet);
1530: }
1531: }
1532:
1533: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1534: s_objet_resultat) == d_erreur)
1535: {
1536: return;
1537: }
1538:
1539: return;
1540: }
1541:
1542:
1543: /*
1544: ================================================================================
1545: Fonction '->NUM'
1546: ================================================================================
1547: Entrées : structure processus
1548: --------------------------------------------------------------------------------
1549: Sorties :
1550: --------------------------------------------------------------------------------
1551: Effets de bord : néant
1552: ================================================================================
1553: */
1554:
1555: void
1556: instruction_fleche_num(struct_processus *s_etat_processus)
1557: {
1558: logical1 last_valide;
1559:
1560: struct_objet *s_objet;
1561: struct_objet *s_objet_simplifie;
1562:
1563: unsigned char registre_type_evaluation;
1564:
1565: (*s_etat_processus).erreur_execution = d_ex;
1566:
1567: if ((*s_etat_processus).affichage_arguments == 'Y')
1568: {
1569: printf("\n ->NUM ");
1570:
1571: if ((*s_etat_processus).langue == 'F')
1572: {
1573: printf("(évaluation d'un objet)\n\n");
1574: }
1575: else
1576: {
1577: printf("(object evaluation)\n\n");
1578: }
1579:
1580: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
1581: " %s, %s, %s, %s, %s,\n"
1582: " %s, %s, %s, %s, %s,\n"
1583: " %s\n",
1584: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1585: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
1586: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
1587: " %s, %s, %s, %s, %s,\n"
1588: " %s, %s, %s, %s, %s,\n"
1589: " %s\n",
1590: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1591: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
1592: printf(" ...\n");
1593: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
1594: " %s, %s, %s, %s, %s,\n"
1595: " %s, %s, %s, %s, %s,\n"
1596: " %s\n",
1597: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1598: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
1599:
1600: return;
1601: }
1602: else if ((*s_etat_processus).test_instruction == 'Y')
1603: {
1604: (*s_etat_processus).nombre_arguments = -1;
1605: return;
1606: }
1607:
1608: if ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai)
1609: {
1610: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1611: {
1612: return;
1613: }
1614:
1615: cf(s_etat_processus, 31);
1616: }
1617:
1618: registre_type_evaluation = (test_cfsf(s_etat_processus, 35) == d_vrai)
1619: ? 'E' : 'N';
1620: cf(s_etat_processus, 35);
1621:
1622: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1623: &s_objet) == d_erreur)
1624: {
1625: if (last_valide == d_vrai)
1626: {
1627: sf(s_etat_processus, 31);
1628: }
1629:
1630: if (registre_type_evaluation == 'E')
1631: {
1632: sf(s_etat_processus, 35);
1633: }
1634: else
1635: {
1636: cf(s_etat_processus, 35);
1637: }
1638:
1639: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1640: return;
1641: }
1642:
1643: if ((s_objet_simplifie = simplification(s_etat_processus, s_objet)) == NULL)
1644: {
1645: if (last_valide == d_vrai)
1646: {
1647: sf(s_etat_processus, 31);
1648: }
1649:
1650: if (registre_type_evaluation == 'E')
1651: {
1652: sf(s_etat_processus, 35);
1653: }
1654: else
1655: {
1656: cf(s_etat_processus, 35);
1657: }
1658:
1659: return;
1660: }
1661:
1662: liberation(s_etat_processus, s_objet);
1663: s_objet = s_objet_simplifie;
1664:
1665: if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur)
1666: {
1667: if (last_valide == d_vrai)
1668: {
1669: sf(s_etat_processus, 31);
1670: }
1671:
1672: if (registre_type_evaluation == 'E')
1673: {
1674: sf(s_etat_processus, 35);
1675: }
1676: else
1677: {
1678: cf(s_etat_processus, 35);
1679: }
1680:
1681: liberation(s_etat_processus, s_objet);
1682: return;
1683: }
1684:
1685: liberation(s_etat_processus, s_objet);
1686:
1687: if (registre_type_evaluation == 'E')
1688: {
1689: sf(s_etat_processus, 35);
1690: }
1691: else
1692: {
1693: cf(s_etat_processus, 35);
1694: }
1695:
1696: if (last_valide == d_vrai)
1697: {
1698: sf(s_etat_processus, 31);
1699: }
1700:
1701: return;
1702: }
1703:
1704:
1705: /*
1706: ================================================================================
1707: Fonction 'fuse'
1708: ================================================================================
1709: Entrées :
1710: --------------------------------------------------------------------------------
1711: Sorties :
1712: --------------------------------------------------------------------------------
1713: Effets de bord : néant
1714: ================================================================================
1715: */
1716:
1717: void
1718: instruction_fuse(struct_processus *s_etat_processus)
1719: {
1720: pthread_attr_t attributs;
1721:
1722: real8 timeout;
1723:
1724: struct_objet *s_objet_argument;
1725:
1726: (*s_etat_processus).erreur_execution = d_ex;
1727:
1728: if ((*s_etat_processus).affichage_arguments == 'Y')
1729: {
1730: printf("\n FUSE ");
1731:
1732: if ((*s_etat_processus).langue == 'F')
1733: {
1734: printf("(mise en place d'un fusible)\n\n");
1735: }
1736: else
1737: {
1738: printf("(set fuse signal)\n\n");
1739: }
1740:
1741: printf(" 1: %s, %s\n", d_INT, d_REL);
1742: return;
1743: }
1744: else if ((*s_etat_processus).test_instruction == 'Y')
1745: {
1746: (*s_etat_processus).nombre_arguments = -1;
1747: return;
1748: }
1749:
1750: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1751: {
1752: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1753: {
1754: return;
1755: }
1756: }
1757:
1758: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1759: &s_objet_argument) == d_erreur)
1760: {
1761: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1762: return;
1763: }
1764:
1765: if ((*s_etat_processus).presence_fusible == d_vrai)
1766: {
1767: liberation(s_etat_processus, s_objet_argument);
1768:
1769: (*s_etat_processus).erreur_execution = d_ex_fusible;
1770: return;
1771: }
1772:
1773: if ((*s_objet_argument).type == INT)
1774: {
1775: timeout = (real8) (*((integer8 *) (*s_objet_argument).objet));
1776: }
1777: else if ((*s_objet_argument).type == REL)
1778: {
1779: timeout = (*((real8 *) (*s_objet_argument).objet));
1780: }
1781: else
1782: {
1783: liberation(s_etat_processus, s_objet_argument);
1784:
1785: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1786: return;
1787: }
1788:
1789: liberation(s_etat_processus, s_objet_argument);
1790:
1791: if (timeout < 0)
1792: {
1793: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1794: return;
1795: }
1796:
1797: (*s_etat_processus).temps_maximal_cpu = timeout;
1798: (*s_etat_processus).presence_fusible = d_vrai;
1799: (*s_etat_processus).thread_surveille_par_fusible = pthread_self();
1800:
1801: // Génération du thread de surveillance
1802:
1803: if (pthread_attr_init(&attributs) != 0)
1804: {
1805: (*s_etat_processus).erreur_systeme = d_es_processus;
1806: return;
1807: }
1808:
1809: if (pthread_attr_setdetachstate(&attributs,
1810: PTHREAD_CREATE_DETACHED) != 0)
1811: {
1812: (*s_etat_processus).erreur_systeme = d_es_processus;
1813: return;
1814: }
1815:
1816: # ifdef SCHED_OTHER
1817: if (pthread_attr_setschedpolicy(&attributs, SCHED_OTHER) != 0)
1818: {
1819: (*s_etat_processus).erreur_systeme = d_es_processus;
1820: return;
1821: }
1822: # endif
1823:
1824: # ifdef PTHREAD_EXPLICIT_SCHED
1825: if (pthread_attr_setinheritsched(&attributs,
1826: PTHREAD_EXPLICIT_SCHED) != 0)
1827: {
1828: (*s_etat_processus).erreur_systeme = d_es_processus;
1829: return;
1830: }
1831: # endif
1832:
1833: # ifdef PTHREAD_SCOPE_SYSTEM
1834: if (pthread_attr_setscope(&attributs, PTHREAD_SCOPE_SYSTEM) != 0)
1835: {
1836: (*s_etat_processus).erreur_systeme = d_es_processus;
1837: return;
1838: }
1839: # endif
1840:
1841: if (pthread_create(&(*s_etat_processus).thread_fusible, &attributs,
1842: fusible, s_etat_processus) != 0)
1843: {
1844: (*s_etat_processus).erreur_systeme = d_es_processus;
1845: return;
1846: }
1847:
1848: if (pthread_attr_destroy(&attributs) != 0)
1849: {
1850: (*s_etat_processus).erreur_systeme = d_es_processus;
1851: return;
1852: }
1853:
1854: return;
1855: }
1856:
1857: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_f3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src