![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_i3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src|
Return to instructions_i3.c CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: /*
2: ================================================================================
1.4 ! bertrand 3: RPL/2 (R) version 4.0.12
1.1 bertrand 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 'inquire'
29: ================================================================================
30: Entrées :
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_inquire(struct_processus *s_etat_processus)
40: {
41: file *fichier;
42:
43: logical1 erreur;
44: logical1 existence;
45: logical1 ouverture;
46:
47: logical1 fin_fichier;
48:
49: long position_courante;
50:
51: struct flock lock;
52:
53: struct_objet *s_objet_argument_1;
54: struct_objet *s_objet_argument_2;
55: struct_objet *s_objet_resultat;
56:
57: unsigned char caractere;
58: unsigned char *requete;
59: unsigned char verrou;
60:
61: unsigned long unite;
62:
63: (*s_etat_processus).erreur_execution = d_ex;
64:
65: if ((*s_etat_processus).affichage_arguments == 'Y')
66: {
67: printf("\n INQUIRE ");
68:
69: if ((*s_etat_processus).langue == 'F')
70: {
71: printf("(caractéristiques d'un fichier)\n\n");
72: }
73: else
74: {
75: printf("(file properties)\n\n");
76: }
77:
78: printf(" 2: %s, %s\n", d_FCH, d_CHN);
79: printf(" 1: %s\n", d_CHN);
80: printf("-> 1: %s, %s, %s\n\n", d_INT, d_CHN, d_LST);
81:
82: if ((*s_etat_processus).langue == 'F')
83: {
84: printf(" Requêtes par descripteur :\n\n");
85: }
86: else
87: {
88: printf(" Queries by descriptor:\n\n");
89: }
90:
91: printf(" END OF FILE : %s (true/false)\n", d_INT);
92: printf(" ACCESS : %s (SEQUENTIAL/DIRECT/KEYED)\n", d_CHN);
93: printf(" NAME : %s\n", d_CHN);
94: printf(" FORMATTED : %s (true/false)\n", d_INT);
95: printf(" KEY FIELD : %s\n", d_INT);
96: printf(" PROTECTION : %s (WRITEONLY/READONLY/READWRITE)\n\n",
97: d_CHN);
98:
99: if ((*s_etat_processus).langue == 'F')
100: {
101: printf(" Requêtes par nom :\n\n");
102: }
103: else
104: {
105: printf(" Queries by name:\n\n");
106: }
107:
108: printf(" FORMAT : %s\n", d_LST);
109: printf(" EXISTENCE : %s (true/false)\n", d_INT);
110: printf(" LOCK : %s (NONE/READ/WRITE)\n", d_CHN);
111:
112: return;
113: }
114: else if ((*s_etat_processus).test_instruction == 'Y')
115: {
116: (*s_etat_processus).nombre_arguments = -1;
117: return;
118: }
119:
120: if (test_cfsf(s_etat_processus, 31) == d_vrai)
121: {
122: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
123: {
124: return;
125: }
126: }
127:
128: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
129: &s_objet_argument_1) == d_erreur)
130: {
131: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
132: return;
133: }
134:
135: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
136: &s_objet_argument_2) == d_erreur)
137: {
138: liberation(s_etat_processus, s_objet_argument_1);
139:
140: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
141: return;
142: }
143:
144: if ((*s_objet_argument_1).type != CHN)
145: {
146: liberation(s_etat_processus, s_objet_argument_1);
147: liberation(s_etat_processus, s_objet_argument_2);
148:
149: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
150: return;
151: }
152:
153: if ((requete = conversion_majuscule((unsigned char *)
154: (*s_objet_argument_1).objet)) == NULL)
155: {
156: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
157: return;
158: }
159:
160: if ((*s_objet_argument_2).type == FCH)
161: {
162: /*
163: * La question porte sur un fichier ouvert.
164: */
165:
166: if (strcmp(requete, "END OF FILE") == 0)
167: {
168: if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces
169: != 'S')
170: {
171: liberation(s_etat_processus, s_objet_argument_1);
172: liberation(s_etat_processus, s_objet_argument_2);
173:
174: free(requete);
175:
176: (*s_etat_processus).erreur_execution =
177: d_ex_erreur_requete_fichier;
178: return;
179: }
180:
181: if ((s_objet_resultat = allocation(s_etat_processus, INT))
182: == NULL)
183: {
184: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
185: return;
186: }
187:
188: /*
189: * La fin du fichier renvoyée ne correspond pas à la fin physique
190: * du fichier mais à un défaut d'enregistrement.
191: */
192:
193: if ((fichier = descripteur_fichier(s_etat_processus,
194: (struct_fichier *) (*s_objet_argument_2).objet)) == NULL)
195: {
196: return;
197: }
198:
199: if ((position_courante = ftell(fichier)) == -1)
200: {
201: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
202: return;
203: }
204:
205: fin_fichier = d_vrai;
206:
207: while(feof(fichier) == 0)
208: {
209: if (fread(&caractere, sizeof(unsigned char), (size_t) 1,
210: fichier) > 0)
211: {
212: if (caractere == '{')
213: {
214: fin_fichier = d_faux;
215: break;
216: }
217: }
218: }
219:
220: if (fseek(fichier, position_courante, SEEK_SET) != 0)
221: {
222: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
223: return;
224: }
225:
226: if (fin_fichier == d_faux)
227: {
228: /*
229: * Fichier à suivre
230: */
231:
232: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
233: }
234: else
235: {
236: /*
237: * Fin de fichier
238: */
239:
240: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
241: }
242: }
243: else if (strcmp(requete, "ACCESS") == 0)
244: {
245: if ((s_objet_resultat = allocation(s_etat_processus, CHN))
246: == NULL)
247: {
248: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
249: return;
250: }
251:
252: if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces
253: == 'S')
254: {
255: if (((*s_objet_resultat).objet = malloc(11 *
256: sizeof(unsigned char))) == NULL)
257: {
258: (*s_etat_processus).erreur_systeme =
259: d_es_allocation_memoire;
260: return;
261: }
262:
263: strcpy((unsigned char *) (*s_objet_resultat).objet,
264: "SEQUENTIAL");
265: }
266: else if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces
267: == 'D')
268: {
269: if (((*s_objet_resultat).objet = malloc(7 *
270: sizeof(unsigned char))) == NULL)
271: {
272: (*s_etat_processus).erreur_systeme =
273: d_es_allocation_memoire;
274: return;
275: }
276:
277: strcpy((unsigned char *) (*s_objet_resultat).objet,
278: "DIRECT");
279: }
280: else
281: {
282: if (((*s_objet_resultat).objet = malloc(6 *
283: sizeof(unsigned char))) == NULL)
284: {
285: (*s_etat_processus).erreur_systeme =
286: d_es_allocation_memoire;
287: return;
288: }
289:
290: strcpy((unsigned char *) (*s_objet_resultat).objet,
291: "KEYED");
292: }
293: }
294: else if (strcmp(requete, "NAME") == 0)
295: {
296: if ((s_objet_resultat = allocation(s_etat_processus, CHN))
297: == NULL)
298: {
299: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
300: return;
301: }
302:
303: if (((*s_objet_resultat).objet = malloc(
304: (strlen((*((struct_fichier *) (*s_objet_argument_2).objet))
305: .nom) + 1) *
306: sizeof(unsigned char))) == NULL)
307: {
308: (*s_etat_processus).erreur_systeme =
309: d_es_allocation_memoire;
310: return;
311: }
312:
313: strcpy((unsigned char *) (*s_objet_resultat).objet,
314: (*((struct_fichier *) (*s_objet_argument_2).objet)).nom);
315: }
316: else if (strcmp(requete, "FORMATTED") == 0)
317: {
318: if ((s_objet_resultat = allocation(s_etat_processus, INT))
319: == NULL)
320: {
321: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
322: return;
323: }
324:
325: (*((integer8 *) (*s_objet_resultat).objet)) =
326: ((*((struct_fichier *) (*s_objet_argument_2).objet)).binaire
327: == 'N') ? -1 : 0;
328: }
329: else if (strcmp(requete, "KEY FIELD") == 0)
330: {
331: if ((*((struct_fichier *) (*s_objet_argument_2).objet))
332: .acces == 'S')
333: {
334: free(requete);
335:
336: liberation(s_etat_processus, s_objet_argument_1);
337: liberation(s_etat_processus, s_objet_argument_2);
338:
339: (*s_etat_processus).erreur_execution =
340: d_ex_erreur_requete_fichier;
341: return;
342: }
343:
344: if ((s_objet_resultat = allocation(s_etat_processus, INT))
345: == NULL)
346: {
347: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
348: return;
349: }
350:
351: (*((integer8 *) (*s_objet_resultat).objet)) =
352: (*((struct_fichier *) (*s_objet_argument_2).objet))
353: .position_clef;
354: }
355: else if (strcmp(requete, "PROTECTION") == 0)
356: {
357: if ((s_objet_resultat = allocation(s_etat_processus, CHN))
358: == NULL)
359: {
360: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
361: return;
362: }
363:
364: if ((*((struct_fichier *) (*s_objet_argument_2).objet)).protection
365: == 'W')
366: {
367: if (((*s_objet_resultat).objet = malloc(10 *
368: sizeof(unsigned char))) == NULL)
369: {
370: (*s_etat_processus).erreur_systeme =
371: d_es_allocation_memoire;
372: return;
373: }
374:
375: strcpy((unsigned char *) (*s_objet_argument_2).objet,
376: "WRITEONLY");
377: }
378: else if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces
379: == 'R')
380: {
381: if (((*s_objet_resultat).objet = malloc(9 *
382: sizeof(unsigned char))) == NULL)
383: {
384: (*s_etat_processus).erreur_systeme =
385: d_es_allocation_memoire;
386: return;
387: }
388:
389: strcpy((unsigned char *) (*s_objet_argument_2).objet,
390: "READONLY");
391: }
392: else
393: {
394: if (((*s_objet_resultat).objet = malloc(10 *
395: sizeof(unsigned char))) == NULL)
396: {
397: (*s_etat_processus).erreur_systeme =
398: d_es_allocation_memoire;
399: return;
400: }
401:
402: strcpy((unsigned char *) (*s_objet_resultat).objet,
403: "READWRITE");
404: }
405: }
406: else if (strcmp(requete, "FORMAT") == 0)
407: {
408: if ((s_objet_resultat = copie_objet(s_etat_processus,
409: (*((struct_fichier *) (*s_objet_argument_2).objet)).format,
410: 'O')) == NULL)
411: {
412: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
413: return;
414: }
415: }
416: else
417: {
418: free(requete);
419:
420: liberation(s_etat_processus, s_objet_argument_1);
421: liberation(s_etat_processus, s_objet_argument_2);
422:
423: (*s_etat_processus).erreur_execution = d_ex_erreur_requete_fichier;
424: return;
425: }
426: }
427: else if ((*s_objet_argument_2).type == CHN)
428: {
429: /*
430: * La question porte sur un fichier fermé.
431: */
432:
433: if (strcmp(requete, "EXISTENCE") == 0)
434: {
435: erreur = caracteristiques_fichier(s_etat_processus,
436: (unsigned char *) (*s_objet_argument_2).objet,
437: &existence, &ouverture, &unite);
438:
439: if (erreur != d_absence_erreur)
440: {
441: free(requete);
442:
443: liberation(s_etat_processus, s_objet_argument_1);
444: liberation(s_etat_processus, s_objet_argument_2);
445:
446: (*s_etat_processus).erreur_execution =
447: d_ex_erreur_acces_fichier;
448: return;
449: }
450:
451: if ((s_objet_resultat = allocation(s_etat_processus, INT))
452: == NULL)
453: {
454: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
455: return;
456: }
457:
458: if (existence == d_faux)
459: {
460: /*
461: * Fichier inexistant
462: */
463:
464: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
465: }
466: else
467: {
468: /*
469: * Fichier existant
470: */
471:
472: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
473: }
474: }
475: else if (strcmp(requete, "LOCK") == 0)
476: {
477: erreur = caracteristiques_fichier(s_etat_processus,
478: (unsigned char *) (*s_objet_argument_2).objet,
479: &existence, &ouverture, &unite);
480:
481: if (erreur != d_absence_erreur)
482: {
483: free(requete);
484:
485: liberation(s_etat_processus, s_objet_argument_1);
486: liberation(s_etat_processus, s_objet_argument_2);
487:
488: (*s_etat_processus).erreur_execution =
489: d_ex_erreur_acces_fichier;
490: return;
491: }
492:
493: if ((s_objet_resultat = allocation(s_etat_processus, CHN))
494: == NULL)
495: {
496: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
497: return;
498: }
499:
500: if (existence == d_faux)
501: {
502: /*
503: * Fichier inexistant
504: */
505:
506: free(requete);
507:
508: liberation(s_etat_processus, s_objet_argument_1);
509: liberation(s_etat_processus, s_objet_argument_2);
510: liberation(s_etat_processus, s_objet_resultat);
511:
512: (*s_etat_processus).erreur_execution =
513: d_ex_erreur_acces_fichier;
514: return;
515: }
516: else
517: {
518: /*
519: * Fichier existant
520: */
521:
522: if ((fichier = fopen((unsigned char *)
523: (*s_objet_argument_2).objet, "r+")) == NULL)
524: {
525: free(requete);
526:
527: liberation(s_etat_processus, s_objet_argument_1);
528: liberation(s_etat_processus, s_objet_argument_2);
529: liberation(s_etat_processus, s_objet_resultat);
530:
531: (*s_etat_processus).erreur_execution =
532: d_ex_erreur_acces_fichier;
533: return;
534: }
535:
536: lock.l_whence = SEEK_SET;
537: lock.l_start = 0;
538: lock.l_len = 0;
539: lock.l_pid = getpid();
540: lock.l_type = F_RDLCK;
541:
542: if (fcntl(fileno(fichier), F_GETLK, &lock) == -1)
543: {
544: if (fclose(fichier) != 0)
545: {
546: free(requete);
547:
548: liberation(s_etat_processus, s_objet_argument_1);
549: liberation(s_etat_processus, s_objet_argument_2);
550: liberation(s_etat_processus, s_objet_resultat);
551:
552: (*s_etat_processus).erreur_systeme =
553: d_es_erreur_fichier;
554: return;
555: }
556:
557: free(requete);
558:
559: liberation(s_etat_processus, s_objet_argument_1);
560: liberation(s_etat_processus, s_objet_argument_2);
561: liberation(s_etat_processus, s_objet_resultat);
562:
563: (*s_etat_processus).erreur_systeme =
564: d_es_erreur_fichier;
565: return;
566: }
567:
568: if (lock.l_type == F_UNLCK)
569: {
570: verrou = 'N';
571: }
572: else
573: {
574: verrou = 'R';
575: }
576:
577: if (verrou == 'N')
578: {
579: lock.l_type = F_WRLCK;
580:
581: if (fcntl(fileno(fichier), F_GETLK, &lock) == -1)
582: {
583: if (fclose(fichier) != 0)
584: {
585: free(requete);
586:
587: liberation(s_etat_processus, s_objet_argument_1);
588: liberation(s_etat_processus, s_objet_argument_2);
589: liberation(s_etat_processus, s_objet_resultat);
590:
591: (*s_etat_processus).erreur_systeme =
592: d_es_erreur_fichier;
593: return;
594: }
595:
596: free(requete);
597:
598: liberation(s_etat_processus, s_objet_argument_1);
599: liberation(s_etat_processus, s_objet_argument_2);
600: liberation(s_etat_processus, s_objet_resultat);
601:
602: (*s_etat_processus).erreur_systeme =
603: d_es_erreur_fichier;
604: return;
605: }
606:
607: if (lock.l_type == F_UNLCK)
608: {
609: verrou = 'N';
610: }
611: else
612: {
613: verrou = 'W';
614: }
615: }
616:
617: switch(verrou)
618: {
619: case 'N' :
620: {
621: if (((*s_objet_resultat).objet =
622: malloc(5 * sizeof(unsigned char))) == NULL)
623: {
624: (*s_etat_processus).erreur_systeme =
625: d_es_allocation_memoire;
626: return;
627: }
628:
629: strcpy((unsigned char *) (*s_objet_resultat).objet,
630: "NONE");
631:
632: break;
633: }
634:
635: case 'R' :
636: {
637: if (((*s_objet_resultat).objet =
638: malloc(5 * sizeof(unsigned char))) == NULL)
639: {
640: (*s_etat_processus).erreur_systeme =
641: d_es_allocation_memoire;
642: return;
643: }
644:
645: strcpy((unsigned char *) (*s_objet_resultat).objet,
646: "READ");
647:
648: break;
649: }
650:
651: case 'W' :
652: {
653: if (((*s_objet_resultat).objet =
654: malloc(6 * sizeof(unsigned char))) == NULL)
655: {
656: (*s_etat_processus).erreur_systeme =
657: d_es_allocation_memoire;
658: return;
659: }
660:
661: strcpy((unsigned char *) (*s_objet_resultat).objet,
662: "WRITE");
663:
664: break;
665: }
666: }
667:
668: if (fclose(fichier) != 0)
669: {
670: free(requete);
671:
672: liberation(s_etat_processus, s_objet_argument_1);
673: liberation(s_etat_processus, s_objet_argument_2);
674: liberation(s_etat_processus, s_objet_resultat);
675:
676: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
677: return;
678: }
679: }
680: }
681: else
682: {
683: free(requete);
684:
685: liberation(s_etat_processus, s_objet_argument_1);
686: liberation(s_etat_processus, s_objet_argument_2);
687:
688: (*s_etat_processus).erreur_execution = d_ex_erreur_requete_fichier;
689: return;
690: }
691: }
692: else
693: {
694: free(requete);
695:
696: liberation(s_etat_processus, s_objet_argument_1);
697: liberation(s_etat_processus, s_objet_argument_2);
698:
699: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
700: return;
701: }
702:
703: free(requete);
704:
705: liberation(s_etat_processus, s_objet_argument_1);
706: liberation(s_etat_processus, s_objet_argument_2);
707:
708: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
709: s_objet_resultat) == d_erreur)
710: {
711: return;
712: }
713:
714: return;
715: }
716:
717:
718: /*
719: ================================================================================
720: Fonction 'IDFT'
721: ================================================================================
722: Entrées : structure processus
723: --------------------------------------------------------------------------------
724: Sorties :
725: --------------------------------------------------------------------------------
726: Effets de bord : néant
727: ================================================================================
728: */
729:
730: void
731: instruction_idft(struct_processus *s_etat_processus)
732: {
733: integer4 erreur;
734: integer4 inverse;
735: integer4 nombre_colonnes;
736: integer4 nombre_lignes;
737:
738: logical1 presence_longueur_dft;
739:
740: long longueur_dft_signee;
741:
742: struct_complexe16 *matrice_f77;
743:
744: struct_objet *s_objet_argument;
745: struct_objet *s_objet_longueur_dft;
746: struct_objet *s_objet_resultat;
747:
748: unsigned long i;
749: unsigned long j;
750: unsigned long k;
751: unsigned long longueur_dft;
752:
753: (*s_etat_processus).erreur_execution = d_ex;
754:
755: if ((*s_etat_processus).affichage_arguments == 'Y')
756: {
757: printf("\n IDFT ");
758:
759: if ((*s_etat_processus).langue == 'F')
760: {
761: printf("(transformée de Fourier inverse discrète)\n\n");
762: }
763: else
764: {
765: printf("(inverse of discrete Fourier transform)\n\n");
766: }
767:
768: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
769: printf("-> 1: %s\n\n", d_VCX);
770:
771: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
772: printf(" 1: %s\n", d_INT);
773: printf("-> 1: %s\n\n", d_VCX);
774:
775: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
776: printf("-> 1: %s\n\n", d_VCX);
777:
778: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
779: printf(" 1: %s\n", d_INT);
780: printf("-> 1: %s\n", d_MCX);
781:
782: return;
783: }
784: else if ((*s_etat_processus).test_instruction == 'Y')
785: {
786: (*s_etat_processus).nombre_arguments = -1;
787: return;
788: }
789:
790: /*
791: * Il est possible d'imposer une longueur de DFT au premier niveau
792: * de la pile.
793: */
794:
795: if ((*s_etat_processus).l_base_pile == NULL)
796: {
797: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
798: return;
799: }
800:
801: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
802: {
803: presence_longueur_dft = d_vrai;
804:
805: if (test_cfsf(s_etat_processus, 31) == d_vrai)
806: {
807: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
808: {
809: return;
810: }
811: }
812:
813: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
814: &s_objet_longueur_dft) == d_erreur)
815: {
816: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
817: return;
818: }
819:
820: longueur_dft_signee = (*((integer8 *) (*s_objet_longueur_dft).objet));
821:
822: liberation(s_etat_processus, s_objet_longueur_dft);
823:
824: if (longueur_dft_signee <= 0)
825: {
826: (*s_etat_processus).erreur_execution = d_ex_longueur_dft;
827: return;
828: }
829:
830: longueur_dft = longueur_dft_signee;
831: }
832: else
833: {
834: presence_longueur_dft = d_faux;
835: longueur_dft = 0;
836:
837: if (test_cfsf(s_etat_processus, 31) == d_vrai)
838: {
839: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
840: {
841: return;
842: }
843: }
844: }
845:
846: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
847: &s_objet_argument) == d_erreur)
848: {
849: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
850: return;
851: }
852:
853: /*
854: --------------------------------------------------------------------------------
855: Vecteur
856: --------------------------------------------------------------------------------
857: */
858:
859: if (((*s_objet_argument).type == VIN) ||
860: ((*s_objet_argument).type == VRL) ||
861: ((*s_objet_argument).type == VCX))
862: {
863: if (presence_longueur_dft == d_faux)
864: {
865: longueur_dft = (*((struct_vecteur *)
866: (*s_objet_argument).objet)).taille;
867: }
868:
869: if ((matrice_f77 = malloc(longueur_dft *
870: sizeof(struct_complexe16))) == NULL)
871: {
872: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
873: return;
874: }
875:
876: if ((*s_objet_argument).type == VIN)
877: {
878: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
879: .taille; i++)
880: {
881: matrice_f77[i].partie_reelle = (real8) ((integer8 *)
882: (*((struct_vecteur *) (*s_objet_argument).objet))
883: .tableau)[i];
884: matrice_f77[i].partie_imaginaire = (real8) 0;
885: }
886: }
887: else if ((*s_objet_argument).type == VRL)
888: {
889: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
890: .taille; i++)
891: {
892: matrice_f77[i].partie_reelle = ((real8 *)
893: (*((struct_vecteur *) (*s_objet_argument).objet))
894: .tableau)[i];
895: matrice_f77[i].partie_imaginaire = (real8) 0;
896: }
897: }
898: else
899: {
900: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
901: .taille; i++)
902: {
903: matrice_f77[i].partie_reelle = ((struct_complexe16 *)
904: (*((struct_vecteur *) (*s_objet_argument).objet))
905: .tableau)[i].partie_reelle;
906: matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
907: (*((struct_vecteur *) (*s_objet_argument).objet))
908: .tableau)[i].partie_imaginaire;
909: }
910: }
911:
912: for(; i < longueur_dft; i++)
913: {
914: matrice_f77[i].partie_reelle = (real8) 0;
915: matrice_f77[i].partie_imaginaire = (real8) 0;
916: }
917:
918: nombre_lignes = 1;
919: nombre_colonnes = longueur_dft;
920: inverse = -1;
921:
922: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
923:
924: if (erreur != 0)
925: {
926: liberation(s_etat_processus, s_objet_argument);
927: free(matrice_f77);
928:
929: (*s_etat_processus).erreur_execution = d_ex_longueur_dft;
930: return;
931: }
932:
933: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
934: {
935: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
936: return;
937: }
938:
939: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_dft;
940: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
941: }
942:
943: /*
944: --------------------------------------------------------------------------------
945: Matrice
946: --------------------------------------------------------------------------------
947: */
948:
949: else if (((*s_objet_argument).type == MIN) ||
950: ((*s_objet_argument).type == MRL) ||
951: ((*s_objet_argument).type == MCX))
952: {
953: if (presence_longueur_dft == d_faux)
954: {
955: longueur_dft = (*((struct_matrice *)
956: (*s_objet_argument).objet)).nombre_colonnes;
957: }
958:
959: if ((matrice_f77 = malloc(longueur_dft *
960: (*((struct_matrice *) (*s_objet_argument).objet))
961: .nombre_lignes * sizeof(struct_complexe16))) == NULL)
962: {
963: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
964: return;
965: }
966:
967: if ((*s_objet_argument).type == MIN)
968: {
969: for(k = 0, j = 0; j < (*((struct_matrice *) (*s_objet_argument)
970: .objet)).nombre_lignes; j++)
971: {
972: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument)
973: .objet)).nombre_colonnes; i++)
974: {
975: matrice_f77[k].partie_reelle = (real8) ((integer8 **)
976: (*((struct_matrice *) (*s_objet_argument).objet))
977: .tableau)[j][i];
978: matrice_f77[k++].partie_imaginaire = (real8) 0;
979: }
980: }
981:
982: for(; k < longueur_dft * (*((struct_matrice *) (*s_objet_argument)
983: .objet)).nombre_lignes; k++)
984: {
985: matrice_f77[k].partie_reelle = (real8) 0;
986: matrice_f77[k].partie_imaginaire = (real8) 0;
987: }
988: }
989: else if ((*s_objet_argument).type == MRL)
990: {
991: for(k = 0, j = 0; j < (*((struct_matrice *) (*s_objet_argument)
992: .objet)).nombre_lignes; j++)
993: {
994: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument)
995: .objet)).nombre_colonnes; i++)
996: {
997: matrice_f77[k].partie_reelle = ((real8 **)
998: (*((struct_matrice *) (*s_objet_argument).objet))
999: .tableau)[j][i];
1000: matrice_f77[k++].partie_imaginaire = (real8) 0;
1001: }
1002: }
1003:
1004: for(; k < longueur_dft * (*((struct_matrice *) (*s_objet_argument)
1005: .objet)).nombre_lignes; k++)
1006: {
1007: matrice_f77[k].partie_reelle = (real8) 0;
1008: matrice_f77[k].partie_imaginaire = (real8) 0;
1009: }
1010: }
1011: else
1012: {
1013: for(k = 0, j = 0; j < (*((struct_matrice *) (*s_objet_argument)
1014: .objet)).nombre_lignes; j++)
1015: {
1016: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument)
1017: .objet)).nombre_colonnes; i++)
1018: {
1019: matrice_f77[k].partie_reelle = ((struct_complexe16 **)
1020: (*((struct_matrice *) (*s_objet_argument).objet))
1021: .tableau)[j][i].partie_reelle;
1022: matrice_f77[k++].partie_imaginaire =
1023: ((struct_complexe16 **) (*((struct_matrice *)
1024: (*s_objet_argument).objet)).tableau)[j][i]
1025: .partie_imaginaire;
1026: }
1027: }
1028:
1029: for(; k < longueur_dft * (*((struct_matrice *) (*s_objet_argument)
1030: .objet)).nombre_lignes; k++)
1031: {
1032: matrice_f77[k].partie_reelle = (real8) 0;
1033: matrice_f77[k].partie_imaginaire = (real8) 0;
1034: }
1035: }
1036:
1037: nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet))
1038: .nombre_lignes;
1039: nombre_colonnes = longueur_dft;
1040: inverse = -1;
1041:
1042: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
1043:
1044: if (erreur != 0)
1045: {
1046: liberation(s_etat_processus, s_objet_argument);
1047: free(matrice_f77);
1048:
1049: (*s_etat_processus).erreur_execution = d_ex_longueur_dft;
1050: return;
1051: }
1052:
1053: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
1054: {
1055: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1056: return;
1057: }
1058:
1059: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1060: (*((struct_matrice *) (*s_objet_argument).objet))
1061: .nombre_lignes;
1062: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1063: longueur_dft;
1064:
1065: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1066: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
1067: .nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
1068: {
1069: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1070: return;
1071: }
1072:
1073: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1074: .nombre_lignes; i++)
1075: {
1076: if ((((struct_complexe16 **) (*((struct_matrice *)
1077: (*s_objet_resultat).objet)).tableau)[i] =
1078: malloc((*((struct_matrice *)
1079: (*s_objet_resultat).objet)).nombre_colonnes *
1080: sizeof(struct_complexe16))) == NULL)
1081: {
1082: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1083: return;
1084: }
1085: }
1086:
1087: for(k = 0, j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
1088: .nombre_lignes; j++)
1089: {
1090: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
1091: .nombre_colonnes; i++)
1092: {
1093: ((struct_complexe16 **) (*((struct_matrice *)
1094: (*s_objet_resultat).objet)).tableau)[j][i]
1095: .partie_reelle = matrice_f77[k].partie_reelle;
1096: ((struct_complexe16 **) (*((struct_matrice *)
1097: (*s_objet_resultat).objet)).tableau)[j][i]
1098: .partie_imaginaire = matrice_f77[k++].partie_imaginaire;
1099: }
1100: }
1101:
1102: free(matrice_f77);
1103: }
1104:
1105: /*
1106: --------------------------------------------------------------------------------
1107: Calcul de DFT impossible
1108: --------------------------------------------------------------------------------
1109: */
1110:
1111: else
1112: {
1113: liberation(s_etat_processus, s_objet_argument);
1114:
1115: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1116: return;
1117: }
1118:
1119: liberation(s_etat_processus, s_objet_argument);
1120:
1121: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1122: s_objet_resultat) == d_erreur)
1123: {
1124: return;
1125: }
1126:
1127: return;
1128: }
1129:
1130:
1131: /*
1132: ================================================================================
1133: Fonction 'ISWI'
1134: ================================================================================
1135: Entrées : structure processus
1136: --------------------------------------------------------------------------------
1137: Sorties :
1138: --------------------------------------------------------------------------------
1139: Effets de bord : néant
1140: ================================================================================
1141: */
1142:
1143: void
1144: instruction_iswi(struct_processus *s_etat_processus)
1145: {
1146: (*s_etat_processus).erreur_execution = d_ex;
1147:
1148: if ((*s_etat_processus).affichage_arguments == 'Y')
1149: {
1150: printf("\n ISWI ");
1151:
1152: if ((*s_etat_processus).langue == 'F')
1153: {
1154: printf("(autorise le traitement interruptif des interruptions)"
1155: "\n\n");
1156: printf(" Aucun argument\n");
1157: }
1158: else
1159: {
1160: printf("(authorize interrupts called from interrupts)\n\n");
1161: printf(" No argument\n");
1162: }
1163:
1164: return;
1165: }
1166: else if ((*s_etat_processus).test_instruction == 'Y')
1167: {
1168: (*s_etat_processus).nombre_arguments = -1;
1169: return;
1170: }
1171:
1172: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1173: {
1174: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1175: {
1176: return;
1177: }
1178: }
1179:
1180: if ((*s_etat_processus).traitement_interruption == 'Y')
1181: {
1182: (*s_etat_processus).traitement_interruption = 'N';
1183: }
1184: else
1185: {
1186: (*s_etat_processus).erreur_execution = d_ex_iswi_hors_interruption;
1187: }
1188:
1189: return;
1190: }
1191:
1192:
1193: /*
1194: ================================================================================
1195: Fonction 'ITRACE'
1196: ================================================================================
1197: Entrées : structure processus
1198: --------------------------------------------------------------------------------
1199: Sorties :
1200: --------------------------------------------------------------------------------
1201: Effets de bord : néant
1202: ================================================================================
1203: */
1204:
1205: void
1206: instruction_itrace(struct_processus *s_etat_processus)
1207: {
1208: struct_objet *s_objet_argument;
1209:
1210: (*s_etat_processus).erreur_execution = d_ex;
1211:
1212: if ((*s_etat_processus).affichage_arguments == 'Y')
1213: {
1214: printf("\n ITRACE ");
1215:
1216: if ((*s_etat_processus).langue == 'F')
1217: {
1218: printf("(trace interne)"
1219: "\n\n");
1220: }
1221: else
1222: {
1223: printf("(internal trace)\n\n");
1224: }
1225:
1226: printf(" 1: %s\n\n", d_BIN);
1227:
1228: if ((*s_etat_processus).langue == 'F')
1229: {
1230: printf(" Drapeaux :\n\n");
1231: }
1232: else
1233: {
1234: printf(" Flags:\n\n");
1235: }
1236:
1237: printf(" 0000 : none\n");
1238: printf(" 0001 : user stack\n");
1239: printf(" 0002 : system stack\n");
1240: printf(" 0004 : function calls\n");
1241: printf(" 0008 : process management\n");
1242: printf(" 0010 : analyze\n");
1243: printf(" 0020 : fuse management\n");
1244: printf(" 0040 : variables management\n");
1245: printf(" 0080 : intrinsic functions\n");
1246: printf(" 0100 : execution levels\n");
1247: printf(" 0200 : algebraic to RPN conversion\n");
1248: printf(" 0400 : interruptions supervision\n");
1249: printf(" 0800 : signals\n");
1250:
1251: return;
1252: }
1253: else if ((*s_etat_processus).test_instruction == 'Y')
1254: {
1255: (*s_etat_processus).nombre_arguments = -1;
1256: return;
1257: }
1258:
1259: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1260: {
1261: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1262: {
1263: return;
1264: }
1265: }
1266:
1267: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1268: &s_objet_argument) == d_erreur)
1269: {
1270: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1271: return;
1272: }
1273:
1274: if ((*s_objet_argument).type == BIN)
1275: {
1276: if ((*((logical8 *) (*s_objet_argument).objet)) == 0)
1277: {
1278: (*s_etat_processus).debug = d_faux;
1279: (*s_etat_processus).type_debug = 0;
1280: }
1281: else
1282: {
1283: (*s_etat_processus).debug = d_vrai;
1284: (*s_etat_processus).type_debug = (*((logical8 *)
1285: (*s_objet_argument).objet));
1286: }
1287: }
1288: else
1289: {
1290: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1291: liberation(s_etat_processus, s_objet_argument);
1292: }
1293:
1294: return;
1295: }
1296:
1297:
1298: // vim: ts=4