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