Annotation of rpl/src/instructions_r1.c, revision 1.12
1.1 bertrand 1: /*
2: ================================================================================
1.10 bertrand 3: RPL/2 (R) version 4.0.18
1.1 bertrand 4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
1.11 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 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: logical1 presence_variable;
909:
910: long i;
911:
912: struct_objet *s_objet;
913: struct_objet *s_objet_variable;
914:
915: (*s_etat_processus).erreur_execution = d_ex;
916:
917: if ((*s_etat_processus).affichage_arguments == 'Y')
918: {
919: printf("\n RCL ");
920:
921: if ((*s_etat_processus).langue == 'F')
922: {
923: printf("(renvoie le contenu d'une variable globale)\n\n");
924: }
925: else
926: {
927: printf("(recall global variable)\n\n");
928: }
929:
930: printf(" 1: %s\n", d_NOM);
931: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
932: " %s, %s, %s, %s, %s,\n"
933: " %s, %s, %s, %s, %s,\n"
934: " %s, %s, %s, %s,\n"
935: " %s, %s\n",
936: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
937: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
938: d_SQL, d_SLB, d_PRC, d_MTX);
939:
940: return;
941: }
942: else if ((*s_etat_processus).test_instruction == 'Y')
943: {
944: (*s_etat_processus).nombre_arguments = -1;
945: return;
946: }
947:
948: if (test_cfsf(s_etat_processus, 31) == d_vrai)
949: {
950: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
951: {
952: return;
953: }
954: }
955:
956: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
957: &s_objet) == d_erreur)
958: {
959: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
960: return;
961: }
962:
963: if ((*s_objet).type != NOM)
964: {
965: liberation(s_etat_processus, s_objet);
966:
967: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
968: return;
969: }
970:
971: if (recherche_variable(s_etat_processus, (*((struct_nom *)
972: (*s_objet).objet)).nom) == d_faux)
973: {
974: liberation(s_etat_processus, s_objet);
975:
976: (*s_etat_processus).erreur_systeme = d_es;
977: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
978: return;
979: }
980:
981: i = (*s_etat_processus).position_variable_courante;
982: presence_variable = d_faux;
983:
984: while(i >= 0)
985: {
986: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
987: (*((struct_nom *) (*s_objet).objet)).nom) == 0) &&
988: ((*s_etat_processus).s_liste_variables[i].niveau == 1))
989: {
990: presence_variable = d_vrai;
991: break;
992: }
993:
994: i--;
995: }
996:
997: (*s_etat_processus).position_variable_courante = i;
998:
999: if (presence_variable == d_faux)
1000: {
1001: liberation(s_etat_processus, s_objet);
1002:
1003: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
1004: return;
1005: }
1006:
1007: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
1008: .position_variable_courante].objet == NULL)
1009: {
1010: liberation(s_etat_processus, s_objet);
1011:
1012: (*s_etat_processus).erreur_systeme = d_es;
1013: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
1014: return;
1015: }
1016:
1017: if ((s_objet_variable = copie_objet(s_etat_processus,
1018: ((*s_etat_processus).s_liste_variables)
1019: [(*s_etat_processus).position_variable_courante].objet, 'P'))
1020: == NULL)
1021: {
1022: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1023: return;
1024: }
1025:
1026: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1027: s_objet_variable) == d_erreur)
1028: {
1029: return;
1030: }
1031:
1032: liberation(s_etat_processus, s_objet);
1033:
1034: return;
1035: }
1036:
1037:
1038: /*
1039: ================================================================================
1040: Fonction 'rand'
1041: ================================================================================
1042: Entrées : structure processus
1043: -------------------------------------------------------------------------------
1044: Sorties :
1045: --------------------------------------------------------------------------------
1046: Effets de bord : néant
1047: ================================================================================
1048: */
1049:
1050: void
1051: instruction_rand(struct_processus *s_etat_processus)
1052: {
1053: struct_objet *s_objet;
1054:
1055: (*s_etat_processus).erreur_execution = d_ex;
1056:
1057: if ((*s_etat_processus).affichage_arguments == 'Y')
1058: {
1059: printf("\n RAND ");
1060:
1061: if ((*s_etat_processus).langue == 'F')
1062: {
1063: printf("(variable aléatoire uniforme)\n\n");
1064: }
1065: else
1066: {
1067: printf("(uniform random number)\n\n");
1068: }
1069:
1070: printf("-> 1: %s\n", d_REL);
1071:
1072: return;
1073: }
1074: else if ((*s_etat_processus).test_instruction == 'Y')
1075: {
1076: (*s_etat_processus).nombre_arguments = -1;
1077: return;
1078: }
1079:
1080: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1081: {
1082: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1083: {
1084: return;
1085: }
1086: }
1087:
1088: if ((*s_etat_processus).generateur_aleatoire == NULL)
1089: {
1090: initialisation_generateur_aleatoire(s_etat_processus, d_vrai, 0);
1091: }
1092:
1093: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
1094: {
1095: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1096: return;
1097: }
1098:
1099: (*((real8 *) (*s_objet).objet)) = gsl_rng_uniform(
1100: (*s_etat_processus).generateur_aleatoire);
1101:
1102: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1103: s_objet) == d_erreur)
1104: {
1105: return;
1106: }
1107:
1108: return;
1109: }
1110:
1111:
1112: /*
1113: ================================================================================
1114: Fonction 'rdz'
1115: ================================================================================
1116: Entrées : structure processus
1117: -------------------------------------------------------------------------------
1118: Sorties :
1119: --------------------------------------------------------------------------------
1120: Effets de bord : néant
1121: ================================================================================
1122: */
1123:
1124: void
1125: instruction_rdz(struct_processus *s_etat_processus)
1126: {
1127: struct_objet *s_objet;
1128:
1129: (*s_etat_processus).erreur_execution = d_ex;
1130:
1131: if ((*s_etat_processus).affichage_arguments == 'Y')
1132: {
1133: printf("\n RDZ ");
1134:
1135: if ((*s_etat_processus).langue == 'F')
1136: {
1137: printf("(racine des nombres aléatoires)\n\n");
1138: }
1139: else
1140: {
1141: printf("(random seed)\n\n");
1142: }
1143:
1144: printf(" 1: %s\n", d_INT);
1145:
1146: return;
1147: }
1148: else if ((*s_etat_processus).test_instruction == 'Y')
1149: {
1150: (*s_etat_processus).nombre_arguments = -1;
1151: return;
1152: }
1153:
1154: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1155: {
1156: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1157: {
1158: return;
1159: }
1160: }
1161:
1162: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1163: &s_objet) == d_erreur)
1164: {
1165: return;
1166: }
1167:
1168: if ((*s_objet).type == INT)
1169: {
1170: initialisation_generateur_aleatoire(s_etat_processus, d_faux,
1171: (unsigned long int) (*((integer8 *) (*s_objet).objet)));
1172: }
1173: else
1174: {
1175: liberation(s_etat_processus, s_objet);
1176:
1177: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1178: return;
1179: }
1180:
1181: liberation(s_etat_processus, s_objet);
1182: }
1183:
1184:
1185: /*
1186: ================================================================================
1187: Fonction 'rnd'
1188: ================================================================================
1189: Entrées : structure processus
1190: --------------------------------------------------------------------------------
1191: Sorties :
1192: --------------------------------------------------------------------------------
1193: Effets de bord : néant
1194: ================================================================================
1195: */
1196:
1197: void
1198: instruction_rnd(struct_processus *s_etat_processus)
1199: {
1200: struct_objet *s_objet_argument;
1201:
1202: unsigned char *instruction_courante;
1203:
1204: (*s_etat_processus).erreur_execution = d_ex;
1205:
1206: if ((*s_etat_processus).affichage_arguments == 'Y')
1207: {
1208: printf("\n RND ");
1209:
1210: if ((*s_etat_processus).langue == 'F')
1211: {
1212: printf("(arrondi)\n\n");
1213: }
1214: else
1215: {
1216: printf("(rounding)\n\n");
1217: }
1218:
1219: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
1220: " %s, %s, %s\n",
1221: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX);
1222: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
1223: " %s, %s, %s\n",
1224: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX);
1225:
1226: return;
1227: }
1228: else if ((*s_etat_processus).test_instruction == 'Y')
1229: {
1230: (*s_etat_processus).nombre_arguments = 1;
1231: return;
1232: }
1233:
1234: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1235: {
1236: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1237: {
1238: return;
1239: }
1240: }
1241:
1242: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1243: &s_objet_argument) == d_erreur)
1244: {
1245: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1246: return;
1247: }
1248:
1249: if (((*s_objet_argument).type == INT) ||
1250: ((*s_objet_argument).type == REL) ||
1251: ((*s_objet_argument).type == CPL) ||
1252: ((*s_objet_argument).type == VIN) ||
1253: ((*s_objet_argument).type == VRL) ||
1254: ((*s_objet_argument).type == VCX) ||
1255: ((*s_objet_argument).type == MIN) ||
1256: ((*s_objet_argument).type == MRL) ||
1257: ((*s_objet_argument).type == MCX))
1258: {
1259: instruction_courante = (*s_etat_processus).instruction_courante;
1260:
1261: if (((*s_etat_processus).instruction_courante =
1262: formateur(s_etat_processus, 0, s_objet_argument)) == NULL)
1263: {
1264: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1265: (*s_etat_processus).instruction_courante = instruction_courante;
1266: return;
1267: }
1268:
1269: recherche_type(s_etat_processus);
1270:
1271: free((*s_etat_processus).instruction_courante);
1272: (*s_etat_processus).instruction_courante = instruction_courante;
1273:
1274: if ((*s_etat_processus).erreur_systeme != d_es)
1275: {
1276: return;
1277: }
1278:
1279: if ((*s_etat_processus).erreur_execution != d_ex)
1280: {
1281: liberation(s_etat_processus, s_objet_argument);
1282: return;
1283: }
1284: }
1285: else
1286: {
1287: liberation(s_etat_processus, s_objet_argument);
1288:
1289: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1290: return;
1291: }
1292:
1293: liberation(s_etat_processus, s_objet_argument);
1294:
1295: return;
1296: }
1297:
1298:
1299: /*
1300: ================================================================================
1301: Fonction 'r->c'
1302: ================================================================================
1303: Entrées : structure processus
1304: --------------------------------------------------------------------------------
1305: Sorties :
1306: --------------------------------------------------------------------------------
1307: Effets de bord : néant
1308: ================================================================================
1309: */
1310:
1311: void
1312: instruction_r_vers_c(struct_processus *s_etat_processus)
1313: {
1314: struct_objet *s_objet_argument_1;
1315: struct_objet *s_objet_argument_2;
1316: struct_objet *s_objet_resultat;
1317:
1318: unsigned long i;
1319: unsigned long j;
1320:
1321: (*s_etat_processus).erreur_execution = d_ex;
1322:
1323: if ((*s_etat_processus).affichage_arguments == 'Y')
1324: {
1325: printf("\n R->C ");
1326:
1327: if ((*s_etat_processus).langue == 'F')
1328: {
1329: printf("(réel vers complexe)\n\n");
1330: }
1331: else
1332: {
1333: printf("(real to complex)\n\n");
1334: }
1335:
1336: printf(" 2: %s, %s\n", d_INT, d_REL);
1337: printf(" 1: %s, %s\n", d_INT, d_REL);
1338: printf("-> 1: %s\n\n", d_CPL);
1339:
1340: printf(" 2: %s, %s\n", d_VIN, d_VRL);
1341: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1342: printf("-> 1: %s\n\n", d_VCX);
1343:
1344: printf(" 2: %s, %s\n", d_MIN, d_MRL);
1345: printf(" 1: %s, %s\n", d_MIN, d_MRL);
1346: printf("-> 1: %s\n", d_MCX);
1347:
1348: return;
1349: }
1350: else if ((*s_etat_processus).test_instruction == 'Y')
1351: {
1352: (*s_etat_processus).nombre_arguments = -1;
1353: return;
1354: }
1355:
1356: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1357: {
1358: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1359: {
1360: return;
1361: }
1362: }
1363:
1364: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1365: &s_objet_argument_1) == d_erreur)
1366: {
1367: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1368: return;
1369: }
1370:
1371: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1372: &s_objet_argument_2) == d_erreur)
1373: {
1374: liberation(s_etat_processus, s_objet_argument_1);
1375:
1376: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1377: return;
1378: }
1379:
1380: /*
1381: --------------------------------------------------------------------------------
1382: Formation d'un complexe à partir de deux réels
1383: --------------------------------------------------------------------------------
1384: */
1385:
1386: if ((((*s_objet_argument_1).type == INT) ||
1387: ((*s_objet_argument_1).type == REL)) &&
1388: (((*s_objet_argument_2).type == INT) ||
1389: ((*s_objet_argument_2).type == REL)))
1390: {
1391: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1392: {
1393: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1394: return;
1395: }
1396:
1397: if ((*s_objet_argument_1).type == INT)
1398: {
1399: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1400: .partie_imaginaire =
1401: (*((integer8 *) (*s_objet_argument_1).objet));
1402: }
1403: else
1404: {
1405: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1406: .partie_imaginaire =
1407: (*((real8 *) (*s_objet_argument_1).objet));
1408: }
1409:
1410: if ((*s_objet_argument_2).type == INT)
1411: {
1412: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1413: .partie_reelle =
1414: (*((integer8 *) (*s_objet_argument_2).objet));
1415: }
1416: else
1417: {
1418: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1419: .partie_reelle =
1420: (*((real8 *) (*s_objet_argument_2).objet));
1421: }
1422: }
1423:
1424: /*
1425: --------------------------------------------------------------------------------
1426: Formation à partir de deux vecteurs
1427: --------------------------------------------------------------------------------
1428: */
1429:
1430: else if ((((*s_objet_argument_1).type == VIN) ||
1431: ((*s_objet_argument_1).type == VRL)) &&
1432: (((*s_objet_argument_2).type == VIN) ||
1433: ((*s_objet_argument_2).type == VRL)))
1434: {
1435: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
1436: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
1437: {
1438: liberation(s_etat_processus, s_objet_argument_1);
1439: liberation(s_etat_processus, s_objet_argument_2);
1440:
1441: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1442: return;
1443: }
1444:
1445: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
1446: {
1447: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1448: return;
1449: }
1450:
1451: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1452: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
1453:
1454: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1455: malloc((*(((struct_vecteur *) (*s_objet_resultat)
1456: .objet))).taille * sizeof(struct_complexe16))) == NULL)
1457: {
1458: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1459: return;
1460: }
1461:
1462: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument_1).objet)))
1463: .taille; i++)
1464: {
1465: if ((*s_objet_argument_1).type == VIN)
1466: {
1467: ((struct_complexe16 *) (*((struct_vecteur *)
1468: (*s_objet_resultat).objet)).tableau)[i]
1469: .partie_imaginaire = ((integer8 *)
1470: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1471: .tableau)[i];
1472: }
1473: else
1474: {
1475: ((struct_complexe16 *) (*((struct_vecteur *)
1476: (*s_objet_resultat).objet)).tableau)[i]
1477: .partie_imaginaire = ((real8 *)
1478: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1479: .tableau)[i];
1480: }
1481:
1482: if ((*s_objet_argument_2).type == VIN)
1483: {
1484: ((struct_complexe16 *) (*((struct_vecteur *)
1485: (*s_objet_resultat).objet)).tableau)[i]
1486: .partie_reelle = ((integer8 *)
1487: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1488: .tableau)[i];
1489: }
1490: else
1491: {
1492: ((struct_complexe16 *) (*((struct_vecteur *)
1493: (*s_objet_resultat).objet)).tableau)[i]
1494: .partie_reelle = ((real8 *)
1495: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1496: .tableau)[i];
1497: }
1498: }
1499: }
1500:
1501: /*
1502: --------------------------------------------------------------------------------
1503: Formation à partir de deux matrices
1504: --------------------------------------------------------------------------------
1505: */
1506:
1507: else if ((((*s_objet_argument_1).type == MIN) ||
1508: ((*s_objet_argument_1).type == MRL)) &&
1509: (((*s_objet_argument_2).type == MIN) ||
1510: ((*s_objet_argument_2).type == MRL)))
1511: {
1512: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
1513: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
1514: .objet))).nombre_lignes) || ((*(((struct_matrice *)
1515: (*s_objet_argument_1).objet))).nombre_colonnes !=
1516: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
1517: .nombre_lignes))
1518: {
1519: liberation(s_etat_processus, s_objet_argument_1);
1520: liberation(s_etat_processus, s_objet_argument_2);
1521:
1522: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1523: return;
1524: }
1525:
1526: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
1527: {
1528: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1529: return;
1530: }
1531:
1532: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1533: (*((struct_matrice *) (*s_objet_argument_1).objet))
1534: .nombre_lignes;
1535: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1536: (*((struct_matrice *) (*s_objet_argument_1).objet))
1537: .nombre_colonnes;
1538:
1539: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1540: malloc((*(((struct_matrice *) (*s_objet_resultat)
1541: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
1542: {
1543: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1544: return;
1545: }
1546:
1547: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_1).objet)))
1548: .nombre_lignes; i++)
1549: {
1550: if ((((struct_complexe16 **) (*((struct_matrice *)
1551: (*s_objet_resultat).objet)).tableau)[i] =
1552: malloc((*((struct_matrice *)
1553: (*s_objet_resultat).objet)).nombre_colonnes *
1554: sizeof(struct_complexe16))) == NULL)
1555: {
1556: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1557: return;
1558: }
1559:
1560: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument_1).objet)))
1561: .nombre_colonnes; j++)
1562: {
1563: if ((*s_objet_argument_1).type == MIN)
1564: {
1565: ((struct_complexe16 **) (*((struct_matrice *)
1566: (*s_objet_resultat).objet)).tableau)[i][j]
1567: .partie_imaginaire = ((integer8 **)
1568: (*((struct_matrice *) (*s_objet_argument_1).objet))
1569: .tableau)[i][j];
1570: }
1571: else
1572: {
1573: ((struct_complexe16 **) (*((struct_matrice *)
1574: (*s_objet_resultat).objet)).tableau)[i][j]
1575: .partie_imaginaire = ((real8 **)
1576: (*((struct_matrice *) (*s_objet_argument_1).objet))
1577: .tableau)[i][j];
1578: }
1579:
1580: if ((*s_objet_argument_2).type == MIN)
1581: {
1582: ((struct_complexe16 **) (*((struct_matrice *)
1583: (*s_objet_resultat).objet)).tableau)[i][j]
1584: .partie_reelle = ((integer8 **)
1585: (*((struct_matrice *) (*s_objet_argument_2).objet))
1586: .tableau)[i][j];
1587: }
1588: else
1589: {
1590: ((struct_complexe16 **) (*((struct_matrice *)
1591: (*s_objet_resultat).objet)).tableau)[i][j]
1592: .partie_reelle = ((real8 **)
1593: (*((struct_matrice *) (*s_objet_argument_2).objet))
1594: .tableau)[i][j];
1595: }
1596: }
1597: }
1598: }
1599:
1600: /*
1601: --------------------------------------------------------------------------------
1602: Formation impossible
1603: --------------------------------------------------------------------------------
1604: */
1605:
1606: else
1607: {
1608: liberation(s_etat_processus, s_objet_argument_1);
1609: liberation(s_etat_processus, s_objet_argument_2);
1610:
1611: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1612: return;
1613: }
1614:
1615: liberation(s_etat_processus, s_objet_argument_1);
1616: liberation(s_etat_processus, s_objet_argument_2);
1617:
1618: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1619: s_objet_resultat) == d_erreur)
1620: {
1621: return;
1622: }
1623:
1624: return;
1625: }
1626:
1627:
1628: /*
1629: ================================================================================
1630: Fonction 're'
1631: ================================================================================
1632: Entrées : structure processus
1633: --------------------------------------------------------------------------------
1634: Sorties :
1635: --------------------------------------------------------------------------------
1636: Effets de bord : néant
1637: ================================================================================
1638: */
1639:
1640: void
1641: instruction_re(struct_processus *s_etat_processus)
1642: {
1643: struct_liste_chainee *l_element_courant;
1644: struct_liste_chainee *l_element_precedent;
1645:
1646: struct_objet *s_copie_argument;
1647: struct_objet *s_objet_argument;
1648: struct_objet *s_objet_resultat;
1649:
1650: unsigned long i;
1651: unsigned long j;
1652:
1653: (*s_etat_processus).erreur_execution = d_ex;
1654:
1655: if ((*s_etat_processus).affichage_arguments == 'Y')
1656: {
1657: printf("\n RE ");
1658:
1659: if ((*s_etat_processus).langue == 'F')
1660: {
1661: printf("(partie réelle)\n\n");
1662: }
1663: else
1664: {
1665: printf("(real part)\n\n");
1666: }
1667:
1668: printf(" 1: %s, %s\n", d_INT, d_REL);
1669: printf("-> 1: %s\n\n", d_INT);
1670:
1671: printf(" 1: %s\n", d_CPL);
1672: printf("-> 1: %s\n\n", d_REL);
1673:
1674: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1675: printf("-> 1: %s\n\n", d_VIN);
1676:
1677: printf(" 1: %s\n", d_VCX);
1678: printf("-> 1: %s\n\n", d_VRL);
1679:
1680: printf(" 1: %s, %s\n", d_MIN, d_MRL);
1681: printf("-> 1: %s\n\n", d_MIN);
1682:
1683: printf(" 1: %s\n", d_MCX);
1684: printf("-> 1: %s\n\n", d_MRL);
1685:
1686: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1687: printf("-> 1: %s\n\n", d_ALG);
1688:
1689: printf(" 1: %s\n", d_RPN);
1690: printf("-> 1: %s\n", d_RPN);
1691:
1692: return;
1693: }
1694: else if ((*s_etat_processus).test_instruction == 'Y')
1695: {
1696: (*s_etat_processus).nombre_arguments = 1;
1697: return;
1698: }
1699:
1700: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1701: {
1702: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1703: {
1704: return;
1705: }
1706: }
1707:
1708: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1709: &s_objet_argument) == d_erreur)
1710: {
1711: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1712: return;
1713: }
1714:
1715: /*
1716: --------------------------------------------------------------------------------
1717: Partie réelle d'un entier ou d'un réel
1718: --------------------------------------------------------------------------------
1719: */
1720:
1721: if (((*s_objet_argument).type == INT) ||
1722: ((*s_objet_argument).type == REL))
1723: {
1724: s_objet_resultat = s_objet_argument;
1725: s_objet_argument = NULL;
1726: }
1727:
1728: /*
1729: --------------------------------------------------------------------------------
1730: Partie réelle d'un complexe
1731: --------------------------------------------------------------------------------
1732: */
1733:
1734: else if ((*s_objet_argument).type == CPL)
1735: {
1736: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1737: {
1738: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1739: return;
1740: }
1741:
1742: (*((real8 *) (*s_objet_resultat).objet)) =
1743: (*((struct_complexe16 *) (*s_objet_argument).objet))
1744: .partie_reelle;
1745: }
1746:
1747: /*
1748: --------------------------------------------------------------------------------
1749: Partie réelle d'un vecteur
1750: --------------------------------------------------------------------------------
1751: */
1752:
1753: else if (((*s_objet_argument).type == VIN) ||
1754: ((*s_objet_argument).type == VRL))
1755: {
1756: s_objet_resultat = s_objet_argument;
1757: s_objet_argument = NULL;
1758: }
1759: else if ((*s_objet_argument).type == VCX)
1760: {
1761: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
1762: {
1763: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1764: return;
1765: }
1766:
1767: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1768: malloc((*(((struct_vecteur *) (*s_objet_argument)
1769: .objet))).taille * sizeof(real8))) == NULL)
1770: {
1771: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1772: return;
1773: }
1774:
1775: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1776: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
1777:
1778: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
1779: .taille; i++)
1780: {
1781: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1782: .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
1783: (*s_objet_argument).objet)).tableau)[i].partie_reelle;
1784: }
1785: }
1786:
1787: /*
1788: --------------------------------------------------------------------------------
1789: Partie réelle d'une matrice
1790: --------------------------------------------------------------------------------
1791: */
1792:
1793: else if (((*s_objet_argument).type == MIN) ||
1794: ((*s_objet_argument).type == MRL))
1795: {
1796: s_objet_resultat = s_objet_argument;
1797: s_objet_argument = NULL;
1798: }
1799: else if ((*s_objet_argument).type == MCX)
1800: {
1801: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
1802: {
1803: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1804: return;
1805: }
1806:
1807: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1808: malloc((*(((struct_matrice *) (*s_objet_argument)
1809: .objet))).nombre_lignes * sizeof(real8 *))) == NULL)
1810: {
1811: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1812: return;
1813: }
1814:
1815: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1816: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
1817: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1818: (*((struct_matrice *) (*s_objet_argument).objet))
1819: .nombre_colonnes;
1820:
1821: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
1822: .nombre_lignes; i++)
1823: {
1824: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1825: .objet)).tableau)[i] = malloc(
1826: (*(((struct_matrice *) (*s_objet_argument).objet)))
1827: .nombre_colonnes * sizeof(real8))) == NULL)
1828: {
1829: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1830: return;
1831: }
1832:
1833: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1834: .nombre_colonnes; j++)
1835: {
1836: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
1837: .tableau)[i][j] = ((struct_complexe16 **)
1838: (*((struct_matrice *) (*s_objet_argument).objet))
1839: .tableau)[i][j].partie_reelle;
1840: }
1841: }
1842: }
1843:
1844: /*
1845: --------------------------------------------------------------------------------
1846: Partie réelle d'un nom
1847: --------------------------------------------------------------------------------
1848: */
1849:
1850: else if ((*s_objet_argument).type == NOM)
1851: {
1852: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1853: {
1854: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1855: return;
1856: }
1857:
1858: if (((*s_objet_resultat).objet =
1859: allocation_maillon(s_etat_processus)) == NULL)
1860: {
1861: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1862: return;
1863: }
1864:
1865: l_element_courant = (*s_objet_resultat).objet;
1866:
1867: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1868: == NULL)
1869: {
1870: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1871: return;
1872: }
1873:
1874: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1875: .nombre_arguments = 0;
1876: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1877: .fonction = instruction_vers_niveau_superieur;
1878:
1879: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1880: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1881: {
1882: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1883: return;
1884: }
1885:
1886: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1887: .nom_fonction, "<<");
1888:
1889: if (((*l_element_courant).suivant =
1890: allocation_maillon(s_etat_processus)) == NULL)
1891: {
1892: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1893: return;
1894: }
1895:
1896: l_element_courant = (*l_element_courant).suivant;
1897: (*l_element_courant).donnee = s_objet_argument;
1898:
1899: if (((*l_element_courant).suivant =
1900: allocation_maillon(s_etat_processus)) == NULL)
1901: {
1902: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1903: return;
1904: }
1905:
1906: l_element_courant = (*l_element_courant).suivant;
1907:
1908: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1909: == NULL)
1910: {
1911: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1912: return;
1913: }
1914:
1915: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1916: .nombre_arguments = 1;
1917: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1918: .fonction = instruction_re;
1919:
1920: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1921: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1922: {
1923: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1924: return;
1925: }
1926:
1927: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1928: .nom_fonction, "RE");
1929:
1930: if (((*l_element_courant).suivant =
1931: allocation_maillon(s_etat_processus)) == NULL)
1932: {
1933: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1934: return;
1935: }
1936:
1937: l_element_courant = (*l_element_courant).suivant;
1938:
1939: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1940: == NULL)
1941: {
1942: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1943: return;
1944: }
1945:
1946: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1947: .nombre_arguments = 0;
1948: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1949: .fonction = instruction_vers_niveau_inferieur;
1950:
1951: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1952: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1953: {
1954: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1955: return;
1956: }
1957:
1958: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1959: .nom_fonction, ">>");
1960:
1961: (*l_element_courant).suivant = NULL;
1962: s_objet_argument = NULL;
1963: }
1964:
1965: /*
1966: --------------------------------------------------------------------------------
1967: Partie réelle d'une expression
1968: --------------------------------------------------------------------------------
1969: */
1970:
1971: else if (((*s_objet_argument).type == ALG) ||
1972: ((*s_objet_argument).type == RPN))
1973: {
1974: if ((s_copie_argument = copie_objet(s_etat_processus,
1975: s_objet_argument, 'N')) == NULL)
1976: {
1977: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1978: return;
1979: }
1980:
1981: l_element_courant = (struct_liste_chainee *)
1982: (*s_copie_argument).objet;
1983: l_element_precedent = l_element_courant;
1984:
1985: while((*l_element_courant).suivant != NULL)
1986: {
1987: l_element_precedent = l_element_courant;
1988: l_element_courant = (*l_element_courant).suivant;
1989: }
1990:
1991: if (((*l_element_precedent).suivant =
1992: allocation_maillon(s_etat_processus)) == NULL)
1993: {
1994: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1995: return;
1996: }
1997:
1998: if (((*(*l_element_precedent).suivant).donnee =
1999: allocation(s_etat_processus, FCT)) == NULL)
2000: {
2001: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2002: return;
2003: }
2004:
2005: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2006: .donnee).objet)).nombre_arguments = 1;
2007: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2008: .donnee).objet)).fonction = instruction_re;
2009:
2010: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2011: .suivant).donnee).objet)).nom_fonction =
2012: malloc(3 * sizeof(unsigned char))) == NULL)
2013: {
2014: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2015: return;
2016: }
2017:
2018: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2019: .suivant).donnee).objet)).nom_fonction, "RE");
2020:
2021: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2022:
2023: s_objet_resultat = s_copie_argument;
2024: }
2025:
2026: /*
2027: --------------------------------------------------------------------------------
2028: Réalisation impossible de la fonction partie réelle
2029: --------------------------------------------------------------------------------
2030: */
2031:
2032: else
2033: {
2034: liberation(s_etat_processus, s_objet_argument);
2035:
2036: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2037: return;
2038: }
2039:
2040: liberation(s_etat_processus, s_objet_argument);
2041:
2042: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2043: s_objet_resultat) == d_erreur)
2044: {
2045: return;
2046: }
2047:
2048: return;
2049: }
2050:
2051:
2052: /*
2053: ================================================================================
2054: Fonction 'r->p'
2055: ================================================================================
2056: Entrées : pointeur sur une structure struct_processus
2057: --------------------------------------------------------------------------------
2058: Sorties :
2059: --------------------------------------------------------------------------------
2060: Effets de bord : néant
2061: ================================================================================
2062: */
2063:
2064: void
2065: instruction_r_vers_p(struct_processus *s_etat_processus)
2066: {
2067: struct_liste_chainee *l_element_courant;
2068: struct_liste_chainee *l_element_precedent;
2069:
2070: struct_objet *s_copie_argument;
2071: struct_objet *s_objet_argument;
2072: struct_objet *s_objet_resultat;
2073:
2074: (*s_etat_processus).erreur_execution = d_ex;
2075:
2076: if ((*s_etat_processus).affichage_arguments == 'Y')
2077: {
2078: printf("\n P->R ");
2079:
2080: if ((*s_etat_processus).langue == 'F')
2081: {
2082: printf("(coordonnées polaires vers cartésiennes)\n\n");
2083: }
2084: else
2085: {
2086: printf("(polar to cartesian coordinates)\n\n");
2087: }
2088:
2089: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
2090: printf("-> 1: %s\n\n", d_CPL);
2091:
2092: printf(" 1: %s, %s\n", d_NOM, d_ALG);
2093: printf("-> 1: %s\n\n", d_ALG);
2094:
2095: printf(" 1: %s\n", d_RPN);
2096: printf("-> 1: %s\n", d_RPN);
2097:
2098: return;
2099: }
2100: else if ((*s_etat_processus).test_instruction == 'Y')
2101: {
2102: (*s_etat_processus).nombre_arguments = -1;
2103: return;
2104: }
2105:
2106: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2107: {
2108: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2109: {
2110: return;
2111: }
2112: }
2113:
2114: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2115: &s_objet_argument) == d_erreur)
2116: {
2117: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2118: return;
2119: }
2120:
2121: /*
2122: --------------------------------------------------------------------------------
2123: Conversion d'un entier ou d'un réel
2124: --------------------------------------------------------------------------------
2125: */
2126:
2127: if (((*s_objet_argument).type == INT) ||
2128: ((*s_objet_argument).type == REL))
2129: {
2130: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2131: == NULL)
2132: {
2133: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2134: return;
2135: }
2136:
2137: if ((*s_objet_argument).type == INT)
2138: {
2139: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle
2140: = (*((integer8 *) (*s_objet_argument).objet));
2141: }
2142: else
2143: {
2144: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle
2145: = (*((real8 *) (*s_objet_argument).objet));
2146: }
2147:
2148: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_imaginaire
2149: = 0;
2150: }
2151:
2152: /*
2153: --------------------------------------------------------------------------------
2154: Conversion d'un complexe
2155: --------------------------------------------------------------------------------
2156: */
2157:
2158: else if ((*s_objet_argument).type == CPL)
2159: {
2160: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2161: == NULL)
2162: {
2163: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2164: return;
2165: }
2166:
2167: f77absc_(((struct_complexe16 *) (*s_objet_argument).objet),
2168: &((*((struct_complexe16 *) (*s_objet_resultat).objet))
2169: .partie_reelle));
2170:
2171: (*((struct_complexe16 *) (*s_objet_resultat).objet))
2172: .partie_imaginaire = atan2((*((struct_complexe16 *)
2173: (*s_objet_argument).objet)).partie_imaginaire,
2174: (*((struct_complexe16 *) (*s_objet_argument).objet))
2175: .partie_reelle);
2176:
2177: if (test_cfsf(s_etat_processus, 60) == d_faux)
2178: {
2179: conversion_radians_vers_degres(&((*((struct_complexe16 *)
2180: (*s_objet_resultat).objet)).partie_imaginaire));
2181: }
2182: }
2183:
2184: /*
2185: --------------------------------------------------------------------------------
2186: Conversion d'un nom
2187: --------------------------------------------------------------------------------
2188: */
2189:
2190: else if ((*s_objet_argument).type == NOM)
2191: {
2192: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
2193: == NULL)
2194: {
2195: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2196: return;
2197: }
2198:
2199: if (((*s_objet_resultat).objet =
2200: allocation_maillon(s_etat_processus)) == NULL)
2201: {
2202: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2203: return;
2204: }
2205:
2206: l_element_courant = (*s_objet_resultat).objet;
2207:
2208: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2209: == NULL)
2210: {
2211: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2212: return;
2213: }
2214:
2215: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2216: .nombre_arguments = 0;
2217: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2218: .fonction = instruction_vers_niveau_superieur;
2219:
2220: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2221: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2222: {
2223: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2224: return;
2225: }
2226:
2227: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2228: .nom_fonction, "<<");
2229:
2230: if (((*l_element_courant).suivant =
2231: allocation_maillon(s_etat_processus)) == NULL)
2232: {
2233: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2234: return;
2235: }
2236:
2237: l_element_courant = (*l_element_courant).suivant;
2238: (*l_element_courant).donnee = s_objet_argument;
2239:
2240: if (((*l_element_courant).suivant =
2241: allocation_maillon(s_etat_processus)) == NULL)
2242: {
2243: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2244: return;
2245: }
2246:
2247: l_element_courant = (*l_element_courant).suivant;
2248:
2249: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2250: == NULL)
2251: {
2252: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2253: return;
2254: }
2255:
2256: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2257: .nombre_arguments = 1;
2258: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2259: .fonction = instruction_r_vers_p;
2260:
2261: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2262: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
2263: {
2264: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2265: return;
2266: }
2267:
2268: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2269: .nom_fonction, "R->P");
2270:
2271: if (((*l_element_courant).suivant =
2272: allocation_maillon(s_etat_processus)) == NULL)
2273: {
2274: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2275: return;
2276: }
2277:
2278: l_element_courant = (*l_element_courant).suivant;
2279:
2280: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2281: == NULL)
2282: {
2283: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2284: return;
2285: }
2286:
2287: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2288: .nombre_arguments = 0;
2289: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2290: .fonction = instruction_vers_niveau_inferieur;
2291:
2292: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2293: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2294: {
2295: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2296: return;
2297: }
2298:
2299: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2300: .nom_fonction, ">>");
2301:
2302: (*l_element_courant).suivant = NULL;
2303: s_objet_argument = NULL;
2304: }
2305:
2306: /*
2307: --------------------------------------------------------------------------------
2308: Conversion d'une expression
2309: --------------------------------------------------------------------------------
2310: */
2311:
2312: else if (((*s_objet_argument).type == ALG) ||
2313: ((*s_objet_argument).type == RPN))
2314: {
2315: if ((s_copie_argument = copie_objet(s_etat_processus,
2316: s_objet_argument, 'N')) == NULL)
2317: {
2318: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2319: return;
2320: }
2321:
2322: l_element_courant = (struct_liste_chainee *)
2323: (*s_copie_argument).objet;
2324: l_element_precedent = l_element_courant;
2325:
2326: while((*l_element_courant).suivant != NULL)
2327: {
2328: l_element_precedent = l_element_courant;
2329: l_element_courant = (*l_element_courant).suivant;
2330: }
2331:
2332: if (((*l_element_precedent).suivant =
2333: allocation_maillon(s_etat_processus)) == NULL)
2334: {
2335: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2336: return;
2337: }
2338:
2339: if (((*(*l_element_precedent).suivant).donnee =
2340: allocation(s_etat_processus, FCT)) == NULL)
2341: {
2342: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2343: return;
2344: }
2345:
2346: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2347: .donnee).objet)).nombre_arguments = 1;
2348: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2349: .donnee).objet)).fonction = instruction_r_vers_p;
2350:
2351: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2352: .suivant).donnee).objet)).nom_fonction =
2353: malloc(5 * sizeof(unsigned char))) == NULL)
2354: {
2355: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2356: return;
2357: }
2358:
2359: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2360: .suivant).donnee).objet)).nom_fonction, "R->P");
2361:
2362: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2363:
2364: s_objet_resultat = s_copie_argument;
2365: }
2366:
2367: /*
2368: --------------------------------------------------------------------------------
2369: Réalisation impossible de la fonction R->P
2370: --------------------------------------------------------------------------------
2371: */
2372:
2373: else
2374: {
2375: liberation(s_etat_processus, s_objet_argument);
2376:
2377: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2378: return;
2379: }
2380:
2381: liberation(s_etat_processus, s_objet_argument);
2382:
2383: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2384: s_objet_resultat) == d_erreur)
2385: {
2386: return;
2387: }
2388:
2389: return;
2390: }
2391:
2392: // 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