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