1: /*
2: ================================================================================
3: RPL/2 (R) version 4.0.15
4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl.conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction 'sin'
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_sin(struct_processus *s_etat_processus)
40: {
41: real8 angle;
42:
43: struct_liste_chainee *l_element_courant;
44: struct_liste_chainee *l_element_precedent;
45:
46: struct_objet *s_copie_argument;
47: struct_objet *s_objet_argument;
48: struct_objet *s_objet_resultat;
49:
50: (*s_etat_processus).erreur_execution = d_ex;
51:
52: if ((*s_etat_processus).affichage_arguments == 'Y')
53: {
54: printf("\n SIN ");
55:
56: if ((*s_etat_processus).langue == 'F')
57: {
58: printf("(sinus)\n\n");
59: }
60: else
61: {
62: printf("(sine)\n\n");
63: }
64:
65: printf(" 1: %s, %s\n", d_INT, d_REL);
66: printf("-> 1: %s\n\n", d_REL);
67:
68: printf(" 1: %s\n", d_CPL);
69: printf("-> 1: %s\n\n", d_CPL);
70:
71: printf(" 1: %s, %s\n", d_NOM, d_ALG);
72: printf("-> 1: %s\n\n", d_ALG);
73:
74: printf(" 1: %s\n", d_RPN);
75: printf("-> 1: %s\n", d_RPN);
76:
77: return;
78: }
79: else if ((*s_etat_processus).test_instruction == 'Y')
80: {
81: (*s_etat_processus).nombre_arguments = 1;
82: return;
83: }
84:
85: if (test_cfsf(s_etat_processus, 31) == d_vrai)
86: {
87: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
88: {
89: return;
90: }
91: }
92:
93: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
94: &s_objet_argument) == d_erreur)
95: {
96: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
97: return;
98: }
99:
100: /*
101: --------------------------------------------------------------------------------
102: Sinus d'un entier ou d'un réel
103: --------------------------------------------------------------------------------
104: */
105:
106: if (((*s_objet_argument).type == INT) ||
107: ((*s_objet_argument).type == REL))
108: {
109: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
110: {
111: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
112: return;
113: }
114:
115: if ((*s_objet_argument).type == INT)
116: {
117: angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
118: }
119: else
120: {
121: angle = (*((real8 *) (*s_objet_argument).objet));
122: }
123:
124: if (test_cfsf(s_etat_processus, 60) == d_faux)
125: {
126: conversion_degres_vers_radians(&angle);
127: }
128:
129: (*((real8 *) (*s_objet_resultat).objet)) = sin(angle);
130: }
131:
132: /*
133: --------------------------------------------------------------------------------
134: Sinus d'un complexe
135: --------------------------------------------------------------------------------
136: */
137:
138: else if ((*s_objet_argument).type == CPL)
139: {
140: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
141: {
142: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
143: return;
144: }
145:
146: f77sin_((struct_complexe16 *) (*s_objet_argument).objet,
147: (struct_complexe16 *) (*s_objet_resultat).objet);
148: }
149:
150: /*
151: --------------------------------------------------------------------------------
152: Sinus d'un nom
153: --------------------------------------------------------------------------------
154: */
155:
156: else if ((*s_objet_argument).type == NOM)
157: {
158: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
159: {
160: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
161: return;
162: }
163:
164: if (((*s_objet_resultat).objet =
165: allocation_maillon(s_etat_processus)) == NULL)
166: {
167: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
168: return;
169: }
170:
171: l_element_courant = (*s_objet_resultat).objet;
172:
173: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
174: == NULL)
175: {
176: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
177: return;
178: }
179:
180: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
181: .nombre_arguments = 0;
182: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
183: .fonction = instruction_vers_niveau_superieur;
184:
185: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
186: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
187: {
188: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
189: return;
190: }
191:
192: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
193: .nom_fonction, "<<");
194:
195: if (((*l_element_courant).suivant =
196: allocation_maillon(s_etat_processus)) == NULL)
197: {
198: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
199: return;
200: }
201:
202: l_element_courant = (*l_element_courant).suivant;
203: (*l_element_courant).donnee = s_objet_argument;
204:
205: if (((*l_element_courant).suivant =
206: allocation_maillon(s_etat_processus)) == NULL)
207: {
208: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
209: return;
210: }
211:
212: l_element_courant = (*l_element_courant).suivant;
213:
214: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
215: == NULL)
216: {
217: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
218: return;
219: }
220:
221: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
222: .nombre_arguments = 1;
223: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
224: .fonction = instruction_sin;
225:
226: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
227: .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
228: {
229: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
230: return;
231: }
232:
233: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
234: .nom_fonction, "SIN");
235:
236: if (((*l_element_courant).suivant =
237: allocation_maillon(s_etat_processus)) == NULL)
238: {
239: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
240: return;
241: }
242:
243: l_element_courant = (*l_element_courant).suivant;
244:
245: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
246: == NULL)
247: {
248: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
249: return;
250: }
251:
252: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
253: .nombre_arguments = 0;
254: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
255: .fonction = instruction_vers_niveau_inferieur;
256:
257: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
258: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
259: {
260: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
261: return;
262: }
263:
264: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
265: .nom_fonction, ">>");
266:
267: (*l_element_courant).suivant = NULL;
268: s_objet_argument = NULL;
269: }
270:
271: /*
272: --------------------------------------------------------------------------------
273: Sinus d'une expression
274: --------------------------------------------------------------------------------
275: */
276:
277: else if (((*s_objet_argument).type == ALG) ||
278: ((*s_objet_argument).type == RPN))
279: {
280: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
281: 'N')) == NULL)
282: {
283: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
284: return;
285: }
286:
287: l_element_courant = (struct_liste_chainee *)
288: (*s_copie_argument).objet;
289: l_element_precedent = l_element_courant;
290:
291: while((*l_element_courant).suivant != NULL)
292: {
293: l_element_precedent = l_element_courant;
294: l_element_courant = (*l_element_courant).suivant;
295: }
296:
297: if (((*l_element_precedent).suivant =
298: allocation_maillon(s_etat_processus)) == NULL)
299: {
300: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
301: return;
302: }
303:
304: if (((*(*l_element_precedent).suivant).donnee =
305: allocation(s_etat_processus, FCT)) == NULL)
306: {
307: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
308: return;
309: }
310:
311: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
312: .donnee).objet)).nombre_arguments = 1;
313: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
314: .donnee).objet)).fonction = instruction_sin;
315:
316: if (((*((struct_fonction *) (*(*(*l_element_precedent)
317: .suivant).donnee).objet)).nom_fonction =
318: malloc(4 * sizeof(unsigned char))) == NULL)
319: {
320: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
321: return;
322: }
323:
324: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
325: .suivant).donnee).objet)).nom_fonction, "SIN");
326:
327: (*(*l_element_precedent).suivant).suivant = l_element_courant;
328:
329: s_objet_resultat = s_copie_argument;
330: }
331:
332: /*
333: --------------------------------------------------------------------------------
334: Réalisation impossible de la fonction sinus
335: --------------------------------------------------------------------------------
336: */
337:
338: else
339: {
340: liberation(s_etat_processus, s_objet_argument);
341:
342: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
343: return;
344: }
345:
346: liberation(s_etat_processus, s_objet_argument);
347:
348: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
349: s_objet_resultat) == d_erreur)
350: {
351: return;
352: }
353:
354: return;
355: }
356:
357:
358: /*
359: ================================================================================
360: Fonction 'sinh'
361: ================================================================================
362: Entrées : pointeur sur une structure struct_processus
363: --------------------------------------------------------------------------------
364: Sorties :
365: --------------------------------------------------------------------------------
366: Effets de bord : néant
367: ================================================================================
368: */
369:
370: void
371: instruction_sinh(struct_processus *s_etat_processus)
372: {
373: real8 argument;
374:
375: struct_liste_chainee *l_element_courant;
376: struct_liste_chainee *l_element_precedent;
377:
378: struct_objet *s_copie_argument;
379: struct_objet *s_objet_argument;
380: struct_objet *s_objet_resultat;
381:
382: (*s_etat_processus).erreur_execution = d_ex;
383:
384: if ((*s_etat_processus).affichage_arguments == 'Y')
385: {
386: printf("\n SINH ");
387:
388: if ((*s_etat_processus).langue == 'F')
389: {
390: printf("(sinus hyperbolique)\n\n");
391: }
392: else
393: {
394: printf("(hyperbolic sine)\n\n");
395: }
396:
397: printf(" 1: %s, %s\n", d_INT, d_REL);
398: printf("-> 1: %s\n\n", d_INT);
399:
400: printf(" 1: %s\n", d_CPL);
401: printf("-> 1: %s\n\n", d_CPL);
402:
403: printf(" 1: %s, %s\n", d_NOM, d_ALG);
404: printf("-> 1: %s\n\n", d_ALG);
405:
406: printf(" 1: %s\n", d_RPN);
407: printf("-> 1: %s\n", d_RPN);
408:
409: return;
410: }
411: else if ((*s_etat_processus).test_instruction == 'Y')
412: {
413: (*s_etat_processus).nombre_arguments = 1;
414: return;
415: }
416:
417: if (test_cfsf(s_etat_processus, 31) == d_vrai)
418: {
419: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
420: {
421: return;
422: }
423: }
424:
425: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
426: &s_objet_argument) == d_erreur)
427: {
428: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
429: return;
430: }
431:
432: /*
433: --------------------------------------------------------------------------------
434: Sinus hyperbolique d'un entier ou d'un réel
435: --------------------------------------------------------------------------------
436: */
437:
438: if (((*s_objet_argument).type == INT) ||
439: ((*s_objet_argument).type == REL))
440: {
441: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
442: {
443: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
444: return;
445: }
446:
447: if ((*s_objet_argument).type == INT)
448: {
449: argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
450: }
451: else
452: {
453: argument = (*((real8 *) (*s_objet_argument).objet));
454: }
455:
456: (*((real8 *) (*s_objet_resultat).objet)) = sinh(argument);
457: }
458:
459: /*
460: --------------------------------------------------------------------------------
461: Sinus hyperbolique d'un complexe
462: --------------------------------------------------------------------------------
463: */
464:
465: else if ((*s_objet_argument).type == CPL)
466: {
467: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
468: {
469: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
470: return;
471: }
472:
473: f77sinh_((struct_complexe16 *) (*s_objet_argument).objet,
474: (struct_complexe16 *) (*s_objet_resultat).objet);
475: }
476:
477: /*
478: --------------------------------------------------------------------------------
479: Sinus hyperbolique d'un nom
480: --------------------------------------------------------------------------------
481: */
482:
483: else if ((*s_objet_argument).type == NOM)
484: {
485: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
486: {
487: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
488: return;
489: }
490:
491: if (((*s_objet_resultat).objet =
492: allocation_maillon(s_etat_processus)) == NULL)
493: {
494: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
495: return;
496: }
497:
498: l_element_courant = (*s_objet_resultat).objet;
499:
500: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
501: == NULL)
502: {
503: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
504: return;
505: }
506:
507: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
508: .nombre_arguments = 0;
509: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
510: .fonction = instruction_vers_niveau_inferieur;
511:
512: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
513: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
514: {
515: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
516: return;
517: }
518:
519: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
520: .nom_fonction, "<<");
521:
522: if (((*l_element_courant).suivant =
523: allocation_maillon(s_etat_processus)) == NULL)
524: {
525: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
526: return;
527: }
528:
529: l_element_courant = (*l_element_courant).suivant;
530: (*l_element_courant).donnee = s_objet_argument;
531:
532: if (((*l_element_courant).suivant =
533: allocation_maillon(s_etat_processus)) == NULL)
534: {
535: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
536: return;
537: }
538:
539: l_element_courant = (*l_element_courant).suivant;
540:
541: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
542: == NULL)
543: {
544: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
545: return;
546: }
547:
548: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
549: .nombre_arguments = 1;
550: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
551: .fonction = instruction_sinh;
552:
553: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
554: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
555: {
556: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
557: return;
558: }
559:
560: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
561: .nom_fonction, "SINH");
562:
563: if (((*l_element_courant).suivant =
564: allocation_maillon(s_etat_processus)) == NULL)
565: {
566: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
567: return;
568: }
569:
570: l_element_courant = (*l_element_courant).suivant;
571:
572: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
573: == NULL)
574: {
575: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
576: return;
577: }
578:
579: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
580: .nombre_arguments = 0;
581: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
582: .fonction = instruction_vers_niveau_inferieur;
583:
584: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
585: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
586: {
587: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
588: return;
589: }
590:
591: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
592: .nom_fonction, ">>");
593:
594: (*l_element_courant).suivant = NULL;
595: s_objet_argument = NULL;
596: }
597:
598: /*
599: --------------------------------------------------------------------------------
600: Sinus hyperbolique d'une expression
601: --------------------------------------------------------------------------------
602: */
603:
604: else if (((*s_objet_argument).type == ALG) ||
605: ((*s_objet_argument).type == RPN))
606: {
607: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
608: 'N')) == NULL)
609: {
610: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
611: return;
612: }
613:
614: l_element_courant = (struct_liste_chainee *)
615: (*s_copie_argument).objet;
616: l_element_precedent = l_element_courant;
617:
618: while((*l_element_courant).suivant != NULL)
619: {
620: l_element_precedent = l_element_courant;
621: l_element_courant = (*l_element_courant).suivant;
622: }
623:
624: if (((*l_element_precedent).suivant =
625: allocation_maillon(s_etat_processus)) == NULL)
626: {
627: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
628: return;
629: }
630:
631: if (((*(*l_element_precedent).suivant).donnee =
632: allocation(s_etat_processus, FCT)) == NULL)
633: {
634: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
635: return;
636: }
637:
638: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
639: .donnee).objet)).nombre_arguments = 1;
640: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
641: .donnee).objet)).fonction = instruction_sinh;
642:
643: if (((*((struct_fonction *) (*(*(*l_element_precedent)
644: .suivant).donnee).objet)).nom_fonction =
645: malloc(5 * sizeof(unsigned char))) == NULL)
646: {
647: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
648: return;
649: }
650:
651: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
652: .suivant).donnee).objet)).nom_fonction, "SINH");
653:
654: (*(*l_element_precedent).suivant).suivant = l_element_courant;
655:
656: s_objet_resultat = s_copie_argument;
657: }
658:
659: /*
660: --------------------------------------------------------------------------------
661: Réalisation impossible de la fonction sinus hyperbolique
662: --------------------------------------------------------------------------------
663: */
664:
665: else
666: {
667: liberation(s_etat_processus, s_objet_argument);
668:
669: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
670: return;
671: }
672:
673: liberation(s_etat_processus, s_objet_argument);
674:
675: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
676: s_objet_resultat) == d_erreur)
677: {
678: return;
679: }
680:
681: return;
682: }
683:
684:
685: /*
686: ================================================================================
687: Fonction 'size'
688: ================================================================================
689: Entrées : pointeur sur une structure struct_processus
690: --------------------------------------------------------------------------------
691: Sorties :
692: --------------------------------------------------------------------------------
693: Effets de bord : néant
694: ================================================================================
695: */
696:
697: void
698: instruction_size(struct_processus *s_etat_processus)
699: {
700: struct_liste_chainee *l_element_courant;
701:
702: struct_objet *s_objet_argument;
703: struct_objet *s_objet_resultat;
704:
705: (*s_etat_processus).erreur_execution = d_ex;
706:
707: if ((*s_etat_processus).affichage_arguments == 'Y')
708: {
709: printf("\n SIZE ");
710:
711: if ((*s_etat_processus).langue == 'F')
712: {
713: printf("(taille d'un objet)\n\n");
714: }
715: else
716: {
717: printf("(object size)\n\n");
718: }
719:
720: printf(" 1: %s, %s, %s, %s\n", d_CHN, d_LST, d_ALG, d_TAB);
721: printf("-> 1: %s\n\n", d_INT);
722:
723: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
724: printf("-> 1: %s\n\n", d_LST);
725:
726: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
727: printf("-> 1: %s\n", d_LST);
728:
729: return;
730: }
731: else if ((*s_etat_processus).test_instruction == 'Y')
732: {
733: (*s_etat_processus).nombre_arguments = -1;
734: return;
735: }
736:
737: if (test_cfsf(s_etat_processus, 31) == d_vrai)
738: {
739: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
740: {
741: return;
742: }
743: }
744:
745: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
746: &s_objet_argument) == d_erreur)
747: {
748: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
749: return;
750: }
751:
752: /*
753: --------------------------------------------------------------------------------
754: Chaîne de caractères
755: --------------------------------------------------------------------------------
756: */
757:
758: if ((*s_objet_argument).type == CHN)
759: {
760: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
761: {
762: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
763: return;
764: }
765:
766: (*((integer8 *) (*s_objet_resultat).objet)) =
767: strlen((unsigned char *) (*s_objet_argument).objet);
768: }
769:
770: /*
771: --------------------------------------------------------------------------------
772: Liste
773: --------------------------------------------------------------------------------
774: */
775:
776: else if ((*s_objet_argument).type == LST)
777: {
778: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
779: {
780: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
781: return;
782: }
783:
784: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
785: l_element_courant = (*s_objet_argument).objet;
786:
787: while(l_element_courant != NULL)
788: {
789: (*((integer8 *) (*s_objet_resultat).objet))++;
790: l_element_courant = (*l_element_courant).suivant;
791: }
792: }
793:
794: /*
795: --------------------------------------------------------------------------------
796: Expression algébrique
797: --------------------------------------------------------------------------------
798: */
799:
800: else if ((*s_objet_argument).type == ALG)
801: {
802: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
803: {
804: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
805: return;
806: }
807:
808: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
809: l_element_courant = (*s_objet_argument).objet;
810:
811: while(l_element_courant != NULL)
812: {
813: (*((integer8 *) (*s_objet_resultat).objet))++;
814: l_element_courant = (*l_element_courant).suivant;
815: }
816:
817: (*((integer8 *) (*s_objet_resultat).objet)) -= 2;
818: }
819:
820: /*
821: --------------------------------------------------------------------------------
822: Table
823: --------------------------------------------------------------------------------
824: */
825:
826: else if ((*s_objet_argument).type == TBL)
827: {
828: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
829: {
830: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
831: return;
832: }
833:
834: (*((integer8 *) (*s_objet_resultat).objet)) = (*((struct_tableau *)
835: (*s_objet_argument).objet)).nombre_elements;
836: }
837:
838: /*
839: --------------------------------------------------------------------------------
840: Vecteur
841: --------------------------------------------------------------------------------
842: */
843:
844: else if (((*s_objet_argument).type == VIN) ||
845: ((*s_objet_argument).type == VRL) ||
846: ((*s_objet_argument).type == VCX))
847: {
848: if ((s_objet_resultat = allocation(s_etat_processus, LST)) == NULL)
849: {
850: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
851: return;
852: }
853:
854: if (((*s_objet_resultat).objet =
855: allocation_maillon(s_etat_processus)) == NULL)
856: {
857: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
858: return;
859: }
860:
861: l_element_courant = (*s_objet_resultat).objet;
862: (*l_element_courant).suivant = NULL;
863:
864: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
865: == NULL)
866: {
867: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
868: return;
869: }
870:
871: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
872: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
873: }
874:
875: /*
876: --------------------------------------------------------------------------------
877: Matrice
878: --------------------------------------------------------------------------------
879: */
880:
881: else if (((*s_objet_argument).type == MIN) ||
882: ((*s_objet_argument).type == MRL) ||
883: ((*s_objet_argument).type == MCX))
884: {
885: if ((s_objet_resultat = allocation(s_etat_processus, LST)) == NULL)
886: {
887: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
888: return;
889: }
890:
891: if (((*s_objet_resultat).objet =
892: allocation_maillon(s_etat_processus)) == NULL)
893: {
894: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
895: return;
896: }
897:
898: l_element_courant = (*s_objet_resultat).objet;
899:
900: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
901: == NULL)
902: {
903: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
904: return;
905: }
906:
907: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
908: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
909:
910: if (((*l_element_courant).suivant =
911: allocation_maillon(s_etat_processus)) == NULL)
912: {
913: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
914: return;
915: }
916:
917: l_element_courant = (*l_element_courant).suivant;
918: (*l_element_courant).suivant = NULL;
919:
920: if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
921: == NULL)
922: {
923: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
924: return;
925: }
926:
927: (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
928: (*((struct_matrice *) (*s_objet_argument).objet))
929: .nombre_colonnes;
930: }
931:
932: /*
933: --------------------------------------------------------------------------------
934: Type d'argument invalide
935: --------------------------------------------------------------------------------
936: */
937:
938: else
939: {
940: liberation(s_etat_processus, s_objet_argument);
941:
942: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
943: return;
944: }
945:
946: liberation(s_etat_processus, s_objet_argument);
947:
948: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
949: s_objet_resultat) == d_erreur)
950: {
951: return;
952: }
953:
954: return;
955: }
956:
957:
958: /*
959: ================================================================================
960: Fonction 'sst'
961: ================================================================================
962: Entrées : pointeur sur une structure struct_processus
963: --------------------------------------------------------------------------------
964: Sorties :
965: --------------------------------------------------------------------------------
966: Effets de bord : néant
967: ================================================================================
968: */
969:
970: void
971: instruction_sst(struct_processus *s_etat_processus)
972: {
973: (*s_etat_processus).erreur_execution = d_ex;
974:
975: if ((*s_etat_processus).affichage_arguments == 'Y')
976: {
977: printf("\n SST ");
978:
979: if ((*s_etat_processus).langue == 'F')
980: {
981: printf("(avance d'un pas)\n\n");
982: printf(" Aucun argument\n");
983: }
984: else
985: {
986: printf("(single step)\n\n");
987: printf(" No argument\n");
988: }
989:
990: return;
991: }
992: else if ((*s_etat_processus).test_instruction == 'Y')
993: {
994: (*s_etat_processus).nombre_arguments = -1;
995: return;
996: }
997:
998: if ((*s_etat_processus).traitement_instruction_halt == d_vrai)
999: {
1000: (*s_etat_processus).execution_pas_suivant = d_vrai;
1001: }
1002:
1003: return;
1004: }
1005:
1006:
1007: /*
1008: ================================================================================
1009: Fonction 'str->'
1010: ================================================================================
1011: Entrées : pointeur sur une structure struct_processus
1012: --------------------------------------------------------------------------------
1013: Sorties :
1014: --------------------------------------------------------------------------------
1015: Effets de bord : néant
1016: ================================================================================
1017: */
1018:
1019: void
1020: instruction_str_fleche(struct_processus *s_etat_processus)
1021: {
1022: logical1 drapeau45;
1023: logical1 presence_chaine;
1024:
1025: struct_objet *s_objet;
1026: struct_objet *s_sous_objet;
1027:
1028: unsigned char *commande;
1029: unsigned char *chaine_convertie;
1030: unsigned char *ptr_e;
1031: unsigned char *ptr_l;
1032: unsigned char *registre_definitions_chainees;
1033: unsigned char *registre_instruction_courante;
1034: unsigned char registre_interruption;
1035: unsigned char *tampon;
1036:
1037: unsigned long nombre_caracteres_supplementaires;
1038: unsigned long position_courante;
1039:
1040: (*s_etat_processus).erreur_execution = d_ex;
1041:
1042: if ((*s_etat_processus).affichage_arguments == 'Y')
1043: {
1044: printf("\n STR-> ");
1045:
1046: if ((*s_etat_processus).langue == 'F')
1047: {
1048: printf("(conversion d'une chaîne)\n\n");
1049: }
1050: else
1051: {
1052: printf("(conversion from a string of chars)\n\n");
1053: }
1054:
1055: printf(" 1: %s\n", d_INT);
1056: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
1057: " %s, %s, %s, %s, %s,\n"
1058: " %s, %s, %s, %s, %s,\n"
1059: " %s\n",
1060: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1061: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
1062: printf(" ...\n");
1063: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
1064: " %s, %s, %s, %s, %s,\n"
1065: " %s, %s, %s, %s, %s,\n"
1066: " %s\n",
1067: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1068: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
1069:
1070: return;
1071: }
1072: else if ((*s_etat_processus).test_instruction == 'Y')
1073: {
1074: (*s_etat_processus).nombre_arguments = -1;
1075: return;
1076: }
1077:
1078: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1079: {
1080: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1081: {
1082: return;
1083: }
1084: }
1085:
1086: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1087: &s_objet) == d_erreur)
1088: {
1089: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1090: return;
1091: }
1092:
1093: if ((*s_objet).type == CHN)
1094: {
1095: // Comptage des caractères à protéger.
1096:
1097: drapeau45 = test_cfsf(s_etat_processus, 45);
1098: cf(s_etat_processus, 45);
1099:
1100: tampon = formateur(s_etat_processus, 0, s_objet);
1101:
1102: if (drapeau45 == d_vrai)
1103: {
1104: sf(s_etat_processus, 45);
1105: }
1106: else
1107: {
1108: cf(s_etat_processus, 45);
1109: }
1110:
1111: ptr_l = tampon;
1112: presence_chaine = d_faux;
1113: nombre_caracteres_supplementaires = 0;
1114:
1115: while((*ptr_l) != d_code_fin_chaine)
1116: {
1117: if ((*ptr_l) == '"')
1118: {
1119: presence_chaine = (presence_chaine == d_faux) ? d_vrai : d_faux;
1120: }
1121:
1122: if (presence_chaine == d_vrai)
1123: {
1124: switch(*ptr_l)
1125: {
1126: case '\\':
1127: case '\t':
1128: case '\b':
1129: case '\n':
1130: {
1131: nombre_caracteres_supplementaires++;
1132: break;
1133: }
1134: }
1135: }
1136: else
1137: {
1138: switch(*ptr_l)
1139: {
1140: case '\n':
1141: case '\b':
1142: case '\t':
1143: {
1144: nombre_caracteres_supplementaires--;
1145: break;
1146: }
1147: }
1148: }
1149:
1150: ptr_l++;
1151: }
1152:
1153: // Échappement des caractères et remplacement dans les chaînes
1154: // de caractères incluses. Le seul caractère protégé est le '\'
1155: // qui est doublé.
1156:
1157: if ((chaine_convertie = malloc((strlen(tampon) +
1158: nombre_caracteres_supplementaires + 1) * sizeof(unsigned char)))
1159: == NULL)
1160: {
1161: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1162: return;
1163: }
1164:
1165: ptr_l = tampon;
1166: ptr_e = chaine_convertie;
1167: presence_chaine = d_faux;
1168:
1169: while((*ptr_l) != d_code_fin_chaine)
1170: {
1171: if ((*ptr_l) == '"')
1172: {
1173: presence_chaine = (presence_chaine == d_faux) ? d_vrai : d_faux;
1174: }
1175:
1176: (*ptr_e) = (*ptr_l);
1177:
1178: if (presence_chaine == d_vrai)
1179: {
1180: switch(*ptr_l)
1181: {
1182: case '\\':
1183: {
1184: (*(++ptr_e)) = '\\';
1185: break;
1186: }
1187:
1188: case '\t':
1189: {
1190: (*ptr_e) = '\\';
1191: (*(++ptr_e)) = 't';
1192: break;
1193: }
1194:
1195: case '\b':
1196: {
1197: (*ptr_e) = '\\';
1198: (*(++ptr_e)) = 'b';
1199: break;
1200: }
1201:
1202: case '\n':
1203: {
1204: (*ptr_e) = '\\';
1205: (*(++ptr_e)) = 'n';
1206: break;
1207: }
1208: }
1209: }
1210: else
1211: {
1212: switch(*ptr_l)
1213: {
1214: case '\n':
1215: case '\b':
1216: case '\t':
1217: {
1218: ptr_e--;
1219: break;
1220: }
1221: }
1222: }
1223:
1224: ptr_l++;
1225: ptr_e++;
1226: }
1227:
1228: (*ptr_e) = d_code_fin_chaine;
1229:
1230: position_courante = (*s_etat_processus).position_courante;
1231: registre_definitions_chainees = (*s_etat_processus)
1232: .definitions_chainees;
1233: registre_instruction_courante = (*s_etat_processus)
1234: .instruction_courante;
1235: (*s_etat_processus).position_courante = 0;
1236: (*s_etat_processus).definitions_chainees = chaine_convertie;
1237: free(tampon);
1238:
1239: if ((*s_etat_processus).definitions_chainees == NULL)
1240: {
1241: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1242: return;
1243: }
1244:
1245: if (analyse_syntaxique(s_etat_processus) == d_absence_erreur)
1246: {
1247: if ((commande = malloc((strlen((unsigned char *)
1248: (*s_objet).objet) + 7) * sizeof(unsigned char))) == NULL)
1249: {
1250: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1251: return;
1252: }
1253:
1254: sprintf(commande, "<< %s >>", (*s_etat_processus)
1255: .definitions_chainees);
1256: (*s_etat_processus).instruction_courante = commande;
1257:
1258: recherche_type(s_etat_processus);
1259:
1260: if ((*s_etat_processus).erreur_execution != d_ex)
1261: {
1262: liberation(s_etat_processus, s_objet);
1263:
1264: free((*s_etat_processus).definitions_chainees);
1265: free((*s_etat_processus).instruction_courante);
1266:
1267: (*s_etat_processus).definitions_chainees =
1268: registre_definitions_chainees;
1269: (*s_etat_processus).instruction_courante =
1270: registre_instruction_courante;
1271: (*s_etat_processus).position_courante =
1272: position_courante;
1273:
1274: return;
1275: }
1276:
1277: if (depilement(s_etat_processus, &((*s_etat_processus)
1278: .l_base_pile), &s_sous_objet) == d_erreur)
1279: {
1280: liberation(s_etat_processus, s_objet);
1281: free((*s_etat_processus).definitions_chainees);
1282: free((*s_etat_processus).instruction_courante);
1283:
1284: (*s_etat_processus).definitions_chainees =
1285: registre_definitions_chainees;
1286: (*s_etat_processus).instruction_courante =
1287: registre_instruction_courante;
1288: (*s_etat_processus).position_courante =
1289: position_courante;
1290:
1291: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1292: return;
1293: }
1294:
1295: registre_interruption = (*s_etat_processus)
1296: .traitement_interruptible;
1297: (*s_etat_processus).traitement_interruptible = 'N';
1298:
1299: if (evaluation(s_etat_processus, s_sous_objet, 'I') == d_erreur)
1300: {
1301: liberation(s_etat_processus, s_sous_objet);
1302: liberation(s_etat_processus, s_objet);
1303:
1304: free((*s_etat_processus).definitions_chainees);
1305: free((*s_etat_processus).instruction_courante);
1306:
1307: (*s_etat_processus).definitions_chainees =
1308: registre_definitions_chainees;
1309: (*s_etat_processus).instruction_courante =
1310: registre_instruction_courante;
1311: (*s_etat_processus).position_courante =
1312: position_courante;
1313:
1314: (*s_etat_processus).traitement_interruptible =
1315: registre_interruption;
1316:
1317: if ((*s_etat_processus).erreur_systeme == d_es)
1318: {
1319: (*s_etat_processus).erreur_execution =
1320: d_ex_expression_invalide;
1321: }
1322: else
1323: {
1324: (*s_etat_processus).erreur_systeme =
1325: d_es_allocation_memoire;
1326: }
1327:
1328: return;
1329: }
1330: }
1331: else
1332: {
1333: liberation(s_etat_processus, s_objet);
1334:
1335: free((*s_etat_processus).definitions_chainees);
1336: free((*s_etat_processus).instruction_courante);
1337:
1338: (*s_etat_processus).definitions_chainees =
1339: registre_definitions_chainees;
1340: (*s_etat_processus).instruction_courante =
1341: registre_instruction_courante;
1342: (*s_etat_processus).position_courante =
1343: position_courante;
1344:
1345: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1346:
1347: return;
1348: }
1349:
1350:
1351: (*s_etat_processus).traitement_interruptible =
1352: registre_interruption;
1353:
1354: liberation(s_etat_processus, s_sous_objet);
1355:
1356: free((*s_etat_processus).definitions_chainees);
1357: free((*s_etat_processus).instruction_courante);
1358:
1359: (*s_etat_processus).definitions_chainees =
1360: registre_definitions_chainees;
1361: (*s_etat_processus).instruction_courante =
1362: registre_instruction_courante;
1363: (*s_etat_processus).position_courante =
1364: position_courante;
1365: }
1366: else
1367: {
1368: liberation(s_etat_processus, s_objet);
1369:
1370: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1371: return;
1372: }
1373:
1374: liberation(s_etat_processus, s_objet);
1375:
1376: return;
1377: }
1378:
1379: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_s2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src