1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.36
4: Copyright (C) 1989-2025 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction 'lu'
29: ================================================================================
30: Entrées : pointeur sur une structure struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_lu(struct_processus *s_etat_processus)
40: {
41: struct_matrice *s_matrice;
42:
43: struct_objet *s_objet_argument;
44: struct_objet *s_objet_copie;
45: struct_objet *s_objet_resultat_1;
46: struct_objet *s_objet_resultat_2;
47: struct_objet *s_objet_resultat_3;
48:
49: integer8 i;
50: integer8 j;
51:
52: (*s_etat_processus).erreur_execution = d_ex;
53:
54: if ((*s_etat_processus).affichage_arguments == 'Y')
55: {
56: printf("\n LU ");
57:
58: if ((*s_etat_processus).langue == 'F')
59: {
60: printf("(décomposition LU)\n\n");
61: }
62: else
63: {
64: printf("(LU decomposition)\n\n");
65: }
66:
67: printf(" 1: %s, %s\n", d_MIN, d_MRL);
68: printf("-> 3: %s\n", d_MIN);
69: printf(" 2: %s\n", d_MRL);
70: printf(" 1: %s\n\n", d_MRL);
71:
72: printf(" 1: %s\n", d_MCX);
73: printf("-> 3: %s\n", d_MIN);
74: printf(" 2: %s\n", d_MCX);
75: printf(" 1: %s\n", d_MCX);
76:
77: return;
78: }
79: else if ((*s_etat_processus).test_instruction == 'Y')
80: {
81: (*s_etat_processus).nombre_arguments = -1;
82: return;
83: }
84:
85: if (test_cfsf(s_etat_processus, 31) == d_vrai)
86: {
87: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
88: {
89: return;
90: }
91: }
92:
93: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
94: &s_objet_argument) == d_erreur)
95: {
96: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
97: return;
98: }
99:
100: /*
101: --------------------------------------------------------------------------------
102: Résultat sous la forme de matrices réelles
103: --------------------------------------------------------------------------------
104: */
105:
106: if (((*s_objet_argument).type == MIN) ||
107: ((*s_objet_argument).type == MRL))
108: {
109: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
110: (*((struct_matrice *) (*s_objet_argument).objet))
111: .nombre_colonnes)
112: {
113: liberation(s_etat_processus, s_objet_argument);
114:
115: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
116: return;
117: }
118:
119: if ((s_objet_copie = copie_objet(s_etat_processus, s_objet_argument,
120: 'Q')) == NULL)
121: {
122: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
123: return;
124: }
125:
126: liberation(s_etat_processus, s_objet_argument);
127: s_objet_argument = s_objet_copie;
128:
129: if ((s_matrice = malloc(sizeof(struct_matrice))) == NULL)
130: {
131: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
132: return;
133: }
134:
135: factorisation_lu(s_etat_processus, (*s_objet_argument).objet,
136: &s_matrice);
137: (*s_objet_copie).type = MRL;
138:
139: if (((*s_etat_processus).exception != d_ep) ||
140: ((*s_etat_processus).erreur_execution != d_ex))
141: {
142: // S'il y a une erreur autre qu'une erreur système, le tableau
143: // de la structure matrice n'a pas encore été alloué.
144:
145: free(s_matrice);
146: liberation(s_etat_processus, s_objet_argument);
147: return;
148: }
149:
150: if ((*s_etat_processus).erreur_systeme != d_es)
151: {
152: return;
153: }
154:
155: if ((s_objet_resultat_1 = allocation(s_etat_processus, NON)) == NULL)
156: {
157: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
158: return;
159: }
160:
161: (*s_objet_resultat_1).objet = s_matrice;
162: (*s_objet_resultat_1).type = MIN;
163:
164: if ((s_objet_resultat_2 = allocation(s_etat_processus, MRL)) == NULL)
165: {
166: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
167: return;
168: }
169:
170: if ((s_objet_resultat_3 = allocation(s_etat_processus, MRL)) == NULL)
171: {
172: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
173: return;
174: }
175:
176: /* L */
177:
178: (*((struct_matrice *) (*s_objet_resultat_3).objet)).nombre_lignes =
179: (*((struct_matrice *) (*s_objet_argument).objet))
180: .nombre_lignes;
181: (*((struct_matrice *) (*s_objet_resultat_3).objet)).nombre_colonnes =
182: (*((struct_matrice *) (*s_objet_argument).objet))
183: .nombre_colonnes;
184:
185: if (((*((struct_matrice *) (*s_objet_resultat_3).objet)).tableau =
186: malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat_3)
187: .objet)).nombre_lignes) * sizeof(real8 *))) == NULL)
188: {
189: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
190: return;
191: }
192:
193: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat_3).objet))
194: .nombre_lignes; i++)
195: {
196: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat_3).objet))
197: .tableau)[i] = malloc(((size_t) (*((struct_matrice *)
198: (*s_objet_resultat_3).objet)).nombre_colonnes) *
199: sizeof(real8))) == NULL)
200: {
201: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
202: return;
203: }
204:
205: /*
206: * Si la décomposition comporte plus de lignes que de colonnes,
207: * L est une matrice trapézoïdale.
208: */
209:
210: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat_3).objet))
211: .nombre_colonnes; j++)
212: {
213: if (i == j)
214: {
215: ((real8 **) (*((struct_matrice *) (*s_objet_resultat_3)
216: .objet)).tableau)[i][j] = 1;
217: }
218: else if (i > j)
219: {
220: ((real8 **) (*((struct_matrice *) (*s_objet_resultat_3)
221: .objet)).tableau)[i][j] = ((real8 **)
222: (*((struct_matrice *) (*s_objet_argument)
223: .objet)).tableau)[i][j];
224: }
225: else
226: {
227: ((real8 **) (*((struct_matrice *) (*s_objet_resultat_3)
228: .objet)).tableau)[i][j] = 0;
229: }
230: }
231: }
232:
233: /* U */
234:
235: (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_lignes =
236: (*((struct_matrice *) (*s_objet_argument).objet))
237: .nombre_lignes;
238: (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_colonnes =
239: (*((struct_matrice *) (*s_objet_argument).objet))
240: .nombre_colonnes;
241:
242: if (((*((struct_matrice *) (*s_objet_resultat_2).objet)).tableau =
243: malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat_2)
244: .objet)).nombre_lignes) * sizeof(real8 *))) == NULL)
245: {
246: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
247: return;
248: }
249:
250: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat_2).objet))
251: .nombre_lignes; i++)
252: {
253: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat_2).objet))
254: .tableau)[i] = malloc(((size_t) (*((struct_matrice *)
255: (*s_objet_resultat_2).objet)).nombre_colonnes) *
256: sizeof(real8))) == NULL)
257: {
258: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
259: return;
260: }
261:
262: /*
263: * Si la décomposition comporte plus de colonnes que de lignes,
264: * U est une matrice trapézoïdale.
265: */
266:
267: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat_2).objet))
268: .nombre_colonnes; j++)
269: {
270: if (i <= j)
271: {
272: ((real8 **) (*((struct_matrice *) (*s_objet_resultat_2)
273: .objet)).tableau)[i][j] = ((real8 **)
274: (*((struct_matrice *) (*s_objet_argument)
275: .objet)).tableau)[i][j];
276: }
277: else
278: {
279: ((real8 **) (*((struct_matrice *) (*s_objet_resultat_2)
280: .objet)).tableau)[i][j] = 0;
281: }
282: }
283: }
284: }
285:
286: /*
287: --------------------------------------------------------------------------------
288: Résultat sous la forme de matrices complexes
289: --------------------------------------------------------------------------------
290: */
291:
292: else if ((*s_objet_argument).type == MCX)
293: {
294: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
295: (*((struct_matrice *) (*s_objet_argument).objet))
296: .nombre_colonnes)
297: {
298: liberation(s_etat_processus, s_objet_argument);
299:
300: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
301: return;
302: }
303:
304: if ((s_objet_copie = copie_objet(s_etat_processus, s_objet_argument,
305: 'Q')) == NULL)
306: {
307: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
308: return;
309: }
310:
311: liberation(s_etat_processus, s_objet_argument);
312: s_objet_argument = s_objet_copie;
313:
314: if ((s_matrice = malloc(sizeof(struct_matrice))) == NULL)
315: {
316: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
317: return;
318: }
319:
320: factorisation_lu(s_etat_processus, (*s_objet_argument).objet,
321: &s_matrice);
322:
323: if (((*s_etat_processus).exception != d_ep) ||
324: ((*s_etat_processus).erreur_execution != d_ex))
325: {
326: // S'il y a une erreur autre qu'une erreur système, le tableau
327: // de la structure matrice n'a pas encore été alloué.
328:
329: free(s_matrice);
330: liberation(s_etat_processus, s_objet_argument);
331: return;
332: }
333:
334: if ((*s_etat_processus).erreur_systeme != d_es)
335: {
336: return;
337: }
338:
339: if ((s_objet_resultat_1 = allocation(s_etat_processus, NON)) == NULL)
340: {
341: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
342: return;
343: }
344:
345: (*s_objet_resultat_1).objet = s_matrice;
346: (*s_objet_resultat_1).type = MIN;
347:
348: if ((s_objet_resultat_2 = allocation(s_etat_processus, MCX)) == NULL)
349: {
350: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
351: return;
352: }
353:
354: if ((s_objet_resultat_3 = allocation(s_etat_processus, MCX)) == NULL)
355: {
356: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
357: return;
358: }
359:
360: /* L */
361:
362: (*((struct_matrice *) (*s_objet_resultat_3).objet)).nombre_lignes =
363: (*((struct_matrice *) (*s_objet_argument).objet))
364: .nombre_lignes;
365: (*((struct_matrice *) (*s_objet_resultat_3).objet)).nombre_colonnes =
366: (*((struct_matrice *) (*s_objet_argument).objet))
367: .nombre_colonnes;
368:
369: if (((*((struct_matrice *) (*s_objet_resultat_3).objet)).tableau =
370: malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat_3)
371: .objet)).nombre_lignes) * sizeof(complex16 *))) == NULL)
372: {
373: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
374: return;
375: }
376:
377: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat_3).objet))
378: .nombre_lignes; i++)
379: {
380: if ((((complex16 **) (*((struct_matrice *)
381: (*s_objet_resultat_3).objet))
382: .tableau)[i] = malloc(((size_t) (*((struct_matrice *)
383: (*s_objet_resultat_3).objet)).nombre_colonnes) *
384: sizeof(complex16))) == NULL)
385: {
386: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
387: return;
388: }
389:
390: /*
391: * Si la décomposition comporte plus de lignes que de colonnes,
392: * L est une matrice trapézoïdale.
393: */
394:
395: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat_3).objet))
396: .nombre_colonnes; j++)
397: {
398: if (i == j)
399: {
400: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
401: .objet)).tableau)[i][j].partie_reelle = 1;
402: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
403: .objet)).tableau)[i][j].partie_imaginaire = 0;
404: }
405: else if (i > j)
406: {
407: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
408: .objet)).tableau)[i][j] = ((complex16 **)
409: (*((struct_matrice *) (*s_objet_argument)
410: .objet)).tableau)[i][j];
411: }
412: else
413: {
414: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
415: .objet)).tableau)[i][j].partie_reelle = 0;
416: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
417: .objet)).tableau)[i][j].partie_imaginaire = 0;
418: }
419: }
420: }
421:
422: /* U */
423:
424: (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_lignes =
425: (*((struct_matrice *) (*s_objet_argument).objet))
426: .nombre_lignes;
427: (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_colonnes =
428: (*((struct_matrice *) (*s_objet_argument).objet))
429: .nombre_colonnes;
430:
431: if (((*((struct_matrice *) (*s_objet_resultat_2).objet)).tableau =
432: malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat_2)
433: .objet)).nombre_lignes) * sizeof(complex16 *))) == NULL)
434: {
435: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
436: return;
437: }
438:
439: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat_2).objet))
440: .nombre_lignes; i++)
441: {
442: if ((((complex16 **) (*((struct_matrice *)
443: (*s_objet_resultat_2).objet))
444: .tableau)[i] = malloc(((size_t) (*((struct_matrice *)
445: (*s_objet_resultat_2).objet)).nombre_colonnes) *
446: sizeof(complex16))) == NULL)
447: {
448: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
449: return;
450: }
451:
452: /*
453: * Si la décomposition comporte plus de colonnes que de lignes,
454: * U est une matrice trapézoïdale.
455: */
456:
457: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat_2).objet))
458: .nombre_colonnes; j++)
459: {
460: if (i <= j)
461: {
462: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_2)
463: .objet)).tableau)[i][j] = ((complex16 **)
464: (*((struct_matrice *) (*s_objet_argument)
465: .objet)).tableau)[i][j];
466: }
467: else
468: {
469: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_2)
470: .objet)).tableau)[i][j].partie_reelle = 0;
471: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_2)
472: .objet)).tableau)[i][j].partie_imaginaire = 0;
473: }
474: }
475: }
476: }
477:
478: /*
479: --------------------------------------------------------------------------------
480: Type d'argument invalide
481: --------------------------------------------------------------------------------
482: */
483:
484: else
485: {
486: liberation(s_etat_processus, s_objet_argument);
487:
488: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
489: return;
490: }
491:
492: liberation(s_etat_processus, s_objet_argument);
493:
494: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
495: s_objet_resultat_1) == d_erreur)
496: {
497: return;
498: }
499:
500: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
501: s_objet_resultat_3) == d_erreur)
502: {
503: return;
504: }
505:
506: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
507: s_objet_resultat_2) == d_erreur)
508: {
509: return;
510: }
511:
512: return;
513: }
514:
515:
516: /*
517: ================================================================================
518: Fonction 'lchol'
519: ================================================================================
520: Entrées : pointeur sur une structure struct_processus
521: --------------------------------------------------------------------------------
522: Sorties :
523: --------------------------------------------------------------------------------
524: Effets de bord : néant
525: ================================================================================
526: */
527:
528: void
529: instruction_lchol(struct_processus *s_etat_processus)
530: {
531: struct_objet *s_copie_objet;
532: struct_objet *s_objet;
533:
534: (*s_etat_processus).erreur_execution = d_ex;
535:
536: if ((*s_etat_processus).affichage_arguments == 'Y')
537: {
538: printf("\n LCHOL ");
539:
540: if ((*s_etat_processus).langue == 'F')
541: {
542: printf("(décomposition de Cholevski à gauche)\n\n");
543: }
544: else
545: {
546: printf("(left Cholevski decomposition)\n\n");
547: }
548:
549: printf(" 1: %s, %s\n", d_MIN, d_MRL);
550: printf("-> 1: %s\n\n", d_MRL);
551:
552: printf(" 1: %s\n", d_MCX);
553: printf("-> 1: %s\n", d_MCX);
554:
555: return;
556: }
557: else if ((*s_etat_processus).test_instruction == 'Y')
558: {
559: (*s_etat_processus).nombre_arguments = -1;
560: return;
561: }
562:
563: if (test_cfsf(s_etat_processus, 31) == d_vrai)
564: {
565: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
566: {
567: return;
568: }
569: }
570:
571: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
572: &s_objet) == d_erreur)
573: {
574: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
575: return;
576: }
577:
578: /*
579: --------------------------------------------------------------------------------
580: Résultat sous la forme de matrices réelles
581: --------------------------------------------------------------------------------
582: */
583:
584: if (((*s_objet).type == MIN) ||
585: ((*s_objet).type == MRL))
586: {
587: if ((*((struct_matrice *) (*s_objet).objet)).nombre_lignes !=
588: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes)
589: {
590: liberation(s_etat_processus, s_objet);
591:
592: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
593: return;
594: }
595:
596: if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'Q'))
597: == NULL)
598: {
599: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
600: return;
601: }
602:
603: liberation(s_etat_processus, s_objet);
604: s_objet = s_copie_objet;
605:
606: factorisation_cholesky(s_etat_processus, (*s_objet).objet, 'L');
607: (*s_objet).type = MRL;
608:
609: if ((*s_etat_processus).erreur_systeme != d_es)
610: {
611: return;
612: }
613:
614: if (((*s_etat_processus).exception != d_ep) ||
615: ((*s_etat_processus).erreur_execution != d_ex))
616: {
617: if ((*s_etat_processus).exception == d_ep_domaine_definition)
618: {
619: (*s_etat_processus).exception =
620: d_ep_matrice_non_definie_positive;
621: }
622:
623: liberation(s_etat_processus, s_objet);
624: return;
625: }
626: }
627:
628: /*
629: --------------------------------------------------------------------------------
630: Résultat sous la forme de matrices complexes
631: --------------------------------------------------------------------------------
632: */
633:
634: else if ((*s_objet).type == MCX)
635: {
636: if ((*((struct_matrice *) (*s_objet).objet)).nombre_lignes !=
637: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes)
638: {
639: liberation(s_etat_processus, s_objet);
640:
641: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
642: return;
643: }
644:
645: if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'Q'))
646: == NULL)
647: {
648: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
649: return;
650: }
651:
652: liberation(s_etat_processus, s_objet);
653: s_objet = s_copie_objet;
654:
655: factorisation_cholesky(s_etat_processus, (*s_objet).objet, 'L');
656:
657: if ((*s_etat_processus).erreur_systeme != d_es)
658: {
659: return;
660: }
661:
662: if (((*s_etat_processus).exception != d_ep) ||
663: ((*s_etat_processus).erreur_execution != d_ex))
664: {
665: if ((*s_etat_processus).exception == d_ep_domaine_definition)
666: {
667: (*s_etat_processus).exception =
668: d_ep_matrice_non_definie_positive;
669: }
670:
671: liberation(s_etat_processus, s_objet);
672: return;
673: }
674: }
675:
676: /*
677: --------------------------------------------------------------------------------
678: Type d'argument invalide
679: --------------------------------------------------------------------------------
680: */
681:
682: else
683: {
684: liberation(s_etat_processus, s_objet);
685:
686: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
687: return;
688: }
689:
690: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
691: s_objet) == d_erreur)
692: {
693: return;
694: }
695:
696: return;
697: }
698:
699:
700: /*
701: ================================================================================
702: Fonction 'lock'
703: ================================================================================
704: Entrées : pointeur sur une structure struct_processus
705: --------------------------------------------------------------------------------
706: Sorties :
707: --------------------------------------------------------------------------------
708: Effets de bord : néant
709: ================================================================================
710: */
711:
712: void
713: instruction_lock(struct_processus *s_etat_processus)
714: {
715: file *descripteur;
716:
717: struct flock lock;
718:
719: struct_descripteur_fichier *fichier;
720:
721: struct_objet *s_objet_argument_1;
722: struct_objet *s_objet_argument_2;
723:
724: unsigned char *chaine;
725:
726: (*s_etat_processus).erreur_execution = d_ex;
727:
728: if ((*s_etat_processus).affichage_arguments == 'Y')
729: {
730: printf("\n LOCK ");
731:
732: if ((*s_etat_processus).langue == 'F')
733: {
734: printf("(verrouillage d'un fichier)\n\n");
735: }
736: else
737: {
738: printf("(file lock)\n\n");
739: }
740:
741: printf(" 2: %s\n", d_FCH);
742: printf(" 1: %s (READ/WRITE/NONE)\n", d_CHN);
743:
744: return;
745: }
746: else if ((*s_etat_processus).test_instruction == 'Y')
747: {
748: (*s_etat_processus).nombre_arguments = -1;
749: return;
750: }
751:
752: if (test_cfsf(s_etat_processus, 31) == d_vrai)
753: {
754: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
755: {
756: return;
757: }
758: }
759:
760: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
761: &s_objet_argument_1) == d_erreur)
762: {
763: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
764: return;
765: }
766:
767: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
768: &s_objet_argument_2) == d_erreur)
769: {
770: liberation(s_etat_processus, s_objet_argument_1);
771:
772: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
773: return;
774: }
775:
776: if (((*s_objet_argument_2).type == FCH) &&
777: ((*s_objet_argument_1).type == CHN))
778: {
779: lock.l_whence = SEEK_SET;
780: lock.l_start = 0;
781: lock.l_len = 0;
782: lock.l_pid = getpid();
783:
784: if ((chaine = conversion_majuscule(s_etat_processus, (unsigned char *)
785: (*s_objet_argument_1).objet)) == NULL)
786: {
787: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
788: return;
789: }
790:
791: if (strcmp(chaine, "READ") == 0)
792: {
793: lock.l_type = F_WRLCK;
794: }
795: else if (strcmp(chaine, "WRITE") == 0)
796: {
797: lock.l_type = F_RDLCK;
798: }
799: else if (strcmp(chaine, "NONE") == 0)
800: {
801: lock.l_type = F_UNLCK;
802: }
803: else
804: {
805: free(chaine);
806:
807: liberation(s_etat_processus, s_objet_argument_1);
808: liberation(s_etat_processus, s_objet_argument_2);
809:
810: (*s_etat_processus).erreur_execution = d_ex_verrou_indefini;
811: return;
812: }
813:
814: free(chaine);
815:
816: if ((fichier = descripteur_fichier(s_etat_processus,
817: (struct_fichier *) (*s_objet_argument_2).objet)) == NULL)
818: {
819: return;
820: }
821:
822: descripteur = (*fichier).descripteur_c;
823:
824: if (fcntl(fileno(descripteur), F_SETLK, &lock) == -1)
825: {
826: liberation(s_etat_processus, s_objet_argument_1);
827: liberation(s_etat_processus, s_objet_argument_2);
828:
829: (*s_etat_processus).erreur_execution = d_ex_fichier_verrouille;
830: return;
831: }
832: }
833: else
834: {
835: liberation(s_etat_processus, s_objet_argument_1);
836: liberation(s_etat_processus, s_objet_argument_2);
837:
838: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
839: return;
840: }
841:
842: return;
843: }
844:
845: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>