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