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