1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.0
4: Copyright (C) 1989-2011 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 'rad'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_rad(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 RAD ");
46:
47: if ((*s_etat_processus).langue == 'F')
48: {
49: printf("(arguments en radians)\n\n");
50: printf(" Aucun argument\n");
51: }
52: else
53: {
54: printf("(radians)\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: sf(s_etat_processus, 60);
67:
68: return;
69: }
70:
71:
72: /*
73: ================================================================================
74: Fonction 'roll'
75: ================================================================================
76: Entrées : structure processus
77: --------------------------------------------------------------------------------
78: Sorties :
79: --------------------------------------------------------------------------------
80: Effets de bord : néant
81: ================================================================================
82: */
83:
84: void
85: instruction_roll(struct_processus *s_etat_processus)
86: {
87: struct_liste_chainee *l_liste1;
88: struct_liste_chainee *l_liste2;
89:
90: struct_objet *s_objet;
91:
92: unsigned long i;
93:
94: (*s_etat_processus).erreur_execution = d_ex;
95:
96: if ((*s_etat_processus).affichage_arguments == 'Y')
97: {
98: printf("\n ROLL ");
99:
100: if ((*s_etat_processus).langue == 'F')
101: {
102: printf("(défilement d'un objet vers le haut)\n\n");
103: }
104: else
105: {
106: printf("(roll up objects on stack)\n\n");
107: }
108:
109: printf(" n+1: %s, %s, %s, %s, %s, %s,\n"
110: " %s, %s, %s, %s, %s,\n"
111: " %s, %s, %s, %s, %s,\n"
112: " %s, %s, %s, %s,\n"
113: " %s, %s\n",
114: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
115: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
116: d_SQL, d_SLB, d_PRC, d_MTX);
117: printf(" ...\n");
118: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
119: " %s, %s, %s, %s, %s,\n"
120: " %s, %s, %s, %s, %s,\n"
121: " %s, %s, %s, %s,\n"
122: " %s, %s\n",
123: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
124: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
125: d_SQL, d_SLB, d_PRC, d_MTX);
126: printf(" 1: %s\n", d_INT);
127: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
128: " %s, %s, %s, %s, %s,\n"
129: " %s, %s, %s, %s, %s,\n"
130: " %s, %s, %s, %s,\n"
131: " %s, %s\n",
132: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
133: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
134: d_SQL, d_SLB, d_PRC, d_MTX);
135: printf(" ...\n");
136: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
137: " %s, %s, %s, %s, %s,\n"
138: " %s, %s, %s, %s, %s,\n"
139: " %s, %s, %s, %s,\n"
140: " %s, %s\n",
141: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
142: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
143: d_SQL, d_SLB, d_PRC, d_MTX);
144:
145: return;
146: }
147: else if ((*s_etat_processus).test_instruction == 'Y')
148: {
149: (*s_etat_processus).nombre_arguments = -1;
150: return;
151: }
152:
153: if (test_cfsf(s_etat_processus, 31) == d_vrai)
154: {
155: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
156: {
157: return;
158: }
159: }
160:
161: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
162: &s_objet) == d_erreur)
163: {
164: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
165: return;
166: }
167:
168: if ((*s_objet).type != INT)
169: {
170: liberation(s_etat_processus, s_objet);
171:
172: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
173: return;
174: }
175:
176: if ((*((integer8 *) (*s_objet).objet)) <= 0)
177: {
178:
179: /*
180: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
181: */
182:
183: liberation(s_etat_processus, s_objet);
184:
185: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
186: return;
187: }
188:
189: if ((*((integer8 *) (*s_objet).objet)) > (integer8) (*s_etat_processus)
190: .hauteur_pile_operationnelle)
191: {
192: liberation(s_etat_processus, s_objet);
193:
194: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
195: return;
196: }
197:
198: if ((*((integer8 *) (*s_objet).objet)) > 1)
199: {
200: l_liste1 = (*s_etat_processus).l_base_pile;
201:
202: for(i = 2; i < (unsigned long) (*((integer8 *) (*s_objet).objet)); i++)
203: {
204: l_liste1 = (*l_liste1).suivant;
205: }
206:
207: l_liste2 = (*l_liste1).suivant;
208: (*l_liste1).suivant = (*l_liste2).suivant;
209: (*l_liste2).suivant = (*s_etat_processus).l_base_pile;
210: (*s_etat_processus).l_base_pile = l_liste2;
211: }
212:
213: liberation(s_etat_processus, s_objet);
214:
215: return;
216: }
217:
218:
219: /*
220: ================================================================================
221: Fonction 'rolld'
222: ================================================================================
223: Entrées : structure processus
224: --------------------------------------------------------------------------------
225: Sorties :
226: --------------------------------------------------------------------------------
227: Effets de bord : néant
228: ================================================================================
229: */
230:
231: void
232: instruction_rolld(struct_processus *s_etat_processus)
233: {
234: struct_liste_chainee *l_liste1;
235: struct_liste_chainee *l_liste2;
236:
237: struct_objet *s_objet;
238:
239: unsigned long i;
240:
241: (*s_etat_processus).erreur_execution = d_ex;
242:
243: if ((*s_etat_processus).affichage_arguments == 'Y')
244: {
245: printf("\n ROLLD ");
246:
247: if ((*s_etat_processus).langue == 'F')
248: {
249: printf("(défilement d'un objet vers le bas)\n\n");
250: }
251: else
252: {
253: printf("(roll down objects on stack)\n\n");
254: }
255:
256: printf(" n+1: %s, %s, %s, %s, %s, %s,\n"
257: " %s, %s, %s, %s, %s,\n"
258: " %s, %s, %s, %s, %s,\n"
259: " %s, %s, %s, %s,\n"
260: " %s, %s\n",
261: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
262: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
263: d_SQL, d_SLB, d_PRC, d_MTX);
264: printf(" ...\n");
265: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
266: " %s, %s, %s, %s, %s,\n"
267: " %s, %s, %s, %s, %s,\n"
268: " %s, %s, %s, %s,\n"
269: " %s, %s\n",
270: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
271: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
272: d_SQL, d_SLB, d_PRC, d_MTX);
273: printf(" 1: %s\n", d_INT);
274: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
275: " %s, %s, %s, %s, %s,\n"
276: " %s, %s, %s, %s, %s,\n"
277: " %s, %s, %s, %s,\n"
278: " %s, %s\n",
279: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
280: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
281: d_SQL, d_SLB, d_PRC, d_MTX);
282: printf(" ...\n");
283: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
284: " %s, %s, %s, %s, %s,\n"
285: " %s, %s, %s, %s, %s,\n"
286: " %s, %s, %s, %s,\n"
287: " %s, %s\n",
288: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
289: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
290: d_SQL, d_SLB, d_PRC, d_MTX);
291:
292: return;
293: }
294: else if ((*s_etat_processus).test_instruction == 'Y')
295: {
296: (*s_etat_processus).nombre_arguments = -1;
297: return;
298: }
299:
300: if (test_cfsf(s_etat_processus, 31) == d_vrai)
301: {
302: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
303: {
304: return;
305: }
306: }
307:
308: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
309: &s_objet) == d_erreur)
310: {
311: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
312: return;
313: }
314:
315: if ((*s_objet).type != INT)
316: {
317: liberation(s_etat_processus, s_objet);
318:
319: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
320: return;
321: }
322:
323: if ((*((integer8 *) (*s_objet).objet)) <= 0)
324: {
325:
326: /*
327: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
328: */
329:
330: liberation(s_etat_processus, s_objet);
331:
332: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
333: return;
334: }
335:
336: if ((*((integer8 *) (*s_objet).objet)) > (integer8) (*s_etat_processus)
337: .hauteur_pile_operationnelle)
338: {
339: liberation(s_etat_processus, s_objet);
340:
341: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
342: return;
343: }
344:
345: if ((*((integer8 *) (*s_objet).objet)) > 1)
346: {
347: l_liste1 = (*s_etat_processus).l_base_pile;
348:
349: for(i = 1; i < (unsigned long) (*((integer8 *) (*s_objet).objet)); i++)
350: {
351: l_liste1 = (*l_liste1).suivant;
352: }
353:
354: l_liste2 = (*s_etat_processus).l_base_pile;
355: (*s_etat_processus).l_base_pile = (*(*s_etat_processus)
356: .l_base_pile).suivant;
357: (*l_liste2).suivant = (*l_liste1).suivant;
358: (*l_liste1).suivant = l_liste2;
359: }
360:
361: liberation(s_etat_processus, s_objet);
362:
363: return;
364: }
365:
366:
367: /*
368: ================================================================================
369: Fonction 'rot'
370: ================================================================================
371: Entrées : structure processus
372: --------------------------------------------------------------------------------
373: Sorties :
374: --------------------------------------------------------------------------------
375: Effets de bord : néant
376: ================================================================================
377: */
378:
379: void
380: instruction_rot(struct_processus *s_etat_processus)
381: {
382: struct_liste_chainee *l_liste1;
383: struct_liste_chainee *l_liste2;
384:
385: (*s_etat_processus).erreur_execution = d_ex;
386:
387: if ((*s_etat_processus).affichage_arguments == 'Y')
388: {
389: printf("\n ROT ");
390:
391: if ((*s_etat_processus).langue == 'F')
392: {
393: printf("(rotation)\n\n");
394: }
395: else
396: {
397: printf("(rotation)\n");
398: }
399:
400: printf(" 3: %s, %s, %s, %s, %s, %s,\n"
401: " %s, %s, %s, %s, %s,\n"
402: " %s, %s, %s, %s, %s,\n"
403: " %s, %s, %s, %s,\n"
404: " %s, %s\n",
405: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
406: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
407: d_SQL, d_SLB, d_PRC, d_MTX);
408: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
409: " %s, %s, %s, %s, %s,\n"
410: " %s, %s, %s, %s, %s,\n"
411: " %s, %s, %s, %s,\n"
412: " %s, %s\n",
413: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
414: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
415: d_SQL, d_SLB, d_PRC, d_MTX);
416: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
417: " %s, %s, %s, %s, %s,\n"
418: " %s, %s, %s, %s, %s,\n"
419: " %s, %s, %s, %s,\n"
420: " %s, %s\n",
421: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
422: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
423: d_SQL, d_SLB, d_PRC, d_MTX);
424: printf("-> 3: %s, %s, %s, %s, %s, %s,\n"
425: " %s, %s, %s, %s, %s,\n"
426: " %s, %s, %s, %s, %s,\n"
427: " %s, %s, %s, %s,\n"
428: " %s, %s\n",
429: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
430: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
431: d_SQL, d_SLB, d_PRC, d_MTX);
432: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
433: " %s, %s, %s, %s, %s,\n"
434: " %s, %s, %s, %s, %s,\n"
435: " %s, %s, %s, %s,\n"
436: " %s, %s\n",
437: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
438: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
439: d_SQL, d_SLB, d_PRC, d_MTX);
440: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
441: " %s, %s, %s, %s, %s,\n"
442: " %s, %s, %s, %s, %s,\n"
443: " %s, %s, %s, %s,\n"
444: " %s, %s\n",
445: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
446: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
447: d_SQL, d_SLB, d_PRC, d_MTX);
448:
449: return;
450: }
451: else if ((*s_etat_processus).test_instruction == 'Y')
452: {
453: (*s_etat_processus).nombre_arguments = -1;
454: return;
455: }
456:
457: if (test_cfsf(s_etat_processus, 31) == d_vrai)
458: {
459: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
460: {
461: return;
462: }
463: }
464:
465: if ((*s_etat_processus).hauteur_pile_operationnelle < 3)
466: {
467: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
468: return;
469: }
470:
471: l_liste1 = (*(*s_etat_processus).l_base_pile).suivant;
472: l_liste2 = (*l_liste1).suivant;
473: (*l_liste1).suivant = (*l_liste2).suivant;
474: (*l_liste2).suivant = (*s_etat_processus).l_base_pile;
475: (*s_etat_processus).l_base_pile = l_liste2;
476:
477: return;
478: }
479:
480:
481: /*
482: ================================================================================
483: Fonction 'repeat'
484: ================================================================================
485: Entrées : structure processus
486: --------------------------------------------------------------------------------
487: Sorties :
488: --------------------------------------------------------------------------------
489: Effets de bord : néant
490: ================================================================================
491: */
492:
493: void
494: instruction_repeat(struct_processus *s_etat_processus)
495: {
496: struct_objet *s_objet;
497:
498: logical1 condition;
499: logical1 drapeau_fin;
500: logical1 execution;
501:
502: struct_liste_chainee *s_registre;
503:
504: unsigned char *instruction_majuscule;
505: unsigned char *tampon;
506:
507: unsigned long niveau;
508:
509: void (*fonction)();
510:
511: (*s_etat_processus).erreur_execution = d_ex;
512:
513: if ((*s_etat_processus).affichage_arguments == 'Y')
514: {
515: printf("\n REPEAT ");
516:
517: if ((*s_etat_processus).langue == 'F')
518: {
519: printf("(structure de contrôle)\n\n");
520: printf(" Utilisation :\n\n");
521: }
522: else
523: {
524: printf("(control statement)\n\n");
525: printf(" Usage:\n\n");
526: }
527:
528: printf(" WHILE\n");
529: printf(" (clause)\n");
530: printf(" REPEAT\n");
531: printf(" (expression 1)\n");
532: printf(" EXIT\n");
533: printf(" (expression 2)\n");
534: printf(" END\n\n");
535:
536: printf(" WHILE\n");
537: printf(" (clause)\n");
538: printf(" REPEAT\n");
539: printf(" (expression)\n");
540: printf(" END\n");
541:
542: return;
543: }
544: else if ((*s_etat_processus).test_instruction == 'Y')
545: {
546: (*s_etat_processus).nombre_arguments = -1;
547: return;
548: }
549:
550: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
551: &s_objet) == d_erreur)
552: {
553: return;
554: }
555:
556: if (((*s_objet).type == INT) ||
557: ((*s_objet).type == REL))
558: {
559: if ((*s_objet).type == INT)
560: {
561: condition = ((*((integer8 *) (*s_objet).objet)) == 0)
562: ? d_faux : d_vrai;
563: }
564: else
565: {
566: condition = ((*((real8 *) (*s_objet).objet)) == 0)
567: ? d_faux : d_vrai;
568: }
569:
570: if (condition == d_faux)
571: {
572: niveau = 0;
573: (*(*s_etat_processus).l_base_pile_systeme).clause = 'M';
574: drapeau_fin = d_faux;
575:
576: if ((*s_etat_processus).mode_execution_programme == 'Y')
577: {
578: tampon = (*s_etat_processus).instruction_courante;
579:
580: do
581: {
582: if (recherche_instruction_suivante(s_etat_processus) !=
583: d_absence_erreur)
584: {
585: liberation(s_etat_processus, s_objet);
586:
587: if ((*s_etat_processus).instruction_courante != NULL)
588: {
589: free((*s_etat_processus).instruction_courante);
590: }
591:
592: (*s_etat_processus).instruction_courante = tampon;
593: (*s_etat_processus).erreur_execution =
594: d_ex_erreur_traitement_condition;
595: return;
596: }
597:
598: if ((instruction_majuscule = conversion_majuscule(
599: (*s_etat_processus).instruction_courante)) == NULL)
600: {
601: liberation(s_etat_processus, s_objet);
602:
603: free((*s_etat_processus).instruction_courante);
604: (*s_etat_processus).instruction_courante = tampon;
605: (*s_etat_processus).erreur_systeme =
606: d_es_allocation_memoire;
607: return;
608: }
609:
610:
611: if (niveau == 0)
612: {
613: if ((strcmp(instruction_majuscule, "END") == 0)
614: || (strcmp(instruction_majuscule, "ELSE") == 0)
615: || (strcmp(instruction_majuscule, "ELSEIF")
616: == 0))
617: {
618: (*s_etat_processus).position_courante -= (strlen(
619: instruction_majuscule) + 1);
620: drapeau_fin = d_vrai;
621: }
622: else
623: {
624: drapeau_fin = d_faux;
625: }
626: }
627: else
628: {
629: drapeau_fin = d_faux;
630: }
631:
632: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
633: (strcmp(instruction_majuscule, "DO") == 0) ||
634: (strcmp(instruction_majuscule, "IF") == 0) ||
635: (strcmp(instruction_majuscule, "IFERR") == 0) ||
636: (strcmp(instruction_majuscule, "SELECT") == 0)
637: || (strcmp(instruction_majuscule, "WHILE")
638: == 0))
639: {
640: niveau++;
641: }
642: else if (strcmp(instruction_majuscule, "END") == 0)
643: {
644: niveau--;
645: }
646:
647: free(instruction_majuscule);
648: free((*s_etat_processus).instruction_courante);
649: } while(drapeau_fin == d_faux);
650:
651: (*s_etat_processus).instruction_courante = tampon;
652: }
653: else
654: {
655: /*
656: * Vérification du pointeur de prédiction de saut
657: */
658:
659: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
660: .expression_courante).donnee).mutex)) != 0)
661: {
662: (*s_etat_processus).erreur_systeme = d_es_processus;
663: return;
664: }
665:
666: if ((*((struct_fonction *) (*(*(*s_etat_processus)
667: .expression_courante).donnee).objet)).prediction_saut
668: != NULL)
669: {
670: s_registre = (*s_etat_processus).expression_courante;
671:
672: (*s_etat_processus).expression_courante =
673: (struct_liste_chainee *)
674: (*((struct_fonction *) (*(*(*s_etat_processus)
675: .expression_courante).donnee).objet))
676: .prediction_saut;
677: fonction = (*((struct_fonction *)
678: (*(*(*s_etat_processus).expression_courante)
679: .donnee).objet)).fonction;
680: execution = (*((struct_fonction *)
681: (*(*s_registre).donnee).objet))
682: .prediction_execution;
683:
684: if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex))
685: != 0)
686: {
687: (*s_etat_processus).erreur_systeme = d_es_processus;
688: return;
689: }
690:
691: if (execution == d_vrai)
692: {
693: fonction(s_etat_processus);
694: }
695: }
696: else
697: {
698: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
699: .expression_courante).donnee).mutex)) != 0)
700: {
701: (*s_etat_processus).erreur_systeme = d_es_processus;
702: return;
703: }
704:
705: s_registre = (*s_etat_processus).expression_courante;
706: execution = d_faux;
707:
708: do
709: {
710: if (((*s_etat_processus).expression_courante =
711: (*(*s_etat_processus)
712: .expression_courante).suivant) == NULL)
713: {
714: liberation(s_etat_processus, s_objet);
715:
716: (*s_etat_processus).erreur_execution =
717: d_ex_erreur_traitement_condition;
718: return;
719: }
720:
721: if ((*(*(*s_etat_processus).expression_courante)
722: .donnee).type == FCT)
723: {
724: fonction = (*((struct_fonction *)
725: (*(*(*s_etat_processus).expression_courante)
726: .donnee).objet)).fonction;
727:
728: if (niveau == 0)
729: {
730: if ((fonction == instruction_end) ||
731: (fonction == instruction_else) ||
732: (fonction == instruction_elseif))
733: {
734: fonction(s_etat_processus);
735: execution = d_vrai;
736: drapeau_fin = d_vrai;
737: }
738: else
739: {
740: drapeau_fin = d_faux;
741: }
742: }
743: else
744: {
745: drapeau_fin = d_faux;
746: }
747:
748: if ((fonction == instruction_case) ||
749: (fonction == instruction_do) ||
750: (fonction == instruction_if) ||
751: (fonction == instruction_iferr) ||
752: (fonction == instruction_select) ||
753: (fonction == instruction_while))
754: {
755: niveau++;
756: }
757: else if (fonction == instruction_end)
758: {
759: niveau--;
760: }
761: }
762: } while(drapeau_fin == d_faux);
763:
764: if (pthread_mutex_lock(&((*(*(*s_etat_processus)
765: .expression_courante).donnee).mutex)) != 0)
766: {
767: (*s_etat_processus).erreur_systeme = d_es_processus;
768: return;
769: }
770:
771: (*((struct_fonction *) (*(*s_registre).donnee).objet))
772: .prediction_saut = (*s_etat_processus)
773: .expression_courante;
774: (*((struct_fonction *) (*(*s_registre).donnee).objet))
775: .prediction_execution = execution;
776:
777: if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
778: .expression_courante).donnee).mutex)) != 0)
779: {
780: (*s_etat_processus).erreur_systeme = d_es_processus;
781: return;
782: }
783: }
784: }
785: }
786: }
787: else
788: {
789: liberation(s_etat_processus, s_objet);
790:
791: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
792: return;
793: }
794:
795: liberation(s_etat_processus, s_objet);
796:
797: return;
798: }
799:
800:
801: /*
802: ================================================================================
803: Fonction 'rclf'
804: ================================================================================
805: Entrées : structure processus
806: --------------------------------------------------------------------------------
807: Sorties :
808: --------------------------------------------------------------------------------
809: Effets de bord : néant
810: ================================================================================
811: */
812:
813: void
814: instruction_rclf(struct_processus *s_etat_processus)
815: {
816: struct_objet *s_objet_resultat;
817:
818: t_8_bits masque;
819:
820: unsigned char indice_bit;
821: unsigned char indice_bloc;
822: unsigned char indice_drapeau;
823: unsigned char taille_bloc;
824:
825: unsigned long i;
826:
827: (*s_etat_processus).erreur_execution = d_ex;
828:
829: if ((*s_etat_processus).affichage_arguments == 'Y')
830: {
831: printf("\n RCLF ");
832:
833: if ((*s_etat_processus).langue == 'F')
834: {
835: printf("(renvoie les drapeaux d'état)\n\n");
836: }
837: else
838: {
839: printf("(recall flags)\n\n");
840: }
841:
842: printf("-> 1: %s\n", d_BIN);
843:
844: return;
845: }
846: else if ((*s_etat_processus).test_instruction == 'Y')
847: {
848: (*s_etat_processus).nombre_arguments = -1;
849: return;
850: }
851:
852: if (test_cfsf(s_etat_processus, 31) == d_vrai)
853: {
854: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
855: {
856: return;
857: }
858: }
859:
860: if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL)
861: {
862: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
863: return;
864: }
865:
866: (*((logical8 *) (*s_objet_resultat).objet)) = 0;
867: taille_bloc = sizeof(t_8_bits) * 8;
868:
869: for(i = 1; i <= 64; i++)
870: {
871: indice_drapeau = i - 1;
872: indice_bloc = indice_drapeau / taille_bloc;
873: indice_bit = indice_drapeau % taille_bloc;
874: masque = ((t_8_bits) 1) << (taille_bloc - indice_bit - 1);
875:
876: if (((*s_etat_processus).drapeaux_etat[indice_bloc] & masque) != 0)
877: {
878: (*((logical8 *) (*s_objet_resultat).objet)) |=
879: ((logical8) 1) << indice_drapeau;
880: }
881: }
882:
883: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
884: s_objet_resultat) == d_erreur)
885: {
886: return;
887: }
888:
889: return;
890: }
891:
892:
893: /*
894: ================================================================================
895: Fonction 'rcl'
896: ================================================================================
897: Entrées : structure processus
898: -------------------------------------------------------------------------------
899: Sorties :
900: --------------------------------------------------------------------------------
901: Effets de bord : néant
902: ================================================================================
903: */
904:
905: void
906: instruction_rcl(struct_processus *s_etat_processus)
907: {
908: struct_objet *s_objet;
909: struct_objet *s_objet_variable;
910:
911: (*s_etat_processus).erreur_execution = d_ex;
912:
913: if ((*s_etat_processus).affichage_arguments == 'Y')
914: {
915: printf("\n RCL ");
916:
917: if ((*s_etat_processus).langue == 'F')
918: {
919: printf("(renvoie le contenu d'une variable globale)\n\n");
920: }
921: else
922: {
923: printf("(recall global variable)\n\n");
924: }
925:
926: printf(" 1: %s\n", d_NOM);
927: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
928: " %s, %s, %s, %s, %s,\n"
929: " %s, %s, %s, %s, %s,\n"
930: " %s, %s, %s, %s,\n"
931: " %s, %s\n",
932: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
933: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
934: d_SQL, d_SLB, d_PRC, d_MTX);
935:
936: return;
937: }
938: else if ((*s_etat_processus).test_instruction == 'Y')
939: {
940: (*s_etat_processus).nombre_arguments = -1;
941: return;
942: }
943:
944: if (test_cfsf(s_etat_processus, 31) == d_vrai)
945: {
946: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
947: {
948: return;
949: }
950: }
951:
952: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
953: &s_objet) == d_erreur)
954: {
955: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
956: return;
957: }
958:
959: if ((*s_objet).type != NOM)
960: {
961: liberation(s_etat_processus, s_objet);
962:
963: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
964: return;
965: }
966:
967: if (recherche_variable_globale(s_etat_processus, (*((struct_nom *)
968: (*s_objet).objet)).nom) == d_faux)
969: {
970: liberation(s_etat_processus, s_objet);
971:
972: (*s_etat_processus).erreur_systeme = d_es;
973:
974: if ((*s_etat_processus).erreur_execution == d_ex)
975: {
976: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
977: }
978:
979: return;
980: }
981:
982: if ((s_objet_variable = copie_objet(s_etat_processus,
983: (*(*s_etat_processus).pointeur_variable_courante).objet, 'P'))
984: == NULL)
985: {
986: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
987: return;
988: }
989:
990: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
991: s_objet_variable) == d_erreur)
992: {
993: return;
994: }
995:
996: liberation(s_etat_processus, s_objet);
997:
998: return;
999: }
1000:
1001:
1002: /*
1003: ================================================================================
1004: Fonction 'rand'
1005: ================================================================================
1006: Entrées : structure processus
1007: -------------------------------------------------------------------------------
1008: Sorties :
1009: --------------------------------------------------------------------------------
1010: Effets de bord : néant
1011: ================================================================================
1012: */
1013:
1014: void
1015: instruction_rand(struct_processus *s_etat_processus)
1016: {
1017: struct_objet *s_objet;
1018:
1019: (*s_etat_processus).erreur_execution = d_ex;
1020:
1021: if ((*s_etat_processus).affichage_arguments == 'Y')
1022: {
1023: printf("\n RAND ");
1024:
1025: if ((*s_etat_processus).langue == 'F')
1026: {
1027: printf("(variable aléatoire uniforme)\n\n");
1028: }
1029: else
1030: {
1031: printf("(uniform random number)\n\n");
1032: }
1033:
1034: printf("-> 1: %s\n", d_REL);
1035:
1036: return;
1037: }
1038: else if ((*s_etat_processus).test_instruction == 'Y')
1039: {
1040: (*s_etat_processus).nombre_arguments = -1;
1041: return;
1042: }
1043:
1044: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1045: {
1046: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1047: {
1048: return;
1049: }
1050: }
1051:
1052: if ((*s_etat_processus).generateur_aleatoire == NULL)
1053: {
1054: initialisation_generateur_aleatoire(s_etat_processus, d_vrai, 0);
1055: }
1056:
1057: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
1058: {
1059: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1060: return;
1061: }
1062:
1063: (*((real8 *) (*s_objet).objet)) = gsl_rng_uniform(
1064: (*s_etat_processus).generateur_aleatoire);
1065:
1066: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1067: s_objet) == d_erreur)
1068: {
1069: return;
1070: }
1071:
1072: return;
1073: }
1074:
1075:
1076: /*
1077: ================================================================================
1078: Fonction 'rdz'
1079: ================================================================================
1080: Entrées : structure processus
1081: -------------------------------------------------------------------------------
1082: Sorties :
1083: --------------------------------------------------------------------------------
1084: Effets de bord : néant
1085: ================================================================================
1086: */
1087:
1088: void
1089: instruction_rdz(struct_processus *s_etat_processus)
1090: {
1091: struct_objet *s_objet;
1092:
1093: (*s_etat_processus).erreur_execution = d_ex;
1094:
1095: if ((*s_etat_processus).affichage_arguments == 'Y')
1096: {
1097: printf("\n RDZ ");
1098:
1099: if ((*s_etat_processus).langue == 'F')
1100: {
1101: printf("(racine des nombres aléatoires)\n\n");
1102: }
1103: else
1104: {
1105: printf("(random seed)\n\n");
1106: }
1107:
1108: printf(" 1: %s\n", d_INT);
1109:
1110: return;
1111: }
1112: else if ((*s_etat_processus).test_instruction == 'Y')
1113: {
1114: (*s_etat_processus).nombre_arguments = -1;
1115: return;
1116: }
1117:
1118: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1119: {
1120: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1121: {
1122: return;
1123: }
1124: }
1125:
1126: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1127: &s_objet) == d_erreur)
1128: {
1129: return;
1130: }
1131:
1132: if ((*s_objet).type == INT)
1133: {
1134: initialisation_generateur_aleatoire(s_etat_processus, d_faux,
1135: (unsigned long int) (*((integer8 *) (*s_objet).objet)));
1136: }
1137: else
1138: {
1139: liberation(s_etat_processus, s_objet);
1140:
1141: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1142: return;
1143: }
1144:
1145: liberation(s_etat_processus, s_objet);
1146: }
1147:
1148:
1149: /*
1150: ================================================================================
1151: Fonction 'rnd'
1152: ================================================================================
1153: Entrées : structure processus
1154: --------------------------------------------------------------------------------
1155: Sorties :
1156: --------------------------------------------------------------------------------
1157: Effets de bord : néant
1158: ================================================================================
1159: */
1160:
1161: void
1162: instruction_rnd(struct_processus *s_etat_processus)
1163: {
1164: struct_objet *s_objet_argument;
1165:
1166: unsigned char *instruction_courante;
1167:
1168: (*s_etat_processus).erreur_execution = d_ex;
1169:
1170: if ((*s_etat_processus).affichage_arguments == 'Y')
1171: {
1172: printf("\n RND ");
1173:
1174: if ((*s_etat_processus).langue == 'F')
1175: {
1176: printf("(arrondi)\n\n");
1177: }
1178: else
1179: {
1180: printf("(rounding)\n\n");
1181: }
1182:
1183: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
1184: " %s, %s, %s\n",
1185: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX);
1186: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
1187: " %s, %s, %s\n",
1188: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX);
1189:
1190: return;
1191: }
1192: else if ((*s_etat_processus).test_instruction == 'Y')
1193: {
1194: (*s_etat_processus).nombre_arguments = 1;
1195: return;
1196: }
1197:
1198: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1199: {
1200: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1201: {
1202: return;
1203: }
1204: }
1205:
1206: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1207: &s_objet_argument) == d_erreur)
1208: {
1209: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1210: return;
1211: }
1212:
1213: if (((*s_objet_argument).type == INT) ||
1214: ((*s_objet_argument).type == REL) ||
1215: ((*s_objet_argument).type == CPL) ||
1216: ((*s_objet_argument).type == VIN) ||
1217: ((*s_objet_argument).type == VRL) ||
1218: ((*s_objet_argument).type == VCX) ||
1219: ((*s_objet_argument).type == MIN) ||
1220: ((*s_objet_argument).type == MRL) ||
1221: ((*s_objet_argument).type == MCX))
1222: {
1223: instruction_courante = (*s_etat_processus).instruction_courante;
1224:
1225: if (((*s_etat_processus).instruction_courante =
1226: formateur(s_etat_processus, 0, s_objet_argument)) == NULL)
1227: {
1228: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1229: (*s_etat_processus).instruction_courante = instruction_courante;
1230: return;
1231: }
1232:
1233: recherche_type(s_etat_processus);
1234:
1235: free((*s_etat_processus).instruction_courante);
1236: (*s_etat_processus).instruction_courante = instruction_courante;
1237:
1238: if ((*s_etat_processus).erreur_systeme != d_es)
1239: {
1240: return;
1241: }
1242:
1243: if ((*s_etat_processus).erreur_execution != d_ex)
1244: {
1245: liberation(s_etat_processus, s_objet_argument);
1246: return;
1247: }
1248: }
1249: else
1250: {
1251: liberation(s_etat_processus, s_objet_argument);
1252:
1253: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1254: return;
1255: }
1256:
1257: liberation(s_etat_processus, s_objet_argument);
1258:
1259: return;
1260: }
1261:
1262:
1263: /*
1264: ================================================================================
1265: Fonction 'r->c'
1266: ================================================================================
1267: Entrées : structure processus
1268: --------------------------------------------------------------------------------
1269: Sorties :
1270: --------------------------------------------------------------------------------
1271: Effets de bord : néant
1272: ================================================================================
1273: */
1274:
1275: void
1276: instruction_r_vers_c(struct_processus *s_etat_processus)
1277: {
1278: struct_objet *s_objet_argument_1;
1279: struct_objet *s_objet_argument_2;
1280: struct_objet *s_objet_resultat;
1281:
1282: unsigned long i;
1283: unsigned long j;
1284:
1285: (*s_etat_processus).erreur_execution = d_ex;
1286:
1287: if ((*s_etat_processus).affichage_arguments == 'Y')
1288: {
1289: printf("\n R->C ");
1290:
1291: if ((*s_etat_processus).langue == 'F')
1292: {
1293: printf("(réel vers complexe)\n\n");
1294: }
1295: else
1296: {
1297: printf("(real to complex)\n\n");
1298: }
1299:
1300: printf(" 2: %s, %s\n", d_INT, d_REL);
1301: printf(" 1: %s, %s\n", d_INT, d_REL);
1302: printf("-> 1: %s\n\n", d_CPL);
1303:
1304: printf(" 2: %s, %s\n", d_VIN, d_VRL);
1305: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1306: printf("-> 1: %s\n\n", d_VCX);
1307:
1308: printf(" 2: %s, %s\n", d_MIN, d_MRL);
1309: printf(" 1: %s, %s\n", d_MIN, d_MRL);
1310: printf("-> 1: %s\n", d_MCX);
1311:
1312: return;
1313: }
1314: else if ((*s_etat_processus).test_instruction == 'Y')
1315: {
1316: (*s_etat_processus).nombre_arguments = -1;
1317: return;
1318: }
1319:
1320: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1321: {
1322: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1323: {
1324: return;
1325: }
1326: }
1327:
1328: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1329: &s_objet_argument_1) == d_erreur)
1330: {
1331: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1332: return;
1333: }
1334:
1335: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1336: &s_objet_argument_2) == d_erreur)
1337: {
1338: liberation(s_etat_processus, s_objet_argument_1);
1339:
1340: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1341: return;
1342: }
1343:
1344: /*
1345: --------------------------------------------------------------------------------
1346: Formation d'un complexe à partir de deux réels
1347: --------------------------------------------------------------------------------
1348: */
1349:
1350: if ((((*s_objet_argument_1).type == INT) ||
1351: ((*s_objet_argument_1).type == REL)) &&
1352: (((*s_objet_argument_2).type == INT) ||
1353: ((*s_objet_argument_2).type == REL)))
1354: {
1355: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1356: {
1357: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1358: return;
1359: }
1360:
1361: if ((*s_objet_argument_1).type == INT)
1362: {
1363: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1364: .partie_imaginaire =
1365: (*((integer8 *) (*s_objet_argument_1).objet));
1366: }
1367: else
1368: {
1369: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1370: .partie_imaginaire =
1371: (*((real8 *) (*s_objet_argument_1).objet));
1372: }
1373:
1374: if ((*s_objet_argument_2).type == INT)
1375: {
1376: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1377: .partie_reelle =
1378: (*((integer8 *) (*s_objet_argument_2).objet));
1379: }
1380: else
1381: {
1382: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1383: .partie_reelle =
1384: (*((real8 *) (*s_objet_argument_2).objet));
1385: }
1386: }
1387:
1388: /*
1389: --------------------------------------------------------------------------------
1390: Formation à partir de deux vecteurs
1391: --------------------------------------------------------------------------------
1392: */
1393:
1394: else if ((((*s_objet_argument_1).type == VIN) ||
1395: ((*s_objet_argument_1).type == VRL)) &&
1396: (((*s_objet_argument_2).type == VIN) ||
1397: ((*s_objet_argument_2).type == VRL)))
1398: {
1399: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
1400: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
1401: {
1402: liberation(s_etat_processus, s_objet_argument_1);
1403: liberation(s_etat_processus, s_objet_argument_2);
1404:
1405: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1406: return;
1407: }
1408:
1409: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
1410: {
1411: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1412: return;
1413: }
1414:
1415: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1416: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
1417:
1418: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1419: malloc((*(((struct_vecteur *) (*s_objet_resultat)
1420: .objet))).taille * sizeof(struct_complexe16))) == NULL)
1421: {
1422: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1423: return;
1424: }
1425:
1426: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument_1).objet)))
1427: .taille; i++)
1428: {
1429: if ((*s_objet_argument_1).type == VIN)
1430: {
1431: ((struct_complexe16 *) (*((struct_vecteur *)
1432: (*s_objet_resultat).objet)).tableau)[i]
1433: .partie_imaginaire = ((integer8 *)
1434: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1435: .tableau)[i];
1436: }
1437: else
1438: {
1439: ((struct_complexe16 *) (*((struct_vecteur *)
1440: (*s_objet_resultat).objet)).tableau)[i]
1441: .partie_imaginaire = ((real8 *)
1442: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1443: .tableau)[i];
1444: }
1445:
1446: if ((*s_objet_argument_2).type == VIN)
1447: {
1448: ((struct_complexe16 *) (*((struct_vecteur *)
1449: (*s_objet_resultat).objet)).tableau)[i]
1450: .partie_reelle = ((integer8 *)
1451: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1452: .tableau)[i];
1453: }
1454: else
1455: {
1456: ((struct_complexe16 *) (*((struct_vecteur *)
1457: (*s_objet_resultat).objet)).tableau)[i]
1458: .partie_reelle = ((real8 *)
1459: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1460: .tableau)[i];
1461: }
1462: }
1463: }
1464:
1465: /*
1466: --------------------------------------------------------------------------------
1467: Formation à partir de deux matrices
1468: --------------------------------------------------------------------------------
1469: */
1470:
1471: else if ((((*s_objet_argument_1).type == MIN) ||
1472: ((*s_objet_argument_1).type == MRL)) &&
1473: (((*s_objet_argument_2).type == MIN) ||
1474: ((*s_objet_argument_2).type == MRL)))
1475: {
1476: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
1477: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
1478: .objet))).nombre_lignes) || ((*(((struct_matrice *)
1479: (*s_objet_argument_1).objet))).nombre_colonnes !=
1480: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
1481: .nombre_lignes))
1482: {
1483: liberation(s_etat_processus, s_objet_argument_1);
1484: liberation(s_etat_processus, s_objet_argument_2);
1485:
1486: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1487: return;
1488: }
1489:
1490: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
1491: {
1492: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1493: return;
1494: }
1495:
1496: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1497: (*((struct_matrice *) (*s_objet_argument_1).objet))
1498: .nombre_lignes;
1499: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1500: (*((struct_matrice *) (*s_objet_argument_1).objet))
1501: .nombre_colonnes;
1502:
1503: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1504: malloc((*(((struct_matrice *) (*s_objet_resultat)
1505: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
1506: {
1507: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1508: return;
1509: }
1510:
1511: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_1).objet)))
1512: .nombre_lignes; i++)
1513: {
1514: if ((((struct_complexe16 **) (*((struct_matrice *)
1515: (*s_objet_resultat).objet)).tableau)[i] =
1516: malloc((*((struct_matrice *)
1517: (*s_objet_resultat).objet)).nombre_colonnes *
1518: sizeof(struct_complexe16))) == NULL)
1519: {
1520: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1521: return;
1522: }
1523:
1524: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument_1).objet)))
1525: .nombre_colonnes; j++)
1526: {
1527: if ((*s_objet_argument_1).type == MIN)
1528: {
1529: ((struct_complexe16 **) (*((struct_matrice *)
1530: (*s_objet_resultat).objet)).tableau)[i][j]
1531: .partie_imaginaire = ((integer8 **)
1532: (*((struct_matrice *) (*s_objet_argument_1).objet))
1533: .tableau)[i][j];
1534: }
1535: else
1536: {
1537: ((struct_complexe16 **) (*((struct_matrice *)
1538: (*s_objet_resultat).objet)).tableau)[i][j]
1539: .partie_imaginaire = ((real8 **)
1540: (*((struct_matrice *) (*s_objet_argument_1).objet))
1541: .tableau)[i][j];
1542: }
1543:
1544: if ((*s_objet_argument_2).type == MIN)
1545: {
1546: ((struct_complexe16 **) (*((struct_matrice *)
1547: (*s_objet_resultat).objet)).tableau)[i][j]
1548: .partie_reelle = ((integer8 **)
1549: (*((struct_matrice *) (*s_objet_argument_2).objet))
1550: .tableau)[i][j];
1551: }
1552: else
1553: {
1554: ((struct_complexe16 **) (*((struct_matrice *)
1555: (*s_objet_resultat).objet)).tableau)[i][j]
1556: .partie_reelle = ((real8 **)
1557: (*((struct_matrice *) (*s_objet_argument_2).objet))
1558: .tableau)[i][j];
1559: }
1560: }
1561: }
1562: }
1563:
1564: /*
1565: --------------------------------------------------------------------------------
1566: Formation impossible
1567: --------------------------------------------------------------------------------
1568: */
1569:
1570: else
1571: {
1572: liberation(s_etat_processus, s_objet_argument_1);
1573: liberation(s_etat_processus, s_objet_argument_2);
1574:
1575: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1576: return;
1577: }
1578:
1579: liberation(s_etat_processus, s_objet_argument_1);
1580: liberation(s_etat_processus, s_objet_argument_2);
1581:
1582: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1583: s_objet_resultat) == d_erreur)
1584: {
1585: return;
1586: }
1587:
1588: return;
1589: }
1590:
1591:
1592: /*
1593: ================================================================================
1594: Fonction 're'
1595: ================================================================================
1596: Entrées : structure processus
1597: --------------------------------------------------------------------------------
1598: Sorties :
1599: --------------------------------------------------------------------------------
1600: Effets de bord : néant
1601: ================================================================================
1602: */
1603:
1604: void
1605: instruction_re(struct_processus *s_etat_processus)
1606: {
1607: struct_liste_chainee *l_element_courant;
1608: struct_liste_chainee *l_element_precedent;
1609:
1610: struct_objet *s_copie_argument;
1611: struct_objet *s_objet_argument;
1612: struct_objet *s_objet_resultat;
1613:
1614: unsigned long i;
1615: unsigned long j;
1616:
1617: (*s_etat_processus).erreur_execution = d_ex;
1618:
1619: if ((*s_etat_processus).affichage_arguments == 'Y')
1620: {
1621: printf("\n RE ");
1622:
1623: if ((*s_etat_processus).langue == 'F')
1624: {
1625: printf("(partie réelle)\n\n");
1626: }
1627: else
1628: {
1629: printf("(real part)\n\n");
1630: }
1631:
1632: printf(" 1: %s, %s\n", d_INT, d_REL);
1633: printf("-> 1: %s\n\n", d_INT);
1634:
1635: printf(" 1: %s\n", d_CPL);
1636: printf("-> 1: %s\n\n", d_REL);
1637:
1638: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1639: printf("-> 1: %s\n\n", d_VIN);
1640:
1641: printf(" 1: %s\n", d_VCX);
1642: printf("-> 1: %s\n\n", d_VRL);
1643:
1644: printf(" 1: %s, %s\n", d_MIN, d_MRL);
1645: printf("-> 1: %s\n\n", d_MIN);
1646:
1647: printf(" 1: %s\n", d_MCX);
1648: printf("-> 1: %s\n\n", d_MRL);
1649:
1650: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1651: printf("-> 1: %s\n\n", d_ALG);
1652:
1653: printf(" 1: %s\n", d_RPN);
1654: printf("-> 1: %s\n", d_RPN);
1655:
1656: return;
1657: }
1658: else if ((*s_etat_processus).test_instruction == 'Y')
1659: {
1660: (*s_etat_processus).nombre_arguments = 1;
1661: return;
1662: }
1663:
1664: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1665: {
1666: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1667: {
1668: return;
1669: }
1670: }
1671:
1672: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1673: &s_objet_argument) == d_erreur)
1674: {
1675: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1676: return;
1677: }
1678:
1679: /*
1680: --------------------------------------------------------------------------------
1681: Partie réelle d'un entier ou d'un réel
1682: --------------------------------------------------------------------------------
1683: */
1684:
1685: if (((*s_objet_argument).type == INT) ||
1686: ((*s_objet_argument).type == REL))
1687: {
1688: s_objet_resultat = s_objet_argument;
1689: s_objet_argument = NULL;
1690: }
1691:
1692: /*
1693: --------------------------------------------------------------------------------
1694: Partie réelle d'un complexe
1695: --------------------------------------------------------------------------------
1696: */
1697:
1698: else if ((*s_objet_argument).type == CPL)
1699: {
1700: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1701: {
1702: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1703: return;
1704: }
1705:
1706: (*((real8 *) (*s_objet_resultat).objet)) =
1707: (*((struct_complexe16 *) (*s_objet_argument).objet))
1708: .partie_reelle;
1709: }
1710:
1711: /*
1712: --------------------------------------------------------------------------------
1713: Partie réelle d'un vecteur
1714: --------------------------------------------------------------------------------
1715: */
1716:
1717: else if (((*s_objet_argument).type == VIN) ||
1718: ((*s_objet_argument).type == VRL))
1719: {
1720: s_objet_resultat = s_objet_argument;
1721: s_objet_argument = NULL;
1722: }
1723: else if ((*s_objet_argument).type == VCX)
1724: {
1725: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
1726: {
1727: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1728: return;
1729: }
1730:
1731: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1732: malloc((*(((struct_vecteur *) (*s_objet_argument)
1733: .objet))).taille * sizeof(real8))) == NULL)
1734: {
1735: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1736: return;
1737: }
1738:
1739: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1740: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
1741:
1742: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
1743: .taille; i++)
1744: {
1745: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1746: .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
1747: (*s_objet_argument).objet)).tableau)[i].partie_reelle;
1748: }
1749: }
1750:
1751: /*
1752: --------------------------------------------------------------------------------
1753: Partie réelle d'une matrice
1754: --------------------------------------------------------------------------------
1755: */
1756:
1757: else if (((*s_objet_argument).type == MIN) ||
1758: ((*s_objet_argument).type == MRL))
1759: {
1760: s_objet_resultat = s_objet_argument;
1761: s_objet_argument = NULL;
1762: }
1763: else if ((*s_objet_argument).type == MCX)
1764: {
1765: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
1766: {
1767: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1768: return;
1769: }
1770:
1771: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1772: malloc((*(((struct_matrice *) (*s_objet_argument)
1773: .objet))).nombre_lignes * sizeof(real8 *))) == NULL)
1774: {
1775: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1776: return;
1777: }
1778:
1779: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1780: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
1781: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1782: (*((struct_matrice *) (*s_objet_argument).objet))
1783: .nombre_colonnes;
1784:
1785: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
1786: .nombre_lignes; i++)
1787: {
1788: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1789: .objet)).tableau)[i] = malloc(
1790: (*(((struct_matrice *) (*s_objet_argument).objet)))
1791: .nombre_colonnes * sizeof(real8))) == NULL)
1792: {
1793: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1794: return;
1795: }
1796:
1797: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1798: .nombre_colonnes; j++)
1799: {
1800: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
1801: .tableau)[i][j] = ((struct_complexe16 **)
1802: (*((struct_matrice *) (*s_objet_argument).objet))
1803: .tableau)[i][j].partie_reelle;
1804: }
1805: }
1806: }
1807:
1808: /*
1809: --------------------------------------------------------------------------------
1810: Partie réelle d'un nom
1811: --------------------------------------------------------------------------------
1812: */
1813:
1814: else if ((*s_objet_argument).type == NOM)
1815: {
1816: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1817: {
1818: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1819: return;
1820: }
1821:
1822: if (((*s_objet_resultat).objet =
1823: allocation_maillon(s_etat_processus)) == NULL)
1824: {
1825: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1826: return;
1827: }
1828:
1829: l_element_courant = (*s_objet_resultat).objet;
1830:
1831: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1832: == NULL)
1833: {
1834: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1835: return;
1836: }
1837:
1838: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1839: .nombre_arguments = 0;
1840: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1841: .fonction = instruction_vers_niveau_superieur;
1842:
1843: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1844: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1845: {
1846: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1847: return;
1848: }
1849:
1850: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1851: .nom_fonction, "<<");
1852:
1853: if (((*l_element_courant).suivant =
1854: allocation_maillon(s_etat_processus)) == NULL)
1855: {
1856: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1857: return;
1858: }
1859:
1860: l_element_courant = (*l_element_courant).suivant;
1861: (*l_element_courant).donnee = s_objet_argument;
1862:
1863: if (((*l_element_courant).suivant =
1864: allocation_maillon(s_etat_processus)) == NULL)
1865: {
1866: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1867: return;
1868: }
1869:
1870: l_element_courant = (*l_element_courant).suivant;
1871:
1872: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1873: == NULL)
1874: {
1875: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1876: return;
1877: }
1878:
1879: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1880: .nombre_arguments = 1;
1881: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1882: .fonction = instruction_re;
1883:
1884: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1885: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1886: {
1887: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1888: return;
1889: }
1890:
1891: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1892: .nom_fonction, "RE");
1893:
1894: if (((*l_element_courant).suivant =
1895: allocation_maillon(s_etat_processus)) == NULL)
1896: {
1897: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1898: return;
1899: }
1900:
1901: l_element_courant = (*l_element_courant).suivant;
1902:
1903: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1904: == NULL)
1905: {
1906: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1907: return;
1908: }
1909:
1910: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1911: .nombre_arguments = 0;
1912: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1913: .fonction = instruction_vers_niveau_inferieur;
1914:
1915: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1916: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1917: {
1918: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1919: return;
1920: }
1921:
1922: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1923: .nom_fonction, ">>");
1924:
1925: (*l_element_courant).suivant = NULL;
1926: s_objet_argument = NULL;
1927: }
1928:
1929: /*
1930: --------------------------------------------------------------------------------
1931: Partie réelle d'une expression
1932: --------------------------------------------------------------------------------
1933: */
1934:
1935: else if (((*s_objet_argument).type == ALG) ||
1936: ((*s_objet_argument).type == RPN))
1937: {
1938: if ((s_copie_argument = copie_objet(s_etat_processus,
1939: s_objet_argument, 'N')) == NULL)
1940: {
1941: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1942: return;
1943: }
1944:
1945: l_element_courant = (struct_liste_chainee *)
1946: (*s_copie_argument).objet;
1947: l_element_precedent = l_element_courant;
1948:
1949: while((*l_element_courant).suivant != NULL)
1950: {
1951: l_element_precedent = l_element_courant;
1952: l_element_courant = (*l_element_courant).suivant;
1953: }
1954:
1955: if (((*l_element_precedent).suivant =
1956: allocation_maillon(s_etat_processus)) == NULL)
1957: {
1958: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1959: return;
1960: }
1961:
1962: if (((*(*l_element_precedent).suivant).donnee =
1963: allocation(s_etat_processus, FCT)) == NULL)
1964: {
1965: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1966: return;
1967: }
1968:
1969: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1970: .donnee).objet)).nombre_arguments = 1;
1971: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1972: .donnee).objet)).fonction = instruction_re;
1973:
1974: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1975: .suivant).donnee).objet)).nom_fonction =
1976: malloc(3 * sizeof(unsigned char))) == NULL)
1977: {
1978: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1979: return;
1980: }
1981:
1982: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1983: .suivant).donnee).objet)).nom_fonction, "RE");
1984:
1985: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1986:
1987: s_objet_resultat = s_copie_argument;
1988: }
1989:
1990: /*
1991: --------------------------------------------------------------------------------
1992: Réalisation impossible de la fonction partie réelle
1993: --------------------------------------------------------------------------------
1994: */
1995:
1996: else
1997: {
1998: liberation(s_etat_processus, s_objet_argument);
1999:
2000: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2001: return;
2002: }
2003:
2004: liberation(s_etat_processus, s_objet_argument);
2005:
2006: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2007: s_objet_resultat) == d_erreur)
2008: {
2009: return;
2010: }
2011:
2012: return;
2013: }
2014:
2015:
2016: /*
2017: ================================================================================
2018: Fonction 'r->p'
2019: ================================================================================
2020: Entrées : pointeur sur une structure struct_processus
2021: --------------------------------------------------------------------------------
2022: Sorties :
2023: --------------------------------------------------------------------------------
2024: Effets de bord : néant
2025: ================================================================================
2026: */
2027:
2028: void
2029: instruction_r_vers_p(struct_processus *s_etat_processus)
2030: {
2031: struct_liste_chainee *l_element_courant;
2032: struct_liste_chainee *l_element_precedent;
2033:
2034: struct_objet *s_copie_argument;
2035: struct_objet *s_objet_argument;
2036: struct_objet *s_objet_resultat;
2037:
2038: (*s_etat_processus).erreur_execution = d_ex;
2039:
2040: if ((*s_etat_processus).affichage_arguments == 'Y')
2041: {
2042: printf("\n P->R ");
2043:
2044: if ((*s_etat_processus).langue == 'F')
2045: {
2046: printf("(coordonnées polaires vers cartésiennes)\n\n");
2047: }
2048: else
2049: {
2050: printf("(polar to cartesian coordinates)\n\n");
2051: }
2052:
2053: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
2054: printf("-> 1: %s\n\n", d_CPL);
2055:
2056: printf(" 1: %s, %s\n", d_NOM, d_ALG);
2057: printf("-> 1: %s\n\n", d_ALG);
2058:
2059: printf(" 1: %s\n", d_RPN);
2060: printf("-> 1: %s\n", d_RPN);
2061:
2062: return;
2063: }
2064: else if ((*s_etat_processus).test_instruction == 'Y')
2065: {
2066: (*s_etat_processus).nombre_arguments = -1;
2067: return;
2068: }
2069:
2070: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2071: {
2072: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2073: {
2074: return;
2075: }
2076: }
2077:
2078: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2079: &s_objet_argument) == d_erreur)
2080: {
2081: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2082: return;
2083: }
2084:
2085: /*
2086: --------------------------------------------------------------------------------
2087: Conversion d'un entier ou d'un réel
2088: --------------------------------------------------------------------------------
2089: */
2090:
2091: if (((*s_objet_argument).type == INT) ||
2092: ((*s_objet_argument).type == REL))
2093: {
2094: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2095: == NULL)
2096: {
2097: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2098: return;
2099: }
2100:
2101: if ((*s_objet_argument).type == INT)
2102: {
2103: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle
2104: = (*((integer8 *) (*s_objet_argument).objet));
2105: }
2106: else
2107: {
2108: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle
2109: = (*((real8 *) (*s_objet_argument).objet));
2110: }
2111:
2112: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_imaginaire
2113: = 0;
2114: }
2115:
2116: /*
2117: --------------------------------------------------------------------------------
2118: Conversion d'un complexe
2119: --------------------------------------------------------------------------------
2120: */
2121:
2122: else if ((*s_objet_argument).type == CPL)
2123: {
2124: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2125: == NULL)
2126: {
2127: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2128: return;
2129: }
2130:
2131: f77absc_(((struct_complexe16 *) (*s_objet_argument).objet),
2132: &((*((struct_complexe16 *) (*s_objet_resultat).objet))
2133: .partie_reelle));
2134:
2135: (*((struct_complexe16 *) (*s_objet_resultat).objet))
2136: .partie_imaginaire = atan2((*((struct_complexe16 *)
2137: (*s_objet_argument).objet)).partie_imaginaire,
2138: (*((struct_complexe16 *) (*s_objet_argument).objet))
2139: .partie_reelle);
2140:
2141: if (test_cfsf(s_etat_processus, 60) == d_faux)
2142: {
2143: conversion_radians_vers_degres(&((*((struct_complexe16 *)
2144: (*s_objet_resultat).objet)).partie_imaginaire));
2145: }
2146: }
2147:
2148: /*
2149: --------------------------------------------------------------------------------
2150: Conversion d'un nom
2151: --------------------------------------------------------------------------------
2152: */
2153:
2154: else if ((*s_objet_argument).type == NOM)
2155: {
2156: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
2157: == NULL)
2158: {
2159: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2160: return;
2161: }
2162:
2163: if (((*s_objet_resultat).objet =
2164: allocation_maillon(s_etat_processus)) == NULL)
2165: {
2166: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2167: return;
2168: }
2169:
2170: l_element_courant = (*s_objet_resultat).objet;
2171:
2172: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2173: == NULL)
2174: {
2175: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2176: return;
2177: }
2178:
2179: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2180: .nombre_arguments = 0;
2181: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2182: .fonction = instruction_vers_niveau_superieur;
2183:
2184: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2185: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2186: {
2187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2188: return;
2189: }
2190:
2191: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2192: .nom_fonction, "<<");
2193:
2194: if (((*l_element_courant).suivant =
2195: allocation_maillon(s_etat_processus)) == NULL)
2196: {
2197: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2198: return;
2199: }
2200:
2201: l_element_courant = (*l_element_courant).suivant;
2202: (*l_element_courant).donnee = s_objet_argument;
2203:
2204: if (((*l_element_courant).suivant =
2205: allocation_maillon(s_etat_processus)) == NULL)
2206: {
2207: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2208: return;
2209: }
2210:
2211: l_element_courant = (*l_element_courant).suivant;
2212:
2213: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2214: == NULL)
2215: {
2216: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2217: return;
2218: }
2219:
2220: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2221: .nombre_arguments = 1;
2222: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2223: .fonction = instruction_r_vers_p;
2224:
2225: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2226: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
2227: {
2228: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2229: return;
2230: }
2231:
2232: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2233: .nom_fonction, "R->P");
2234:
2235: if (((*l_element_courant).suivant =
2236: allocation_maillon(s_etat_processus)) == NULL)
2237: {
2238: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2239: return;
2240: }
2241:
2242: l_element_courant = (*l_element_courant).suivant;
2243:
2244: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2245: == NULL)
2246: {
2247: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2248: return;
2249: }
2250:
2251: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2252: .nombre_arguments = 0;
2253: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2254: .fonction = instruction_vers_niveau_inferieur;
2255:
2256: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2257: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2258: {
2259: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2260: return;
2261: }
2262:
2263: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2264: .nom_fonction, ">>");
2265:
2266: (*l_element_courant).suivant = NULL;
2267: s_objet_argument = NULL;
2268: }
2269:
2270: /*
2271: --------------------------------------------------------------------------------
2272: Conversion d'une expression
2273: --------------------------------------------------------------------------------
2274: */
2275:
2276: else if (((*s_objet_argument).type == ALG) ||
2277: ((*s_objet_argument).type == RPN))
2278: {
2279: if ((s_copie_argument = copie_objet(s_etat_processus,
2280: s_objet_argument, 'N')) == NULL)
2281: {
2282: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2283: return;
2284: }
2285:
2286: l_element_courant = (struct_liste_chainee *)
2287: (*s_copie_argument).objet;
2288: l_element_precedent = l_element_courant;
2289:
2290: while((*l_element_courant).suivant != NULL)
2291: {
2292: l_element_precedent = l_element_courant;
2293: l_element_courant = (*l_element_courant).suivant;
2294: }
2295:
2296: if (((*l_element_precedent).suivant =
2297: allocation_maillon(s_etat_processus)) == NULL)
2298: {
2299: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2300: return;
2301: }
2302:
2303: if (((*(*l_element_precedent).suivant).donnee =
2304: allocation(s_etat_processus, FCT)) == NULL)
2305: {
2306: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2307: return;
2308: }
2309:
2310: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2311: .donnee).objet)).nombre_arguments = 1;
2312: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2313: .donnee).objet)).fonction = instruction_r_vers_p;
2314:
2315: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2316: .suivant).donnee).objet)).nom_fonction =
2317: malloc(5 * sizeof(unsigned char))) == NULL)
2318: {
2319: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2320: return;
2321: }
2322:
2323: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2324: .suivant).donnee).objet)).nom_fonction, "R->P");
2325:
2326: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2327:
2328: s_objet_resultat = s_copie_argument;
2329: }
2330:
2331: /*
2332: --------------------------------------------------------------------------------
2333: Réalisation impossible de la fonction R->P
2334: --------------------------------------------------------------------------------
2335: */
2336:
2337: else
2338: {
2339: liberation(s_etat_processus, s_objet_argument);
2340:
2341: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2342: return;
2343: }
2344:
2345: liberation(s_etat_processus, s_objet_argument);
2346:
2347: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2348: s_objet_resultat) == d_erreur)
2349: {
2350: return;
2351: }
2352:
2353: return;
2354: }
2355:
2356: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_r1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src