Annotation of rpl/src/instructions_r1.c, revision 1.50
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:
1.50 ! bertrand 1234: (*s_etat_processus).type_en_cours = NON;
1.1 bertrand 1235: recherche_type(s_etat_processus);
1236:
1237: free((*s_etat_processus).instruction_courante);
1238: (*s_etat_processus).instruction_courante = instruction_courante;
1239:
1240: if ((*s_etat_processus).erreur_systeme != d_es)
1241: {
1242: return;
1243: }
1244:
1245: if ((*s_etat_processus).erreur_execution != d_ex)
1246: {
1247: liberation(s_etat_processus, s_objet_argument);
1248: return;
1249: }
1250: }
1251: else
1252: {
1253: liberation(s_etat_processus, s_objet_argument);
1254:
1255: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1256: return;
1257: }
1258:
1259: liberation(s_etat_processus, s_objet_argument);
1260:
1261: return;
1262: }
1263:
1264:
1265: /*
1266: ================================================================================
1267: Fonction 'r->c'
1268: ================================================================================
1269: Entrées : structure processus
1270: --------------------------------------------------------------------------------
1271: Sorties :
1272: --------------------------------------------------------------------------------
1273: Effets de bord : néant
1274: ================================================================================
1275: */
1276:
1277: void
1278: instruction_r_vers_c(struct_processus *s_etat_processus)
1279: {
1280: struct_objet *s_objet_argument_1;
1281: struct_objet *s_objet_argument_2;
1282: struct_objet *s_objet_resultat;
1283:
1.42 bertrand 1284: integer8 i;
1285: integer8 j;
1.1 bertrand 1286:
1287: (*s_etat_processus).erreur_execution = d_ex;
1288:
1289: if ((*s_etat_processus).affichage_arguments == 'Y')
1290: {
1291: printf("\n R->C ");
1292:
1293: if ((*s_etat_processus).langue == 'F')
1294: {
1295: printf("(réel vers complexe)\n\n");
1296: }
1297: else
1298: {
1299: printf("(real to complex)\n\n");
1300: }
1301:
1302: printf(" 2: %s, %s\n", d_INT, d_REL);
1303: printf(" 1: %s, %s\n", d_INT, d_REL);
1304: printf("-> 1: %s\n\n", d_CPL);
1305:
1306: printf(" 2: %s, %s\n", d_VIN, d_VRL);
1307: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1308: printf("-> 1: %s\n\n", d_VCX);
1309:
1310: printf(" 2: %s, %s\n", d_MIN, d_MRL);
1311: printf(" 1: %s, %s\n", d_MIN, d_MRL);
1312: printf("-> 1: %s\n", d_MCX);
1313:
1314: return;
1315: }
1316: else if ((*s_etat_processus).test_instruction == 'Y')
1317: {
1318: (*s_etat_processus).nombre_arguments = -1;
1319: return;
1320: }
1321:
1322: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1323: {
1324: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1325: {
1326: return;
1327: }
1328: }
1329:
1330: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1331: &s_objet_argument_1) == d_erreur)
1332: {
1333: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1334: return;
1335: }
1336:
1337: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1338: &s_objet_argument_2) == d_erreur)
1339: {
1340: liberation(s_etat_processus, s_objet_argument_1);
1341:
1342: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1343: return;
1344: }
1345:
1346: /*
1347: --------------------------------------------------------------------------------
1348: Formation d'un complexe à partir de deux réels
1349: --------------------------------------------------------------------------------
1350: */
1351:
1352: if ((((*s_objet_argument_1).type == INT) ||
1353: ((*s_objet_argument_1).type == REL)) &&
1354: (((*s_objet_argument_2).type == INT) ||
1355: ((*s_objet_argument_2).type == REL)))
1356: {
1357: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1358: {
1359: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1360: return;
1361: }
1362:
1363: if ((*s_objet_argument_1).type == INT)
1364: {
1365: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1.42 bertrand 1366: .partie_imaginaire = (real8)
1.1 bertrand 1367: (*((integer8 *) (*s_objet_argument_1).objet));
1368: }
1369: else
1370: {
1371: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1372: .partie_imaginaire =
1373: (*((real8 *) (*s_objet_argument_1).objet));
1374: }
1375:
1376: if ((*s_objet_argument_2).type == INT)
1377: {
1378: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1.42 bertrand 1379: .partie_reelle = (real8)
1.1 bertrand 1380: (*((integer8 *) (*s_objet_argument_2).objet));
1381: }
1382: else
1383: {
1384: (*((struct_complexe16 *) (*s_objet_resultat).objet))
1385: .partie_reelle =
1386: (*((real8 *) (*s_objet_argument_2).objet));
1387: }
1388: }
1389:
1390: /*
1391: --------------------------------------------------------------------------------
1392: Formation à partir de deux vecteurs
1393: --------------------------------------------------------------------------------
1394: */
1395:
1396: else if ((((*s_objet_argument_1).type == VIN) ||
1397: ((*s_objet_argument_1).type == VRL)) &&
1398: (((*s_objet_argument_2).type == VIN) ||
1399: ((*s_objet_argument_2).type == VRL)))
1400: {
1401: if ((*(((struct_vecteur *) (*s_objet_argument_1).objet))).taille !=
1402: (*(((struct_vecteur *) (*s_objet_argument_2).objet))).taille)
1403: {
1404: liberation(s_etat_processus, s_objet_argument_1);
1405: liberation(s_etat_processus, s_objet_argument_2);
1406:
1407: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1408: return;
1409: }
1410:
1411: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
1412: {
1413: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1414: return;
1415: }
1416:
1417: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1418: (*((struct_vecteur *) (*s_objet_argument_1).objet)).taille;
1419:
1420: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.42 bertrand 1421: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_resultat)
1422: .objet))).taille) * sizeof(struct_complexe16))) == NULL)
1.1 bertrand 1423: {
1424: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1425: return;
1426: }
1427:
1428: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument_1).objet)))
1429: .taille; i++)
1430: {
1431: if ((*s_objet_argument_1).type == VIN)
1432: {
1433: ((struct_complexe16 *) (*((struct_vecteur *)
1434: (*s_objet_resultat).objet)).tableau)[i]
1.42 bertrand 1435: .partie_imaginaire = (real8) ((integer8 *)
1.1 bertrand 1436: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1437: .tableau)[i];
1438: }
1439: else
1440: {
1441: ((struct_complexe16 *) (*((struct_vecteur *)
1442: (*s_objet_resultat).objet)).tableau)[i]
1443: .partie_imaginaire = ((real8 *)
1444: (*((struct_vecteur *) (*s_objet_argument_1).objet))
1445: .tableau)[i];
1446: }
1447:
1448: if ((*s_objet_argument_2).type == VIN)
1449: {
1450: ((struct_complexe16 *) (*((struct_vecteur *)
1451: (*s_objet_resultat).objet)).tableau)[i]
1.42 bertrand 1452: .partie_reelle = (real8) ((integer8 *)
1.1 bertrand 1453: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1454: .tableau)[i];
1455: }
1456: else
1457: {
1458: ((struct_complexe16 *) (*((struct_vecteur *)
1459: (*s_objet_resultat).objet)).tableau)[i]
1460: .partie_reelle = ((real8 *)
1461: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1462: .tableau)[i];
1463: }
1464: }
1465: }
1466:
1467: /*
1468: --------------------------------------------------------------------------------
1469: Formation à partir de deux matrices
1470: --------------------------------------------------------------------------------
1471: */
1472:
1473: else if ((((*s_objet_argument_1).type == MIN) ||
1474: ((*s_objet_argument_1).type == MRL)) &&
1475: (((*s_objet_argument_2).type == MIN) ||
1476: ((*s_objet_argument_2).type == MRL)))
1477: {
1478: if (((*(((struct_matrice *) (*s_objet_argument_1).objet)))
1479: .nombre_lignes != (*(((struct_matrice *) (*s_objet_argument_2)
1480: .objet))).nombre_lignes) || ((*(((struct_matrice *)
1481: (*s_objet_argument_1).objet))).nombre_colonnes !=
1482: (*(((struct_matrice *) (*s_objet_argument_2).objet)))
1483: .nombre_lignes))
1484: {
1485: liberation(s_etat_processus, s_objet_argument_1);
1486: liberation(s_etat_processus, s_objet_argument_2);
1487:
1488: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
1489: return;
1490: }
1491:
1492: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
1493: {
1494: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1495: return;
1496: }
1497:
1498: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1499: (*((struct_matrice *) (*s_objet_argument_1).objet))
1500: .nombre_lignes;
1501: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1502: (*((struct_matrice *) (*s_objet_argument_1).objet))
1503: .nombre_colonnes;
1504:
1505: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.42 bertrand 1506: malloc(((size_t) (*(((struct_matrice *) (*s_objet_resultat)
1507: .objet))).nombre_lignes) * sizeof(struct_complexe16 *)))
1508: == NULL)
1.1 bertrand 1509: {
1510: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1511: return;
1512: }
1513:
1514: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_1).objet)))
1515: .nombre_lignes; i++)
1516: {
1517: if ((((struct_complexe16 **) (*((struct_matrice *)
1518: (*s_objet_resultat).objet)).tableau)[i] =
1.42 bertrand 1519: malloc(((size_t) (*((struct_matrice *)
1520: (*s_objet_resultat).objet)).nombre_colonnes) *
1.1 bertrand 1521: sizeof(struct_complexe16))) == NULL)
1522: {
1523: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1524: return;
1525: }
1526:
1527: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument_1).objet)))
1528: .nombre_colonnes; j++)
1529: {
1530: if ((*s_objet_argument_1).type == MIN)
1531: {
1532: ((struct_complexe16 **) (*((struct_matrice *)
1533: (*s_objet_resultat).objet)).tableau)[i][j]
1.42 bertrand 1534: .partie_imaginaire = (real8) ((integer8 **)
1.1 bertrand 1535: (*((struct_matrice *) (*s_objet_argument_1).objet))
1536: .tableau)[i][j];
1537: }
1538: else
1539: {
1540: ((struct_complexe16 **) (*((struct_matrice *)
1541: (*s_objet_resultat).objet)).tableau)[i][j]
1542: .partie_imaginaire = ((real8 **)
1543: (*((struct_matrice *) (*s_objet_argument_1).objet))
1544: .tableau)[i][j];
1545: }
1546:
1547: if ((*s_objet_argument_2).type == MIN)
1548: {
1549: ((struct_complexe16 **) (*((struct_matrice *)
1550: (*s_objet_resultat).objet)).tableau)[i][j]
1.42 bertrand 1551: .partie_reelle = (real8) ((integer8 **)
1.1 bertrand 1552: (*((struct_matrice *) (*s_objet_argument_2).objet))
1553: .tableau)[i][j];
1554: }
1555: else
1556: {
1557: ((struct_complexe16 **) (*((struct_matrice *)
1558: (*s_objet_resultat).objet)).tableau)[i][j]
1559: .partie_reelle = ((real8 **)
1560: (*((struct_matrice *) (*s_objet_argument_2).objet))
1561: .tableau)[i][j];
1562: }
1563: }
1564: }
1565: }
1566:
1567: /*
1568: --------------------------------------------------------------------------------
1569: Formation impossible
1570: --------------------------------------------------------------------------------
1571: */
1572:
1573: else
1574: {
1575: liberation(s_etat_processus, s_objet_argument_1);
1576: liberation(s_etat_processus, s_objet_argument_2);
1577:
1578: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1579: return;
1580: }
1581:
1582: liberation(s_etat_processus, s_objet_argument_1);
1583: liberation(s_etat_processus, s_objet_argument_2);
1584:
1585: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1586: s_objet_resultat) == d_erreur)
1587: {
1588: return;
1589: }
1590:
1591: return;
1592: }
1593:
1594:
1595: /*
1596: ================================================================================
1597: Fonction 're'
1598: ================================================================================
1599: Entrées : structure processus
1600: --------------------------------------------------------------------------------
1601: Sorties :
1602: --------------------------------------------------------------------------------
1603: Effets de bord : néant
1604: ================================================================================
1605: */
1606:
1607: void
1608: instruction_re(struct_processus *s_etat_processus)
1609: {
1610: struct_liste_chainee *l_element_courant;
1611: struct_liste_chainee *l_element_precedent;
1612:
1613: struct_objet *s_copie_argument;
1614: struct_objet *s_objet_argument;
1615: struct_objet *s_objet_resultat;
1616:
1.42 bertrand 1617: integer8 i;
1618: integer8 j;
1.1 bertrand 1619:
1620: (*s_etat_processus).erreur_execution = d_ex;
1621:
1622: if ((*s_etat_processus).affichage_arguments == 'Y')
1623: {
1624: printf("\n RE ");
1625:
1626: if ((*s_etat_processus).langue == 'F')
1627: {
1628: printf("(partie réelle)\n\n");
1629: }
1630: else
1631: {
1632: printf("(real part)\n\n");
1633: }
1634:
1635: printf(" 1: %s, %s\n", d_INT, d_REL);
1636: printf("-> 1: %s\n\n", d_INT);
1637:
1638: printf(" 1: %s\n", d_CPL);
1639: printf("-> 1: %s\n\n", d_REL);
1640:
1641: printf(" 1: %s, %s\n", d_VIN, d_VRL);
1642: printf("-> 1: %s\n\n", d_VIN);
1643:
1644: printf(" 1: %s\n", d_VCX);
1645: printf("-> 1: %s\n\n", d_VRL);
1646:
1647: printf(" 1: %s, %s\n", d_MIN, d_MRL);
1648: printf("-> 1: %s\n\n", d_MIN);
1649:
1650: printf(" 1: %s\n", d_MCX);
1651: printf("-> 1: %s\n\n", d_MRL);
1652:
1653: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1654: printf("-> 1: %s\n\n", d_ALG);
1655:
1656: printf(" 1: %s\n", d_RPN);
1657: printf("-> 1: %s\n", d_RPN);
1658:
1659: return;
1660: }
1661: else if ((*s_etat_processus).test_instruction == 'Y')
1662: {
1663: (*s_etat_processus).nombre_arguments = 1;
1664: return;
1665: }
1666:
1667: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1668: {
1669: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1670: {
1671: return;
1672: }
1673: }
1674:
1675: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1676: &s_objet_argument) == d_erreur)
1677: {
1678: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1679: return;
1680: }
1681:
1682: /*
1683: --------------------------------------------------------------------------------
1684: Partie réelle d'un entier ou d'un réel
1685: --------------------------------------------------------------------------------
1686: */
1687:
1688: if (((*s_objet_argument).type == INT) ||
1689: ((*s_objet_argument).type == REL))
1690: {
1691: s_objet_resultat = s_objet_argument;
1692: s_objet_argument = NULL;
1693: }
1694:
1695: /*
1696: --------------------------------------------------------------------------------
1697: Partie réelle d'un complexe
1698: --------------------------------------------------------------------------------
1699: */
1700:
1701: else if ((*s_objet_argument).type == CPL)
1702: {
1703: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
1704: {
1705: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1706: return;
1707: }
1708:
1709: (*((real8 *) (*s_objet_resultat).objet)) =
1710: (*((struct_complexe16 *) (*s_objet_argument).objet))
1711: .partie_reelle;
1712: }
1713:
1714: /*
1715: --------------------------------------------------------------------------------
1716: Partie réelle d'un vecteur
1717: --------------------------------------------------------------------------------
1718: */
1719:
1720: else if (((*s_objet_argument).type == VIN) ||
1721: ((*s_objet_argument).type == VRL))
1722: {
1723: s_objet_resultat = s_objet_argument;
1724: s_objet_argument = NULL;
1725: }
1726: else if ((*s_objet_argument).type == VCX)
1727: {
1728: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
1729: {
1730: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1731: return;
1732: }
1733:
1734: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
1.42 bertrand 1735: malloc(((size_t) (*(((struct_vecteur *) (*s_objet_argument)
1736: .objet))).taille) * sizeof(real8))) == NULL)
1.1 bertrand 1737: {
1738: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1739: return;
1740: }
1741:
1742: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
1743: (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
1744:
1745: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
1746: .taille; i++)
1747: {
1748: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
1749: .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
1750: (*s_objet_argument).objet)).tableau)[i].partie_reelle;
1751: }
1752: }
1753:
1754: /*
1755: --------------------------------------------------------------------------------
1756: Partie réelle d'une matrice
1757: --------------------------------------------------------------------------------
1758: */
1759:
1760: else if (((*s_objet_argument).type == MIN) ||
1761: ((*s_objet_argument).type == MRL))
1762: {
1763: s_objet_resultat = s_objet_argument;
1764: s_objet_argument = NULL;
1765: }
1766: else if ((*s_objet_argument).type == MCX)
1767: {
1768: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
1769: {
1770: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1771: return;
1772: }
1773:
1774: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
1.42 bertrand 1775: malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument)
1776: .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
1.1 bertrand 1777: {
1778: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1779: return;
1780: }
1781:
1782: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
1783: (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
1784: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
1785: (*((struct_matrice *) (*s_objet_argument).objet))
1786: .nombre_colonnes;
1787:
1788: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
1789: .nombre_lignes; i++)
1790: {
1791: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
1.42 bertrand 1792: .objet)).tableau)[i] = malloc(((size_t)
1.1 bertrand 1793: (*(((struct_matrice *) (*s_objet_argument).objet)))
1.42 bertrand 1794: .nombre_colonnes) * sizeof(real8))) == NULL)
1.1 bertrand 1795: {
1796: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1797: return;
1798: }
1799:
1800: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
1801: .nombre_colonnes; j++)
1802: {
1803: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
1804: .tableau)[i][j] = ((struct_complexe16 **)
1805: (*((struct_matrice *) (*s_objet_argument).objet))
1806: .tableau)[i][j].partie_reelle;
1807: }
1808: }
1809: }
1810:
1811: /*
1812: --------------------------------------------------------------------------------
1813: Partie réelle d'un nom
1814: --------------------------------------------------------------------------------
1815: */
1816:
1817: else if ((*s_objet_argument).type == NOM)
1818: {
1819: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
1820: {
1821: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1822: return;
1823: }
1824:
1825: if (((*s_objet_resultat).objet =
1826: allocation_maillon(s_etat_processus)) == NULL)
1827: {
1828: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1829: return;
1830: }
1831:
1832: l_element_courant = (*s_objet_resultat).objet;
1833:
1834: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1835: == NULL)
1836: {
1837: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1838: return;
1839: }
1840:
1841: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1842: .nombre_arguments = 0;
1843: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1844: .fonction = instruction_vers_niveau_superieur;
1845:
1846: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1847: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1848: {
1849: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1850: return;
1851: }
1852:
1853: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1854: .nom_fonction, "<<");
1855:
1856: if (((*l_element_courant).suivant =
1857: allocation_maillon(s_etat_processus)) == NULL)
1858: {
1859: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1860: return;
1861: }
1862:
1863: l_element_courant = (*l_element_courant).suivant;
1864: (*l_element_courant).donnee = s_objet_argument;
1865:
1866: if (((*l_element_courant).suivant =
1867: allocation_maillon(s_etat_processus)) == NULL)
1868: {
1869: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1870: return;
1871: }
1872:
1873: l_element_courant = (*l_element_courant).suivant;
1874:
1875: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1876: == NULL)
1877: {
1878: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1879: return;
1880: }
1881:
1882: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1883: .nombre_arguments = 1;
1884: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1885: .fonction = instruction_re;
1886:
1887: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1888: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1889: {
1890: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1891: return;
1892: }
1893:
1894: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1895: .nom_fonction, "RE");
1896:
1897: if (((*l_element_courant).suivant =
1898: allocation_maillon(s_etat_processus)) == NULL)
1899: {
1900: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1901: return;
1902: }
1903:
1904: l_element_courant = (*l_element_courant).suivant;
1905:
1906: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1907: == NULL)
1908: {
1909: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1910: return;
1911: }
1912:
1913: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1914: .nombre_arguments = 0;
1915: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1916: .fonction = instruction_vers_niveau_inferieur;
1917:
1918: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1919: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1920: {
1921: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1922: return;
1923: }
1924:
1925: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1926: .nom_fonction, ">>");
1927:
1928: (*l_element_courant).suivant = NULL;
1929: s_objet_argument = NULL;
1930: }
1931:
1932: /*
1933: --------------------------------------------------------------------------------
1934: Partie réelle d'une expression
1935: --------------------------------------------------------------------------------
1936: */
1937:
1938: else if (((*s_objet_argument).type == ALG) ||
1939: ((*s_objet_argument).type == RPN))
1940: {
1941: if ((s_copie_argument = copie_objet(s_etat_processus,
1942: s_objet_argument, 'N')) == NULL)
1943: {
1944: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1945: return;
1946: }
1947:
1948: l_element_courant = (struct_liste_chainee *)
1949: (*s_copie_argument).objet;
1950: l_element_precedent = l_element_courant;
1951:
1952: while((*l_element_courant).suivant != NULL)
1953: {
1954: l_element_precedent = l_element_courant;
1955: l_element_courant = (*l_element_courant).suivant;
1956: }
1957:
1958: if (((*l_element_precedent).suivant =
1959: allocation_maillon(s_etat_processus)) == NULL)
1960: {
1961: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1962: return;
1963: }
1964:
1965: if (((*(*l_element_precedent).suivant).donnee =
1966: allocation(s_etat_processus, FCT)) == NULL)
1967: {
1968: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1969: return;
1970: }
1971:
1972: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1973: .donnee).objet)).nombre_arguments = 1;
1974: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1975: .donnee).objet)).fonction = instruction_re;
1976:
1977: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1978: .suivant).donnee).objet)).nom_fonction =
1979: malloc(3 * sizeof(unsigned char))) == NULL)
1980: {
1981: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1982: return;
1983: }
1984:
1985: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1986: .suivant).donnee).objet)).nom_fonction, "RE");
1987:
1988: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1989:
1990: s_objet_resultat = s_copie_argument;
1991: }
1992:
1993: /*
1994: --------------------------------------------------------------------------------
1995: Réalisation impossible de la fonction partie réelle
1996: --------------------------------------------------------------------------------
1997: */
1998:
1999: else
2000: {
2001: liberation(s_etat_processus, s_objet_argument);
2002:
2003: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2004: return;
2005: }
2006:
2007: liberation(s_etat_processus, s_objet_argument);
2008:
2009: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2010: s_objet_resultat) == d_erreur)
2011: {
2012: return;
2013: }
2014:
2015: return;
2016: }
2017:
2018:
2019: /*
2020: ================================================================================
2021: Fonction 'r->p'
2022: ================================================================================
2023: Entrées : pointeur sur une structure struct_processus
2024: --------------------------------------------------------------------------------
2025: Sorties :
2026: --------------------------------------------------------------------------------
2027: Effets de bord : néant
2028: ================================================================================
2029: */
2030:
2031: void
2032: instruction_r_vers_p(struct_processus *s_etat_processus)
2033: {
2034: struct_liste_chainee *l_element_courant;
2035: struct_liste_chainee *l_element_precedent;
2036:
2037: struct_objet *s_copie_argument;
2038: struct_objet *s_objet_argument;
2039: struct_objet *s_objet_resultat;
2040:
2041: (*s_etat_processus).erreur_execution = d_ex;
2042:
2043: if ((*s_etat_processus).affichage_arguments == 'Y')
2044: {
2045: printf("\n P->R ");
2046:
2047: if ((*s_etat_processus).langue == 'F')
2048: {
2049: printf("(coordonnées polaires vers cartésiennes)\n\n");
2050: }
2051: else
2052: {
2053: printf("(polar to cartesian coordinates)\n\n");
2054: }
2055:
2056: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
2057: printf("-> 1: %s\n\n", d_CPL);
2058:
2059: printf(" 1: %s, %s\n", d_NOM, d_ALG);
2060: printf("-> 1: %s\n\n", d_ALG);
2061:
2062: printf(" 1: %s\n", d_RPN);
2063: printf("-> 1: %s\n", d_RPN);
2064:
2065: return;
2066: }
2067: else if ((*s_etat_processus).test_instruction == 'Y')
2068: {
2069: (*s_etat_processus).nombre_arguments = -1;
2070: return;
2071: }
2072:
2073: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2074: {
2075: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2076: {
2077: return;
2078: }
2079: }
2080:
2081: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2082: &s_objet_argument) == d_erreur)
2083: {
2084: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2085: return;
2086: }
2087:
2088: /*
2089: --------------------------------------------------------------------------------
2090: Conversion d'un entier ou d'un réel
2091: --------------------------------------------------------------------------------
2092: */
2093:
2094: if (((*s_objet_argument).type == INT) ||
2095: ((*s_objet_argument).type == REL))
2096: {
2097: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2098: == NULL)
2099: {
2100: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2101: return;
2102: }
2103:
2104: if ((*s_objet_argument).type == INT)
2105: {
2106: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle
1.42 bertrand 2107: = (real8) (*((integer8 *) (*s_objet_argument).objet));
1.1 bertrand 2108: }
2109: else
2110: {
2111: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_reelle
2112: = (*((real8 *) (*s_objet_argument).objet));
2113: }
2114:
2115: (*((struct_complexe16 *) (*s_objet_resultat).objet)).partie_imaginaire
2116: = 0;
2117: }
2118:
2119: /*
2120: --------------------------------------------------------------------------------
2121: Conversion d'un complexe
2122: --------------------------------------------------------------------------------
2123: */
2124:
2125: else if ((*s_objet_argument).type == CPL)
2126: {
2127: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
2128: == NULL)
2129: {
2130: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2131: return;
2132: }
2133:
2134: f77absc_(((struct_complexe16 *) (*s_objet_argument).objet),
2135: &((*((struct_complexe16 *) (*s_objet_resultat).objet))
2136: .partie_reelle));
2137:
2138: (*((struct_complexe16 *) (*s_objet_resultat).objet))
2139: .partie_imaginaire = atan2((*((struct_complexe16 *)
2140: (*s_objet_argument).objet)).partie_imaginaire,
2141: (*((struct_complexe16 *) (*s_objet_argument).objet))
2142: .partie_reelle);
2143:
2144: if (test_cfsf(s_etat_processus, 60) == d_faux)
2145: {
2146: conversion_radians_vers_degres(&((*((struct_complexe16 *)
2147: (*s_objet_resultat).objet)).partie_imaginaire));
2148: }
2149: }
2150:
2151: /*
2152: --------------------------------------------------------------------------------
2153: Conversion d'un nom
2154: --------------------------------------------------------------------------------
2155: */
2156:
2157: else if ((*s_objet_argument).type == NOM)
2158: {
2159: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
2160: == NULL)
2161: {
2162: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2163: return;
2164: }
2165:
2166: if (((*s_objet_resultat).objet =
2167: allocation_maillon(s_etat_processus)) == NULL)
2168: {
2169: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2170: return;
2171: }
2172:
2173: l_element_courant = (*s_objet_resultat).objet;
2174:
2175: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2176: == NULL)
2177: {
2178: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2179: return;
2180: }
2181:
2182: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2183: .nombre_arguments = 0;
2184: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2185: .fonction = instruction_vers_niveau_superieur;
2186:
2187: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2188: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2189: {
2190: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2191: return;
2192: }
2193:
2194: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2195: .nom_fonction, "<<");
2196:
2197: if (((*l_element_courant).suivant =
2198: allocation_maillon(s_etat_processus)) == NULL)
2199: {
2200: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2201: return;
2202: }
2203:
2204: l_element_courant = (*l_element_courant).suivant;
2205: (*l_element_courant).donnee = s_objet_argument;
2206:
2207: if (((*l_element_courant).suivant =
2208: allocation_maillon(s_etat_processus)) == NULL)
2209: {
2210: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2211: return;
2212: }
2213:
2214: l_element_courant = (*l_element_courant).suivant;
2215:
2216: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2217: == NULL)
2218: {
2219: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2220: return;
2221: }
2222:
2223: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2224: .nombre_arguments = 1;
2225: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2226: .fonction = instruction_r_vers_p;
2227:
2228: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2229: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
2230: {
2231: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2232: return;
2233: }
2234:
2235: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2236: .nom_fonction, "R->P");
2237:
2238: if (((*l_element_courant).suivant =
2239: allocation_maillon(s_etat_processus)) == NULL)
2240: {
2241: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2242: return;
2243: }
2244:
2245: l_element_courant = (*l_element_courant).suivant;
2246:
2247: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2248: == NULL)
2249: {
2250: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2251: return;
2252: }
2253:
2254: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2255: .nombre_arguments = 0;
2256: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2257: .fonction = instruction_vers_niveau_inferieur;
2258:
2259: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2260: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2261: {
2262: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2263: return;
2264: }
2265:
2266: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2267: .nom_fonction, ">>");
2268:
2269: (*l_element_courant).suivant = NULL;
2270: s_objet_argument = NULL;
2271: }
2272:
2273: /*
2274: --------------------------------------------------------------------------------
2275: Conversion d'une expression
2276: --------------------------------------------------------------------------------
2277: */
2278:
2279: else if (((*s_objet_argument).type == ALG) ||
2280: ((*s_objet_argument).type == RPN))
2281: {
2282: if ((s_copie_argument = copie_objet(s_etat_processus,
2283: s_objet_argument, 'N')) == NULL)
2284: {
2285: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2286: return;
2287: }
2288:
2289: l_element_courant = (struct_liste_chainee *)
2290: (*s_copie_argument).objet;
2291: l_element_precedent = l_element_courant;
2292:
2293: while((*l_element_courant).suivant != NULL)
2294: {
2295: l_element_precedent = l_element_courant;
2296: l_element_courant = (*l_element_courant).suivant;
2297: }
2298:
2299: if (((*l_element_precedent).suivant =
2300: allocation_maillon(s_etat_processus)) == NULL)
2301: {
2302: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2303: return;
2304: }
2305:
2306: if (((*(*l_element_precedent).suivant).donnee =
2307: allocation(s_etat_processus, FCT)) == NULL)
2308: {
2309: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2310: return;
2311: }
2312:
2313: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2314: .donnee).objet)).nombre_arguments = 1;
2315: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2316: .donnee).objet)).fonction = instruction_r_vers_p;
2317:
2318: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2319: .suivant).donnee).objet)).nom_fonction =
2320: malloc(5 * sizeof(unsigned char))) == NULL)
2321: {
2322: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2323: return;
2324: }
2325:
2326: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2327: .suivant).donnee).objet)).nom_fonction, "R->P");
2328:
2329: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2330:
2331: s_objet_resultat = s_copie_argument;
2332: }
2333:
2334: /*
2335: --------------------------------------------------------------------------------
2336: Réalisation impossible de la fonction R->P
2337: --------------------------------------------------------------------------------
2338: */
2339:
2340: else
2341: {
2342: liberation(s_etat_processus, s_objet_argument);
2343:
2344: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
2345: return;
2346: }
2347:
2348: liberation(s_etat_processus, s_objet_argument);
2349:
2350: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2351: s_objet_resultat) == d_erreur)
2352: {
2353: return;
2354: }
2355:
2356: return;
2357: }
2358:
2359: // 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