1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.5
4: Copyright (C) 1989-2012 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 'dupcntxt'
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_dupcntxt(struct_processus *s_etat_processus)
40: {
41: struct_objet *s_objet;
42: struct_objet *s_pile;
43:
44: (*s_etat_processus).erreur_execution = d_ex;
45:
46: if ((*s_etat_processus).affichage_arguments == 'Y')
47: {
48: printf("\n DUPCNTXT ");
49:
50: if ((*s_etat_processus).langue == 'F')
51: {
52: printf("(duplication du contexte)\n\n");
53: printf(" Aucun argument\n");
54: }
55: else
56: {
57: printf("(context duplication)\n\n");
58: printf(" No argument\n");
59: }
60:
61: return;
62: }
63: else if ((*s_etat_processus).test_instruction == 'Y')
64: {
65: (*s_etat_processus).nombre_arguments = -1;
66: return;
67: }
68:
69: if (test_cfsf(s_etat_processus, 31) == d_vrai)
70: {
71: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
72: {
73: return;
74: }
75: }
76:
77: if ((s_objet = allocation(s_etat_processus, LST)) == NULL)
78: {
79: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
80: return;
81: }
82:
83: (*s_objet).objet = (*s_etat_processus).l_base_pile;
84:
85: if ((s_pile = copie_objet(s_etat_processus, s_objet, 'N')) == NULL)
86: {
87: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
88: return;
89: }
90:
91: if (empilement(s_etat_processus, &((*s_etat_processus).
92: l_base_pile_contextes), s_objet) == d_erreur)
93: {
94: return;
95: }
96:
97: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
98: {
99: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
100: return;
101: }
102:
103: (*((integer8 *) (*s_objet).objet)) = (*s_etat_processus)
104: .hauteur_pile_operationnelle;
105:
106: if (empilement(s_etat_processus, &((*s_etat_processus)
107: .l_base_pile_taille_contextes), s_objet) == d_erreur)
108: {
109: return;
110: }
111:
112: /*
113: * Copie de la pile opérationnelle
114: */
115:
116: (*s_etat_processus).l_base_pile = (*s_pile).objet;
117:
118: (*s_pile).objet = NULL;
119: liberation(s_etat_processus, s_pile);
120:
121: return;
122: }
123:
124:
125: /*
126: ================================================================================
127: Fonction 'dropcntxt'
128: ================================================================================
129: Entrées : pointeur sur une structure struct_processus
130: --------------------------------------------------------------------------------
131: Sorties :
132: --------------------------------------------------------------------------------
133: Effets de bord : néant
134: ================================================================================
135: */
136:
137: void
138: instruction_dropcntxt(struct_processus *s_etat_processus)
139: {
140: struct_objet *s_objet;
141:
142: (*s_etat_processus).erreur_execution = d_ex;
143:
144: if ((*s_etat_processus).affichage_arguments == 'Y')
145: {
146: printf("\n DROPCNTXT ");
147:
148: if ((*s_etat_processus).langue == 'F')
149: {
150: printf("(effacement d'un contexte)\n\n");
151: printf(" Aucun argument\n");
152: }
153: else
154: {
155: printf("(drops context)\n\n");
156: printf(" No argument\n");
157: }
158:
159: return;
160: }
161: else if ((*s_etat_processus).test_instruction == 'Y')
162: {
163: (*s_etat_processus).nombre_arguments = -1;
164: return;
165: }
166:
167: if (test_cfsf(s_etat_processus, 31) == d_vrai)
168: {
169: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
170: {
171: return;
172: }
173: }
174:
175: if (((*s_etat_processus).l_base_pile_contextes == NULL) ||
176: ((*s_etat_processus).l_base_pile_taille_contextes == NULL))
177: {
178: (*s_etat_processus).erreur_execution = d_ex_contexte;
179: return;
180: }
181:
182: if (depilement(s_etat_processus, &((*s_etat_processus)
183: .l_base_pile_contextes), &s_objet) == d_erreur)
184: {
185: return;
186: }
187:
188: liberation(s_etat_processus, s_objet);
189:
190: if (depilement(s_etat_processus, &((*s_etat_processus)
191: .l_base_pile_taille_contextes), &s_objet) == d_erreur)
192: {
193: return;
194: }
195:
196: liberation(s_etat_processus, s_objet);
197:
198: return;
199: }
200:
201:
202: /*
203: ================================================================================
204: Fonction 'dgtiz'
205: ================================================================================
206: Entrées : pointeur sur une structure struct_processus
207: --------------------------------------------------------------------------------
208: Sorties :
209: --------------------------------------------------------------------------------
210: Effets de bord : néant
211: ================================================================================
212: */
213:
214: void
215: instruction_dgtiz(struct_processus *s_etat_processus)
216: {
217: (*s_etat_processus).erreur_execution = d_ex;
218:
219: if ((*s_etat_processus).affichage_arguments == 'Y')
220: {
221: printf("\n DGTIZ ");
222:
223: if ((*s_etat_processus).langue == 'F')
224: {
225: printf("(mouse support in plot functions)\n\n");
226: printf(" Aucun argument\n");
227: }
228: else
229: {
230: printf("(support de la souris dans les fonctions graphiques)\n\n");
231: printf(" No argument\n");
232: }
233:
234: return;
235: }
236: else if ((*s_etat_processus).test_instruction == 'Y')
237: {
238: (*s_etat_processus).nombre_arguments = -1;
239: return;
240: }
241:
242: if (test_cfsf(s_etat_processus, 31) == d_vrai)
243: {
244: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
245: {
246: return;
247: }
248: }
249:
250: if ((*s_etat_processus).fichiers_graphiques != NULL)
251: {
252: (*s_etat_processus).souris_active = d_vrai;
253: appel_gnuplot(s_etat_processus, 'N');
254: (*s_etat_processus).souris_active = d_faux;
255: }
256:
257: return;
258: }
259:
260:
261: /*
262: ================================================================================
263: Fonction 'daemonize'
264: ================================================================================
265: Entrées : pointeur sur une structure struct_processus
266: --------------------------------------------------------------------------------
267: Sorties :
268: --------------------------------------------------------------------------------
269: Effets de bord : néant
270: ================================================================================
271: */
272:
273: void
274: instruction_daemonize(struct_processus *s_etat_processus)
275: {
276: (*s_etat_processus).erreur_execution = d_ex;
277:
278: if ((*s_etat_processus).affichage_arguments == 'Y')
279: {
280: printf("\n DAEMONIZE ");
281:
282: if ((*s_etat_processus).langue == 'F')
283: {
284: printf("(basculement en mode daemon)\n\n");
285: printf(" Aucun argument\n");
286: }
287: else
288: {
289: printf("(convert to daemon)\n\n");
290: printf(" No argument\n");
291: }
292:
293: return;
294: }
295: else if ((*s_etat_processus).test_instruction == 'Y')
296: {
297: (*s_etat_processus).nombre_arguments = -1;
298: return;
299: }
300:
301: if (test_cfsf(s_etat_processus, 31) == d_vrai)
302: {
303: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
304: {
305: return;
306: }
307: }
308:
309: if (((*s_etat_processus).var_volatile_processus_pere == -1) &&
310: ((*s_etat_processus).l_base_pile_processus == NULL))
311: {
312: lancement_daemon(s_etat_processus);
313: }
314: else
315: {
316: (*s_etat_processus).erreur_execution = d_ex_daemon;
317: return;
318: }
319:
320: return;
321: }
322:
323:
324: /*
325: ================================================================================
326: Fonction 'diag->'
327: ================================================================================
328: Entrées : pointeur sur une structure struct_processus
329: --------------------------------------------------------------------------------
330: Sorties :
331: --------------------------------------------------------------------------------
332: Effets de bord : néant
333: ================================================================================
334: */
335:
336: void
337: instruction_diag_fleche(struct_processus *s_etat_processus)
338: {
339: struct_objet *s_objet_argument;
340: struct_objet *s_objet_resultat;
341:
342: unsigned long i;
343: unsigned long j;
344:
345: (*s_etat_processus).erreur_execution = d_ex;
346:
347: if ((*s_etat_processus).affichage_arguments == 'Y')
348: {
349: printf("\n DIAG-> ");
350:
351: if ((*s_etat_processus).langue == 'F')
352: {
353: printf("(conversion d'une matrice diagonale en vecteur)\n\n");
354: }
355: else
356: {
357: printf("(diagonal matrix to vector conversion)\n\n");
358: }
359:
360: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
361: printf("-> 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
362:
363: return;
364: }
365: else if ((*s_etat_processus).test_instruction == 'Y')
366: {
367: (*s_etat_processus).nombre_arguments = -1;
368: return;
369: }
370:
371: if (test_cfsf(s_etat_processus, 31) == d_vrai)
372: {
373: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
374: {
375: return;
376: }
377: }
378:
379: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
380: &s_objet_argument) == d_erreur)
381: {
382: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
383: return;
384: }
385:
386: /*
387: * Conversion d'une matrice
388: */
389:
390: if ((*s_objet_argument).type == MIN)
391: {
392: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
393: (*((struct_matrice *) (*s_objet_argument).objet))
394: .nombre_colonnes)
395: {
396: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
397:
398: liberation(s_etat_processus, s_objet_argument);
399: return;
400: }
401:
402: if ((s_objet_resultat = allocation(s_etat_processus, VIN)) == NULL)
403: {
404: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
405: return;
406: }
407:
408: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
409: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
410:
411: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau
412: = malloc((*((struct_vecteur *) (*s_objet_resultat).objet))
413: .taille * sizeof(integer8))) == NULL)
414: {
415: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
416: return;
417: }
418:
419: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
420: .nombre_lignes; i++)
421: {
422: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
423: .nombre_colonnes; j++)
424: {
425: if (i != j)
426: {
427: if (((integer8 **) (*((struct_matrice *) (*s_objet_argument)
428: .objet)).tableau)[i][j] != 0)
429: {
430: liberation(s_etat_processus, s_objet_argument);
431: liberation(s_etat_processus, s_objet_resultat);
432:
433: (*s_etat_processus).erreur_execution =
434: d_ex_matrice_non_diagonale;
435: return;
436: }
437: }
438: else
439: {
440: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
441: .objet)).tableau)[i] = ((integer8 **)
442: (*((struct_matrice *) (*s_objet_argument)
443: .objet)).tableau)[i][j];
444: }
445: }
446: }
447: }
448: else if ((*s_objet_argument).type == MRL)
449: {
450: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
451: (*((struct_matrice *) (*s_objet_argument).objet))
452: .nombre_colonnes)
453: {
454: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
455:
456: liberation(s_etat_processus, s_objet_argument);
457: return;
458: }
459:
460: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
461: {
462: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
463: return;
464: }
465:
466: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
467: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
468:
469: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau
470: = malloc((*((struct_vecteur *) (*s_objet_resultat).objet))
471: .taille * sizeof(real8))) == NULL)
472: {
473: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
474: return;
475: }
476:
477: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
478: .nombre_lignes; i++)
479: {
480: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
481: .nombre_colonnes; j++)
482: {
483: if (i != j)
484: {
485: if (((real8 **) (*((struct_matrice *) (*s_objet_argument)
486: .objet)).tableau)[i][j] != 0)
487: {
488: liberation(s_etat_processus, s_objet_argument);
489: liberation(s_etat_processus, s_objet_resultat);
490:
491: (*s_etat_processus).erreur_execution =
492: d_ex_matrice_non_diagonale;
493: return;
494: }
495: }
496: else
497: {
498: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
499: .objet)).tableau)[i] = ((real8 **)
500: (*((struct_matrice *) (*s_objet_argument)
501: .objet)).tableau)[i][j];
502: }
503: }
504: }
505: }
506: else if ((*s_objet_argument).type == MCX)
507: {
508: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
509: (*((struct_matrice *) (*s_objet_argument).objet))
510: .nombre_colonnes)
511: {
512: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
513:
514: liberation(s_etat_processus, s_objet_argument);
515: return;
516: }
517:
518: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
519: {
520: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
521: return;
522: }
523:
524: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
525: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
526:
527: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau
528: = malloc((*((struct_vecteur *) (*s_objet_resultat).objet))
529: .taille * sizeof(complex16))) == NULL)
530: {
531: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
532: return;
533: }
534:
535: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
536: .nombre_lignes; i++)
537: {
538: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
539: .nombre_colonnes; j++)
540: {
541: if (i != j)
542: {
543: if ((((complex16 **) (*((struct_matrice *)
544: (*s_objet_argument).objet)).tableau)[i][j]
545: .partie_reelle != 0) ||
546: (((complex16 **) (*((struct_matrice *)
547: (*s_objet_argument).objet)).tableau)[i][j]
548: .partie_imaginaire != 0))
549: {
550: liberation(s_etat_processus, s_objet_argument);
551: liberation(s_etat_processus, s_objet_resultat);
552:
553: (*s_etat_processus).erreur_execution =
554: d_ex_matrice_non_diagonale;
555: return;
556: }
557: }
558: else
559: {
560: ((complex16 *) (*((struct_vecteur *) (*s_objet_resultat)
561: .objet)).tableau)[i] = ((complex16 **)
562: (*((struct_matrice *) (*s_objet_argument)
563: .objet)).tableau)[i][j];
564: }
565: }
566: }
567: }
568:
569: /*
570: * Conversion impossible impossible
571: */
572:
573: else
574: {
575: liberation(s_etat_processus, s_objet_argument);
576:
577: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
578: return;
579: }
580:
581: liberation(s_etat_processus, s_objet_argument);
582:
583: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
584: s_objet_resultat) == d_erreur)
585: {
586: return;
587: }
588:
589: return;
590: }
591:
592: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_d6.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src