Annotation of rpl/src/instructions_r3.c, revision 1.28
1.1 bertrand 1: /*
2: ================================================================================
1.27 bertrand 3: RPL/2 (R) version 4.1.0.prerelease.1
1.22 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.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: struct_objet *s_objet_variable;
745:
746: (*s_etat_processus).erreur_execution = d_ex;
747:
748: if ((*s_etat_processus).affichage_arguments == 'Y')
749: {
750: printf("\n RCEQ ");
751:
752: if ((*s_etat_processus).langue == 'F')
753: {
754: printf("(rappel de la variable EQ)\n\n");
755: }
756: else
757: {
758: printf("(recall EQ variable)\n\n");
759: }
760:
761: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
762: " %s, %s, %s, %s, %s,\n"
763: " %s, %s, %s, %s, %s,\n"
764: " %s, %s, %s, %s,\n"
765: " %s, %s\n",
766: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
767: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
768: d_SQL, d_SLB, d_PRC, d_MTX);
769:
770: return;
771: }
772: else if ((*s_etat_processus).test_instruction == 'Y')
773: {
774: (*s_etat_processus).nombre_arguments = -1;
775: return;
776: }
777:
778: if (test_cfsf(s_etat_processus, 31) == d_vrai)
779: {
780: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
781: {
782: return;
783: }
784: }
785:
1.26 bertrand 786: if (recherche_variable_globale(s_etat_processus, "EQ") == d_faux)
1.1 bertrand 787: {
1.26 bertrand 788: (*s_etat_processus).erreur_systeme = d_es;
1.1 bertrand 789:
1.26 bertrand 790: if ((*s_etat_processus).erreur_execution == d_ex)
1.1 bertrand 791: {
792: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
793: }
794:
795: return;
796: }
797:
798: if ((s_objet_variable = copie_objet(s_etat_processus,
1.26 bertrand 799: (*(*s_etat_processus).pointeur_variable_courante).objet, 'P'))
1.1 bertrand 800: == NULL)
801: {
802: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
803: return;
804: }
805:
806: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
807: s_objet_variable) == d_erreur)
808: {
809: return;
810: }
811:
812: return;
813: }
814:
815:
816: /*
817: ================================================================================
818: Fonction 'res'
819: ================================================================================
820: Entrées : pointeur sur une structure struct_processus
821: --------------------------------------------------------------------------------
822: Sorties :
823: --------------------------------------------------------------------------------
824: Effets de bord : néant
825: ================================================================================
826: */
827:
828: void
829: instruction_res(struct_processus *s_etat_processus)
830: {
831: struct_objet *s_objet;
832:
833: (*s_etat_processus).erreur_execution = d_ex;
834:
835: if ((*s_etat_processus).affichage_arguments == 'Y')
836: {
837: printf("\n RES ");
838:
839: if ((*s_etat_processus).langue == 'F')
840: {
841: printf("(résolution)\n\n");
842: }
843: else
844: {
845: printf("(resolution)\n\n");
846: }
847:
848: printf(" 1: %s, %s\n", d_INT, d_REL);
849:
850: return;
851: }
852: else if ((*s_etat_processus).test_instruction == 'Y')
853: {
854: (*s_etat_processus).nombre_arguments = -1;
855: return;
856: }
857:
858: if (test_cfsf(s_etat_processus, 31) == d_vrai)
859: {
860: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
861: {
862: return;
863: }
864: }
865:
866: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
867: &s_objet) == d_erreur)
868: {
869: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
870: return;
871: }
872:
873: if ((*s_objet).type == INT)
874: {
875: if ((*((integer8 *) (*s_objet).objet)) <= 0)
876: {
877: liberation(s_etat_processus, s_objet);
878:
879: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
880: return;
881: }
882:
883: (*s_etat_processus).resolution = (real8) (*((integer8 *)
884: (*s_objet).objet));
885: }
886: else if ((*s_objet).type == REL)
887: {
888: if ((*((real8 *) (*s_objet).objet)) <= 0)
889: {
890: liberation(s_etat_processus, s_objet);
891:
892: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
893: return;
894: }
895:
896: (*s_etat_processus).resolution = (*((real8 *) (*s_objet).objet));
897: }
898: else
899: {
900: liberation(s_etat_processus, s_objet);
901:
902: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
903: return;
904: }
905:
906: liberation(s_etat_processus, s_objet);
907: return;
908: }
909:
910:
911: /*
912: ================================================================================
913: Fonction 'recall'
914: ================================================================================
915: Entrées : pointeur sur une structure struct_processus
916: --------------------------------------------------------------------------------
917: Sorties :
918: --------------------------------------------------------------------------------
919: Effets de bord : néant
920: ================================================================================
921: */
922:
923: void
924: instruction_recall(struct_processus *s_etat_processus)
925: {
926: file *pipe;
927: file *fichier;
928:
929: int caractere;
930: int ios;
931:
1.7 bertrand 932: logical1 drapeau_fin;
933: logical1 indicateur_48;
934: logical1 presence_chaine;
935:
1.1 bertrand 936: long i;
937: long nombre_caracteres_source;
938:
939: struct_objet *s_objet;
940:
1.7 bertrand 941: unsigned char autorisation_empilement_programme;
942: unsigned char *chaine;
1.1 bertrand 943: unsigned char *commande;
1.6 bertrand 944: unsigned char *executable_candidat;
1.16 bertrand 945:
946: # ifndef OS2
1.1 bertrand 947: unsigned char *instructions = "%s/bin/rpliconv %s "
948: "`%s/bin/rplfile "
1.18 bertrand 949: "-m %s/share/rplfiles -i %s | "
950: "%s/bin/rplawk "
951: "'{ print $3; }' | %s/bin/rplawk -F= '{ if "
1.1 bertrand 952: "($2 != \"\") printf(\"-f %%s\", $2); }'` "
953: "-t `locale charmap` | %s/bin/%s -o %s";
1.16 bertrand 954: # else
1.20 bertrand 955: unsigned char *instructions = BOURNE_SHELL
956: " -c \"%s/bin/rpliconv %s "
1.16 bertrand 957: "`%s/bin/rplfile "
1.18 bertrand 958: "-m %s/share/rplfiles -i %s | "
959: "%s/bin/rplawk "
960: "'{ print $3; }' | %s/bin/rplawk -F= '{ if "
1.16 bertrand 961: "($2 != \\\"\\\") printf(\\\"-f %%s\\\", "
962: "$2); }'` -t `" d_locale
963: "` | %s/bin/%s -o %s\"";
964: # endif
965:
1.1 bertrand 966: unsigned char *nom_fichier_temporaire;
1.7 bertrand 967: unsigned char *tampon_definitions_chainees;
968: unsigned char *tampon_instruction_courante;
969:
970: unsigned long position_courante;
1.1 bertrand 971:
972: (*s_etat_processus).erreur_execution = d_ex;
973:
974: if ((*s_etat_processus).affichage_arguments == 'Y')
975: {
976: printf("\n RECALL ");
977:
978: if ((*s_etat_processus).langue == 'F')
979: {
980: printf("(rappel d'une variable stockée sur disque)\n\n");
981: }
982: else
983: {
984: printf("(recall a variable stored on disk)\n\n");
985: }
986:
987: printf(" 1: %s\n", d_CHN);
988: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
989: " %s, %s, %s, %s, %s,\n"
990: " %s, %s, %s, %s, %s\n",
991: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
992: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
993:
994: return;
995: }
996: else if ((*s_etat_processus).test_instruction == 'Y')
997: {
998: (*s_etat_processus).nombre_arguments = -1;
999: return;
1000: }
1001:
1002: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1003: {
1004: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1005: {
1006: return;
1007: }
1008: }
1009:
1010: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1011: &s_objet) == d_erreur)
1012: {
1013: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1014: return;
1015: }
1016:
1017: if ((*s_objet).type == CHN)
1018: {
1019: if ((fichier = fopen((unsigned char *) (*s_objet).objet, "r")) == NULL)
1020: {
1021: liberation(s_etat_processus, s_objet);
1022:
1023: (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
1024: return;
1025: }
1026:
1027: if (fclose(fichier) != 0)
1028: {
1029: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1030: return;
1031: }
1032:
1033: if ((nom_fichier_temporaire = creation_nom_fichier(s_etat_processus,
1034: (*s_etat_processus).chemin_fichiers_temporaires)) == NULL)
1035: {
1036: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1037: return;
1038: }
1039:
1.5 bertrand 1040: if ((*s_etat_processus).rpl_home == NULL)
1.1 bertrand 1041: {
1.5 bertrand 1042: if ((commande = malloc((strlen(ds_preprocesseur) +
1043: (2 * strlen((unsigned char *) (*s_objet).objet)) +
1.18 bertrand 1044: (6 * strlen(d_exec_path)) +
1045: strlen(nom_fichier_temporaire) + strlen(instructions) - 19)
1.5 bertrand 1046: * sizeof(unsigned char))) == NULL)
1047: {
1048: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1049: return;
1050: }
1051:
1052: sprintf(commande, instructions, d_exec_path,
1053: (unsigned char *) (*s_objet).objet,
1054: d_exec_path, d_exec_path,
1055: (unsigned char *) (*s_objet).objet,
1.18 bertrand 1056: d_exec_path, d_exec_path,
1.5 bertrand 1057: d_exec_path, ds_preprocesseur, nom_fichier_temporaire);
1.6 bertrand 1058:
1059: if (alsprintf(&executable_candidat, "%s/bin/rpliconv",
1060: d_exec_path) < 0)
1061: {
1062: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1063: return;
1064: }
1065:
1066: if (controle(s_etat_processus, executable_candidat, "md5",
1067: rpliconv_md5) != d_vrai)
1068: {
1069: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1070: return;
1071: }
1072:
1073: if (controle(s_etat_processus, executable_candidat, "sha1",
1074: rpliconv_sha1) != d_vrai)
1075: {
1076: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1077: return;
1078: }
1079:
1080: free(executable_candidat);
1081:
1082: if (alsprintf(&executable_candidat, "%s/bin/rplfile",
1083: d_exec_path) < 0)
1084: {
1085: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1086: return;
1087: }
1088:
1089: if (controle(s_etat_processus, executable_candidat, "md5",
1090: rplfile_md5) != d_vrai)
1091: {
1092: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1093: return;
1094: }
1095:
1096: if (controle(s_etat_processus, executable_candidat, "sha1",
1097: rplfile_sha1) != d_vrai)
1098: {
1099: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1100: return;
1101: }
1102:
1103: free(executable_candidat);
1104:
1105: if (alsprintf(&executable_candidat, "%s/bin/rplpp",
1106: d_exec_path) < 0)
1107: {
1108: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1109: return;
1110: }
1111:
1112: if (controle(s_etat_processus, executable_candidat, "md5",
1113: rplpp_md5) != d_vrai)
1114: {
1115: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1116: return;
1117: }
1118:
1119: if (controle(s_etat_processus, executable_candidat, "sha1",
1120: rplpp_sha1) != d_vrai)
1121: {
1122: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1123: return;
1124: }
1125:
1126: free(executable_candidat);
1.18 bertrand 1127:
1128: if (alsprintf(&executable_candidat, "%s/bin/rplawk",
1129: d_exec_path) < 0)
1130: {
1131: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1132: return;
1133: }
1134:
1135: if (controle(s_etat_processus, executable_candidat, "md5",
1.19 bertrand 1136: rplawk_md5) != d_vrai)
1.18 bertrand 1137: {
1138: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1139: return;
1140: }
1141:
1142: if (controle(s_etat_processus, executable_candidat, "sha1",
1143: rplawk_sha1) != d_vrai)
1144: {
1145: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1146: return;
1147: }
1148:
1149: free(executable_candidat);
1.1 bertrand 1150: }
1.5 bertrand 1151: else
1152: {
1153: if ((commande = malloc((strlen(ds_preprocesseur) +
1154: (2 * strlen((unsigned char *) (*s_objet).objet)) +
1.18 bertrand 1155: (6 * strlen((*s_etat_processus).rpl_home)) +
1156: strlen(nom_fichier_temporaire) + strlen(instructions) - 19)
1.5 bertrand 1157: * sizeof(unsigned char))) == NULL)
1158: {
1159: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1160: return;
1161: }
1.1 bertrand 1162:
1.5 bertrand 1163: sprintf(commande, instructions, (*s_etat_processus).rpl_home,
1164: (unsigned char *) (*s_objet).objet,
1165: (*s_etat_processus).rpl_home, (*s_etat_processus).rpl_home,
1166: (unsigned char *) (*s_objet).objet,
1.18 bertrand 1167: (*s_etat_processus).rpl_home, (*s_etat_processus).rpl_home,
1.5 bertrand 1168: (*s_etat_processus).rpl_home, ds_preprocesseur,
1169: nom_fichier_temporaire);
1.6 bertrand 1170:
1171: if (alsprintf(&executable_candidat, "%s/bin/rpliconv",
1172: (*s_etat_processus).rpl_home) < 0)
1173: {
1174: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1175: return;
1176: }
1177:
1178: if (controle(s_etat_processus, executable_candidat, "md5",
1179: rpliconv_md5) != d_vrai)
1180: {
1181: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1182: return;
1183: }
1184:
1185: if (controle(s_etat_processus, executable_candidat, "sha1",
1186: rpliconv_sha1) != d_vrai)
1187: {
1188: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1189: return;
1190: }
1191:
1192: free(executable_candidat);
1193:
1194: if (alsprintf(&executable_candidat, "%s/bin/rplfile",
1195: (*s_etat_processus).rpl_home) < 0)
1196: {
1197: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1198: return;
1199: }
1200:
1201: if (controle(s_etat_processus, executable_candidat, "md5",
1202: rplfile_md5) != d_vrai)
1203: {
1204: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1205: return;
1206: }
1207:
1208: if (controle(s_etat_processus, executable_candidat, "sha1",
1209: rplfile_sha1) != d_vrai)
1210: {
1211: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1212: return;
1213: }
1214:
1215: free(executable_candidat);
1216:
1217: if (alsprintf(&executable_candidat, "%s/bin/rplpp",
1218: (*s_etat_processus).rpl_home) < 0)
1219: {
1220: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1221: return;
1222: }
1223:
1224: if (controle(s_etat_processus, executable_candidat, "md5",
1225: rplpp_md5) != d_vrai)
1226: {
1227: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1228: return;
1229: }
1230:
1231: if (controle(s_etat_processus, executable_candidat, "sha1",
1232: rplpp_sha1) != d_vrai)
1233: {
1234: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1235: return;
1236: }
1237:
1238: free(executable_candidat);
1.18 bertrand 1239:
1240: if (alsprintf(&executable_candidat, "%s/bin/rplawk",
1241: d_exec_path) < 0)
1242: {
1243: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1244: return;
1245: }
1246:
1247: if (controle(s_etat_processus, executable_candidat, "md5",
1.19 bertrand 1248: rplawk_md5) != d_vrai)
1.18 bertrand 1249: {
1250: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1251: return;
1252: }
1253:
1254: if (controle(s_etat_processus, executable_candidat, "sha1",
1255: rplawk_sha1) != d_vrai)
1256: {
1257: (*s_etat_processus).erreur_systeme = d_es_somme_controle;
1258: return;
1259: }
1260:
1261: free(executable_candidat);
1.5 bertrand 1262: }
1.1 bertrand 1263:
1264: if ((pipe = popen(commande, "r")) == NULL)
1265: {
1266: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1267: return;
1268: }
1269:
1270: if ((ios = pclose(pipe)) != EXIT_SUCCESS)
1271: {
1272: liberation(s_etat_processus, s_objet);
1273: free(commande);
1274:
1275: (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
1276: return;
1277: }
1278: else if (ios == -1)
1279: {
1280: (*s_etat_processus).erreur_systeme = d_es_processus;
1281: return;
1282: }
1283:
1284: free(commande);
1285:
1286: nombre_caracteres_source = 0;
1287:
1288: if ((pipe = fopen(nom_fichier_temporaire, "r")) == NULL)
1289: {
1290: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1291: return;
1292: }
1293:
1294: while(getc(pipe) != EOF)
1295: {
1296: nombre_caracteres_source++;
1297: }
1298:
1299: if (nombre_caracteres_source == 0)
1300: {
1301: if (fclose(pipe) == -1)
1302: {
1303: (*s_etat_processus).erreur_systeme = d_es_processus;
1304: return;
1305: }
1306:
1307: liberation(s_etat_processus, s_objet);
1308:
1309: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1310: {
1311: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1312: return;
1313: }
1314:
1315: free(nom_fichier_temporaire);
1316:
1317: (*s_etat_processus).erreur_execution = d_ex_fichier_vide;
1318: return;
1319: }
1320:
1.7 bertrand 1321: if ((chaine = malloc((nombre_caracteres_source + 1)
1.1 bertrand 1322: * sizeof(unsigned char))) == NULL)
1323: {
1324: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1325: return;
1326: }
1327:
1328: rewind(pipe);
1329:
1330: i = 0;
1.7 bertrand 1331: drapeau_fin = d_faux;
1332: presence_chaine = d_faux;
1333:
1334: while(drapeau_fin == d_faux)
1.1 bertrand 1335: {
1.7 bertrand 1336: if ((caractere = getc(pipe)) != EOF)
1.1 bertrand 1337: {
1.7 bertrand 1338: if ((caractere == d_code_retour_chariot) ||
1339: (caractere == d_code_tabulation) ||
1340: ((caractere == d_code_espace) &&
1341: (presence_chaine == d_faux)))
1.1 bertrand 1342: {
1.7 bertrand 1343: do
1344: {
1345: caractere = getc(pipe);
1346: } while(((caractere == d_code_retour_chariot) ||
1347: (caractere == d_code_tabulation) ||
1348: ((caractere == d_code_espace) &&
1349: (presence_chaine == d_faux))) &&
1350: (caractere != EOF));
1351:
1352: if (caractere != EOF)
1353: {
1354: chaine[i++] = d_code_espace;
1355: }
1356: else
1357: {
1358: drapeau_fin = d_vrai;
1359: }
1360: }
1.1 bertrand 1361:
1.7 bertrand 1362: if ((chaine[i] = caractere) == '\"')
1.1 bertrand 1363: {
1.7 bertrand 1364: if (i > 0)
1365: {
1366: if (chaine[i - 1] != '\\')
1367: {
1368: presence_chaine = (presence_chaine == d_faux)
1369: ? d_vrai : d_faux;
1370: }
1371: }
1372:
1373: i++;
1.1 bertrand 1374: }
1.7 bertrand 1375: else
1376: {
1377: i++;
1378: }
1379: }
1380: else
1381: {
1382: drapeau_fin = d_vrai;
1.1 bertrand 1383: }
1384: }
1385:
1.7 bertrand 1386: if ((caractere == EOF) && (i > 0))
1.1 bertrand 1387: {
1388: i--;
1389: }
1390:
1.7 bertrand 1391: chaine[i] = d_code_fin_chaine;
1.1 bertrand 1392:
1393: if (fclose(pipe) != 0)
1394: {
1395: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1396: return;
1397: }
1398:
1.7 bertrand 1399: indicateur_48 = test_cfsf(s_etat_processus, 48);
1400: cf(s_etat_processus, 48);
1401:
1402: tampon_definitions_chainees = (*s_etat_processus).definitions_chainees;
1403: tampon_instruction_courante = (*s_etat_processus).instruction_courante;
1404: position_courante = (*s_etat_processus).position_courante;
1405: autorisation_empilement_programme = (*s_etat_processus)
1406: .autorisation_empilement_programme;
1407:
1408: (*s_etat_processus).instruction_courante = NULL;
1409:
1410: if (((*s_etat_processus).definitions_chainees = transliteration(
1411: s_etat_processus, chaine, "UTF-8", d_locale)) == NULL)
1.1 bertrand 1412: {
1.7 bertrand 1413: if (indicateur_48 == d_vrai)
1414: {
1415: sf(s_etat_processus, 48);
1416: }
1417: else
1418: {
1419: cf(s_etat_processus, 48);
1420: }
1421:
1422: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1423: {
1424: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1425: return;
1426: }
1427:
1.1 bertrand 1428: free(nom_fichier_temporaire);
1.7 bertrand 1429: free((*s_etat_processus).instruction_courante);
1430: free(chaine);
1431:
1432: (*s_etat_processus).position_courante = position_courante;
1433: (*s_etat_processus).instruction_courante =
1434: tampon_instruction_courante;
1435: (*s_etat_processus).definitions_chainees =
1436: tampon_definitions_chainees;
1437: (*s_etat_processus).autorisation_empilement_programme =
1438: autorisation_empilement_programme;
1439:
1440: liberation(s_etat_processus, s_objet);
1.1 bertrand 1441: return;
1442: }
1443:
1.7 bertrand 1444: (*s_etat_processus).autorisation_empilement_programme = 'Y';
1445: (*s_etat_processus).position_courante = 0;
1446:
1447: if (analyse_syntaxique(s_etat_processus) == d_erreur)
1448: {
1449: if (indicateur_48 == d_vrai)
1450: {
1451: sf(s_etat_processus, 48);
1452: }
1453: else
1454: {
1455: cf(s_etat_processus, 48);
1456: }
1457:
1458: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1459: {
1460: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1461: return;
1462: }
1463:
1464: free(nom_fichier_temporaire);
1465: free((*s_etat_processus).instruction_courante);
1466: free((*s_etat_processus).definitions_chainees);
1467: free(chaine);
1468:
1469: (*s_etat_processus).position_courante = position_courante;
1470: (*s_etat_processus).instruction_courante =
1471: tampon_instruction_courante;
1472: (*s_etat_processus).definitions_chainees =
1473: tampon_definitions_chainees;
1474: (*s_etat_processus).autorisation_empilement_programme =
1475: autorisation_empilement_programme;
1476:
1477: liberation(s_etat_processus, s_objet);
1478: return;
1479: }
1480:
1481: (*s_etat_processus).position_courante = 0;
1482:
1483: if (recherche_instruction_suivante(s_etat_processus) !=
1484: d_absence_erreur)
1485: {
1486: if (indicateur_48 == d_vrai)
1487: {
1488: sf(s_etat_processus, 48);
1489: }
1490: else
1491: {
1492: cf(s_etat_processus, 48);
1493: }
1494:
1495: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1496: {
1497: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1498: return;
1499: }
1500:
1501: free(nom_fichier_temporaire);
1502: free((*s_etat_processus).instruction_courante);
1503: free((*s_etat_processus).definitions_chainees);
1504: free(chaine);
1505:
1506: (*s_etat_processus).position_courante = position_courante;
1507: (*s_etat_processus).instruction_courante =
1508: tampon_instruction_courante;
1509: (*s_etat_processus).definitions_chainees =
1510: tampon_definitions_chainees;
1511: (*s_etat_processus).autorisation_empilement_programme =
1512: autorisation_empilement_programme;
1513:
1514: liberation(s_etat_processus, s_objet);
1515: return;
1516: }
1517:
1518: recherche_type(s_etat_processus);
1519:
1520: while((*s_etat_processus).definitions_chainees
1521: [(*s_etat_processus).position_courante] != d_code_fin_chaine)
1522: {
1523: if ((*s_etat_processus).definitions_chainees
1524: [(*s_etat_processus).position_courante++] != d_code_espace)
1525: {
1526: (*s_etat_processus).erreur_execution = d_ex_syntaxe;
1527: }
1528: }
1529:
1530: free((*s_etat_processus).instruction_courante);
1531: free((*s_etat_processus).definitions_chainees);
1532: free(chaine);
1533:
1534: (*s_etat_processus).position_courante = position_courante;
1535: (*s_etat_processus).instruction_courante =
1536: tampon_instruction_courante;
1537: (*s_etat_processus).definitions_chainees =
1538: tampon_definitions_chainees;
1539: (*s_etat_processus).autorisation_empilement_programme =
1540: autorisation_empilement_programme;
1541:
1542: if (indicateur_48 == d_vrai)
1543: {
1544: sf(s_etat_processus, 48);
1545: }
1546: else
1547: {
1548: cf(s_etat_processus, 48);
1549: }
1.1 bertrand 1550:
1551: if (destruction_fichier(nom_fichier_temporaire) == d_erreur)
1552: {
1553: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
1554: return;
1555: }
1556:
1557: free(nom_fichier_temporaire);
1558: }
1559: else
1560: {
1561: liberation(s_etat_processus, s_objet);
1562:
1563: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1564: return;
1565: }
1566:
1567: liberation(s_etat_processus, s_objet);
1568: return;
1569: }
1570:
1571:
1572: /*
1573: ================================================================================
1574: Fonction 'rcws'
1575: ================================================================================
1576: Entrées : pointeur sur une structure struct_processus
1577: --------------------------------------------------------------------------------
1578: Sorties :
1579: --------------------------------------------------------------------------------
1580: Effets de bord : néant
1581: ================================================================================
1582: */
1583:
1584: void
1585: instruction_rcws(struct_processus *s_etat_processus)
1586: {
1587: struct_objet *s_objet_resultat;
1588:
1589: unsigned long i;
1590: unsigned long j;
1591: unsigned long longueur;
1592:
1593: (*s_etat_processus).erreur_execution = d_ex;
1594:
1595: if ((*s_etat_processus).affichage_arguments == 'Y')
1596: {
1597: printf("\n RCWS ");
1598:
1599: if ((*s_etat_processus).langue == 'F')
1600: {
1601: printf("(rappel de la longueur des entiers binaires)\n\n");
1602: }
1603: else
1604: {
1605: printf("(recall the length of the binary integers)\n\n");
1606: }
1607:
1608: printf("-> 1: %s\n", d_INT);
1609:
1610: return;
1611: }
1612: else if ((*s_etat_processus).test_instruction == 'Y')
1613: {
1614: (*s_etat_processus).nombre_arguments = -1;
1615: return;
1616: }
1617:
1618: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1619: {
1620: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1621: {
1622: return;
1623: }
1624: }
1625:
1626: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1627: {
1628: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1629: return;
1630: }
1631:
1632: longueur = 1;
1633: j = 1;
1634:
1635: for(i = 37; i <= 42; i++)
1636: {
1637: longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
1638: == d_vrai) ? j : 0;
1639: j *= 2;
1640: }
1641:
1642: (*((integer8 *) (*s_objet_resultat).objet)) = longueur;
1643:
1644: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1645: s_objet_resultat) == d_erreur)
1646: {
1647: return;
1648: }
1649:
1650: return;
1651: }
1652:
1653:
1654: /*
1655: ================================================================================
1656: Fonction 'rcls'
1657: ================================================================================
1658: Entrées : pointeur sur une structure struct_processus
1659: --------------------------------------------------------------------------------
1660: Sorties :
1661: --------------------------------------------------------------------------------
1662: Effets de bord : néant
1663: ================================================================================
1664: */
1665:
1666: void
1667: instruction_rcls(struct_processus *s_etat_processus)
1668: {
1669: struct_objet *s_objet_variable;
1670:
1671: (*s_etat_processus).erreur_execution = d_ex;
1672:
1673: if ((*s_etat_processus).affichage_arguments == 'Y')
1674: {
1675: printf("\n RCLS ");
1676:
1677: if ((*s_etat_processus).langue == 'F')
1678: {
1679: printf("(rappel de la variable %s)\n\n", ds_sdat);
1680: }
1681: else
1682: {
1683: printf("(recall %s variable)\n\n", ds_sdat);
1684: }
1685:
1686: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
1687: " %s, %s, %s, %s, %s,\n"
1688: " %s, %s, %s, %s, %s,\n"
1689: " %s\n",
1690: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1691: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
1692:
1693: return;
1694: }
1695: else if ((*s_etat_processus).test_instruction == 'Y')
1696: {
1697: (*s_etat_processus).nombre_arguments = -1;
1698: return;
1699: }
1700:
1701: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1702: {
1703: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1704: {
1705: return;
1706: }
1707: }
1708:
1.26 bertrand 1709: if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
1.1 bertrand 1710: {
1.26 bertrand 1711: (*s_etat_processus).erreur_systeme = d_es;
1.1 bertrand 1712:
1.26 bertrand 1713: if ((*s_etat_processus).erreur_execution == d_ex)
1.1 bertrand 1714: {
1715: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
1716: }
1717:
1718: return;
1719: }
1720:
1721: if ((s_objet_variable = copie_objet(s_etat_processus,
1.26 bertrand 1722: (*(*s_etat_processus).pointeur_variable_courante).objet, 'O'))
1.1 bertrand 1723: == NULL)
1724: {
1725: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1726: return;
1727: }
1728:
1729: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1730: s_objet_variable) == d_erreur)
1731: {
1732: return;
1733: }
1734:
1735: return;
1736: }
1737:
1738: // 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