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