1: /*
2: ================================================================================
3: RPL/2 (R) version 4.0.12
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: #include "convert.conv.h"
25:
26:
27: /*
28: ================================================================================
29: Fonction 'cov'
30: ================================================================================
31: Entrées :
32: --------------------------------------------------------------------------------
33: Sorties :
34: --------------------------------------------------------------------------------
35: Effets de bord : néant
36: ================================================================================
37: */
38:
39: void
40: instruction_cov(struct_processus *s_etat_processus)
41: {
42: integer8 nombre_colonnes;
43:
44: logical1 erreur;
45: logical1 presence_variable;
46:
47: long i;
48:
49: struct_objet *s_objet_statistique;
50: struct_objet *s_objet_resultat;
51:
52: (*s_etat_processus).erreur_execution = d_ex;
53:
54: if ((*s_etat_processus).affichage_arguments == 'Y')
55: {
56: printf("\n COV ");
57:
58: if ((*s_etat_processus).langue == 'F')
59: {
60: printf("(covariance)\n\n");
61: }
62: else
63: {
64: printf("(covariance)\n\n");
65: }
66:
67: printf("-> 1: %s\n", d_REL);
68:
69: return;
70: }
71: else if ((*s_etat_processus).test_instruction == 'Y')
72: {
73: (*s_etat_processus).nombre_arguments = -1;
74: return;
75: }
76:
77: if (test_cfsf(s_etat_processus, 31) == d_vrai)
78: {
79: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
80: {
81: return;
82: }
83: }
84:
85: /*
86: * Recherche d'une variable globale référencée par SIGMA
87: */
88:
89: if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
90: {
91: /*
92: * Aucune variable SIGMA
93: */
94:
95: (*s_etat_processus).erreur_systeme = d_es;
96: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
97: return;
98: }
99: else
100: {
101: /*
102: * Il existe une variable locale SIGMA. Reste à vérifier l'existence
103: * d'une variable SIGMA globale...
104: */
105:
106: i = (*s_etat_processus).position_variable_courante;
107: presence_variable = d_faux;
108:
109: while(i >= 0)
110: {
111: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
112: ds_sdat) == 0) && ((*s_etat_processus)
113: .s_liste_variables[i].niveau == 1))
114: {
115: presence_variable = d_vrai;
116: break;
117: }
118:
119: i--;
120: }
121:
122: if (presence_variable == d_faux)
123: {
124: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
125: return;
126: }
127: else
128: {
129: (*s_etat_processus).position_variable_courante = i;
130:
131: if ((*s_etat_processus).s_liste_variables
132: [(*s_etat_processus).position_variable_courante].objet
133: == NULL)
134: {
135: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
136: return;
137: }
138:
139: if (((*((*s_etat_processus).s_liste_variables
140: [(*s_etat_processus).position_variable_courante].objet))
141: .type != MIN) && ((*((*s_etat_processus)
142: .s_liste_variables[(*s_etat_processus)
143: .position_variable_courante].objet)).type != MRL))
144: {
145: (*s_etat_processus).erreur_execution =
146: d_ex_matrice_statistique_invalide;
147: return;
148: }
149:
150: nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
151: .s_liste_variables[(*s_etat_processus)
152: .position_variable_courante].objet)).objet))
153: .nombre_colonnes;
154: }
155: }
156:
157: s_objet_statistique = ((*s_etat_processus).s_liste_variables
158: [(*s_etat_processus).position_variable_courante]).objet;
159:
160: if (((*s_objet_statistique).type == MIN) ||
161: ((*s_objet_statistique).type == MRL))
162: {
163: if (((*s_etat_processus).colonne_statistique_1 < 1) ||
164: ((*s_etat_processus).colonne_statistique_2 < 1) ||
165: ((*s_etat_processus).colonne_statistique_1 > nombre_colonnes) ||
166: ((*s_etat_processus).colonne_statistique_2 > nombre_colonnes))
167: {
168: (*s_etat_processus).erreur_execution =
169: d_ex_observations_inexistantes;
170: return;
171: }
172:
173: if ((s_objet_resultat = allocation(s_etat_processus, REL))
174: == NULL)
175: {
176: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
177: return;
178: }
179:
180: (*((real8 *) (*s_objet_resultat).objet)) = covariance_statistique(
181: (struct_matrice *) (*s_objet_statistique).objet,
182: (*s_etat_processus).colonne_statistique_1,
183: (*s_etat_processus).colonne_statistique_2, 'E', &erreur);
184:
185: if (erreur == d_erreur)
186: {
187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
188: return;
189: }
190: }
191: else
192: {
193: (*s_etat_processus).erreur_execution =
194: d_ex_matrice_statistique_invalide;
195: return;
196: }
197:
198: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
199: s_objet_resultat) == d_erreur)
200: {
201: return;
202: }
203:
204: return;
205: }
206:
207:
208: /*
209: ================================================================================
210: Fonction 'corr'
211: ================================================================================
212: Entrées :
213: --------------------------------------------------------------------------------
214: Sorties :
215: --------------------------------------------------------------------------------
216: Effets de bord : néant
217: ================================================================================
218: */
219:
220: void
221: instruction_corr(struct_processus *s_etat_processus)
222: {
223: logical1 erreur;
224: logical1 presence_variable;
225:
226: long i;
227:
228: struct_objet *s_objet_statistique;
229: struct_objet *s_objet_resultat;
230:
231: unsigned long nombre_colonnes;
232:
233: (*s_etat_processus).erreur_execution = d_ex;
234:
235: if ((*s_etat_processus).affichage_arguments == 'Y')
236: {
237: printf("\n CORR ");
238:
239: if ((*s_etat_processus).langue == 'F')
240: {
241: printf("(corrélation)\n\n");
242: }
243: else
244: {
245: printf("(correlation)\n\n");
246: }
247:
248: printf("-> 1: %s\n", d_REL);
249:
250: return;
251: }
252: else if ((*s_etat_processus).test_instruction == 'Y')
253: {
254: (*s_etat_processus).nombre_arguments = -1;
255: return;
256: }
257:
258: if (test_cfsf(s_etat_processus, 31) == d_vrai)
259: {
260: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
261: {
262: return;
263: }
264: }
265:
266: /*
267: * Recherche d'une variable globale référencée par SIGMA
268: */
269:
270: if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
271: {
272: /*
273: * Aucune variable SIGMA
274: */
275:
276: (*s_etat_processus).erreur_systeme = d_es;
277: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
278: return;
279: }
280: else
281: {
282: /*
283: * Il existe une variable locale SIGMA. Reste à vérifier l'existence
284: * d'une variable SIGMA globale...
285: */
286:
287: i = (*s_etat_processus).position_variable_courante;
288: presence_variable = d_faux;
289:
290: while(i >= 0)
291: {
292: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
293: ds_sdat) == 0) && ((*s_etat_processus)
294: .s_liste_variables[i].niveau == 1))
295: {
296: presence_variable = d_vrai;
297: break;
298: }
299:
300: i--;
301: }
302:
303: if (presence_variable == d_faux)
304: {
305: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
306: return;
307: }
308: else
309: {
310: (*s_etat_processus).position_variable_courante = i;
311:
312: if ((*s_etat_processus).s_liste_variables
313: [(*s_etat_processus).position_variable_courante].objet
314: == NULL)
315: {
316: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
317: return;
318: }
319:
320: if (((*((*s_etat_processus).s_liste_variables
321: [(*s_etat_processus).position_variable_courante].objet))
322: .type != MIN) && ((*((*s_etat_processus)
323: .s_liste_variables[(*s_etat_processus)
324: .position_variable_courante].objet)).type != MRL))
325: {
326: (*s_etat_processus).erreur_execution =
327: d_ex_matrice_statistique_invalide;
328: return;
329: }
330:
331: nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
332: .s_liste_variables[(*s_etat_processus)
333: .position_variable_courante].objet)).objet))
334: .nombre_colonnes;
335: }
336: }
337:
338: s_objet_statistique = ((*s_etat_processus).s_liste_variables
339: [(*s_etat_processus).position_variable_courante]).objet;
340:
341: if (((*s_objet_statistique).type == MIN) ||
342: ((*s_objet_statistique).type == MRL))
343: {
344: if (((*s_etat_processus).colonne_statistique_1 < 1) ||
345: ((*s_etat_processus).colonne_statistique_2 < 1) ||
346: ((*s_etat_processus).colonne_statistique_1 > (long)
347: nombre_colonnes) || ((*s_etat_processus).colonne_statistique_2
348: > (long) nombre_colonnes))
349: {
350: (*s_etat_processus).erreur_execution =
351: d_ex_observations_inexistantes;
352: return;
353: }
354:
355: if ((s_objet_resultat = allocation(s_etat_processus, REL))
356: == NULL)
357: {
358: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
359: return;
360: }
361:
362: (*((real8 *) (*s_objet_resultat).objet)) = correlation_statistique(
363: (struct_matrice *) (*s_objet_statistique).objet,
364: (*s_etat_processus).colonne_statistique_1,
365: (*s_etat_processus).colonne_statistique_2, &erreur);
366:
367: if (erreur == d_erreur)
368: {
369: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
370: return;
371: }
372: }
373: else
374: {
375: (*s_etat_processus).erreur_execution =
376: d_ex_matrice_statistique_invalide;
377: return;
378: }
379:
380: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
381: s_objet_resultat) == d_erreur)
382: {
383: return;
384: }
385:
386: return;
387: }
388:
389:
390: /*
391: ================================================================================
392: Fonction 'copyright'
393: ================================================================================
394: Entrées :
395: --------------------------------------------------------------------------------
396: Sorties :
397: --------------------------------------------------------------------------------
398: Effets de bord : néant
399: ================================================================================
400: */
401:
402: void
403: instruction_copyright(struct_processus *s_etat_processus)
404: {
405: # include "copyright.conv.h"
406:
407: (*s_etat_processus).erreur_execution = d_ex;
408:
409: if ((*s_etat_processus).affichage_arguments == 'Y')
410: {
411: printf("\n COPYRIGHT ");
412:
413: if ((*s_etat_processus).langue == 'F')
414: {
415: printf("(copyright)\n\n");
416: printf(" Aucun argument\n");
417: }
418: else
419: {
420: printf("(copyright)\n\n");
421: printf(" No argument\n");
422: }
423:
424: return;
425: }
426: else if ((*s_etat_processus).test_instruction == 'Y')
427: {
428: (*s_etat_processus).nombre_arguments = -1;
429: return;
430: }
431:
432: printf("\n RPL/2 (R) version %s\n", d_version_rpl);
433: printf("%s\n", ((*s_etat_processus).langue == 'F' )
434: ? copyright : copyright_anglais);
435:
436: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
437: {
438: printf("\n");
439: }
440:
441: return;
442: }
443:
444:
445: /*
446: ================================================================================
447: Fonction 'convert'
448: ================================================================================
449: Entrées :
450: --------------------------------------------------------------------------------
451: Sorties :
452: --------------------------------------------------------------------------------
453: Effets de bord : néant
454: ================================================================================
455: */
456:
457: void
458: instruction_convert(struct_processus *s_etat_processus)
459: {
460: file *pipe;
461:
462: int fin_fichier;
463:
464: logical1 last_valide;
465:
466: long longueur_chaine;
467:
468: logical1 presence_resultat;
469:
470: struct_objet *s_objet_argument_1;
471: struct_objet *s_objet_argument_2;
472: struct_objet *s_objet_argument_3;
473:
474: unsigned char *commande;
475: unsigned char ligne[1024 + 1];
476: unsigned char *tampon_instruction;
477:
478: (*s_etat_processus).erreur_execution = d_ex;
479:
480: if ((*s_etat_processus).affichage_arguments == 'Y')
481: {
482: printf("\n CONVERT ");
483:
484: if ((*s_etat_processus).langue == 'F')
485: {
486: printf("(conversion d'unités)\n\n");
487: }
488: else
489: {
490: printf("(units conversion)\n\n");
491: }
492:
493: printf(" 3: %s, %s\n", d_INT, d_REL);
494: printf(" 2: %s\n", d_CHN);
495: printf(" 1: %s\n", d_CHN);
496: printf("-> 2: %s, %s\n", d_INT, d_REL);
497: printf(" 1: %s\n", d_CHN);
498:
499: return;
500: }
501: else if ((*s_etat_processus).test_instruction == 'Y')
502: {
503: (*s_etat_processus).nombre_arguments = -1;
504: return;
505: }
506:
507: if ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai)
508: {
509: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
510: {
511: return;
512: }
513: }
514:
515: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
516: &s_objet_argument_1) == d_erreur)
517: {
518: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
519: return;
520: }
521:
522: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
523: &s_objet_argument_2) == d_erreur)
524: {
525: liberation(s_etat_processus, s_objet_argument_1);
526:
527: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
528: return;
529: }
530:
531: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
532: &s_objet_argument_3) == d_erreur)
533: {
534: liberation(s_etat_processus, s_objet_argument_1);
535: liberation(s_etat_processus, s_objet_argument_2);
536:
537: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
538: return;
539: }
540:
541: if (((*s_objet_argument_1).type == CHN) &&
542: ((*s_objet_argument_2).type == CHN) &&
543: (((*s_objet_argument_3).type == INT) ||
544: ((*s_objet_argument_3).type == REL)))
545: {
546: if ((*s_etat_processus).rpl_home == NULL)
547: {
548: longueur_chaine = strlen(ds_rplconvert_commande) - 9
549: + strlen((unsigned char *) (*s_objet_argument_1).objet)
550: + strlen((unsigned char *) (*s_objet_argument_2).objet)
551: + (2 * strlen(d_exec_path));
552:
553: if ((commande = malloc((longueur_chaine + 1) *
554: sizeof(unsigned char))) == NULL)
555: {
556: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
557: return;
558: }
559:
560: sprintf(commande, ds_rplconvert_commande, d_exec_path, d_exec_path,
561: (unsigned char *) (*s_objet_argument_2).objet,
562: (unsigned char *) (*s_objet_argument_1).objet);
563: }
564: else
565: {
566: longueur_chaine = strlen(ds_rplconvert_commande) - 9
567: + strlen((unsigned char *) (*s_objet_argument_1).objet)
568: + strlen((unsigned char *) (*s_objet_argument_2).objet)
569: + (2 * strlen((*s_etat_processus).rpl_home));
570:
571: if ((commande = malloc((longueur_chaine + 1) *
572: sizeof(unsigned char))) == NULL)
573: {
574: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
575: return;
576: }
577:
578: sprintf(commande, ds_rplconvert_commande,
579: (*s_etat_processus).rpl_home, (*s_etat_processus).rpl_home,
580: (unsigned char *) (*s_objet_argument_2).objet,
581: (unsigned char *) (*s_objet_argument_1).objet);
582: }
583:
584: if ((pipe = popen(commande, "r")) == NULL)
585: {
586: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
587: return;
588: }
589:
590: free(commande);
591:
592: presence_resultat = d_faux;
593:
594: do
595: {
596: fin_fichier = fscanf(pipe, "%1024s", ligne);
597:
598: if (strcmp(ligne, "*") == 0)
599: {
600: fin_fichier = fscanf(pipe, "%1024s", ligne);
601:
602: if (fin_fichier != EOF)
603: {
604: presence_resultat = d_vrai;
605:
606: tampon_instruction =
607: (*s_etat_processus).instruction_courante;
608: (*s_etat_processus).instruction_courante = ligne;
609:
610: recherche_type(s_etat_processus);
611:
612: (*s_etat_processus).instruction_courante =
613: tampon_instruction;
614:
615: if ((*s_etat_processus).erreur_execution != d_ex)
616: {
617: if (pclose(pipe) == -1)
618: {
619: (*s_etat_processus).erreur_systeme = d_es_processus;
620: return;
621: }
622:
623: liberation(s_etat_processus, s_objet_argument_1);
624: liberation(s_etat_processus, s_objet_argument_2);
625: liberation(s_etat_processus, s_objet_argument_3);
626:
627: return;
628: }
629: }
630: }
631: } while(fin_fichier != EOF);
632:
633: /*
634: * Récupération de la ligne renvoyée commencant par "*". Si une telle
635: * ligne n'existe par, rplconvert retourne une erreur de type
636: * « conformability error » ou « Unknown unit ».
637: */
638:
639: if (pclose(pipe) == -1)
640: {
641: (*s_etat_processus).erreur_systeme = d_es_processus;
642: return;
643: }
644:
645: if (presence_resultat == d_faux)
646: {
647: liberation(s_etat_processus, s_objet_argument_1);
648: liberation(s_etat_processus, s_objet_argument_2);
649: liberation(s_etat_processus, s_objet_argument_3);
650:
651: (*s_etat_processus).erreur_execution = d_ex_conversion_unite;
652: return;
653: }
654:
655: /*
656: * Retrait des espaces dans la chaîne unité renvoyée
657: */
658:
659: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
660: s_objet_argument_3) == d_erreur)
661: {
662: return;
663: }
664:
665: if (last_valide == d_vrai)
666: {
667: cf(s_etat_processus, 31);
668: }
669:
670: instruction_multiplication(s_etat_processus);
671:
672: if (last_valide == d_vrai)
673: {
674: sf(s_etat_processus, 31);
675: }
676: }
677: else
678: {
679: liberation(s_etat_processus, s_objet_argument_1);
680: liberation(s_etat_processus, s_objet_argument_2);
681: liberation(s_etat_processus, s_objet_argument_3);
682:
683: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
684: return;
685: }
686:
687: liberation(s_etat_processus, s_objet_argument_1);
688: liberation(s_etat_processus, s_objet_argument_2);
689:
690: return;
691: }
692:
693:
694: /*
695: ================================================================================
696: Fonction 'close'
697: ================================================================================
698: Entrées :
699: --------------------------------------------------------------------------------
700: Sorties :
701: --------------------------------------------------------------------------------
702: Effets de bord : néant
703: ================================================================================
704: */
705:
706: void
707: instruction_close(struct_processus *s_etat_processus)
708: {
709: file *descripteur;
710:
711: int socket;
712:
713: logical1 socket_connectee;
714:
715: struct_liste_chainee *l_element_courant;
716: struct_liste_chainee *l_element_precedent;
717:
718: struct_objet *s_objet_argument;
719:
720: (*s_etat_processus).erreur_execution = d_ex;
721:
722: if ((*s_etat_processus).affichage_arguments == 'Y')
723: {
724: printf("\n CLOSE ");
725:
726: if ((*s_etat_processus).langue == 'F')
727: {
728: printf("(fermeture d'un fichier, d'une socket ou d'un sémaphore)"
729: "\n\n");
730: }
731: else
732: {
733: printf("(close file, socket or semaphore)\n\n");
734: }
735:
736: printf(" 1: %s\n\n", d_FCH);
737:
738: printf(" 1: %s\n\n", d_SCK);
739:
740: printf(" 1: %s\n", d_SPH);
741:
742: return;
743: }
744: else if ((*s_etat_processus).test_instruction == 'Y')
745: {
746: (*s_etat_processus).nombre_arguments = -1;
747: return;
748: }
749:
750: if (test_cfsf(s_etat_processus, 31) == d_vrai)
751: {
752: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
753: {
754: return;
755: }
756: }
757:
758: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
759: &s_objet_argument) == d_erreur)
760: {
761: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
762: return;
763: }
764:
765: if ((*s_objet_argument).type == FCH)
766: {
767: /*
768: * Retrait du descripteur de la pile de fichiers
769: */
770:
771: l_element_courant = (*s_etat_processus).s_fichiers;
772: l_element_precedent = NULL;
773:
774: descripteur = NULL;
775:
776: while(l_element_courant != NULL)
777: {
778: if (((*((struct_descripteur_fichier *) (*l_element_courant).donnee))
779: .identifiant == (*((struct_fichier *) (*s_objet_argument)
780: .objet)).descripteur) && ((*((struct_descripteur_fichier *)
781: (*l_element_courant).donnee)).pid == getpid()) &&
782: (pthread_equal((*((struct_descripteur_fichier *)
783: (*l_element_courant).donnee)).tid, pthread_self()) != 0))
784: {
785: if (((*((struct_fichier *) (*s_objet_argument).objet)).pid ==
786: (*((struct_descripteur_fichier *) (*l_element_courant)
787: .donnee)).pid) && (pthread_equal((*((struct_fichier *)
788: (*s_objet_argument).objet)).tid,
789: (*((struct_descripteur_fichier *) (*l_element_courant)
790: .donnee)).tid) != 0))
791: {
792: descripteur = (*((struct_descripteur_fichier *)
793: (*l_element_courant).donnee)).descripteur;
794:
795: if (l_element_precedent == NULL)
796: {
797: (*s_etat_processus).s_fichiers =
798: (*l_element_courant).suivant;
799: }
800: else if ((*l_element_courant).suivant == NULL)
801: {
802: (*l_element_precedent).suivant = NULL;
803: }
804: else
805: {
806: (*l_element_precedent).suivant =
807: (*l_element_courant).suivant;
808: }
809:
810: free((*((struct_descripteur_fichier *)
811: (*l_element_courant).donnee)).nom);
812: free((*l_element_courant).donnee);
813: free(l_element_courant);
814:
815: break;
816: }
817: }
818:
819: l_element_precedent = l_element_courant;
820: l_element_courant = (*l_element_courant).suivant;
821: }
822:
823: if (descripteur == NULL)
824: {
825: liberation(s_etat_processus, s_objet_argument);
826:
827: (*s_etat_processus).erreur_execution = d_ex_erreur_acces_fichier;
828: return;
829: }
830:
831: /*
832: * Fermeture du fichier
833: */
834:
835: if (fclose(descripteur) != 0)
836: {
837: liberation(s_etat_processus, s_objet_argument);
838:
839: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
840: return;
841: }
842:
843: if ((*((struct_fichier *) (*s_objet_argument).objet)).ouverture == 'S')
844: {
845: if (destruction_fichier((*((struct_fichier *)
846: (*s_objet_argument).objet)).nom) == d_erreur)
847: {
848: liberation(s_etat_processus, s_objet_argument);
849:
850: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
851: return;
852: }
853: }
854: }
855: else if ((*s_objet_argument).type == SCK)
856: {
857: /*
858: * Retrait de la socket de la pile
859: */
860:
861: l_element_courant = (*s_etat_processus).s_sockets;
862: l_element_precedent = NULL;
863:
864: socket = -1;
865: socket_connectee = d_faux;
866:
867: while(l_element_courant != NULL)
868: {
869: if ((*((struct_socket *) (*(*l_element_courant).donnee).objet))
870: .socket == (*((struct_socket *) (*s_objet_argument)
871: .objet)).socket)
872: {
873: socket = (*((struct_socket *)
874: (*(*l_element_courant).donnee).objet)).socket;
875: socket_connectee = (*((struct_socket *)
876: (*(*l_element_courant).donnee).objet)).socket_connectee;
877:
878: if (l_element_precedent == NULL)
879: {
880: (*s_etat_processus).s_sockets =
881: (*l_element_courant).suivant;
882: }
883: else if ((*l_element_courant).suivant == NULL)
884: {
885: (*l_element_precedent).suivant = NULL;
886: }
887: else
888: {
889: (*l_element_precedent).suivant =
890: (*l_element_courant).suivant;
891: }
892:
893: liberation(s_etat_processus, (*l_element_courant).donnee);
894: free(l_element_courant);
895:
896: break;
897: }
898:
899: l_element_precedent = l_element_courant;
900: l_element_courant = (*l_element_courant).suivant;
901: }
902:
903: if (socket == -1)
904: {
905: liberation(s_etat_processus, s_objet_argument);
906:
907: (*s_etat_processus).erreur_execution = d_ex_erreur_acces_fichier;
908: return;
909: }
910:
911: /*
912: * Fermeture de la socket
913: */
914:
915: if (socket_connectee == d_vrai)
916: {
917: shutdown(socket, SHUT_RDWR);
918: }
919:
920: if (close(socket) != 0)
921: {
922: liberation(s_etat_processus, s_objet_argument);
923:
924: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
925: return;
926: }
927:
928: if ((*((struct_socket *) (*s_objet_argument).objet)).effacement == 'Y')
929: {
930: unlink((*((struct_socket *) (*s_objet_argument).objet)).adresse);
931: }
932: }
933: else if ((*s_objet_argument).type == SPH)
934: {
935: if (sem_close((*((struct_semaphore *) (*s_objet_argument).objet))
936: .semaphore) != 0)
937: {
938: (*s_etat_processus).erreur_execution = d_ex_semaphore;
939: return;
940: }
941: }
942: else
943: {
944: liberation(s_etat_processus, s_objet_argument);
945:
946: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
947: return;
948: }
949:
950: liberation(s_etat_processus, s_objet_argument);
951:
952: return;
953: }
954:
955:
956: /*
957: ================================================================================
958: Fonction 'create'
959: ================================================================================
960: Entrées :
961: --------------------------------------------------------------------------------
962: Sorties :
963: --------------------------------------------------------------------------------
964: Effets de bord : néant
965: ================================================================================
966: */
967:
968: void
969: instruction_create(struct_processus *s_etat_processus)
970: {
971: file *fichier;
972:
973: logical1 erreur;
974: logical1 existence;
975: logical1 ouverture;
976:
977: struct_objet *s_objet_argument;
978:
979: unsigned long unite;
980:
981: (*s_etat_processus).erreur_execution = d_ex;
982:
983: if ((*s_etat_processus).affichage_arguments == 'Y')
984: {
985: printf("\n CREATE ");
986:
987: if ((*s_etat_processus).langue == 'F')
988: {
989: printf("(création d'un fichier)\n\n");
990: }
991: else
992: {
993: printf("(create file)\n\n");
994: }
995:
996: printf(" 1: %s\n", d_CHN);
997:
998: return;
999: }
1000: else if ((*s_etat_processus).test_instruction == 'Y')
1001: {
1002: (*s_etat_processus).nombre_arguments = -1;
1003: return;
1004: }
1005:
1006: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1007: {
1008: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1009: {
1010: return;
1011: }
1012: }
1013:
1014: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1015: &s_objet_argument) == d_erreur)
1016: {
1017: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1018: return;
1019: }
1020:
1021: if ((*s_objet_argument).type == CHN)
1022: {
1023: erreur = caracteristiques_fichier(s_etat_processus, (unsigned char *)
1024: (*s_objet_argument).objet, &existence, &ouverture, &unite);
1025:
1026: if ((erreur != d_absence_erreur) || (existence == d_vrai))
1027: {
1028: liberation(s_etat_processus, s_objet_argument);
1029:
1030: (*s_etat_processus).erreur_execution =
1031: d_ex_erreur_acces_fichier;
1032: return;
1033: }
1034:
1035: if ((fichier = fopen((unsigned char *) (*s_objet_argument).objet, "w"))
1036: == NULL)
1037: {
1038: liberation(s_etat_processus, s_objet_argument);
1039:
1040: (*s_etat_processus).erreur_execution =
1041: d_ex_erreur_acces_fichier;
1042: return;
1043: }
1044:
1045: if (fclose(fichier) != 0)
1046: {
1047: liberation(s_etat_processus, s_objet_argument);
1048:
1049: (*s_etat_processus).erreur_execution =
1050: d_ex_erreur_acces_fichier;
1051: return;
1052: }
1053: }
1054: else
1055: {
1056: liberation(s_etat_processus, s_objet_argument);
1057:
1058: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1059: return;
1060: }
1061:
1062: liberation(s_etat_processus, s_objet_argument);
1063:
1064: return;
1065: }
1066:
1067:
1068: /*
1069: ================================================================================
1070: Fonction 'cswp'
1071: ================================================================================
1072: Entrées :
1073: --------------------------------------------------------------------------------
1074: Sorties :
1075: --------------------------------------------------------------------------------
1076: Effets de bord : néant
1077: ================================================================================
1078: */
1079:
1080: void
1081: instruction_cswp(struct_processus *s_etat_processus)
1082: {
1083: struct_objet *s_copie_argument_3;
1084: struct_objet *s_objet_argument_1;
1085: struct_objet *s_objet_argument_2;
1086: struct_objet *s_objet_argument_3;
1087:
1088: signed long colonne_1;
1089: signed long colonne_2;
1090:
1091: unsigned long i;
1092:
1093: (*s_etat_processus).erreur_execution = d_ex;
1094:
1095: if ((*s_etat_processus).affichage_arguments == 'Y')
1096: {
1097: printf("\n CSWP ");
1098:
1099: if ((*s_etat_processus).langue == 'F')
1100: {
1101: printf("(échange de deux colonnes d'une matrice)\n\n");
1102: }
1103: else
1104: {
1105: printf("(swap two columns of a matrix)\n\n");
1106: }
1107:
1108: printf(" 3: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1109: printf(" 2: %s\n", d_INT);
1110: printf(" 1: %s\n", d_INT);
1111: printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1112:
1113: return;
1114: }
1115: else if ((*s_etat_processus).test_instruction == 'Y')
1116: {
1117: (*s_etat_processus).nombre_arguments = -1;
1118: return;
1119: }
1120:
1121: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1122: {
1123: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
1124: {
1125: return;
1126: }
1127: }
1128:
1129: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1130: &s_objet_argument_1) == d_erreur)
1131: {
1132: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1133: return;
1134: }
1135:
1136: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1137: &s_objet_argument_2) == d_erreur)
1138: {
1139: liberation(s_etat_processus, s_objet_argument_1);
1140:
1141: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1142: return;
1143: }
1144:
1145: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1146: &s_objet_argument_3) == d_erreur)
1147: {
1148: liberation(s_etat_processus, s_objet_argument_1);
1149: liberation(s_etat_processus, s_objet_argument_2);
1150:
1151: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1152: return;
1153: }
1154:
1155: if (((*s_objet_argument_1).type == INT) &&
1156: ((*s_objet_argument_2).type == INT))
1157: {
1158: colonne_1 = (*((integer8 *) (*s_objet_argument_1).objet)) - 1;
1159: colonne_2 = (*((integer8 *) (*s_objet_argument_2).objet)) - 1;
1160:
1161: if ((*s_objet_argument_3).type == MIN)
1162: {
1163: if ((colonne_1 < 0) || (colonne_1 > ((signed long)
1164: (*((struct_matrice *) (*s_objet_argument_3).objet))
1165: .nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >
1166: ((signed long) (*((struct_matrice *)
1167: (*s_objet_argument_3).objet)).nombre_colonnes) - 1))
1168: {
1169: liberation(s_etat_processus, s_objet_argument_1);
1170: liberation(s_etat_processus, s_objet_argument_2);
1171: liberation(s_etat_processus, s_objet_argument_3);
1172:
1173: (*s_etat_processus).erreur_execution =
1174: d_ex_dimensions_invalides;
1175: return;
1176: }
1177:
1178: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
1179: s_objet_argument_3, 'Q')) == NULL)
1180: {
1181: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1182: return;
1183: }
1184:
1185: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
1186: .nombre_lignes; i++)
1187: {
1188: ((integer8 **) (*((struct_matrice *)
1189: (*s_copie_argument_3).objet)).tableau)
1190: [i][colonne_1] = ((integer8 **) (*((struct_matrice *)
1191: (*s_objet_argument_3).objet)).tableau)[i][colonne_2];
1192: ((integer8 **) (*((struct_matrice *)
1193: (*s_copie_argument_3).objet)).tableau)
1194: [i][colonne_2] = ((integer8 **) (*((struct_matrice *)
1195: (*s_objet_argument_3).objet)).tableau)[i][colonne_1];
1196: }
1197: }
1198: else if ((*s_objet_argument_3).type == MRL)
1199: {
1200: if ((colonne_1 < 0) || (colonne_1 > ((signed long)
1201: (*((struct_matrice *) (*s_objet_argument_3).objet))
1202: .nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >
1203: ((signed long) (*((struct_matrice *)
1204: (*s_objet_argument_3).objet)).nombre_colonnes) - 1))
1205: {
1206: liberation(s_etat_processus, s_objet_argument_1);
1207: liberation(s_etat_processus, s_objet_argument_2);
1208: liberation(s_etat_processus, s_objet_argument_3);
1209:
1210: (*s_etat_processus).erreur_execution =
1211: d_ex_dimensions_invalides;
1212: return;
1213: }
1214:
1215: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
1216: s_objet_argument_3, 'O')) == NULL)
1217: {
1218: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1219: return;
1220: }
1221:
1222: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
1223: .nombre_lignes; i++)
1224: {
1225: ((real8 **) (*((struct_matrice *)
1226: (*s_copie_argument_3).objet)).tableau)
1227: [i][colonne_1] = ((real8 **) (*((struct_matrice *)
1228: (*s_objet_argument_3).objet)).tableau)[i][colonne_2];
1229: ((real8 **) (*((struct_matrice *)
1230: (*s_copie_argument_3).objet)).tableau)
1231: [i][colonne_2] = ((real8 **) (*((struct_matrice *)
1232: (*s_objet_argument_3).objet)).tableau)[i][colonne_1];
1233: }
1234: }
1235: else if ((*s_objet_argument_3).type == MCX)
1236: {
1237: if ((colonne_1 < 0) || (colonne_1 > ((signed long)
1238: (*((struct_matrice *) (*s_objet_argument_3).objet))
1239: .nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >
1240: ((signed long) (*((struct_matrice *)
1241: (*s_objet_argument_3).objet)).nombre_colonnes) - 1))
1242: {
1243: liberation(s_etat_processus, s_objet_argument_1);
1244: liberation(s_etat_processus, s_objet_argument_2);
1245: liberation(s_etat_processus, s_objet_argument_3);
1246:
1247: (*s_etat_processus).erreur_execution =
1248: d_ex_dimensions_invalides;
1249: return;
1250: }
1251:
1252: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
1253: s_objet_argument_3, 'O')) == NULL)
1254: {
1255: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1256: return;
1257: }
1258:
1259: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
1260: .nombre_lignes; i++)
1261: {
1262: ((complex16 **) (*((struct_matrice *)
1263: (*s_copie_argument_3).objet)).tableau)
1264: [i][colonne_1].partie_reelle =
1265: ((complex16 **) (*((struct_matrice *)
1266: (*s_objet_argument_3).objet)).tableau)[i][colonne_2]
1267: .partie_reelle;
1268: ((complex16 **) (*((struct_matrice *)
1269: (*s_copie_argument_3).objet)).tableau)
1270: [i][colonne_1].partie_imaginaire =
1271: ((complex16 **) (*((struct_matrice *)
1272: (*s_objet_argument_3).objet)).tableau)[i][colonne_2]
1273: .partie_imaginaire;
1274: ((complex16 **) (*((struct_matrice *)
1275: (*s_copie_argument_3).objet)).tableau)
1276: [i][colonne_2].partie_reelle =
1277: ((complex16 **) (*((struct_matrice *)
1278: (*s_objet_argument_3).objet)).tableau)[i][colonne_1]
1279: .partie_reelle;
1280: ((complex16 **) (*((struct_matrice *)
1281: (*s_copie_argument_3).objet)).tableau)
1282: [i][colonne_2].partie_imaginaire =
1283: ((complex16 **) (*((struct_matrice *)
1284: (*s_objet_argument_3).objet)).tableau)[i][colonne_1]
1285: .partie_imaginaire;
1286: }
1287: }
1288: else
1289: {
1290: liberation(s_etat_processus, s_objet_argument_1);
1291: liberation(s_etat_processus, s_objet_argument_2);
1292: liberation(s_etat_processus, s_objet_argument_3);
1293:
1294: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1295: return;
1296: }
1297: }
1298: else
1299: {
1300: liberation(s_etat_processus, s_objet_argument_1);
1301: liberation(s_etat_processus, s_objet_argument_2);
1302: liberation(s_etat_processus, s_objet_argument_3);
1303:
1304: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1305: return;
1306: }
1307:
1308: liberation(s_etat_processus, s_objet_argument_1);
1309: liberation(s_etat_processus, s_objet_argument_2);
1310: liberation(s_etat_processus, s_objet_argument_3);
1311:
1312: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1313: s_copie_argument_3) == d_erreur)
1314: {
1315: return;
1316: }
1317:
1318: return;
1319: }
1320:
1321: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_c4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src