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