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