Annotation of rpl/src/instructions_r3.c, revision 1.18
1.1 bertrand 1: /*
2: ================================================================================
1.17 bertrand 3: RPL/2 (R) version 4.0.19
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:
1.14 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction 'rsd'
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_rsd(struct_processus *s_etat_processus)
40: {
41: struct_liste_chainee *l_element_courant;
42: struct_liste_chainee *registre_pile_last;
43:
44: (*s_etat_processus).erreur_execution = d_ex;
45:
46: if ((*s_etat_processus).affichage_arguments == 'Y')
47: {
48: printf("\n RSD ");
49:
50: if ((*s_etat_processus).langue == 'F')
51: {
52: printf("(calcul d'un tableau résiduel)\n\n");
53: }
54: else
55: {
56: printf("(compute a resudial array)\n\n");
57: }
58:
59: printf(" 3: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
60: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
61: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
62: printf("-> 1: %s, %s ,%s\n\n", d_VIN, d_VRL, d_VCX);
63:
64: printf(" 3: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
65: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
66: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
67: printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
68:
69: return;
70: }
71: else if ((*s_etat_processus).test_instruction == 'Y')
72: {
73: (*s_etat_processus).nombre_arguments = -1;
74: return;
75: }
76:
77: /*
78: * Test du type et du nombre des arguments
79: */
80:
81: if ((*s_etat_processus).hauteur_pile_operationnelle < 3)
82: {
83: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
84: return;
85: }
86:
87: l_element_courant = (*s_etat_processus).l_base_pile;
88:
89: if (((*(*l_element_courant).donnee).type != VIN) &&
90: ((*(*l_element_courant).donnee).type != VRL) &&
91: ((*(*l_element_courant).donnee).type != VCX) &&
92: ((*(*l_element_courant).donnee).type != MIN) &&
93: ((*(*l_element_courant).donnee).type != MRL) &&
94: ((*(*l_element_courant).donnee).type != MCX))
95: {
96: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
97: return;
98: }
99:
100: l_element_courant = (*l_element_courant).suivant;
101:
102: if (((*(*l_element_courant).donnee).type != MIN) &&
103: ((*(*l_element_courant).donnee).type != MRL) &&
104: ((*(*l_element_courant).donnee).type != MCX))
105: {
106: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
107: return;
108: }
109:
110: l_element_courant = (*l_element_courant).suivant;
111:
112: if (((*(*l_element_courant).donnee).type != VIN) &&
113: ((*(*l_element_courant).donnee).type != VRL) &&
114: ((*(*l_element_courant).donnee).type != VCX) &&
115: ((*(*l_element_courant).donnee).type != MIN) &&
116: ((*(*l_element_courant).donnee).type != MRL) &&
117: ((*(*l_element_courant).donnee).type != MCX))
118: {
119: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
120: return;
121: }
122:
123: /*
124: * Sauvegarde de la pile LAST courante
125: */
126:
127: registre_pile_last = NULL;
128:
129: if (test_cfsf(s_etat_processus, 31) == d_vrai)
130: {
131: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
132: {
133: return;
134: }
135:
136: registre_pile_last = (*s_etat_processus).l_base_pile_last;
137: (*s_etat_processus).l_base_pile_last = NULL;
138: }
139:
140: instruction_multiplication(s_etat_processus);
141:
142: if (((*s_etat_processus).erreur_systeme != d_es) ||
143: ((*s_etat_processus).erreur_execution != d_ex) ||
144: ((*s_etat_processus).exception != d_ep))
145: {
146: if (test_cfsf(s_etat_processus, 31) == d_vrai)
147: {
148: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
149: {
150: return;
151: }
152: }
153:
154: (*s_etat_processus).l_base_pile_last = registre_pile_last;
155:
156: return;
157: }
158:
159: instruction_moins(s_etat_processus);
160:
161: /*
162: * Restauration de la pile LAST
163: */
164:
165: if (test_cfsf(s_etat_processus, 31) == d_vrai)
166: {
167: /*
168: * Astuce pour libérer l'ancienne pile last...
169: */
170:
171: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
172: {
173: return;
174: }
175:
176: (*s_etat_processus).l_base_pile_last = registre_pile_last;
177: }
178:
179: return;
180: }
181:
182:
183: /*
184: ================================================================================
185: Fonction 'regv'
186: ================================================================================
187: Entrées : pointeur sur une structure struct_processus
188: --------------------------------------------------------------------------------
189: Sorties :
190: --------------------------------------------------------------------------------
191: Effets de bord : néant
192: ================================================================================
193: */
194:
195: void
196: instruction_regv(struct_processus *s_etat_processus)
197: {
198: struct_objet *s_objet_argument;
199: struct_objet *s_objet_resultat_1;
200: struct_objet *s_objet_resultat_2;
201:
202: (*s_etat_processus).erreur_execution = d_ex;
203:
204: if ((*s_etat_processus).affichage_arguments == 'Y')
205: {
206: printf("\n REGV ");
207:
208: if ((*s_etat_processus).langue == 'F')
209: {
210: printf("(valeurs et vecteurs propres droits)\n\n");
211: }
212: else
213: {
214: printf("(eigenvalues and right eigenvectors)\n\n");
215: }
216:
217: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
218: printf("-> 2: %s\n", d_MCX);
219: printf(" 1: %s\n", d_VCX);
220:
221: return;
222: }
223: else if ((*s_etat_processus).test_instruction == 'Y')
224: {
225: (*s_etat_processus).nombre_arguments = -1;
226: return;
227: }
228:
229: if (test_cfsf(s_etat_processus, 31) == d_vrai)
230: {
231: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
232: {
233: return;
234: }
235: }
236:
237: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
238: &s_objet_argument) == d_erreur)
239: {
240: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
241: return;
242: }
243:
244: /*
245: --------------------------------------------------------------------------------
246: L'argument est une matrice carrée
247: --------------------------------------------------------------------------------
248: */
249:
250: if (((*s_objet_argument).type == MIN) ||
251: ((*s_objet_argument).type == MRL) ||
252: ((*s_objet_argument).type == MCX))
253: {
254: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
255: (*((struct_matrice *) (*s_objet_argument).objet))
256: .nombre_colonnes)
257: {
258: liberation(s_etat_processus, s_objet_argument);
259:
260: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
261: return;
262: }
263:
264: if ((s_objet_resultat_1 = allocation(s_etat_processus, VCX)) == NULL)
265: {
266: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
267: return;
268: }
269:
270: if ((s_objet_resultat_2 = allocation(s_etat_processus, MCX)) == NULL)
271: {
272: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
273: return;
274: }
275:
276: valeurs_propres(s_etat_processus,
277: (struct_matrice *) (*s_objet_argument).objet,
278: (struct_vecteur *) (*s_objet_resultat_1).objet,
279: NULL, (struct_matrice *) (*s_objet_resultat_2).objet);
280:
281: if ((*s_etat_processus).erreur_systeme != d_es)
282: {
283: return;
284: }
285:
286: if (((*s_etat_processus).exception != d_ep) ||
287: ((*s_etat_processus).erreur_execution != d_ex))
288: {
289: liberation(s_etat_processus, s_objet_argument);
290: liberation(s_etat_processus, s_objet_resultat_1);
291: liberation(s_etat_processus, s_objet_resultat_2);
292: return;
293: }
294: }
295:
296: /*
297: --------------------------------------------------------------------------------
298: Type incompatible
299: --------------------------------------------------------------------------------
300: */
301:
302: else
303: {
304: liberation(s_etat_processus, s_objet_argument);
305:
306: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
307: return;
308: }
309:
310: liberation(s_etat_processus, s_objet_argument);
311:
312: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
313: s_objet_resultat_2) == d_erreur)
314: {
315: return;
316: }
317:
318: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
319: s_objet_resultat_1) == d_erreur)
320: {
321: return;
322: }
323:
324: return;
325: }
326:
327:
328: /*
329: ================================================================================
330: Fonction 'rnrm'
331: ================================================================================
332: Entrées : pointeur sur une structure struct_processus
333: --------------------------------------------------------------------------------
334: Sorties :
335: --------------------------------------------------------------------------------
336: Effets de bord : néant
337: ================================================================================
338: */
339:
340: void
341: instruction_rnrm(struct_processus *s_etat_processus)
342: {
343: logical1 depassement;
344: logical1 erreur_memoire;
345:
346: real8 cumul_reel;
347: real8 registre;
348:
349: integer8 cumul_entier;
350: integer8 entier_courant;
351: integer8 tampon;
352:
353: struct_objet *s_objet_argument;
354: struct_objet *s_objet_resultat;
355:
356: unsigned long i;
357: unsigned long j;
358:
359: void *accumulateur;
360:
361: (*s_etat_processus).erreur_execution = d_ex;
362:
363: if ((*s_etat_processus).affichage_arguments == 'Y')
364: {
365: printf("\n RNRM ");
366:
367: if ((*s_etat_processus).langue == 'F')
368: {
369: printf("(norme de ligne)\n\n");
370: }
371: else
372: {
373: printf("(row norm)\n\n");
374: }
375:
376: printf(" 1: %s, %s\n", d_VIN, d_MIN);
377: printf("-> 1: %s, %s\n\n", d_INT, d_REL);
378:
379: printf(" 1: %s, %s, %s, %s\n", d_VRL, d_VCX, d_MRL, d_MCX);
380: printf("-> 1: %s\n", d_REL);
381:
382: return;
383: }
384: else if ((*s_etat_processus).test_instruction == 'Y')
385: {
386: (*s_etat_processus).nombre_arguments = -1;
387: return;
388: }
389:
390: if (test_cfsf(s_etat_processus, 31) == d_vrai)
391: {
392: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
393: {
394: return;
395: }
396: }
397:
398: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
399: &s_objet_argument) == d_erreur)
400: {
401: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
402: return;
403: }
404:
405: /*
406: --------------------------------------------------------------------------------
407: Traitement des vecteurs
408: --------------------------------------------------------------------------------
409: */
410:
411: if ((*s_objet_argument).type == VIN)
412: {
413: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
414: {
415: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
416: return;
417: }
418:
419: (*((integer8 *) (*s_objet_resultat).objet)) = abs(((integer8 *)
420: (*((struct_vecteur *) (*s_objet_argument).objet)).tableau)[0]);
421:
422: for(i = 1; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
423: i++)
424: {
425: if (abs(((integer8 *) (*((struct_vecteur *) (*s_objet_argument)
426: .objet)).tableau)[i]) > (*((integer8 *)
427: (*s_objet_resultat).objet)))
428: {
429: (*((integer8 *) (*s_objet_resultat).objet)) =
430: abs(((integer8 *) (*((struct_vecteur *)
431: (*s_objet_argument).objet)).tableau)[i]);
432: }
433: }
434: }
435: else if ((*s_objet_argument).type == VRL)
436: {
437: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
438: {
439: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
440: return;
441: }
442:
443: (*((real8 *) (*s_objet_resultat).objet)) = fabs(((real8 *)
444: (*((struct_vecteur *) (*s_objet_argument).objet)).tableau)[0]);
445:
446: for(i = 1; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
447: i++)
448: {
449: if (fabs(((real8 *) (*((struct_vecteur *) (*s_objet_argument)
450: .objet)).tableau)[i]) > (*((real8 *)
451: (*s_objet_resultat).objet)))
452: {
453: (*((real8 *) (*s_objet_resultat).objet)) =
454: fabs(((real8 *) (*((struct_vecteur *)
455: (*s_objet_argument).objet)).tableau)[i]);
456: }
457: }
458: }
459: else if ((*s_objet_argument).type == VCX)
460: {
461: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
462: {
463: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
464: return;
465: }
466:
467: f77absc_(&(((struct_complexe16 *) (*((struct_vecteur *)
468: (*s_objet_argument).objet)).tableau)[0]), (real8 *)
469: (*s_objet_resultat).objet);
470:
471: for(i = 1; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
472: i++)
473: {
474: f77absc_(&(((struct_complexe16 *) (*((struct_vecteur *)
475: (*s_objet_argument).objet)).tableau)[i]), ®istre);
476:
477: if (registre > (*((real8 *) (*s_objet_resultat).objet)))
478: {
479: (*((real8 *) (*s_objet_resultat).objet)) = registre;
480: }
481: }
482: }
483:
484: /*
485: --------------------------------------------------------------------------------
486: Traitement des matrices
487: --------------------------------------------------------------------------------
488: */
489:
490: else if ((*s_objet_argument).type == MIN)
491: {
492: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
493: {
494: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
495: return;
496: }
497:
498: cumul_entier = 0;
499: depassement = d_faux;
500:
501: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
502: .nombre_colonnes; j++)
503: {
504: entier_courant = abs(((integer8 **)
505: (*((struct_matrice *) (*s_objet_argument).objet))
506: .tableau)[0][j]);
507:
508: if (depassement_addition(&cumul_entier, &entier_courant, &tampon)
509: == d_erreur)
510: {
511: depassement = d_vrai;
512: break;
513: }
514: }
515:
516: if (depassement == d_faux)
517: {
518: (*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier;
519:
520: for(i = 1; i < (*((struct_matrice *) (*s_objet_argument).objet))
521: .nombre_lignes; i++)
522: {
523: cumul_entier = 0;
524:
525: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
526: .nombre_colonnes; j++)
527: {
528: entier_courant = abs(((integer8 **) (*((struct_matrice *)
529: (*s_objet_argument).objet)).tableau)[i][j]);
530:
531: if (depassement_addition(&cumul_entier, &entier_courant,
532: &tampon) == d_erreur)
533: {
534: depassement = d_vrai;
535: break;
536: }
537:
538: cumul_entier = tampon;
539: }
540:
541: if (depassement == d_vrai)
542: {
543: break;
544: }
545:
546: if (cumul_entier > (*((integer8 *) (*s_objet_resultat).objet)))
547: {
548: (*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier;
549: }
550: }
551: }
552:
553: if (depassement == d_vrai)
554: {
555: /*
556: * Dépassement : il faut refaire le calcul en real*8...
557: */
558:
559: free((*s_objet_resultat).objet);
560: (*s_objet_resultat).type = REL;
561:
562: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
563: {
564: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
565: return;
566: }
567:
568: if ((accumulateur = malloc((*((struct_matrice *)
569: (*s_objet_argument).objet)).nombre_colonnes *
570: sizeof(real8))) == NULL)
571: {
572: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
573: return;
574: }
575:
576: (*((real8 *) (*s_objet_resultat).objet)) = 0;
577:
578: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
579: .nombre_lignes; i++)
580: {
581: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
582: .nombre_colonnes; j++)
583: {
584: ((real8 *) accumulateur)[j] = fabs((real8) ((integer8 **)
585: (*((struct_matrice *) (*s_objet_argument).objet))
586: .tableau)[i][j]);
587: }
588:
589: cumul_reel = sommation_vecteur_reel(accumulateur,
590: &((*((struct_matrice *) (*s_objet_argument).objet))
591: .nombre_colonnes), &erreur_memoire);
592:
593: if (erreur_memoire == d_vrai)
594: {
595: (*s_etat_processus).erreur_systeme =
596: d_es_allocation_memoire;
597: return;
598: }
599:
600: if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet)))
601: {
602: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
603: }
604: }
605:
606: free(accumulateur);
607: }
608: }
609: else if ((*s_objet_argument).type == MRL)
610: {
611: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
612: {
613: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
614: return;
615: }
616:
617: if ((accumulateur = malloc((*((struct_matrice *)
618: (*s_objet_argument).objet)).nombre_colonnes * sizeof(real8)))
619: == NULL)
620: {
621: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
622: return;
623: }
624:
625: (*((real8 *) (*s_objet_resultat).objet)) = 0;
626:
627: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
628: .nombre_lignes; i++)
629: {
630: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
631: .nombre_colonnes; j++)
632: {
633: ((real8 *) accumulateur)[j] = fabs(((real8 **)
634: (*((struct_matrice *) (*s_objet_argument).objet))
635: .tableau)[i][j]);
636: }
637:
638: cumul_reel = sommation_vecteur_reel(accumulateur,
639: &((*((struct_matrice *) (*s_objet_argument).objet))
640: .nombre_colonnes), &erreur_memoire);
641:
642: if (erreur_memoire == d_vrai)
643: {
644: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
645: return;
646: }
647:
648: if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet)))
649: {
650: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
651: }
652: }
653:
654: free(accumulateur);
655: }
656: else if ((*s_objet_argument).type == MCX)
657: {
658: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
659: {
660: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
661: return;
662: }
663:
664: if ((accumulateur = malloc((*((struct_matrice *)
665: (*s_objet_argument).objet)).nombre_colonnes * sizeof(real8)))
666: == NULL)
667: {
668: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
669: return;
670: }
671:
672: (*((real8 *) (*s_objet_resultat).objet)) = 0;
673:
674: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
675: .nombre_lignes; i++)
676: {
677: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
678: .nombre_colonnes; j++)
679: {
680: f77absc_(&(((struct_complexe16 **) (*((struct_matrice *)
681: (*s_objet_argument).objet)).tableau)[i][j]),
682: &(((real8 *) accumulateur)[j]));
683: }
684:
685: cumul_reel = sommation_vecteur_reel(accumulateur,
686: &((*((struct_matrice *) (*s_objet_argument).objet))
687: .nombre_colonnes), &erreur_memoire);
688:
689: if (erreur_memoire == d_vrai)
690: {
691: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
692: return;
693: }
694:
695: if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet)))
696: {
697: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel;
698: }
699: }
700:
701: free(accumulateur);
702: }
703: /*
704: --------------------------------------------------------------------------------
705: Traitement impossible du fait du type de l'argument
706: --------------------------------------------------------------------------------
707: */
708:
709: else
710: {
711: liberation(s_etat_processus, s_objet_argument);
712:
713: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
714: return;
715: }
716:
717: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
718: s_objet_resultat) == d_erreur)
719: {
720: return;
721: }
722:
723: liberation(s_etat_processus, s_objet_argument);
724:
725: return;
726: }
727:
728:
729: /*
730: ================================================================================
731: Fonction 'rceq'
732: ================================================================================
733: Entrées : pointeur sur une structure struct_processus
734: --------------------------------------------------------------------------------
735: Sorties :
736: --------------------------------------------------------------------------------
737: Effets de bord : néant
738: ================================================================================
739: */
740:
741: void
742: instruction_rceq(struct_processus *s_etat_processus)
743: {
744: logical1 presence_variable;
745:
746: long i;
747:
748: struct_objet *s_objet_variable;
749:
750: (*s_etat_processus).erreur_execution = d_ex;
751:
752: if ((*s_etat_processus).affichage_arguments == 'Y')
753: {
754: printf("\n RCEQ ");
755:
756: if ((*s_etat_processus).langue == 'F')
757: {
758: printf("(rappel de la variable EQ)\n\n");
759: }
760: else
761: {
762: printf("(recall EQ variable)\n\n");
763: }
764:
765: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
766: " %s, %s, %s, %s, %s,\n"
767: " %s, %s, %s, %s, %s,\n"
768: " %s, %s, %s, %s,\n"
769: " %s, %s\n",
770: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
771: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
772: d_SQL, d_SLB, d_PRC, d_MTX);
773:
774: return;
775: }
776: else if ((*s_etat_processus).test_instruction == 'Y')
777: {
778: (*s_etat_processus).nombre_arguments = -1;
779: return;
780: }
781:
782: if (test_cfsf(s_etat_processus, 31) == d_vrai)
783: {
784: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
785: {
786: return;
787: }
788: }
789:
790: if (recherche_variable(s_etat_processus, "EQ") == d_vrai)
791: {
792: i = (*s_etat_processus).position_variable_courante;
793: presence_variable = d_faux;
794:
795: while(i >= 0)
796: {
797: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom, "EQ")
798: == 0) && ((*s_etat_processus).s_liste_variables[i]
799: .niveau == 1))
800: {
801: presence_variable = d_vrai;
802: break;
803: }
804:
805: i--;
806: }
807:
808: (*s_etat_processus).position_variable_courante = i;
809:
810: if (presence_variable == d_faux)
811: {
812: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
813: return;
814: }
815:
816: if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
817: {
818: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
819: return;
820: }
821: }
822: else
823: {
824: (*s_etat_processus).erreur_systeme = d_es;
825: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
826: return;
827: }
828:
829: if ((s_objet_variable = copie_objet(s_etat_processus,
830: ((*s_etat_processus).s_liste_variables)
831: [(*s_etat_processus).position_variable_courante].objet, 'P'))
832: == NULL)
833: {
834: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
835: return;
836: }
837:
838: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
839: s_objet_variable) == d_erreur)
840: {
841: return;
842: }
843:
844: return;
845: }
846:
847:
848: /*
849: ================================================================================
850: Fonction 'res'
851: ================================================================================
852: Entrées : pointeur sur une structure struct_processus
853: --------------------------------------------------------------------------------
854: Sorties :
855: --------------------------------------------------------------------------------
856: Effets de bord : néant
857: ================================================================================
858: */
859:
860: void
861: instruction_res(struct_processus *s_etat_processus)
862: {
863: struct_objet *s_objet;
864:
865: (*s_etat_processus).erreur_execution = d_ex;
866:
867: if ((*s_etat_processus).affichage_arguments == 'Y')
868: {
869: printf("\n RES ");
870:
871: if ((*s_etat_processus).langue == 'F')
872: {
873: printf("(résolution)\n\n");
874: }
875: else
876: {
877: printf("(resolution)\n\n");
878: }
879:
880: printf(" 1: %s, %s\n", d_INT, d_REL);
881:
882: return;
883: }
884: else if ((*s_etat_processus).test_instruction == 'Y')
885: {
886: (*s_etat_processus).nombre_arguments = -1;
887: return;
888: }
889:
890: if (test_cfsf(s_etat_processus, 31) == d_vrai)
891: {
892: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
893: {
894: return;
895: }
896: }
897:
898: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
899: &s_objet) == d_erreur)
900: {
901: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
902: return;
903: }
904:
905: if ((*s_objet).type == INT)
906: {
907: if ((*((integer8 *) (*s_objet).objet)) <= 0)
908: {
909: liberation(s_etat_processus, s_objet);
910:
911: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
912: return;
913: }
914:
915: (*s_etat_processus).resolution = (real8) (*((integer8 *)
916: (*s_objet).objet));
917: }
918: else if ((*s_objet).type == REL)
919: {
920: if ((*((real8 *) (*s_objet).objet)) <= 0)
921: {
922: liberation(s_etat_processus, s_objet);
923:
924: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
925: return;
926: }
927:
928: (*s_etat_processus).resolution = (*((real8 *) (*s_objet).objet));
929: }
930: else
931: {
932: liberation(s_etat_processus, s_objet);
933:
934: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
935: return;
936: }
937:
938: liberation(s_etat_processus, s_objet);
939: return;
940: }
941:
942:
943: /*
944: ================================================================================
945: Fonction 'recall'
946: ================================================================================
947: Entrées : pointeur sur une structure struct_processus
948: --------------------------------------------------------------------------------
949: Sorties :
950: --------------------------------------------------------------------------------
951: Effets de bord : néant
952: ================================================================================
953: */
954:
955: void
956: instruction_recall(struct_processus *s_etat_processus)
957: {
958: file *pipe;
959: file *fichier;
960:
961: int caractere;
962: int ios;
963:
1.7 bertrand 964: logical1 drapeau_fin;
965: logical1 indicateur_48;
966: logical1 presence_chaine;
967:
1.1 bertrand 968: long i;
969: long nombre_caracteres_source;
970:
971: struct_objet *s_objet;
972:
1.7 bertrand 973: unsigned char autorisation_empilement_programme;
974: unsigned char *chaine;
1.1 bertrand 975: unsigned char *commande;
1.6 bertrand 976: unsigned char *executable_candidat;
1.16 bertrand 977:
978: # ifndef OS2
1.1 bertrand 979: unsigned char *instructions = "%s/bin/rpliconv %s "
980: "`%s/bin/rplfile "
1.18 ! bertrand 981: "-m %s/share/rplfiles -i %s | "
! 982: "%s/bin/rplawk "
! 983: "'{ print $3; }' | %s/bin/rplawk -F= '{ if "
1.1 bertrand 984: "($2 != \"\") printf(\"-f %%s\", $2); }'` "
985: "-t `locale charmap` | %s/bin/%s -o %s";
1.16 bertrand 986: # else
987: unsigned char *instructions = "sh -c \"%s/bin/rpliconv %s "
988: "`%s/bin/rplfile "
1.18 ! bertrand 989: "-m %s/share/rplfiles -i %s | "
! 990: "%s/bin/rplawk "
! 991: "'{ print $3; }' | %s/bin/rplawk -F= '{ if "
1.16 bertrand 992: "($2 != \\\"\\\") printf(\\\"-f %%s\\\", "
993: "$2); }'` -t `" d_locale
994: "` | %s/bin/%s -o %s\"";
995: # endif
996:
1.1 bertrand 997: unsigned char *nom_fichier_temporaire;
1.7 bertrand 998: unsigned char *tampon_definitions_chainees;
999: unsigned char *tampon_instruction_courante;
1000:
1001: unsigned long position_courante;
1.1 bertrand 1002:
1003: (*s_etat_processus).erreur_execution = d_ex;
1004:
1005: if ((*s_etat_processus).affichage_arguments == 'Y')
1006: {
1007: printf("\n RECALL ");
1008:
1009: if ((*s_etat_processus).langue == 'F')
1010: {
1011: printf("(rappel d'une variable stockée sur disque)\n\n");
1012: }
1013: else
1014: {
1015: printf("(recall a variable stored on disk)\n\n");
1016: }
1017:
1018: printf(" 1: %s\n", d_CHN);
1019: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
1020: " %s, %s, %s, %s, %s,\n"
1021: " %s, %s, %s, %s, %s\n",
1022: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1023: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
1024:
1025: return;
1026: }
1027: else if ((*s_etat_processus).test_instruction == 'Y')
1028: {
1029: (*s_etat_processus).nombre_arguments = -1;
1030: return;
1031: }
1032:
1033: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1034: {
1035: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1036: {
1037: return;
1038: }
1039: }
1040:
1041: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1042: &s_objet) == d_erreur)
1043: {
1044: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1045: return;
1046: }
1047:
1048: if ((*s_objet).type == CHN)
1049: {
1050: if ((fichier = fopen((unsigned char *) (*s_objet).objet, "r")) == NULL)
1051: {
1052: liberation(s_etat_processus, s_objet);
1053:
1054: (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
1055: return;
1056: }
1057:
1058: if (fclose(fichier) != 0)
1059: {
1060: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1061: return;
1062: }
1063:
1064: if ((nom_fichier_temporaire = creation_nom_fichier(s_etat_processus,
1065: (*s_etat_processus).chemin_fichiers_temporaires)) == NULL)
1066: {
1067: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1068: return;
1069: }
1070:
1.5 bertrand 1071: if ((*s_etat_processus).rpl_home == NULL)
1.1 bertrand 1072: {
1.5 bertrand 1073: if ((commande = malloc((strlen(ds_preprocesseur) +
1074: (2 * strlen((unsigned char *) (*s_objet).objet)) +
1.18 ! bertrand 1075: (6 * strlen(d_exec_path)) +
! 1076: strlen(nom_fichier_temporaire) + strlen(instructions) - 19)
1.5 bertrand 1077: * sizeof(unsigned char))) == NULL)
1078: {
1079: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1080: return;
1081: }
1082:
1083: sprintf(commande, instructions, d_exec_path,
1084: (unsigned char *) (*s_objet).objet,
1085: d_exec_path, d_exec_path,
1086: (unsigned char *) (*s_objet).objet,
1.18 ! bertrand 1087: d_exec_path, d_exec_path,
1.5 bertrand 1088: d_exec_path, ds_preprocesseur, nom_fichier_temporaire);
1.6 bertrand 1089:
1090: if (alsprintf(&executable_candidat, "%s/bin/rpliconv",
1091: d_exec_path) < 0)
1092: {
1093: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1094: return;
1095: }
1096:
1097: if (controle(s_etat_processus, executable_candidat, "md5",
1098: rpliconv_md5) != d_vrai)
1099: {
1100: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1101: return;
1102: }
1103:
1104: if (controle(s_etat_processus, executable_candidat, "sha1",
1105: rpliconv_sha1) != d_vrai)
1106: {
1107: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1108: return;
1109: }
1110:
1111: free(executable_candidat);
1112:
1113: if (alsprintf(&executable_candidat, "%s/bin/rplfile",
1114: d_exec_path) < 0)
1115: {
1116: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1117: return;
1118: }
1119:
1120: if (controle(s_etat_processus, executable_candidat, "md5",
1121: rplfile_md5) != d_vrai)
1122: {
1123: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1124: return;
1125: }
1126:
1127: if (controle(s_etat_processus, executable_candidat, "sha1",
1128: rplfile_sha1) != d_vrai)
1129: {
1130: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1131: return;
1132: }
1133:
1134: free(executable_candidat);
1135:
1136: if (alsprintf(&executable_candidat, "%s/bin/rplpp",
1137: d_exec_path) < 0)
1138: {
1139: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1140: return;
1141: }
1142:
1143: if (controle(s_etat_processus, executable_candidat, "md5",
1144: rplpp_md5) != d_vrai)
1145: {
1146: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1147: return;
1148: }
1149:
1150: if (controle(s_etat_processus, executable_candidat, "sha1",
1151: rplpp_sha1) != d_vrai)
1152: {
1153: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1154: return;
1155: }
1156:
1157: free(executable_candidat);
1.18 ! bertrand 1158:
! 1159: if (alsprintf(&executable_candidat, "%s/bin/rplawk",
! 1160: d_exec_path) < 0)
! 1161: {
! 1162: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1163: return;
! 1164: }
! 1165:
! 1166: if (controle(s_etat_processus, executable_candidat, "md5",
! 1167: rplawkpp_md5) != d_vrai)
! 1168: {
! 1169: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
! 1170: return;
! 1171: }
! 1172:
! 1173: if (controle(s_etat_processus, executable_candidat, "sha1",
! 1174: rplawk_sha1) != d_vrai)
! 1175: {
! 1176: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
! 1177: return;
! 1178: }
! 1179:
! 1180: free(executable_candidat);
1.1 bertrand 1181: }
1.5 bertrand 1182: else
1183: {
1184: if ((commande = malloc((strlen(ds_preprocesseur) +
1185: (2 * strlen((unsigned char *) (*s_objet).objet)) +
1.18 ! bertrand 1186: (6 * strlen((*s_etat_processus).rpl_home)) +
! 1187: strlen(nom_fichier_temporaire) + strlen(instructions) - 19)
1.5 bertrand 1188: * sizeof(unsigned char))) == NULL)
1189: {
1190: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1191: return;
1192: }
1.1 bertrand 1193:
1.5 bertrand 1194: sprintf(commande, instructions, (*s_etat_processus).rpl_home,
1195: (unsigned char *) (*s_objet).objet,
1196: (*s_etat_processus).rpl_home, (*s_etat_processus).rpl_home,
1197: (unsigned char *) (*s_objet).objet,
1.18 ! bertrand 1198: (*s_etat_processus).rpl_home, (*s_etat_processus).rpl_home,
1.5 bertrand 1199: (*s_etat_processus).rpl_home, ds_preprocesseur,
1200: nom_fichier_temporaire);
1.6 bertrand 1201:
1202: if (alsprintf(&executable_candidat, "%s/bin/rpliconv",
1203: (*s_etat_processus).rpl_home) < 0)
1204: {
1205: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1206: return;
1207: }
1208:
1209: if (controle(s_etat_processus, executable_candidat, "md5",
1210: rpliconv_md5) != d_vrai)
1211: {
1212: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1213: return;
1214: }
1215:
1216: if (controle(s_etat_processus, executable_candidat, "sha1",
1217: rpliconv_sha1) != d_vrai)
1218: {
1219: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1220: return;
1221: }
1222:
1223: free(executable_candidat);
1224:
1225: if (alsprintf(&executable_candidat, "%s/bin/rplfile",
1226: (*s_etat_processus).rpl_home) < 0)
1227: {
1228: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1229: return;
1230: }
1231:
1232: if (controle(s_etat_processus, executable_candidat, "md5",
1233: rplfile_md5) != d_vrai)
1234: {
1235: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1236: return;
1237: }
1238:
1239: if (controle(s_etat_processus, executable_candidat, "sha1",
1240: rplfile_sha1) != d_vrai)
1241: {
1242: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1243: return;
1244: }
1245:
1246: free(executable_candidat);
1247:
1248: if (alsprintf(&executable_candidat, "%s/bin/rplpp",
1249: (*s_etat_processus).rpl_home) < 0)
1250: {
1251: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1252: return;
1253: }
1254:
1255: if (controle(s_etat_processus, executable_candidat, "md5",
1256: rplpp_md5) != d_vrai)
1257: {
1258: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1259: return;
1260: }
1261:
1262: if (controle(s_etat_processus, executable_candidat, "sha1",
1263: rplpp_sha1) != d_vrai)
1264: {
1265: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1266: return;
1267: }
1268:
1269: free(executable_candidat);
1.18 ! bertrand 1270:
! 1271: if (alsprintf(&executable_candidat, "%s/bin/rplawk",
! 1272: d_exec_path) < 0)
! 1273: {
! 1274: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1275: return;
! 1276: }
! 1277:
! 1278: if (controle(s_etat_processus, executable_candidat, "md5",
! 1279: rplawkpp_md5) != d_vrai)
! 1280: {
! 1281: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
! 1282: return;
! 1283: }
! 1284:
! 1285: if (controle(s_etat_processus, executable_candidat, "sha1",
! 1286: rplawk_sha1) != d_vrai)
! 1287: {
! 1288: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
! 1289: return;
! 1290: }
! 1291:
! 1292: free(executable_candidat);
1.5 bertrand 1293: }
1.1 bertrand 1294:
1295: if ((pipe = popen(commande, "r")) == NULL)
1296: {
1297: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1298: return;
1299: }
1300:
1301: if ((ios = pclose(pipe)) != EXIT_SUCCESS)
1302: {
1303: liberation(s_etat_processus, s_objet);
1304: free(commande);
1305:
1306: (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
1307: return;
1308: }
1309: else if (ios == -1)
1310: {
1311: (*s_etat_processus).erreur_systeme = d_es_processus;
1312: return;
1313: }
1314:
1315: free(commande);
1316:
1317: nombre_caracteres_source = 0;
1318:
1319: if ((pipe = fopen(nom_fichier_temporaire, "r")) == NULL)
1320: {
1321: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1322: return;
1323: }
1324:
1325: while(getc(pipe) != EOF)
1326: {
1327: nombre_caracteres_source++;
1328: }
1329:
1330: if (nombre_caracteres_source == 0)
1331: {
1332: if (fclose(pipe) == -1)
1333: {
1334: (*s_etat_processus).erreur_systeme = d_es_processus;
1335: return;
1336: }
1337:
1338: liberation(s_etat_processus, s_objet);
1339:
1340: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1341: {
1342: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1343: return;
1344: }
1345:
1346: free(nom_fichier_temporaire);
1347:
1348: (*s_etat_processus).erreur_execution = d_ex_fichier_vide;
1349: return;
1350: }
1351:
1.7 bertrand 1352: if ((chaine = malloc((nombre_caracteres_source + 1)
1.1 bertrand 1353: * sizeof(unsigned char))) == NULL)
1354: {
1355: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1356: return;
1357: }
1358:
1359: rewind(pipe);
1360:
1361: i = 0;
1.7 bertrand 1362: drapeau_fin = d_faux;
1363: presence_chaine = d_faux;
1364:
1365: while(drapeau_fin == d_faux)
1.1 bertrand 1366: {
1.7 bertrand 1367: if ((caractere = getc(pipe)) != EOF)
1.1 bertrand 1368: {
1.7 bertrand 1369: if ((caractere == d_code_retour_chariot) ||
1370: (caractere == d_code_tabulation) ||
1371: ((caractere == d_code_espace) &&
1372: (presence_chaine == d_faux)))
1.1 bertrand 1373: {
1.7 bertrand 1374: do
1375: {
1376: caractere = getc(pipe);
1377: } while(((caractere == d_code_retour_chariot) ||
1378: (caractere == d_code_tabulation) ||
1379: ((caractere == d_code_espace) &&
1380: (presence_chaine == d_faux))) &&
1381: (caractere != EOF));
1382:
1383: if (caractere != EOF)
1384: {
1385: chaine[i++] = d_code_espace;
1386: }
1387: else
1388: {
1389: drapeau_fin = d_vrai;
1390: }
1391: }
1.1 bertrand 1392:
1.7 bertrand 1393: if ((chaine[i] = caractere) == '\"')
1.1 bertrand 1394: {
1.7 bertrand 1395: if (i > 0)
1396: {
1397: if (chaine[i - 1] != '\\')
1398: {
1399: presence_chaine = (presence_chaine == d_faux)
1400: ? d_vrai : d_faux;
1401: }
1402: }
1403:
1404: i++;
1.1 bertrand 1405: }
1.7 bertrand 1406: else
1407: {
1408: i++;
1409: }
1410: }
1411: else
1412: {
1413: drapeau_fin = d_vrai;
1.1 bertrand 1414: }
1415: }
1416:
1.7 bertrand 1417: if ((caractere == EOF) && (i > 0))
1.1 bertrand 1418: {
1419: i--;
1420: }
1421:
1.7 bertrand 1422: chaine[i] = d_code_fin_chaine;
1.1 bertrand 1423:
1424: if (fclose(pipe) != 0)
1425: {
1426: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1427: return;
1428: }
1429:
1.7 bertrand 1430: indicateur_48 = test_cfsf(s_etat_processus, 48);
1431: cf(s_etat_processus, 48);
1432:
1433: tampon_definitions_chainees = (*s_etat_processus).definitions_chainees;
1434: tampon_instruction_courante = (*s_etat_processus).instruction_courante;
1435: position_courante = (*s_etat_processus).position_courante;
1436: autorisation_empilement_programme = (*s_etat_processus)
1437: .autorisation_empilement_programme;
1438:
1439: (*s_etat_processus).instruction_courante = NULL;
1440:
1441: if (((*s_etat_processus).definitions_chainees = transliteration(
1442: s_etat_processus, chaine, "UTF-8", d_locale)) == NULL)
1.1 bertrand 1443: {
1.7 bertrand 1444: if (indicateur_48 == d_vrai)
1445: {
1446: sf(s_etat_processus, 48);
1447: }
1448: else
1449: {
1450: cf(s_etat_processus, 48);
1451: }
1452:
1453: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1454: {
1455: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1456: return;
1457: }
1458:
1.1 bertrand 1459: free(nom_fichier_temporaire);
1.7 bertrand 1460: free((*s_etat_processus).instruction_courante);
1461: free(chaine);
1462:
1463: (*s_etat_processus).position_courante = position_courante;
1464: (*s_etat_processus).instruction_courante =
1465: tampon_instruction_courante;
1466: (*s_etat_processus).definitions_chainees =
1467: tampon_definitions_chainees;
1468: (*s_etat_processus).autorisation_empilement_programme =
1469: autorisation_empilement_programme;
1470:
1471: liberation(s_etat_processus, s_objet);
1.1 bertrand 1472: return;
1473: }
1474:
1.7 bertrand 1475: (*s_etat_processus).autorisation_empilement_programme = 'Y';
1476: (*s_etat_processus).position_courante = 0;
1477:
1478: if (analyse_syntaxique(s_etat_processus) == d_erreur)
1479: {
1480: if (indicateur_48 == d_vrai)
1481: {
1482: sf(s_etat_processus, 48);
1483: }
1484: else
1485: {
1486: cf(s_etat_processus, 48);
1487: }
1488:
1489: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1490: {
1491: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1492: return;
1493: }
1494:
1495: free(nom_fichier_temporaire);
1496: free((*s_etat_processus).instruction_courante);
1497: free((*s_etat_processus).definitions_chainees);
1498: free(chaine);
1499:
1500: (*s_etat_processus).position_courante = position_courante;
1501: (*s_etat_processus).instruction_courante =
1502: tampon_instruction_courante;
1503: (*s_etat_processus).definitions_chainees =
1504: tampon_definitions_chainees;
1505: (*s_etat_processus).autorisation_empilement_programme =
1506: autorisation_empilement_programme;
1507:
1508: liberation(s_etat_processus, s_objet);
1509: return;
1510: }
1511:
1512: (*s_etat_processus).position_courante = 0;
1513:
1514: if (recherche_instruction_suivante(s_etat_processus) !=
1515: d_absence_erreur)
1516: {
1517: if (indicateur_48 == d_vrai)
1518: {
1519: sf(s_etat_processus, 48);
1520: }
1521: else
1522: {
1523: cf(s_etat_processus, 48);
1524: }
1525:
1526: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1527: {
1528: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1529: return;
1530: }
1531:
1532: free(nom_fichier_temporaire);
1533: free((*s_etat_processus).instruction_courante);
1534: free((*s_etat_processus).definitions_chainees);
1535: free(chaine);
1536:
1537: (*s_etat_processus).position_courante = position_courante;
1538: (*s_etat_processus).instruction_courante =
1539: tampon_instruction_courante;
1540: (*s_etat_processus).definitions_chainees =
1541: tampon_definitions_chainees;
1542: (*s_etat_processus).autorisation_empilement_programme =
1543: autorisation_empilement_programme;
1544:
1545: liberation(s_etat_processus, s_objet);
1546: return;
1547: }
1548:
1549: recherche_type(s_etat_processus);
1550:
1551: while((*s_etat_processus).definitions_chainees
1552: [(*s_etat_processus).position_courante] != d_code_fin_chaine)
1553: {
1554: if ((*s_etat_processus).definitions_chainees
1555: [(*s_etat_processus).position_courante++] != d_code_espace)
1556: {
1557: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1558: }
1559: }
1560:
1561: free((*s_etat_processus).instruction_courante);
1562: free((*s_etat_processus).definitions_chainees);
1563: free(chaine);
1564:
1565: (*s_etat_processus).position_courante = position_courante;
1566: (*s_etat_processus).instruction_courante =
1567: tampon_instruction_courante;
1568: (*s_etat_processus).definitions_chainees =
1569: tampon_definitions_chainees;
1570: (*s_etat_processus).autorisation_empilement_programme =
1571: autorisation_empilement_programme;
1572:
1573: if (indicateur_48 == d_vrai)
1574: {
1575: sf(s_etat_processus, 48);
1576: }
1577: else
1578: {
1579: cf(s_etat_processus, 48);
1580: }
1.1 bertrand 1581:
1582: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1583: {
1584: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1585: return;
1586: }
1587:
1588: free(nom_fichier_temporaire);
1589: }
1590: else
1591: {
1592: liberation(s_etat_processus, s_objet);
1593:
1594: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1595: return;
1596: }
1597:
1598: liberation(s_etat_processus, s_objet);
1599: return;
1600: }
1601:
1602:
1603: /*
1604: ================================================================================
1605: Fonction 'rcws'
1606: ================================================================================
1607: Entrées : pointeur sur une structure struct_processus
1608: --------------------------------------------------------------------------------
1609: Sorties :
1610: --------------------------------------------------------------------------------
1611: Effets de bord : néant
1612: ================================================================================
1613: */
1614:
1615: void
1616: instruction_rcws(struct_processus *s_etat_processus)
1617: {
1618: struct_objet *s_objet_resultat;
1619:
1620: unsigned long i;
1621: unsigned long j;
1622: unsigned long longueur;
1623:
1624: (*s_etat_processus).erreur_execution = d_ex;
1625:
1626: if ((*s_etat_processus).affichage_arguments == 'Y')
1627: {
1628: printf("\n RCWS ");
1629:
1630: if ((*s_etat_processus).langue == 'F')
1631: {
1632: printf("(rappel de la longueur des entiers binaires)\n\n");
1633: }
1634: else
1635: {
1636: printf("(recall the length of the binary integers)\n\n");
1637: }
1638:
1639: printf("-> 1: %s\n", d_INT);
1640:
1641: return;
1642: }
1643: else if ((*s_etat_processus).test_instruction == 'Y')
1644: {
1645: (*s_etat_processus).nombre_arguments = -1;
1646: return;
1647: }
1648:
1649: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1650: {
1651: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1652: {
1653: return;
1654: }
1655: }
1656:
1657: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1658: {
1659: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1660: return;
1661: }
1662:
1663: longueur = 1;
1664: j = 1;
1665:
1666: for(i = 37; i <= 42; i++)
1667: {
1668: longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
1669: == d_vrai) ? j : 0;
1670: j *= 2;
1671: }
1672:
1673: (*((integer8 *) (*s_objet_resultat).objet)) = longueur;
1674:
1675: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1676: s_objet_resultat) == d_erreur)
1677: {
1678: return;
1679: }
1680:
1681: return;
1682: }
1683:
1684:
1685: /*
1686: ================================================================================
1687: Fonction 'rcls'
1688: ================================================================================
1689: Entrées : pointeur sur une structure struct_processus
1690: --------------------------------------------------------------------------------
1691: Sorties :
1692: --------------------------------------------------------------------------------
1693: Effets de bord : néant
1694: ================================================================================
1695: */
1696:
1697: void
1698: instruction_rcls(struct_processus *s_etat_processus)
1699: {
1700: logical1 presence_variable;
1701:
1702: long i;
1703:
1704: struct_objet *s_objet_variable;
1705:
1706: (*s_etat_processus).erreur_execution = d_ex;
1707:
1708: if ((*s_etat_processus).affichage_arguments == 'Y')
1709: {
1710: printf("\n RCLS ");
1711:
1712: if ((*s_etat_processus).langue == 'F')
1713: {
1714: printf("(rappel de la variable %s)\n\n", ds_sdat);
1715: }
1716: else
1717: {
1718: printf("(recall %s variable)\n\n", ds_sdat);
1719: }
1720:
1721: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
1722: " %s, %s, %s, %s, %s,\n"
1723: " %s, %s, %s, %s, %s,\n"
1724: " %s\n",
1725: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1726: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
1727:
1728: return;
1729: }
1730: else if ((*s_etat_processus).test_instruction == 'Y')
1731: {
1732: (*s_etat_processus).nombre_arguments = -1;
1733: return;
1734: }
1735:
1736: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1737: {
1738: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1739: {
1740: return;
1741: }
1742: }
1743:
1744: if (recherche_variable(s_etat_processus, ds_sdat) == d_vrai)
1745: {
1746: i = (*s_etat_processus).position_variable_courante;
1747: presence_variable = d_faux;
1748:
1749: while(i >= 0)
1750: {
1751: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom, ds_sdat)
1752: == 0) && ((*s_etat_processus).s_liste_variables[i]
1753: .niveau == 1))
1754: {
1755: presence_variable = d_vrai;
1756: break;
1757: }
1758:
1759: i--;
1760: }
1761:
1762: (*s_etat_processus).position_variable_courante = i;
1763:
1764: if (presence_variable == d_faux)
1765: {
1766: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
1767: return;
1768: }
1769:
1770: if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
1771: {
1772: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
1773: return;
1774: }
1775: }
1776: else
1777: {
1778: (*s_etat_processus).erreur_systeme = d_es;
1779: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
1780: return;
1781: }
1782:
1783: if ((s_objet_variable = copie_objet(s_etat_processus,
1784: ((*s_etat_processus).s_liste_variables)
1785: [(*s_etat_processus).position_variable_courante].objet, 'O'))
1786: == NULL)
1787: {
1788: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1789: return;
1790: }
1791:
1792: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1793: s_objet_variable) == d_erreur)
1794: {
1795: return;
1796: }
1797:
1798: return;
1799: }
1800:
1801: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_r3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src