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