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