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