Annotation of rpl/src/instructions_d1.c, revision 1.17.2.3
1.1 bertrand 1: /*
2: ================================================================================
1.17.2.3! bertrand 3: RPL/2 (R) version 4.0.24
1.16 bertrand 4: Copyright (C) 1989-2011 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.12 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction 'dec'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_dec(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 DEC ");
46:
47: if ((*s_etat_processus).langue == 'F')
48: {
49: printf("(base 10)\n\n");
50: printf(" Aucun argument\n");
51: }
52: else
53: {
54: printf("(decimal base)\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: cf(s_etat_processus, 43);
67: cf(s_etat_processus, 44);
68:
69: if (test_cfsf(s_etat_processus, 31) == d_vrai)
70: {
71: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
72: {
73: return;
74: }
75: }
76:
77: return;
78: }
79:
80:
81: /*
82: ================================================================================
83: Fonction 'deg'
84: ================================================================================
85: Entrées : structure processus
86: --------------------------------------------------------------------------------
87: Sorties :
88: --------------------------------------------------------------------------------
89: Effets de bord : néant
90: ================================================================================
91: */
92:
93: void
94: instruction_deg(struct_processus *s_etat_processus)
95: {
96: (*s_etat_processus).erreur_execution = d_ex;
97:
98: if ((*s_etat_processus).affichage_arguments == 'Y')
99: {
100: printf("\n DEG ");
101:
102: if ((*s_etat_processus).langue == 'F')
103: {
104: printf("(arguments en degres)\n\n");
105: printf(" Aucun argument\n");
106: }
107: else
108: {
109: printf("(degrees)\n\n");
110: printf(" No argument\n");
111: }
112:
113: return;
114: }
115: else if ((*s_etat_processus).test_instruction == 'Y')
116: {
117: (*s_etat_processus).nombre_arguments = -1;
118: return;
119: }
120:
121: cf(s_etat_processus, 60);
122:
123: if (test_cfsf(s_etat_processus, 31) == d_vrai)
124: {
125: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
126: {
127: return;
128: }
129: }
130:
131: return;
132: }
133:
134:
135: /*
136: ================================================================================
137: Fonction 'depth'
138: ================================================================================
139: Entrées : structure processus
140: --------------------------------------------------------------------------------
141: Sorties :
142: --------------------------------------------------------------------------------
143: Effets de bord : néant
144: ================================================================================
145: */
146:
147: void
148: instruction_depth(struct_processus *s_etat_processus)
149: {
150: struct_objet *s_objet;
151:
152: (*s_etat_processus).erreur_execution = d_ex;
153:
154: if ((*s_etat_processus).affichage_arguments == 'Y')
155: {
156: printf("\n DEPTH ");
157:
158: if ((*s_etat_processus).langue == 'F')
159: {
160: printf("(profondeur de la pile)\n\n");
161: }
162: else
163: {
164: printf("(stack depth)\n\n");
165: }
166:
167: printf("-> 1: %s\n", d_INT);
168:
169: return;
170: }
171: else if ((*s_etat_processus).test_instruction == 'Y')
172: {
173: (*s_etat_processus).nombre_arguments = -1;
174: return;
175: }
176:
177: if (test_cfsf(s_etat_processus, 31) == d_vrai)
178: {
179: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
180: {
181: return;
182: }
183: }
184:
185: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
186: {
187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
188: return;
189: }
190:
191: (*((integer8 *) ((*s_objet).objet))) = (integer8)
192: (*s_etat_processus).hauteur_pile_operationnelle;
193:
194: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
195: s_objet) == d_erreur)
196: {
197: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
198: return;
199: }
200:
201: return;
202: }
203:
204:
205: /*
206: ================================================================================
207: Fonction 'disp'
208: ================================================================================
209: Entrées : structure processus
210: --------------------------------------------------------------------------------
211: Sorties :
212: --------------------------------------------------------------------------------
213: Effets de bord : néant
214: ================================================================================
215: */
216:
217: void
218: instruction_disp(struct_processus *s_etat_processus)
219: {
220: struct_objet *s_objet;
221:
222: unsigned char *chaine;
223:
224: (*s_etat_processus).erreur_execution = d_ex;
225:
226: if ((*s_etat_processus).affichage_arguments == 'Y')
227: {
228: printf("\n DISP ");
229:
230: if ((*s_etat_processus).langue == 'F')
231: {
232: printf("(affichage d'un objet)\n\n");
233: }
234: else
235: {
236: printf("(display object)\n\n");
237: }
238:
239: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
240: " %s, %s, %s, %s, %s,\n"
241: " %s, %s, %s, %s, %s,\n"
242: " %s, %s, %s, %s,\n"
243: " %s, %s\n",
244: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
245: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
246: d_SQL, d_SLB, d_PRC, d_MTX);
247:
248: return;
249: }
250: else if ((*s_etat_processus).test_instruction == 'Y')
251: {
252: (*s_etat_processus).nombre_arguments = -1;
253: return;
254: }
255:
256: if (test_cfsf(s_etat_processus, 31) == d_vrai)
257: {
258: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
259: {
260: return;
261: }
262: }
263:
264: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
265: &s_objet) == d_erreur)
266: {
267: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
268: return;
269: }
270:
271: chaine = formateur(s_etat_processus, 0, s_objet);
272:
273: if (chaine != NULL)
274: {
275: flockfile(stdout);
276: fprintf(stdout, "%s", chaine);
277:
278: if (test_cfsf(s_etat_processus, 33) == d_faux)
279: {
280: fprintf(stdout, "\n");
281: }
282:
283: funlockfile(stdout);
284:
285: if (test_cfsf(s_etat_processus, 32) == d_vrai)
286: {
287: formateur_tex(s_etat_processus, s_objet, 'N');
288: }
289:
290: free(chaine);
291: }
292: else
293: {
294: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
295: return;
296: }
297:
298: liberation(s_etat_processus, s_objet);
299:
300: return;
301: }
302:
303:
304: /*
305: ================================================================================
306: Fonction 'drop'
307: ================================================================================
308: Entrées : structure processus
309: --------------------------------------------------------------------------------
310: Sorties :
311: --------------------------------------------------------------------------------
312: Effets de bord : néant
313: ================================================================================
314: */
315:
316: void
317: instruction_drop(struct_processus *s_etat_processus)
318: {
319: struct_objet *s_objet;
320:
321: (*s_etat_processus).erreur_execution = d_ex;
322:
323: if ((*s_etat_processus).affichage_arguments == 'Y')
324: {
325: printf("\n DROP ");
326:
327: if ((*s_etat_processus).langue == 'F')
328: {
329: printf("(effacement d'un objet)\n\n");
330: }
331: else
332: {
333: printf("(drop object)\n\n");
334: }
335:
336: printf(" n: %s, %s, %s, %s, %s, %s,\n"
337: " %s, %s, %s, %s, %s,\n"
338: " %s, %s, %s, %s, %s,\n"
339: " %s, %s, %s, %s,\n"
340: " %s, %s\n",
341: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
342: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
343: d_SQL, d_SLB, d_PRC, d_MTX);
344: printf(" ...\n");
345: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
346: " %s, %s, %s, %s, %s,\n"
347: " %s, %s, %s, %s, %s,\n"
348: " %s, %s, %s, %s,\n"
349: " %s, %s\n",
350: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
351: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
352: d_SQL, d_SLB, d_PRC, d_MTX);
353: printf("->n-1: %s, %s, %s, %s, %s, %s,\n"
354: " %s, %s, %s, %s, %s,\n"
355: " %s, %s, %s, %s, %s,\n"
356: " %s, %s, %s, %s,\n"
357: " %s, %s\n",
358: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
359: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
360: d_SQL, d_SLB, d_PRC, d_MTX);
361: printf(" ...\n");
362: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
363: " %s, %s, %s, %s, %s,\n"
364: " %s, %s, %s, %s, %s,\n"
365: " %s, %s, %s, %s,\n"
366: " %s, %s\n",
367: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
368: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
369: d_SQL, d_SLB, d_PRC, d_MTX);
370:
371: return;
372: }
373: else if ((*s_etat_processus).test_instruction == 'Y')
374: {
375: (*s_etat_processus).nombre_arguments = -1;
376: return;
377: }
378:
379: if (test_cfsf(s_etat_processus, 31) == d_vrai)
380: {
381: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
382: {
383: return;
384: }
385: }
386:
387: if ((*s_etat_processus).l_base_pile == NULL)
388: {
389: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
390: return;
391: }
392:
393: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
394: &s_objet) == d_erreur)
395: {
396: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
397: return;
398: }
399:
400: liberation(s_etat_processus, s_objet);
401:
402: return;
403: }
404:
405:
406: /*
407: ================================================================================
408: Fonction 'drop2'
409: ================================================================================
410: Entrées : structure processus
411: --------------------------------------------------------------------------------
412: Sorties :
413: --------------------------------------------------------------------------------
414: Effets de bord : néant
415: ================================================================================
416: */
417:
418: void
419: instruction_drop2(struct_processus *s_etat_processus)
420: {
421: struct_objet *s_objet;
422:
423: logical1 erreur;
424:
425: (*s_etat_processus).erreur_execution = d_ex;
426:
427: if ((*s_etat_processus).affichage_arguments == 'Y')
428: {
429: printf("\n DROP2 ");
430:
431: if ((*s_etat_processus).langue == 'F')
432: {
433: printf("(effacement de deux objets)\n\n");
434: }
435: else
436: {
437: printf("(drop two objects)\n\n");
438: }
439:
440: printf(" n: %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: printf(" ...\n");
449: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
450: " %s, %s, %s, %s, %s,\n"
451: " %s, %s, %s, %s, %s,\n"
452: " %s, %s, %s, %s,\n"
453: " %s, %s\n",
454: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
455: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
456: d_SQL, d_SLB, d_PRC, d_MTX);
457: printf("->n-2: %s, %s, %s, %s, %s, %s,\n"
458: " %s, %s, %s, %s, %s,\n"
459: " %s, %s, %s, %s, %s,\n"
460: " %s, %s, %s, %s,\n"
461: " %s, %s\n",
462: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
463: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
464: d_SQL, d_SLB, d_PRC, d_MTX);
465: printf(" ...\n");
466: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
467: " %s, %s, %s, %s, %s,\n"
468: " %s, %s, %s, %s, %s,\n"
469: " %s, %s, %s, %s,\n"
470: " %s, %s\n",
471: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
472: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
473: d_SQL, d_SLB, d_PRC, d_MTX);
474:
475: return;
476: }
477: else if ((*s_etat_processus).test_instruction == 'Y')
478: {
479: (*s_etat_processus).nombre_arguments = -1;
480: return;
481: }
482:
483: if (test_cfsf(s_etat_processus, 31) == d_vrai)
484: {
485: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
486: {
487: return;
488: }
489: }
490:
491: if ((*s_etat_processus).hauteur_pile_operationnelle < 2)
492: {
493: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
494: return;
495: }
496:
497: erreur = depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
498: &s_objet);
499: liberation(s_etat_processus, s_objet);
500:
501: erreur = depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
502: &s_objet);
503: liberation(s_etat_processus, s_objet);
504:
505: return;
506: }
507:
508:
509: /*
510: ================================================================================
511: Fonction 'dropn'
512: ================================================================================
513: Entrées : structure processus
514: --------------------------------------------------------------------------------
515: Sorties :
516: --------------------------------------------------------------------------------
517: Effets de bord : néant
518: ================================================================================
519: */
520:
521: void
522: instruction_dropn(struct_processus *s_etat_processus)
523: {
524: struct_objet *s_objet;
525:
526: signed long nombre_suppressions;
527:
528: unsigned long i;
529:
530: (*s_etat_processus).erreur_execution = d_ex;
531:
532: if ((*s_etat_processus).affichage_arguments == 'Y')
533: {
534: printf("\n DROPN ");
535:
536: if ((*s_etat_processus).langue == 'F')
537: {
538: printf("(effacement de n objets)\n\n");
539: }
540: else
541: {
542: printf("(drop n objects)\n\n");
543: }
544:
545: printf(" m: %s, %s, %s, %s, %s, %s,\n"
546: " %s, %s, %s, %s, %s,\n"
547: " %s, %s, %s, %s, %s,\n"
548: " %s, %s, %s, %s,\n"
549: " %s, %s\n",
550: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
551: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
552: d_SQL, d_SLB, d_PRC, d_MTX);
553: printf(" ...\n");
554: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
555: " %s, %s, %s, %s, %s,\n"
556: " %s, %s, %s, %s, %s,\n"
557: " %s, %s, %s, %s,\n"
558: " %s, %s\n",
559: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
560: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
561: d_SQL, d_SLB, d_PRC, d_MTX);
562: printf(" 1: %s\n", d_INT);
563: printf("->m-n: %s, %s, %s, %s, %s, %s,\n"
564: " %s, %s, %s, %s, %s,\n"
565: " %s, %s, %s, %s, %s,\n"
566: " %s, %s, %s, %s,\n"
567: " %s, %s\n",
568: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
569: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
570: d_SQL, d_SLB, d_PRC, d_MTX);
571: printf(" ...\n");
572: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
573: " %s, %s, %s, %s, %s,\n"
574: " %s, %s, %s, %s, %s,\n"
575: " %s, %s, %s, %s,\n"
576: " %s, %s\n",
577: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
578: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
579: d_SQL, d_SLB, d_PRC, d_MTX);
580:
581: return;
582: }
583: else if ((*s_etat_processus).test_instruction == 'Y')
584: {
585: (*s_etat_processus).nombre_arguments = -1;
586: return;
587: }
588:
589: if (test_cfsf(s_etat_processus, 31) == d_vrai)
590: {
591: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
592: {
593: return;
594: }
595: }
596:
597: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
598: &s_objet) == d_erreur)
599: {
600: return;
601: }
602:
603: if ((*s_objet).type != INT)
604: {
605: liberation(s_etat_processus, s_objet);
606:
607: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
608: return;
609: }
610:
611: nombre_suppressions = (*((integer8 *) (*s_objet).objet));
612: liberation(s_etat_processus, s_objet);
613:
614: if (nombre_suppressions < 0)
615: {
616:
617: /*
618: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
619: */
620:
621: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
622: return;
623: }
624:
625: if ((unsigned long) nombre_suppressions >
626: (*s_etat_processus).hauteur_pile_operationnelle)
627: {
628: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
629: return;
630: }
631:
632: for(i = 0; i < (unsigned long) nombre_suppressions; i++)
633: {
634: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
635: &s_objet) == d_erreur)
636: {
637: return;
638: }
639:
640: liberation(s_etat_processus, s_objet);
641: }
642:
643: return;
644: }
645:
646:
647: /*
648: ================================================================================
649: Fonction 'dup'
650: ================================================================================
651: Entrées : structure processus
652: --------------------------------------------------------------------------------
653: Sorties :
654: --------------------------------------------------------------------------------
655: Effets de bord : néant
656: ================================================================================
657: */
658:
659: void
660: instruction_dup(struct_processus *s_etat_processus)
661: {
662: struct_objet *s_objet;
663:
664: (*s_etat_processus).erreur_execution = d_ex;
665:
666: if ((*s_etat_processus).affichage_arguments == 'Y')
667: {
668: printf("\n DUP ");
669:
670: if ((*s_etat_processus).langue == 'F')
671: {
672: printf("(duplication d'un objet)\n\n");
673: }
674: else
675: {
676: printf("(duplication of object)\n\n");
677: }
678:
679: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
680: " %s, %s, %s, %s, %s,\n"
681: " %s, %s, %s, %s, %s,\n"
682: " %s, %s, %s, %s,\n"
683: " %s, %s\n",
684: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
685: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
686: d_SQL, d_SLB, d_PRC, d_MTX);
687: printf("-> 2: %s, %s, %s, %s, %s, %s,\n"
688: " %s, %s, %s, %s, %s,\n"
689: " %s, %s, %s, %s, %s,\n"
690: " %s, %s, %s, %s,\n"
691: " %s, %s\n",
692: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
693: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
694: d_SQL, d_SLB, d_PRC, d_MTX);
695: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
696: " %s, %s, %s, %s, %s,\n"
697: " %s, %s, %s, %s, %s,\n"
698: " %s, %s, %s, %s,\n"
699: " %s, %s\n",
700: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
701: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
702: d_SQL, d_SLB, d_PRC, d_MTX);
703:
704: return;
705: }
706: else if ((*s_etat_processus).test_instruction == 'Y')
707: {
708: (*s_etat_processus).nombre_arguments = -1;
709: return;
710: }
711:
712: if (test_cfsf(s_etat_processus, 31) == d_vrai)
713: {
714: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
715: {
716: return;
717: }
718: }
719:
720: if ((*s_etat_processus).l_base_pile == NULL)
721: {
722: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
723: return;
724: }
725:
726: s_objet = copie_objet(s_etat_processus,
727: (*(*s_etat_processus).l_base_pile).donnee, 'P');
728:
729: if (s_objet == NULL)
730: {
731: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
732: return;
733: }
734:
735: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
736: s_objet) == d_erreur)
737: {
738: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
739: return;
740: }
741:
742: return;
743: }
744:
745:
746: /*
747: ================================================================================
748: Fonction 'dup2'
749: ================================================================================
750: Entrées : structure processus
751: --------------------------------------------------------------------------------
752: Sorties :
753: --------------------------------------------------------------------------------
754: Effets de bord : néant
755: ================================================================================
756: */
757:
758: void
759: instruction_dup2(struct_processus *s_etat_processus)
760: {
761: struct_objet *s_objet;
762:
763: unsigned long i;
764:
765: (*s_etat_processus).erreur_execution = d_ex;
766:
767: if ((*s_etat_processus).affichage_arguments == 'Y')
768: {
769: printf("\n DUP2 ");
770:
771: if ((*s_etat_processus).langue == 'F')
772: {
773: printf("(duplication de deux objets)\n\n");
774: }
775: else
776: {
777: printf("(duplication of two objects)\n\n");
778: }
779:
780: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
781: " %s, %s, %s, %s, %s,\n"
782: " %s, %s, %s, %s, %s,\n"
783: " %s, %s, %s, %s,\n"
784: " %s, %s\n",
785: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
786: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
787: d_SQL, d_SLB, d_PRC, d_MTX);
788: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
789: " %s, %s, %s, %s, %s,\n"
790: " %s, %s, %s, %s, %s,\n"
791: " %s, %s, %s, %s,\n"
792: " %s, %s\n",
793: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
794: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
795: d_SQL, d_SLB, d_PRC, d_MTX);
796: printf("-> 4: %s, %s, %s, %s, %s, %s,\n"
797: " %s, %s, %s, %s, %s,\n"
798: " %s, %s, %s, %s, %s,\n"
799: " %s, %s, %s, %s,\n"
800: " %s, %s\n",
801: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
802: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
803: d_SQL, d_SLB, d_PRC, d_MTX);
804: printf(" ...\n");
805: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
806: " %s, %s, %s, %s, %s,\n"
807: " %s, %s, %s, %s, %s,\n"
808: " %s, %s, %s, %s,\n"
809: " %s, %s\n",
810: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
811: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
812: d_SQL, d_SLB, d_PRC, d_MTX);
813:
814: return;
815: }
816: else if ((*s_etat_processus).test_instruction == 'Y')
817: {
818: (*s_etat_processus).nombre_arguments = -1;
819: return;
820: }
821:
822: if (test_cfsf(s_etat_processus, 31) == d_vrai)
823: {
824: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
825: {
826: return;
827: }
828: }
829:
830: if ((*s_etat_processus).hauteur_pile_operationnelle < 2)
831: {
832: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
833: return;
834: }
835:
836: for(i = 0; i < 2; i++)
837: {
838: s_objet = copie_objet(s_etat_processus,
839: (*(*(*s_etat_processus).l_base_pile).suivant).donnee, 'P');
840:
841: if (s_objet == NULL)
842: {
843: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
844: return;
845: }
846:
847: if (empilement(s_etat_processus, &((*s_etat_processus)
848: .l_base_pile), s_objet) == d_erreur)
849: {
850: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
851: return;
852: }
853: }
854:
855: return;
856: }
857:
858:
859: /*
860: ================================================================================
861: Fonction 'dupn'
862: ================================================================================
863: Entrées : structure processus
864: --------------------------------------------------------------------------------
865: Sorties :
866: --------------------------------------------------------------------------------
867: Effets de bord : néant
868: ================================================================================
869: */
870:
871: void
872: instruction_dupn(struct_processus *s_etat_processus)
873: {
874: struct_liste_chainee *l_base_pile;
875: struct_liste_chainee *l_element_courant;
876:
877: struct_objet *s_objet;
878: struct_objet *s_nouvel_objet;
879:
880: signed long nombre_duplications;
881: unsigned long i;
882:
883: (*s_etat_processus).erreur_execution = d_ex;
884:
885: if ((*s_etat_processus).affichage_arguments == 'Y')
886: {
887: printf("\n DUPN ");
888:
889: if ((*s_etat_processus).langue == 'F')
890: {
891: printf("(duplication de n objets)\n\n");
892: }
893: else
894: {
895: printf("(duplication of n objects)\n\n");
896: }
897:
898: printf(" m: %s, %s, %s, %s, %s, %s,\n"
899: " %s, %s, %s, %s, %s,\n"
900: " %s, %s, %s, %s, %s,\n"
901: " %s, %s, %s, %s,\n"
902: " %s, %s\n",
903: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
904: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
905: d_SQL, d_SLB, d_PRC, d_MTX);
906: printf(" ...\n");
907: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
908: " %s, %s, %s, %s, %s,\n"
909: " %s, %s, %s, %s, %s,\n"
910: " %s, %s, %s, %s,\n"
911: " %s, %s\n",
912: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
913: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
914: d_SQL, d_SLB, d_PRC, d_MTX);
915: printf(" 1: %s\n", d_INT);
916: printf("->m+n: %s, %s, %s, %s, %s, %s,\n"
917: " %s, %s, %s, %s, %s,\n"
918: " %s, %s, %s, %s, %s,\n"
919: " %s, %s, %s, %s,\n"
920: " %s, %s\n",
921: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
922: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
923: d_SQL, d_SLB, d_PRC, d_MTX);
924: printf(" ...\n");
925: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
926: " %s, %s, %s, %s, %s,\n"
927: " %s, %s, %s, %s, %s,\n"
928: " %s, %s, %s, %s,\n"
929: " %s, %s\n",
930: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
931: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
932: d_SQL, d_SLB, d_PRC, d_MTX);
933:
934: return;
935: }
936: else if ((*s_etat_processus).test_instruction == 'Y')
937: {
938: (*s_etat_processus).nombre_arguments = -1;
939: return;
940: }
941:
942: if (test_cfsf(s_etat_processus, 31) == d_vrai)
943: {
944: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
945: {
946: return;
947: }
948: }
949:
950: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
951: &s_objet) == d_erreur)
952: {
953: return;
954: }
955:
956: if ((*s_objet).type != INT)
957: {
958: liberation(s_etat_processus, s_objet);
959:
960: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
961: return;
962: }
963:
964: nombre_duplications = (*((integer8 *) (*s_objet).objet));
965: liberation(s_etat_processus, s_objet);
966:
967: if (nombre_duplications < 0)
968: {
969:
970: /*
971: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
972: */
973:
974: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
975: return;
976: }
977:
978: l_element_courant = (*s_etat_processus).l_base_pile;
979:
980: for(i = 0; i < (unsigned long) nombre_duplications; i++)
981: {
982: if (l_element_courant == NULL)
983: {
984: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
985: return;
986: }
987:
988: s_nouvel_objet = copie_objet(s_etat_processus,
989: (*l_element_courant).donnee, 'P');
990:
991: if (s_nouvel_objet == NULL)
992: {
993: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
994: return;
995: }
996:
997: if (empilement(s_etat_processus, &l_base_pile, s_nouvel_objet)
998: == d_erreur)
999: {
1000: return;
1001: }
1002:
1003: l_element_courant = (*l_element_courant).suivant;
1004: }
1005:
1006: for(i = 0; i < (unsigned long) nombre_duplications; i++)
1007: {
1008: if (depilement(s_etat_processus, &l_base_pile, &s_objet) == d_erreur)
1009: {
1010: return;
1011: }
1012:
1013: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1014: s_objet) == d_erreur)
1015: {
1016: return;
1017: }
1018: }
1019:
1020: return;
1021: }
1022:
1023:
1024: /*
1025: ================================================================================
1026: Fonction '/'
1027: ================================================================================
1028: Entrées : structure processus
1029: --------------------------------------------------------------------------------
1030: Sorties :
1031: --------------------------------------------------------------------------------
1032: Effets de bord : néant
1033: ================================================================================
1034: */
1035:
1036: void
1037: instruction_division(struct_processus *s_etat_processus)
1038: {
1039: integer8 reste;
1040:
1041: real8 dividende_reel;
1042: real8 diviseur_reel;
1043:
1044: logical1 drapeau;
1045: logical1 resultat_entier;
1046:
1047: struct_complexe16 accumulateur;
1048:
1049: struct_liste_chainee *l_element_courant;
1050: struct_liste_chainee *l_element_precedent;
1051:
1052: struct_objet *s_copie_argument_1;
1053: struct_objet *s_copie_argument_2;
1054: struct_objet *s_objet_argument_1;
1055: struct_objet *s_objet_argument_2;
1056: struct_objet *s_objet_resultat;
1057:
1058: unsigned long i;
1059: unsigned long j;
1060: unsigned long k;
1061: unsigned long nombre_elements;
1062:
1063: (*s_etat_processus).erreur_execution = d_ex;
1064:
1065: if ((*s_etat_processus).affichage_arguments == 'Y')
1066: {
1067: printf("\n / ");
1068:
1069: if ((*s_etat_processus).langue == 'F')
1070: {
1071: printf("(division)\n\n");
1072: }
1073: else
1074: {
1075: printf("(division)\n\n");
1076: }
1077:
1078: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1079: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1080: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
1081:
1082: printf(" 2: %s, %s\n", d_NOM, d_ALG);
1083: printf(" 1: %s, %s, %s, %s, %s\n",
1084: d_INT, d_REL, d_CPL, d_NOM, d_ALG);
1085: printf("-> 1: %s\n\n", d_ALG);
1086:
1087: printf(" 2: %s, %s, %s, %s, %s\n",
1088: d_INT, d_REL, d_CPL, d_NOM, d_ALG);
1089: printf(" 1: %s, %s\n", d_NOM, d_ALG);
1090: printf("-> 1: %s\n\n", d_ALG);
1091:
1092: printf(" 2: %s\n", d_RPN);
1093: printf(" 1: %s, %s, %s, %s, %s\n",
1094: d_INT, d_REL, d_CPL, d_NOM, d_RPN);
1095: printf("-> 1: %s\n\n", d_RPN);
1096:
1097: printf(" 2: %s, %s, %s, %s, %s\n",
1098: d_INT, d_REL, d_CPL, d_NOM, d_RPN);
1099: printf(" 1: %s\n", d_RPN);
1100: printf("-> 1: %s\n\n", d_RPN);
1101:
1102: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1103: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1104: printf("-> 1: %s, %s, %s\n\n", d_VIN, d_VRL, d_VCX);
1105:
1106: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1107: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1108: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
1109:
1110: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1111: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1112: printf("-> 1: %s, %s\n\n", d_VRL, d_VCX);
1113:
1114: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1115: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1116: printf("-> 1: %s, %s\n\n", d_MRL, d_MCX);
1117:
1118: printf(" 2: %s, %s\n", d_BIN, d_INT);
1119: printf(" 1: %s, %s\n", d_BIN, d_INT);
1120: printf("-> 1: %s\n", d_BIN);
1121:
1122: return;
1123: }
1124: else if ((*s_etat_processus).test_instruction == 'Y')
1125: {
1126: (*s_etat_processus).nombre_arguments = 0;
1127: return;
1128: }
1129:
1130: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1131: {
1132: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1133: {
1134: return;
1135: }
1136: }
1137:
1138: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1139: &s_objet_argument_1) == d_erreur)
1140: {
1141: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1142: return;
1143: }
1144:
1145: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1146: &s_objet_argument_2) == d_erreur)
1147: {
1148: liberation(s_etat_processus, s_objet_argument_1);
1149:
1150: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1151: return;
1152: }
1153:
1154: /*
1155: --------------------------------------------------------------------------------
1156: Division donnant un résultat réel (ou entier si cela reste correct)
1157: --------------------------------------------------------------------------------
1158: */
1159:
1160: if ((((*s_objet_argument_1).type == INT) ||
1161: ((*s_objet_argument_1).type == REL)) &&
1162: (((*s_objet_argument_2).type == INT) ||
1163: ((*s_objet_argument_2).type == REL)))
1164: {
1165: if (((*s_objet_argument_2).type == INT) &&
1166: ((*s_objet_argument_1).type == INT))
1167: {
1168: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
1169: {
1170: reste = -1;
1171: }
1172: else
1173: {
1174: reste = (*((integer8 *) (*s_objet_argument_2).objet)) %
1175: (*((integer8 *) (*s_objet_argument_1).objet));
1176: }
1177: }
1178: else
1179: {
1180: reste = -1;
1181: }
1182:
1183: if (reste == 0)
1184: {
1185: /*
1186: * Résultat entier
1187: */
1188:
1189: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1190: == NULL)
1191: {
1192: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1193: return;
1194: }
1195:
1196: (*((integer8 *) (*s_objet_resultat).objet)) = (*((integer8 *)
1197: (*s_objet_argument_2).objet)) / (*((integer8 *)
1198: (*s_objet_argument_1).objet));
1199: }
1200: else
1201: {
1202: /*
1203: * Résultat réel
1204: */
1205:
1206: if ((s_objet_resultat = allocation(s_etat_processus, REL))
1207: == NULL)
1208: {
1209: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1210: return;
1211: }
1212:
1213: if ((*s_objet_argument_1).type == INT)
1214: {
1215: diviseur_reel = (real8) (*((integer8 *)
1216: (*s_objet_argument_1).objet));
1217: }
1218: else
1219: {
1220: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
1221: }
1222:
1223: if ((*s_objet_argument_2).type == INT)
1224: {
1225: dividende_reel = (real8) (*((integer8 *)
1226: (*s_objet_argument_2).objet));
1227: }
1228: else
1229: {
1230: dividende_reel = (*((real8 *) (*s_objet_argument_2).objet));
1231: }
1232:
1233: if ((diviseur_reel == 0) && (test_cfsf(s_etat_processus, 59) ==
1234: d_vrai))
1235: {
1236: liberation(s_etat_processus, s_objet_argument_1);
1237: liberation(s_etat_processus, s_objet_argument_2);
1238: liberation(s_etat_processus, s_objet_resultat);
1239:
1240: (*s_etat_processus).exception = d_ep_division_par_zero;
1241: return;
1242: }
1243:
1244: (*((real8 *) (*s_objet_resultat).objet)) = dividende_reel /
1245: diviseur_reel;
1246: }
1247: }
1248:
1249: /*
1250: --------------------------------------------------------------------------------
1251: Division donnant un résultat complexe
1252: --------------------------------------------------------------------------------
1253: */
1254:
1255: else if ((((*s_objet_argument_1).type == CPL) &&
1256: (((*s_objet_argument_2).type == INT) ||
1257: ((*s_objet_argument_2).type == REL) ||
1258: ((*s_objet_argument_2).type == CPL))) ||
1259: (((*s_objet_argument_2).type == CPL) &&
1260: (((*s_objet_argument_1).type == INT) ||
1261: ((*s_objet_argument_1).type == REL) ||
1262: ((*s_objet_argument_1).type == CPL))))
1263: {
1264: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
1265: {
1266: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1267: return;
1268: }
1269:
1270: if ((*s_objet_argument_1).type == CPL)
1271: {
1272: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
1273: .partie_reelle == 0) && ((*((struct_complexe16 *)
1274: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
1275: {
1276: liberation(s_etat_processus, s_objet_argument_1);
1277: liberation(s_etat_processus, s_objet_argument_2);
1278: liberation(s_etat_processus, s_objet_resultat);
1279:
1280: (*s_etat_processus).exception = d_ep_division_par_zero;
1281: return;
1282: }
1283:
1284: if ((*s_objet_argument_2).type == INT)
1285: {
1286: f77divisionic_(&((*((integer8 *) (*s_objet_argument_2)
1287: .objet))), &((*((struct_complexe16 *)
1288: (*s_objet_argument_1).objet))),
1289: &((*((struct_complexe16 *)
1290: (*s_objet_resultat).objet))));
1291: }
1292: else if ((*s_objet_argument_2).type == REL)
1293: {
1294: f77divisionrc_(&((*((real8 *) (*s_objet_argument_2)
1295: .objet))), &((*((struct_complexe16 *)
1296: (*s_objet_argument_1).objet))),
1297: &((*((struct_complexe16 *)
1298: (*s_objet_resultat).objet))));
1299: }
1300: else
1301: {
1302: f77divisioncc_(&((*((struct_complexe16 *) (*s_objet_argument_2)
1303: .objet))), &((*((struct_complexe16 *)
1304: (*s_objet_argument_1).objet))),
1305: &((*((struct_complexe16 *)
1306: (*s_objet_resultat).objet))));
1307: }
1308: }
1309: else
1310: {
1311: if ((*s_objet_argument_1).type == INT)
1312: {
1313: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
1314: {
1315: liberation(s_etat_processus, s_objet_argument_1);
1316: liberation(s_etat_processus, s_objet_argument_2);
1317: liberation(s_etat_processus, s_objet_resultat);
1318:
1319: (*s_etat_processus).exception = d_ep_division_par_zero;
1320: return;
1321: }
1322:
1323: f77divisionci_(&((*((struct_complexe16 *) (*s_objet_argument_2)
1324: .objet))), &((*((integer8 *)
1325: (*s_objet_argument_1).objet))),
1326: &((*((struct_complexe16 *)
1327: (*s_objet_resultat).objet))));
1328: }
1329: else
1330: {
1331: if ((*((real8 *) (*s_objet_argument_1).objet)) == 0)
1332: {
1333: liberation(s_etat_processus, s_objet_argument_1);
1334: liberation(s_etat_processus, s_objet_argument_2);
1335: liberation(s_etat_processus, s_objet_resultat);
1336:
1337: (*s_etat_processus).exception = d_ep_division_par_zero;
1338: return;
1339: }
1340:
1341: f77divisioncr_(&((*((struct_complexe16 *) (*s_objet_argument_2)
1342: .objet))), &((*((real8 *)
1343: (*s_objet_argument_1).objet))),
1344: &((*((struct_complexe16 *)
1345: (*s_objet_resultat).objet))));
1346: }
1347: }
1348: }
1349:
1350: /*
1351: --------------------------------------------------------------------------------
1352: Division mettant en oeuvre un nom ou une expression algébrique
1353: --------------------------------------------------------------------------------
1354: */
1355: /*
1356: * Nom ou valeur numérique / Nom ou valeur numérique
1357: */
1358:
1359: else if ((((*s_objet_argument_1).type == NOM) &&
1360: (((*s_objet_argument_2).type == NOM) ||
1361: ((*s_objet_argument_2).type == INT) ||
1362: ((*s_objet_argument_2).type == REL) ||
1363: ((*s_objet_argument_2).type == CPL))) ||
1364: (((*s_objet_argument_2).type == NOM) &&
1365: (((*s_objet_argument_1).type == INT) ||
1366: ((*s_objet_argument_1).type == REL) ||
1367: ((*s_objet_argument_1).type == CPL))))
1368: {
1369: drapeau = d_vrai;
1370:
1371: if ((*s_objet_argument_2).type == NOM)
1372: {
1373: if ((*s_objet_argument_1).type == INT)
1374: {
1375: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
1376: { // Division par 1
1377: drapeau = d_faux;
1378:
1379: s_objet_resultat = s_objet_argument_2;
1380: s_objet_argument_2 = NULL;
1381: }
1382: }
1383: else if ((*s_objet_argument_1).type == REL)
1384: {
1385: if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
1386: { // Division par 1.0
1387: drapeau = d_faux;
1388:
1389: s_objet_resultat = s_objet_argument_2;
1390: s_objet_argument_2 = NULL;
1391: }
1392: }
1393: else if ((*s_objet_argument_1).type == CPL)
1394: {
1395: if (((*((complex16 *) (*s_objet_argument_1).objet))
1396: .partie_reelle == 1) && ((*((complex16 *)
1397: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
1398: { // Division par (1.0,0.0)
1399: drapeau = d_faux;
1400:
1401: s_objet_resultat = s_objet_argument_2;
1402: s_objet_argument_2 = NULL;
1403: }
1404: }
1405: }
1406: else if ((*s_objet_argument_1).type == NOM)
1407: {
1408: if ((*s_objet_argument_2).type == INT)
1409: {
1410: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
1411: { // Dividende nul
1412: drapeau = d_faux;
1413:
1414: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1415: == NULL)
1416: {
1417: (*s_etat_processus).erreur_systeme =
1418: d_es_allocation_memoire;
1419: return;
1420: }
1421:
1422: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1423: }
1424: }
1425: else if ((*s_objet_argument_2).type == REL)
1426: {
1427: if ((*((real8 *) (*s_objet_argument_2).objet)) == 0)
1428: { // Dividende nul
1429: drapeau = d_faux;
1430:
1431: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1432: == NULL)
1433: {
1434: (*s_etat_processus).erreur_systeme =
1435: d_es_allocation_memoire;
1436: return;
1437: }
1438:
1439: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1440: }
1441: }
1442: else if ((*s_objet_argument_2).type == CPL)
1443: {
1444: if (((*((complex16 *) (*s_objet_argument_2).objet))
1445: .partie_reelle == 0) && ((*((complex16 *)
1446: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
1447: { // Dividende nul
1448: drapeau = d_faux;
1449:
1450: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1451: == NULL)
1452: {
1453: (*s_etat_processus).erreur_systeme =
1454: d_es_allocation_memoire;
1455: return;
1456: }
1457:
1458: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1459: }
1460: }
1461: }
1462:
1463: if (drapeau == d_vrai)
1464: {
1465: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
1466: == NULL)
1467: {
1468: (*s_etat_processus).erreur_systeme =
1469: d_es_allocation_memoire;
1470: return;
1471: }
1472:
1473: if (((*s_objet_resultat).objet =
1474: allocation_maillon(s_etat_processus)) == NULL)
1475: {
1476: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1477: return;
1478: }
1479:
1480: l_element_courant = (*s_objet_resultat).objet;
1481:
1482: if (((*l_element_courant).donnee =
1483: allocation(s_etat_processus, FCT)) == NULL)
1484: {
1485: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1486: return;
1487: }
1488:
1489: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1490: .nombre_arguments = 0;
1491: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1492: .fonction = instruction_vers_niveau_superieur;
1493:
1494: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1495: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1496: {
1497: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1498: return;
1499: }
1500:
1501: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1502: .nom_fonction, "<<");
1503:
1504: if (((*l_element_courant).suivant =
1505: allocation_maillon(s_etat_processus)) == NULL)
1506: {
1507: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1508: return;
1509: }
1510:
1511: l_element_courant = (*l_element_courant).suivant;
1512: (*l_element_courant).donnee = s_objet_argument_2;
1513:
1514: if (((*l_element_courant).suivant =
1515: allocation_maillon(s_etat_processus)) == NULL)
1516: {
1517: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1518: return;
1519: }
1520:
1521: l_element_courant = (*l_element_courant).suivant;
1522: (*l_element_courant).donnee = s_objet_argument_1;
1523:
1524: if (((*l_element_courant).suivant =
1525: allocation_maillon(s_etat_processus)) == NULL)
1526: {
1527: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1528: return;
1529: }
1530:
1531: l_element_courant = (*l_element_courant).suivant;
1532:
1533: if (((*l_element_courant).donnee =
1534: allocation(s_etat_processus, FCT)) == NULL)
1535: {
1536: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1537: return;
1538: }
1539:
1540: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1541: .nombre_arguments = 0;
1542: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1543: .fonction = instruction_division;
1544:
1545: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1546: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
1547: {
1548: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1549: return;
1550: }
1551:
1552: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1553: .nom_fonction, "/");
1554:
1555: if (((*l_element_courant).suivant =
1556: allocation_maillon(s_etat_processus)) == NULL)
1557: {
1558: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1559: return;
1560: }
1561:
1562: l_element_courant = (*l_element_courant).suivant;
1563:
1564: if (((*l_element_courant).donnee =
1565: allocation(s_etat_processus, FCT)) == NULL)
1566: {
1567: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1568: return;
1569: }
1570:
1571: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1572: .nombre_arguments = 0;
1573: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1574: .fonction = instruction_vers_niveau_inferieur;
1575:
1576: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1577: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1578: {
1579: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1580: return;
1581: }
1582:
1583: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1584: .nom_fonction, ">>");
1585:
1586: (*l_element_courant).suivant = NULL;
1587:
1588: s_objet_argument_1 = NULL;
1589: s_objet_argument_2 = NULL;
1590: }
1591: }
1592:
1593: /*
1594: * Nom ou valeur numérique / Expression
1595: */
1596:
1597: else if ((((*s_objet_argument_1).type == ALG) ||
1598: ((*s_objet_argument_1).type == RPN)) &&
1599: (((*s_objet_argument_2).type == NOM) ||
1600: ((*s_objet_argument_2).type == INT) ||
1601: ((*s_objet_argument_2).type == REL) ||
1602: ((*s_objet_argument_2).type == CPL)))
1603: {
1604: drapeau = d_vrai;
1605:
1606: nombre_elements = 0;
1607: l_element_courant = (struct_liste_chainee *)
1608: (*s_objet_argument_1).objet;
1609:
1610: while(l_element_courant != NULL)
1611: {
1612: nombre_elements++;
1613: l_element_courant = (*l_element_courant).suivant;
1614: }
1615:
1616: if (nombre_elements == 2)
1617: {
1618: liberation(s_etat_processus, s_objet_argument_1);
1619: liberation(s_etat_processus, s_objet_argument_1);
1620:
1621: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1622: return;
1623: }
1624:
1625: if ((*s_objet_argument_2).type == INT)
1626: {
1627: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
1628: {
1629: drapeau = d_faux;
1630:
1631: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1632: == NULL)
1633: {
1634: (*s_etat_processus).erreur_systeme =
1635: d_es_allocation_memoire;
1636: return;
1637: }
1638:
1639: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1640: }
1641: }
1642: else if ((*s_objet_argument_2).type == REL)
1643: {
1644: if ((*((real8 *) (*s_objet_argument_2).objet)) == 0)
1645: {
1646: drapeau = d_faux;
1647:
1648: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1649: == NULL)
1650: {
1651: (*s_etat_processus).erreur_systeme =
1652: d_es_allocation_memoire;
1653: return;
1654: }
1655:
1656: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1657: }
1658: }
1659: else if ((*s_objet_argument_2).type == CPL)
1660: {
1661: if (((*((complex16 *) (*s_objet_argument_2).objet))
1662: .partie_reelle == 0) && ((*((complex16 *)
1663: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
1664: {
1665: drapeau = d_faux;
1666:
1667: if ((s_objet_resultat = allocation(s_etat_processus, INT))
1668: == NULL)
1669: {
1670: (*s_etat_processus).erreur_systeme =
1671: d_es_allocation_memoire;
1672: return;
1673: }
1674:
1675: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1676: }
1677: }
1678:
1679: if (drapeau == d_vrai)
1680: {
1681: if ((s_objet_resultat = copie_objet(s_etat_processus,
1682: s_objet_argument_1, 'N')) == NULL)
1683: {
1684: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1685: return;
1686: }
1687:
1688: l_element_courant = (struct_liste_chainee *)
1689: (*s_objet_resultat).objet;
1690: l_element_precedent = l_element_courant;
1691: l_element_courant = (*l_element_courant).suivant;
1692:
1693: if (((*l_element_precedent).suivant =
1694: allocation_maillon(s_etat_processus)) == NULL)
1695: {
1696: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1697: return;
1698: }
1699:
1700: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
1701: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1702:
1703: while((*l_element_courant).suivant != NULL)
1704: {
1705: l_element_precedent = l_element_courant;
1706: l_element_courant = (*l_element_courant).suivant;
1707: }
1708:
1709: if (((*l_element_precedent).suivant =
1710: allocation_maillon(s_etat_processus)) == NULL)
1711: {
1712: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1713: return;
1714: }
1715:
1716: if (((*(*l_element_precedent).suivant).donnee =
1717: allocation(s_etat_processus, FCT)) == NULL)
1718: {
1719: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1720: return;
1721: }
1722:
1723: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1724: .donnee).objet)).nombre_arguments = 0;
1725: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1726: .donnee).objet)).fonction = instruction_division;
1727:
1728: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1729: .suivant).donnee).objet)).nom_fonction =
1730: malloc(2 * sizeof(unsigned char))) == NULL)
1731: {
1732: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1733: return;
1734: }
1735:
1736: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1737: .suivant).donnee).objet)).nom_fonction, "/");
1738:
1739: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1740:
1741: s_objet_argument_2 = NULL;
1742: }
1743: }
1744:
1745: /*
1746: * Expression / Nom ou valeur numérique
1747: */
1748:
1749: else if ((((*s_objet_argument_1).type == NOM) ||
1750: ((*s_objet_argument_1).type == INT) ||
1751: ((*s_objet_argument_1).type == REL) ||
1752: ((*s_objet_argument_1).type == CPL)) &&
1753: (((*s_objet_argument_2).type == ALG) ||
1754: ((*s_objet_argument_2).type == RPN)))
1755: {
1756: drapeau = d_vrai;
1757:
1758: nombre_elements = 0;
1759: l_element_courant = (struct_liste_chainee *)
1760: (*s_objet_argument_2).objet;
1761:
1762: while(l_element_courant != NULL)
1763: {
1764: nombre_elements++;
1765: l_element_courant = (*l_element_courant).suivant;
1766: }
1767:
1768: if (nombre_elements == 2)
1769: {
1770: liberation(s_etat_processus, s_objet_argument_1);
1771: liberation(s_etat_processus, s_objet_argument_2);
1772:
1773: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1774: return;
1775: }
1776:
1777: if ((*s_objet_argument_1).type == INT)
1778: {
1779: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
1780: {
1781: drapeau = d_faux;
1782:
1783: s_objet_resultat = s_objet_argument_2;
1784: s_objet_argument_2 = NULL;
1785: }
1786: }
1787: else if ((*s_objet_argument_1).type == REL)
1788: {
1789: if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
1790: {
1791: drapeau = d_faux;
1792:
1793: s_objet_resultat = s_objet_argument_2;
1794: s_objet_argument_2 = NULL;
1795: }
1796: }
1797: else if ((*s_objet_argument_1).type == CPL)
1798: {
1799: if (((*((complex16 *) (*s_objet_argument_1).objet))
1800: .partie_reelle == 1) && ((*((complex16 *)
1801: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
1802: {
1803: drapeau = d_faux;
1804:
1805: s_objet_resultat = s_objet_argument_2;
1806: s_objet_argument_2 = NULL;
1807: }
1808: }
1809:
1810: if (drapeau == d_vrai)
1811: {
1812: if ((s_objet_resultat = copie_objet(s_etat_processus,
1813: s_objet_argument_2, 'N')) == NULL)
1814: {
1815: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1816: return;
1817: }
1818:
1819: l_element_courant = (struct_liste_chainee *)
1820: (*s_objet_resultat).objet;
1821: l_element_precedent = l_element_courant;
1822:
1823: while((*l_element_courant).suivant != NULL)
1824: {
1825: l_element_precedent = l_element_courant;
1826: l_element_courant = (*l_element_courant).suivant;
1827: }
1828:
1829: if (((*l_element_precedent).suivant =
1830: allocation_maillon(s_etat_processus)) == NULL)
1831: {
1832: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1833: return;
1834: }
1835:
1836: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
1837: l_element_precedent = (*l_element_precedent).suivant;
1838:
1839: if (((*l_element_precedent).suivant =
1840: allocation_maillon(s_etat_processus)) == NULL)
1841: {
1842: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1843: return;
1844: }
1845:
1846: if (((*(*l_element_precedent).suivant).donnee =
1847: allocation(s_etat_processus, FCT)) == NULL)
1848: {
1849: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1850: return;
1851: }
1852:
1853: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1854: .donnee).objet)).nombre_arguments = 0;
1855: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1856: .donnee).objet)).fonction = instruction_division;
1857:
1858: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1859: .suivant).donnee).objet)).nom_fonction =
1860: malloc(2 * sizeof(unsigned char))) == NULL)
1861: {
1862: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1863: return;
1864: }
1865:
1866: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1867: .suivant).donnee).objet)).nom_fonction, "/");
1868:
1869: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1870:
1871: s_objet_argument_1 = NULL;
1872: }
1873: }
1874:
1875: /*
1876: * Expression / Expression
1877: */
1878:
1879: else if ((((*s_objet_argument_1).type == ALG) &&
1880: ((*s_objet_argument_2).type == ALG)) ||
1881: (((*s_objet_argument_1).type == RPN) &&
1882: ((*s_objet_argument_2).type == RPN)))
1883: {
1884: nombre_elements = 0;
1885: l_element_courant = (struct_liste_chainee *)
1886: (*s_objet_argument_1).objet;
1887:
1888: while(l_element_courant != NULL)
1889: {
1890: nombre_elements++;
1891: l_element_courant = (*l_element_courant).suivant;
1892: }
1893:
1894: if (nombre_elements == 2)
1895: {
1896: liberation(s_etat_processus, s_objet_argument_1);
1897: liberation(s_etat_processus, s_objet_argument_2);
1898:
1899: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1900: return;
1901: }
1902:
1903: nombre_elements = 0;
1904: l_element_courant = (struct_liste_chainee *)
1905: (*s_objet_argument_2).objet;
1906:
1907: while(l_element_courant != NULL)
1908: {
1909: nombre_elements++;
1910: l_element_courant = (*l_element_courant).suivant;
1911: }
1912:
1913: if (nombre_elements == 2)
1914: {
1915: liberation(s_etat_processus, s_objet_argument_1);
1916: liberation(s_etat_processus, s_objet_argument_2);
1917:
1918: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1919: return;
1920: }
1921:
1922: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
1923: s_objet_argument_1, 'N')) == NULL)
1924: {
1925: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1926: return;
1927: }
1928:
1929: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
1930: s_objet_argument_2, 'N')) == NULL)
1931: {
1932: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1933: return;
1934: }
1935:
1936: l_element_courant = (struct_liste_chainee *)
1937: (*s_copie_argument_1).objet;
1938: (*s_copie_argument_1).objet = (*((struct_liste_chainee *)
1939: (*s_copie_argument_1).objet)).suivant;
1940:
1941: liberation(s_etat_processus, (*l_element_courant).donnee);
1942: free(l_element_courant);
1943:
1944: l_element_courant = (struct_liste_chainee *)
1945: (*s_copie_argument_2).objet;
1946: l_element_precedent = l_element_courant;
1947: s_objet_resultat = s_copie_argument_2;
1948:
1949: while((*l_element_courant).suivant != NULL)
1950: {
1951: l_element_precedent = l_element_courant;
1952: l_element_courant = (*l_element_courant).suivant;
1953: }
1954:
1955: liberation(s_etat_processus, (*l_element_courant).donnee);
1956: free(l_element_courant);
1957:
1958: (*l_element_precedent).suivant = (struct_liste_chainee *)
1959: (*s_copie_argument_1).objet;
1960: free(s_copie_argument_1);
1961:
1962: l_element_courant = (*l_element_precedent).suivant;
1963: while((*l_element_courant).suivant != NULL)
1964: {
1965: l_element_precedent = l_element_courant;
1966: l_element_courant = (*l_element_courant).suivant;
1967: }
1968:
1969: if (((*l_element_precedent).suivant =
1970: allocation_maillon(s_etat_processus)) == NULL)
1971: {
1972: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1973: return;
1974: }
1975:
1976: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1977: l_element_courant = (*l_element_precedent).suivant;
1978:
1979: if (((*l_element_courant).donnee =
1980: allocation(s_etat_processus, FCT)) == NULL)
1981: {
1982: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1983: return;
1984: }
1985:
1986: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1987: .nombre_arguments = 0;
1988: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1989: .fonction = instruction_division;
1990:
1991: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1992: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
1993: {
1994: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1995: return;
1996: }
1997:
1998: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1999: .nom_fonction, "/");
2000: }
2001:
2002: /*
2003: --------------------------------------------------------------------------------
2004: Division d'un vecteur par un scalaire
2005: --------------------------------------------------------------------------------
2006: */
2007: /*
2008: * Vecteur d'entiers ou de réels / Entier ou réel
2009: */
2010:
2011: else if ((((*s_objet_argument_1).type == INT) ||
2012: ((*s_objet_argument_1).type == REL)) &&
2013: (((*s_objet_argument_2).type == VIN) ||
2014: ((*s_objet_argument_2).type == VRL)))
2015: {
2016: resultat_entier = d_faux;
2017:
2018: if (((*s_objet_argument_2).type == VIN) &&
2019: ((*s_objet_argument_1).type == INT))
2020: {
2021: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
2022: {
2023: resultat_entier = d_faux;
2024: }
2025: else
2026: {
2027: resultat_entier = d_vrai;
2028:
2029: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument_2)
2030: .objet))).taille; i++)
2031: {
2032: if ((((integer8 *) (*((struct_vecteur *)
2033: (*s_objet_argument_2).objet)).tableau)[i] %
2034: (*((integer8 *) (*s_objet_argument_1).objet))) != 0)
2035: {
2036: resultat_entier = d_faux;
2037: }
2038: }
2039: }
2040: }
2041:
2042: if (resultat_entier == d_vrai)
2043: {
2044: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
2045: == NULL)
2046: {
2047: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2048: return;
2049: }
2050:
2051: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2052: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2053:
2054: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
2055: malloc((*(((struct_vecteur *) (*s_objet_resultat)
2056: .objet))).taille * sizeof(integer8))) == NULL)
2057: {
2058: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2059: return;
2060: }
2061:
2062: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2063: .objet))).taille; i++)
2064: {
2065: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2066: .tableau)[i] = ((integer8 *)
2067: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2068: .tableau)[i] / (*((integer8 *) (*s_objet_argument_1)
2069: .objet));
2070: }
2071: }
2072: else
2073: {
2074: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
2075: == NULL)
2076: {
2077: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2078: return;
2079: }
2080:
2081: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2082: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2083:
2084: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
2085: malloc((*(((struct_vecteur *) (*s_objet_resultat)
2086: .objet))).taille * sizeof(real8))) == NULL)
2087: {
2088: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2089: return;
2090: }
2091:
2092: if ((*s_objet_argument_1).type == INT)
2093: {
2094: diviseur_reel = (real8) (*((integer8 *)
2095: (*s_objet_argument_1).objet));
2096: }
2097: else
2098: {
2099: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
2100: }
2101:
2102: if ((diviseur_reel == 0) && (test_cfsf(s_etat_processus, 59) ==
2103: d_vrai))
2104: {
2105: liberation(s_etat_processus, s_objet_argument_1);
2106: liberation(s_etat_processus, s_objet_argument_2);
2107: liberation(s_etat_processus, s_objet_resultat);
2108:
2109: (*s_etat_processus).exception = d_ep_division_par_zero;
2110: return;
2111: }
2112:
2113: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2114: .objet))).taille; i++)
2115: {
2116: if ((*s_objet_argument_2).type == VIN)
2117: {
2118: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2119: .tableau)[i] = (real8) ((integer8 *)
2120: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2121: .tableau)[i] / diviseur_reel;
2122: }
2123: else
2124: {
2125: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2126: .tableau)[i] = ((real8 *)
2127: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2128: .tableau)[i] / diviseur_reel;
2129: }
2130: }
2131: }
2132: }
2133:
2134: /*
2135: * Vecteur d'entiers ou de réels / Complexe
2136: */
2137:
2138: else if (((*s_objet_argument_1).type == CPL) &&
2139: (((*s_objet_argument_2).type == VIN) ||
2140: ((*s_objet_argument_2).type == VRL)))
2141: {
2142: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
2143: {
2144: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2145: return;
2146: }
2147:
2148: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2149: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2150:
2151: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
2152: malloc((*(((struct_vecteur *) (*s_objet_resultat)
2153: .objet))).taille * sizeof(struct_complexe16))) == NULL)
2154: {
2155: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2156: return;
2157: }
2158:
2159: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
2160: .partie_reelle == 0) && (((*((struct_complexe16 *)
2161: (*s_objet_argument_1).objet)).partie_imaginaire == 0)))
2162: {
2163: liberation(s_etat_processus, s_objet_argument_1);
2164: liberation(s_etat_processus, s_objet_argument_2);
2165: liberation(s_etat_processus, s_objet_resultat);
2166:
2167: (*s_etat_processus).exception = d_ep_division_par_zero;
2168: return;
2169: }
2170:
2171: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2172: .objet))).taille; i++)
2173: {
2174: if ((*s_objet_argument_2).type == VIN)
2175: {
2176: f77divisionic_(&(((integer8 *)
2177: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2178: .tableau)[i]), &(*((struct_complexe16 *)
2179: (*s_objet_argument_1).objet)), &((struct_complexe16 *)
2180: (*((struct_vecteur *)
2181: (*s_objet_resultat).objet)).tableau)[i]);
2182: }
2183: else
2184: {
2185: f77divisionrc_(&(((real8 *)
2186: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2187: .tableau)[i]), &(*((struct_complexe16 *)
2188: (*s_objet_argument_1).objet)), &((struct_complexe16 *)
2189: (*((struct_vecteur *)
2190: (*s_objet_resultat).objet)).tableau)[i]);
2191: }
2192: }
2193: }
2194:
2195: /*
2196: * Vecteur de complexes / Entier, réel
2197: */
2198:
2199: else if ((((*s_objet_argument_1).type == INT) ||
2200: ((*s_objet_argument_1).type == REL)) &&
2201: ((*s_objet_argument_2).type == VCX))
2202: {
2203: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
2204: {
2205: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2206: return;
2207: }
2208:
2209: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2210: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2211:
2212: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
2213: malloc((*(((struct_vecteur *) (*s_objet_resultat)
2214: .objet))).taille * sizeof(struct_complexe16))) == NULL)
2215: {
2216: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2217: return;
2218: }
2219:
2220: if ((*s_objet_argument_1).type == INT)
2221: {
2222: diviseur_reel = (real8) (*((integer8 *)
2223: (*s_objet_argument_1).objet));
2224: }
2225: else
2226: {
2227: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
2228: }
2229:
2230: if (diviseur_reel == 0)
2231: {
2232: liberation(s_etat_processus, s_objet_argument_1);
2233: liberation(s_etat_processus, s_objet_argument_2);
2234: liberation(s_etat_processus, s_objet_resultat);
2235:
2236: (*s_etat_processus).exception = d_ep_division_par_zero;
2237: return;
2238: }
2239:
2240: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2241: .objet))).taille; i++)
2242: {
2243: if ((*s_objet_argument_1).type == INT)
2244: {
2245: f77divisionci_(&(((struct_complexe16 *)
2246: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2247: .tableau)[i]), &((*((integer8 *)
2248: (*s_objet_argument_1).objet))),
2249: &(((struct_complexe16 *) (*((struct_vecteur *)
2250: (*s_objet_resultat).objet)).tableau)[i]));
2251: }
2252: else
2253: {
2254: f77divisioncr_(&(((struct_complexe16 *)
2255: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2256: .tableau)[i]), &((*((real8 *)
2257: (*s_objet_argument_1).objet))),
2258: &(((struct_complexe16 *) (*((struct_vecteur *)
2259: (*s_objet_resultat).objet)).tableau)[i]));
2260: }
2261: }
2262: }
2263:
2264: /*
2265: * Vecteur de complexes / Complexe
2266: */
2267:
2268: else if (((*s_objet_argument_1).type == CPL) &&
2269: ((*s_objet_argument_2).type == VCX))
2270: {
2271: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
2272: {
2273: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2274: return;
2275: }
2276:
2277: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2278: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
2279:
2280: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
2281: malloc((*(((struct_vecteur *) (*s_objet_resultat)
2282: .objet))).taille * sizeof(struct_complexe16))) == NULL)
2283: {
2284: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2285: return;
2286: }
2287:
2288: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
2289: .partie_reelle == 0) && ((*((struct_complexe16 *)
2290: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
2291: {
2292: liberation(s_etat_processus, s_objet_argument_1);
2293: liberation(s_etat_processus, s_objet_argument_2);
2294: liberation(s_etat_processus, s_objet_resultat);
2295:
2296: (*s_etat_processus).exception = d_ep_division_par_zero;
2297: return;
2298: }
2299:
2300: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
2301: .objet))).taille; i++)
2302: {
2303: f77divisioncc_(&(((struct_complexe16 *)
2304: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2305: .tableau)[i]), &((*((struct_complexe16 *)
2306: (*s_objet_argument_1).objet))),
2307: &(((struct_complexe16 *) (*((struct_vecteur *)
2308: (*s_objet_resultat).objet)).tableau)[i]));
2309: }
2310: }
2311:
2312: /*
2313: --------------------------------------------------------------------------------
2314: Division d'une matrice par un scalaire
2315: --------------------------------------------------------------------------------
2316: */
2317: /*
2318: * Matrice d'entiers ou de réels / Entier ou réel
2319: */
2320:
2321: else if ((((*s_objet_argument_1).type == INT) ||
2322: ((*s_objet_argument_1).type == REL)) &&
2323: (((*s_objet_argument_2).type == MIN) ||
2324: ((*s_objet_argument_2).type == MRL)))
2325: {
2326: resultat_entier = d_faux;
2327:
2328: if (((*s_objet_argument_2).type == MIN) &&
2329: ((*s_objet_argument_1).type == INT))
2330: {
2331: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
2332: {
2333: resultat_entier = d_faux;
2334: }
2335: else
2336: {
2337: resultat_entier = d_vrai;
2338:
2339: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
2340: .objet))).nombre_lignes; i++)
2341: {
2342: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument_2)
2343: .objet))).nombre_colonnes; j++)
2344: {
2345: if ((((integer8 **) (*((struct_matrice *)
2346: (*s_objet_argument_2).objet)).tableau)[i][j] %
2347: (*((integer8 *) (*s_objet_argument_1).objet)))
2348: != 0)
2349: {
2350: resultat_entier = d_faux;
2351: }
2352: }
2353: }
2354: }
2355: }
2356:
2357: if (resultat_entier == d_vrai)
2358: {
2359: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
2360: == NULL)
2361: {
2362: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2363: return;
2364: }
2365:
2366: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
2367: (*((struct_matrice *) (*s_objet_argument_2).objet))
2368: .nombre_lignes;
2369: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
2370: (*((struct_matrice *) (*s_objet_argument_2).objet))
2371: .nombre_colonnes;
2372:
2373: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
2374: malloc((*(((struct_matrice *) (*s_objet_resultat)
2375: .objet))).nombre_lignes * sizeof(integer8 *))) == NULL)
2376: {
2377: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2378: return;
2379: }
2380:
2381: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
2382: .objet))).nombre_lignes; i++)
2383: {
2384: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
2385: .objet)).tableau)[i] = malloc((*(((struct_matrice *)
2386: (*s_objet_resultat).objet))).nombre_colonnes *
2387: sizeof(integer8))) == NULL)
2388: {
2389: (*s_etat_processus).erreur_systeme =
2390: d_es_allocation_memoire;
2391: return;
2392: }
2393:
2394: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
2395: .objet))).nombre_colonnes; j++)
2396: {
2397: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
2398: .objet)).tableau)[i][j] = ((integer8 **)
2399: (*((struct_matrice *) (*s_objet_argument_2)
2400: .objet)).tableau)[i][j] / (*((integer8 *)
2401: (*s_objet_argument_1).objet));
2402: }
2403: }
2404: }
2405: else
2406: {
2407: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
2408: == NULL)
2409: {
2410: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2411: return;
2412: }
2413:
2414: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
2415: (*((struct_matrice *) (*s_objet_argument_2).objet))
2416: .nombre_lignes;
2417: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
2418: (*((struct_matrice *) (*s_objet_argument_2).objet))
2419: .nombre_colonnes;
2420:
2421: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
2422: malloc((*(((struct_matrice *) (*s_objet_resultat)
2423: .objet))).nombre_lignes * sizeof(real8 *))) == NULL)
2424: {
2425: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2426: return;
2427: }
2428:
2429: if ((*s_objet_argument_1).type == INT)
2430: {
2431: diviseur_reel = (real8) (*((integer8 *)
2432: (*s_objet_argument_1).objet));
2433: }
2434: else
2435: {
2436: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
2437: }
2438:
2439: if ((diviseur_reel == 0) && (test_cfsf(s_etat_processus, 59) ==
2440: d_vrai))
2441: {
2442: liberation(s_etat_processus, s_objet_argument_1);
2443: liberation(s_etat_processus, s_objet_argument_2);
2444: liberation(s_etat_processus, s_objet_resultat);
2445:
2446: (*s_etat_processus).exception = d_ep_division_par_zero;
2447: return;
2448: }
2449:
2450: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
2451: .objet))).nombre_lignes; i++)
2452: {
2453: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
2454: .objet)).tableau)[i] = malloc((*(((struct_matrice *)
2455: (*s_objet_resultat).objet))).nombre_colonnes *
2456: sizeof(real8))) == NULL)
2457: {
2458: (*s_etat_processus).erreur_systeme =
2459: d_es_allocation_memoire;
2460: return;
2461: }
2462:
2463: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
2464: .objet))).nombre_colonnes; j++)
2465: {
2466: if ((*s_objet_argument_2).type == MIN)
2467: {
2468: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
2469: .objet)).tableau)[i][j] = (real8) ((integer8 **)
2470: (*((struct_matrice *) (*s_objet_argument_2)
2471: .objet)).tableau)[i][j] / diviseur_reel;
2472: }
2473: else
2474: {
2475: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
2476: .objet)).tableau)[i][j] = ((real8 **)
2477: (*((struct_matrice *) (*s_objet_argument_2)
2478: .objet)).tableau)[i][j] / diviseur_reel;
2479: }
2480: }
2481: }
2482: }
2483: }
2484:
2485: /*
2486: * Matrice d'entiers ou de réels / Complexe
2487: */
2488:
2489: else if (((*s_objet_argument_1).type == CPL) &&
2490: (((*s_objet_argument_2).type == MIN) ||
2491: ((*s_objet_argument_2).type == MRL)))
2492: {
2493: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
2494: {
2495: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2496: return;
2497: }
2498:
2499: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
2500: (*((struct_matrice *) (*s_objet_argument_2).objet))
2501: .nombre_lignes;
2502: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
2503: (*((struct_matrice *) (*s_objet_argument_2).objet))
2504: .nombre_colonnes;
2505:
2506: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
2507: malloc((*(((struct_matrice *) (*s_objet_resultat)
2508: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
2509: {
2510: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2511: return;
2512: }
2513:
2514: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
2515: .partie_reelle == 0) && (((*((struct_complexe16 *)
2516: (*s_objet_argument_1).objet)).partie_imaginaire == 0)))
2517: {
2518: liberation(s_etat_processus, s_objet_argument_1);
2519: liberation(s_etat_processus, s_objet_argument_2);
2520: liberation(s_etat_processus, s_objet_resultat);
2521:
2522: (*s_etat_processus).exception = d_ep_division_par_zero;
2523: return;
2524: }
2525:
2526: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
2527: .objet))).nombre_lignes; i++)
2528: {
2529: if ((((struct_complexe16 **) (*((struct_matrice *)
2530: (*s_objet_resultat).objet)).tableau)[i] =
2531: malloc((*(((struct_matrice *)
2532: (*s_objet_resultat).objet))).nombre_colonnes *
2533: sizeof(struct_complexe16))) == NULL)
2534: {
2535: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2536: return;
2537: }
2538:
2539: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
2540: .objet))).nombre_colonnes; j++)
2541: {
2542: if ((*s_objet_argument_2).type == MIN)
2543: {
2544: f77divisionic_(&(((integer8 **)
2545: (*((struct_matrice *) (*s_objet_argument_2).objet))
2546: .tableau)[i][j]), &(*((struct_complexe16 *)
2547: (*s_objet_argument_1).objet)),
2548: &((struct_complexe16 **) (*((struct_matrice *)
2549: (*s_objet_resultat).objet)).tableau)[i][j]);
2550: }
2551: else
2552: {
2553: f77divisionrc_(&(((real8 **)
2554: (*((struct_matrice *) (*s_objet_argument_2).objet))
2555: .tableau)[i][j]), &(*((struct_complexe16 *)
2556: (*s_objet_argument_1).objet)),
2557: &((struct_complexe16 **) (*((struct_matrice *)
2558: (*s_objet_resultat).objet)).tableau)[i][j]);
2559: }
2560: }
2561: }
2562: }
2563:
2564: /*
2565: * Matrice de complexes / Entier, réel
2566: */
2567:
2568: else if ((((*s_objet_argument_1).type == INT) ||
2569: ((*s_objet_argument_1).type == REL)) &&
2570: ((*s_objet_argument_2).type == MCX))
2571: {
2572: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
2573: {
2574: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2575: return;
2576: }
2577:
2578: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
2579: (*((struct_matrice *) (*s_objet_argument_2).objet))
2580: .nombre_lignes;
2581: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
2582: (*((struct_matrice *) (*s_objet_argument_2).objet))
2583: .nombre_colonnes;
2584:
2585: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
2586: malloc((*(((struct_matrice *) (*s_objet_resultat)
2587: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
2588: {
2589: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2590: return;
2591: }
2592:
2593: if ((*s_objet_argument_1).type == INT)
2594: {
2595: diviseur_reel = (real8) (*((integer8 *)
2596: (*s_objet_argument_1).objet));
2597: }
2598: else
2599: {
2600: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
2601: }
2602:
2603: if (diviseur_reel == 0)
2604: {
2605: liberation(s_etat_processus, s_objet_argument_1);
2606: liberation(s_etat_processus, s_objet_argument_2);
2607: liberation(s_etat_processus, s_objet_resultat);
2608:
2609: (*s_etat_processus).exception = d_ep_division_par_zero;
2610: return;
2611: }
2612:
2613: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
2614: .objet))).nombre_lignes; i++)
2615: {
2616: if ((((struct_complexe16 **) (*((struct_matrice *)
2617: (*s_objet_resultat).objet)).tableau)[i] =
2618: malloc((*(((struct_matrice *)
2619: (*s_objet_resultat).objet))).nombre_colonnes *
2620: sizeof(struct_complexe16))) == NULL)
2621: {
2622: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2623: return;
2624: }
2625:
2626: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
2627: .objet))).nombre_colonnes; j++)
2628: {
2629: if ((*s_objet_argument_1).type == INT)
2630: {
2631: f77divisionci_(&(((struct_complexe16 **)
2632: (*((struct_matrice *) (*s_objet_argument_2).objet))
2633: .tableau)[i][j]), &((*((integer8 *)
2634: (*s_objet_argument_1).objet))),
2635: &(((struct_complexe16 **) (*((struct_matrice *)
2636: (*s_objet_resultat).objet)).tableau)[i][j]));
2637: }
2638: else
2639: {
2640: f77divisioncr_(&(((struct_complexe16 **)
2641: (*((struct_matrice *) (*s_objet_argument_2).objet))
2642: .tableau)[i][j]), &((*((real8 *)
2643: (*s_objet_argument_1).objet))),
2644: &(((struct_complexe16 **) (*((struct_matrice *)
2645: (*s_objet_resultat).objet)).tableau)[i][j]));
2646: }
2647: }
2648: }
2649: }
2650:
2651: /*
2652: * Matrice de complexes / Complexe
2653: */
2654:
2655: else if (((*s_objet_argument_1).type == CPL) &&
2656: ((*s_objet_argument_2).type == MCX))
2657: {
2658: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
2659: {
2660: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2661: return;
2662: }
2663:
2664: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
2665: (*((struct_matrice *) (*s_objet_argument_2).objet))
2666: .nombre_lignes;
2667: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
2668: (*((struct_matrice *) (*s_objet_argument_2).objet))
2669: .nombre_colonnes;
2670:
2671: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
2672: malloc((*(((struct_matrice *) (*s_objet_resultat)
2673: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
2674: {
2675: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2676: return;
2677: }
2678:
2679: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
2680: .partie_reelle == 0) && ((*((struct_complexe16 *)
2681: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
2682: {
2683: liberation(s_etat_processus, s_objet_argument_1);
2684: liberation(s_etat_processus, s_objet_argument_2);
2685: liberation(s_etat_processus, s_objet_resultat);
2686:
2687: (*s_etat_processus).exception = d_ep_division_par_zero;
2688: return;
2689: }
2690:
2691: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
2692: .objet))).nombre_lignes; i++)
2693: {
2694: if ((((struct_complexe16 **) (*((struct_matrice *)
2695: (*s_objet_resultat).objet)).tableau)[i] =
2696: malloc((*(((struct_matrice *)
2697: (*s_objet_resultat).objet))).nombre_colonnes *
2698: sizeof(struct_complexe16))) == NULL)
2699: {
2700: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2701: return;
2702: }
2703:
2704: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
2705: .objet))).nombre_colonnes; j++)
2706: {
2707: f77divisioncc_(&(((struct_complexe16 **)
2708: (*((struct_matrice *) (*s_objet_argument_2).objet))
2709: .tableau)[i][j]), &((*((struct_complexe16 *)
2710: (*s_objet_argument_1).objet))),
2711: &(((struct_complexe16 **) (*((struct_matrice *)
2712: (*s_objet_resultat).objet)).tableau)[i][j]));
2713: }
2714: }
2715: }
2716:
2717: /*
2718: --------------------------------------------------------------------------------
2719: Division mettant en oeuvre une inversion de matrice
2720: --------------------------------------------------------------------------------
2721: */
2722: /*
2723: * Vecteur d'entiers ou de réels / Matrice d'entiers ou de réels
2724: */
2725:
2726: else if ((((*s_objet_argument_1).type == MIN) ||
2727: ((*s_objet_argument_1).type == MRL)) &&
2728: (((*s_objet_argument_2).type == VIN) ||
2729: ((*s_objet_argument_2).type == VRL)))
2730: {
2731: if ((*s_objet_argument_1).type == MIN)
2732: {
2733: (*s_objet_argument_1).type = MRL;
2734: }
2735:
2736: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
2737: .nombre_colonnes != (*(((struct_vecteur *)
2738: (*s_objet_argument_2).objet))).taille)
2739: {
2740: liberation(s_etat_processus, s_objet_argument_1);
2741: liberation(s_etat_processus, s_objet_argument_2);
2742:
2743: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
2744: return;
2745: }
2746:
2747: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
2748: {
2749: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2750: return;
2751: }
2752:
2753: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2754: (*(((struct_vecteur *) (*s_objet_argument_2)
2755: .objet))).taille;
2756:
2757: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
2758: malloc((*((struct_vecteur *)
2759: (*s_objet_resultat).objet)).taille * sizeof(real8))) == NULL)
2760: {
2761: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2762: return;
2763: }
2764:
2765: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
2766: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
2767: .nombre_colonnes)
2768: {
2769: liberation(s_etat_processus, s_objet_argument_1);
2770: liberation(s_etat_processus, s_objet_argument_2);
2771: liberation(s_etat_processus, s_objet_resultat);
2772:
2773: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
2774: return;
2775: }
2776:
2777: inversion_matrice(s_etat_processus,
2778: (struct_matrice *) (*s_objet_argument_1).objet);
2779:
2780: if (((*s_etat_processus).exception != d_ep) ||
2781: ((*s_etat_processus).erreur_execution != d_ex))
2782: {
2783: liberation(s_etat_processus, s_objet_argument_1);
2784: liberation(s_etat_processus, s_objet_argument_2);
2785: liberation(s_etat_processus, s_objet_resultat);
2786: return;
2787: }
2788:
2789: if ((*s_etat_processus).erreur_systeme != d_es)
2790: {
2791: return;
2792: }
2793:
2794: for(i = 0; i < (*((struct_vecteur *)
2795: (*s_objet_resultat).objet)).taille; i++)
2796: {
2797: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
2798: .tableau)[i] = 0;
2799:
2800: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_1).objet))
2801: .nombre_colonnes; j++)
2802: {
2803: if ((*s_objet_argument_2).type == VIN)
2804: {
2805: ((real8 *) (*((struct_vecteur *)
2806: (*s_objet_resultat).objet))
2807: .tableau)[i] += ((real8 **) (*((struct_matrice *)
2808: (*s_objet_argument_1).objet)).tableau)[i][j] *
2809: ((integer8 *) (*((struct_vecteur *)
2810: (*s_objet_argument_2).objet)).tableau)[j];
2811: }
2812: else
2813: {
2814: ((real8 *) (*((struct_vecteur *)
2815: (*s_objet_resultat).objet))
2816: .tableau)[i] += ((real8 **) (*((struct_matrice *)
2817: (*s_objet_argument_1).objet)).tableau)[i][j] *
2818: ((real8 *) (*((struct_vecteur *)
2819: (*s_objet_argument_2).objet)).tableau)[j];
2820: }
2821: }
2822: }
2823: }
2824:
2825: /*
2826: * Vecteur d'entiers ou de réels / Matrice de complexes
2827: */
2828:
2829: else if (((*s_objet_argument_1).type == MCX) &&
2830: (((*s_objet_argument_2).type == VIN) ||
2831: ((*s_objet_argument_2).type == VRL)))
2832: {
2833: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
2834: .nombre_colonnes != (*(((struct_vecteur *)
2835: (*s_objet_argument_2).objet))).taille)
2836: {
2837: liberation(s_etat_processus, s_objet_argument_1);
2838: liberation(s_etat_processus, s_objet_argument_2);
2839:
2840: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
2841: return;
2842: }
2843:
2844: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
2845: {
2846: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2847: return;
2848: }
2849:
2850: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'C';
2851: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2852: (*(((struct_vecteur *) (*s_objet_argument_2)
2853: .objet))).taille;
2854:
2855: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
2856: malloc((*((struct_vecteur *)
2857: (*s_objet_resultat).objet)).taille * sizeof(struct_complexe16)))
2858: == NULL)
2859: {
2860: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2861: return;
2862: }
2863:
2864: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
2865: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
2866: .nombre_colonnes)
2867: {
2868: liberation(s_etat_processus, s_objet_argument_1);
2869: liberation(s_etat_processus, s_objet_argument_2);
2870: liberation(s_etat_processus, s_objet_resultat);
2871:
2872: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
2873: return;
2874: }
2875:
2876: inversion_matrice(s_etat_processus,
2877: (struct_matrice *) (*s_objet_argument_1).objet);
2878:
2879: if (((*s_etat_processus).exception != d_ep) ||
2880: ((*s_etat_processus).erreur_execution != d_ex))
2881: {
2882: liberation(s_etat_processus, s_objet_argument_1);
2883: liberation(s_etat_processus, s_objet_argument_2);
2884: liberation(s_etat_processus, s_objet_resultat);
2885: return;
2886: }
2887:
2888: if ((*s_etat_processus).erreur_systeme != d_es)
2889: {
2890: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2891: return;
2892: }
2893:
2894: for(i = 0; i < (*((struct_vecteur *)
2895: (*s_objet_resultat).objet)).taille; i++)
2896: {
2897: (((struct_complexe16 *) (*((struct_vecteur *)
2898: (*s_objet_resultat).objet)).tableau)[i]).partie_reelle = 0;
2899: (((struct_complexe16 *) (*((struct_vecteur *)
2900: (*s_objet_resultat).objet)).tableau)[i]).partie_imaginaire
2901: = 0;
2902:
2903: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_1).objet))
2904: .nombre_colonnes; j++)
2905: {
2906: if ((*s_objet_argument_2).type == VIN)
2907: {
2908: f77multiplicationci_(&(((struct_complexe16 **)
2909: (*((struct_matrice *) (*s_objet_argument_1).objet))
2910: .tableau)[i][j]), &(((integer8 *)
2911: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2912: .tableau)[j]), &accumulateur);
2913:
2914: f77additioncc_(&(((struct_complexe16 *)
2915: (*((struct_vecteur *) (*s_objet_resultat).objet))
2916: .tableau)[i]), &accumulateur,
2917: &(((struct_complexe16 *)
2918: (*((struct_vecteur *) (*s_objet_resultat).objet))
2919: .tableau)[i]));
2920: }
2921: else
2922: {
2923: f77multiplicationcr_(&(((struct_complexe16 **)
2924: (*((struct_matrice *) (*s_objet_argument_1).objet))
2925: .tableau)[i][j]), &(((real8 *)
2926: (*((struct_vecteur *) (*s_objet_argument_2).objet))
2927: .tableau)[j]), &accumulateur);
2928:
2929: f77additioncc_(&(((struct_complexe16 *)
2930: (*((struct_vecteur *) (*s_objet_resultat).objet))
2931: .tableau)[i]), &accumulateur,
2932: &(((struct_complexe16 *)
2933: (*((struct_vecteur *) (*s_objet_resultat).objet))
2934: .tableau)[i]));
2935: }
2936: }
2937: }
2938: }
2939:
2940: /*
2941: * Vecteur de complexes / Matrice de complexes
2942: */
2943:
2944: else if (((*s_objet_argument_1).type == MCX) &&
2945: ((*s_objet_argument_2).type == VCX))
2946: {
2947: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
2948: .nombre_colonnes != (*(((struct_vecteur *)
2949: (*s_objet_argument_2).objet))).taille)
2950: {
2951: liberation(s_etat_processus, s_objet_argument_1);
2952: liberation(s_etat_processus, s_objet_argument_2);
2953:
2954: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
2955: return;
2956: }
2957:
2958: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
2959: {
2960: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2961: return;
2962: }
2963:
2964: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
2965: (*(((struct_vecteur *) (*s_objet_argument_2)
2966: .objet))).taille;
2967:
2968: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
2969: malloc((*((struct_vecteur *)
2970: (*s_objet_resultat).objet)).taille * sizeof(struct_complexe16)))
2971: == NULL)
2972: {
2973: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2974: return;
2975: }
2976:
2977: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
2978: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
2979: .nombre_colonnes)
2980: {
2981: liberation(s_etat_processus, s_objet_argument_1);
2982: liberation(s_etat_processus, s_objet_argument_2);
2983: liberation(s_etat_processus, s_objet_resultat);
2984:
2985: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
2986: return;
2987: }
2988:
2989: inversion_matrice(s_etat_processus,
2990: (struct_matrice *) (*s_objet_argument_1).objet);
2991:
2992: if (((*s_etat_processus).exception != d_ep) ||
2993: ((*s_etat_processus).erreur_execution != d_ex))
2994: {
2995: liberation(s_etat_processus, s_objet_argument_1);
2996: liberation(s_etat_processus, s_objet_argument_2);
2997: liberation(s_etat_processus, s_objet_resultat);
2998: return;
2999: }
3000:
3001: if ((*s_etat_processus).erreur_systeme != d_es)
3002: {
3003: return;
3004: }
3005:
3006: for(i = 0; i < (*((struct_vecteur *)
3007: (*s_objet_resultat).objet)).taille; i++)
3008: {
3009: (((struct_complexe16 *) (*((struct_vecteur *)
3010: (*s_objet_resultat).objet)).tableau)[i]).partie_reelle = 0;
3011: (((struct_complexe16 *) (*((struct_vecteur *)
3012: (*s_objet_resultat).objet)).tableau)[i]).partie_imaginaire
3013: = 0;
3014:
3015: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_1).objet))
3016: .nombre_colonnes; j++)
3017: {
3018: f77multiplicationcc_(&(((struct_complexe16 **)
3019: (*((struct_matrice *) (*s_objet_argument_1).objet))
3020: .tableau)[i][j]), &(((struct_complexe16 *)
3021: (*((struct_vecteur *) (*s_objet_argument_2).objet))
3022: .tableau)[j]), &accumulateur);
3023:
3024: f77additioncc_(&(((struct_complexe16 *)
3025: (*((struct_vecteur *) (*s_objet_resultat).objet))
3026: .tableau)[i]), &accumulateur,
3027: &(((struct_complexe16 *)
3028: (*((struct_vecteur *) (*s_objet_resultat).objet))
3029: .tableau)[i]));
3030: }
3031: }
3032: }
3033:
3034: /*
3035: * Vecteur de complexes / Matrice d'entiers ou de réels
3036: */
3037:
3038: else if (((*s_objet_argument_2).type == VCX) &&
3039: (((*s_objet_argument_1).type == MRL) ||
3040: ((*s_objet_argument_1).type == MIN)))
3041: {
3042: if ((*s_objet_argument_1).type == MIN)
3043: {
3044: (*s_objet_argument_1).type = MRL;
3045: }
3046:
3047: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
3048: .nombre_colonnes != (*(((struct_vecteur *)
3049: (*s_objet_argument_2).objet))).taille)
3050: {
3051: liberation(s_etat_processus, s_objet_argument_1);
3052: liberation(s_etat_processus, s_objet_argument_2);
3053:
3054: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3055: return;
3056: }
3057:
3058: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
3059: {
3060: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3061: return;
3062: }
3063:
3064: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
3065: (*(((struct_vecteur *) (*s_objet_argument_2)
3066: .objet))).taille;
3067:
3068: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
3069: malloc((*((struct_vecteur *)
3070: (*s_objet_resultat).objet)).taille * sizeof(struct_complexe16)))
3071: == NULL)
3072: {
3073: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3074: return;
3075: }
3076:
3077: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
3078: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
3079: .nombre_colonnes)
3080: {
3081: liberation(s_etat_processus, s_objet_argument_1);
3082: liberation(s_etat_processus, s_objet_argument_2);
3083: liberation(s_etat_processus, s_objet_resultat);
3084:
3085: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3086: return;
3087: }
3088:
3089: inversion_matrice(s_etat_processus,
3090: (struct_matrice *) (*s_objet_argument_1).objet);
3091:
3092: if (((*s_etat_processus).exception != d_ep) ||
3093: ((*s_etat_processus).erreur_execution != d_ex))
3094: {
3095: liberation(s_etat_processus, s_objet_argument_1);
3096: liberation(s_etat_processus, s_objet_argument_2);
3097: liberation(s_etat_processus, s_objet_resultat);
3098: return;
3099: }
3100:
3101: if ((*s_etat_processus).erreur_systeme != d_es)
3102: {
3103: return;
3104: }
3105:
3106: for(i = 0; i < (*((struct_vecteur *)
3107: (*s_objet_resultat).objet)).taille; i++)
3108: {
3109: (((struct_complexe16 *) (*((struct_vecteur *)
3110: (*s_objet_resultat).objet)).tableau)[i]).partie_reelle = 0;
3111: (((struct_complexe16 *) (*((struct_vecteur *)
3112: (*s_objet_resultat).objet)).tableau)[i]).partie_imaginaire
3113: = 0;
3114:
3115: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_1).objet))
3116: .nombre_colonnes; j++)
3117: {
3118: f77multiplicationcr_(&(((struct_complexe16 *)
3119: (*((struct_vecteur *) (*s_objet_argument_2).objet))
3120: .tableau)[j]), &(((real8 **)
3121: (*((struct_matrice *) (*s_objet_argument_1).objet))
3122: .tableau)[i][j]), &accumulateur);
3123:
3124: f77additioncc_(&(((struct_complexe16 *)
3125: (*((struct_vecteur *) (*s_objet_resultat).objet))
3126: .tableau)[i]), &accumulateur,
3127: &(((struct_complexe16 *)
3128: (*((struct_vecteur *) (*s_objet_resultat).objet))
3129: .tableau)[i]));
3130: }
3131: }
3132: }
3133:
3134: /*
3135: * Matrice d'entiers ou de réels / Matrice d'entiers ou de réels
3136: */
3137:
3138: else if ((((*s_objet_argument_1).type == MIN) ||
3139: ((*s_objet_argument_1).type == MRL)) &&
3140: (((*s_objet_argument_2).type == MIN) ||
3141: ((*s_objet_argument_2).type == MRL)))
3142: {
3143: if ((*s_objet_argument_1).type == MIN)
3144: {
3145: (*s_objet_argument_1).type = MRL;
3146: }
3147:
3148: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
3149: .nombre_colonnes != (*(((struct_matrice *)
3150: (*s_objet_argument_2).objet))).nombre_lignes)
3151: {
3152: liberation(s_etat_processus, s_objet_argument_1);
3153: liberation(s_etat_processus, s_objet_argument_2);
3154:
3155: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3156: return;
3157: }
3158:
3159: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
3160: {
3161: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3162: return;
3163: }
3164:
3165: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3166: (*(((struct_matrice *) (*s_objet_argument_2)
3167: .objet))).nombre_lignes;
3168: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3169: (*(((struct_matrice *) (*s_objet_argument_2)
3170: .objet))).nombre_colonnes;
3171:
3172: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
3173: malloc((*((struct_matrice *)
3174: (*s_objet_resultat).objet)).nombre_lignes * sizeof(real8 *)))
3175: == NULL)
3176: {
3177: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3178: return;
3179: }
3180:
3181: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
3182: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
3183: .nombre_colonnes)
3184: {
3185: liberation(s_etat_processus, s_objet_argument_1);
3186: liberation(s_etat_processus, s_objet_argument_2);
3187: liberation(s_etat_processus, s_objet_resultat);
3188:
3189: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3190: return;
3191: }
3192:
3193: inversion_matrice(s_etat_processus,
3194: (struct_matrice *) (*s_objet_argument_1).objet);
3195:
3196: if (((*s_etat_processus).exception != d_ep) ||
3197: ((*s_etat_processus).erreur_execution != d_ex))
3198: {
3199: liberation(s_etat_processus, s_objet_argument_1);
3200: liberation(s_etat_processus, s_objet_argument_2);
3201: liberation(s_etat_processus, s_objet_resultat);
3202: return;
3203: }
3204:
3205: if ((*s_etat_processus).erreur_systeme != d_es)
3206: {
3207: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3208: return;
3209: }
3210:
3211: for(i = 0; i < (*((struct_matrice *)
3212: (*s_objet_resultat).objet)).nombre_lignes; i++)
3213: {
3214: if ((((*((struct_matrice *) (*s_objet_resultat).objet)).tableau)[i]
3215: = malloc((*((struct_matrice *)
3216: (*s_objet_resultat).objet)).nombre_colonnes *
3217: sizeof(real8))) == NULL)
3218: {
3219: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3220: return;
3221: }
3222:
3223: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
3224: .nombre_colonnes; j++)
3225: {
3226: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
3227: .tableau)[i][j] = 0;
3228:
3229: for(k = 0; k < (*((struct_matrice *) (*s_objet_argument_2)
3230: .objet)).nombre_lignes; k++)
3231: {
3232: if ((*s_objet_argument_2).type == MIN)
3233: {
3234: ((real8 **) (*((struct_matrice *)
3235: (*s_objet_resultat).objet))
3236: .tableau)[i][j] += ((real8 **)
3237: (*((struct_matrice *)
3238: (*s_objet_argument_1).objet)).tableau)[i][k] *
3239: ((integer8 **) (*((struct_matrice *)
3240: (*s_objet_argument_2).objet)).tableau)[k][j];
3241: }
3242: else
3243: {
3244: ((real8 **) (*((struct_matrice *)
3245: (*s_objet_resultat).objet))
3246: .tableau)[i][j] += ((real8 **)
3247: (*((struct_matrice *)
3248: (*s_objet_argument_1).objet)).tableau)[i][k] *
3249: ((real8 **) (*((struct_matrice *)
3250: (*s_objet_argument_2).objet)).tableau)[k][j];
3251: }
3252: }
3253: }
3254: }
3255: }
3256:
3257: /*
3258: * Matrice d'entiers ou de réels / Matrice de complexes
3259: */
3260:
3261: else if (((*s_objet_argument_1).type == MCX) &&
3262: (((*s_objet_argument_2).type == MIN) ||
3263: ((*s_objet_argument_2).type == MRL)))
3264: {
3265: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
3266: .nombre_colonnes != (*(((struct_matrice *)
3267: (*s_objet_argument_2).objet))).nombre_lignes)
3268: {
3269: liberation(s_etat_processus, s_objet_argument_1);
3270: liberation(s_etat_processus, s_objet_argument_2);
3271:
3272: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3273: return;
3274: }
3275:
3276: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
3277: {
3278: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3279: return;
3280: }
3281:
3282: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3283: (*(((struct_matrice *) (*s_objet_argument_2)
3284: .objet))).nombre_lignes;
3285: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3286: (*(((struct_matrice *) (*s_objet_argument_2)
3287: .objet))).nombre_colonnes;
3288:
3289: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
3290: malloc((*((struct_matrice *)
3291: (*s_objet_resultat).objet)).nombre_lignes *
3292: sizeof(struct_complexe16))) == NULL)
3293: {
3294: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3295: return;
3296: }
3297:
3298: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
3299: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
3300: .nombre_colonnes)
3301: {
3302: liberation(s_etat_processus, s_objet_argument_1);
3303: liberation(s_etat_processus, s_objet_argument_2);
3304: liberation(s_etat_processus, s_objet_resultat);
3305:
3306: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3307: return;
3308: }
3309:
3310: inversion_matrice(s_etat_processus,
3311: (struct_matrice *) (*s_objet_argument_1).objet);
3312:
3313: if (((*s_etat_processus).exception != d_ep) ||
3314: ((*s_etat_processus).erreur_execution != d_ex))
3315: {
3316: liberation(s_etat_processus, s_objet_argument_1);
3317: liberation(s_etat_processus, s_objet_argument_2);
3318: liberation(s_etat_processus, s_objet_resultat);
3319: return;
3320: }
3321:
3322: if ((*s_etat_processus).erreur_systeme != d_es)
3323: {
3324: return;
3325: }
3326:
3327: for(i = 0; i < (*((struct_matrice *)
3328: (*s_objet_resultat).objet)).nombre_lignes; i++)
3329: {
3330: if ((((*((struct_matrice *) (*s_objet_resultat).objet)).tableau)[i]
3331: = malloc((*((struct_matrice *)
3332: (*s_objet_resultat).objet)).nombre_colonnes *
3333: sizeof(struct_complexe16))) == NULL)
3334: {
3335: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3336: return;
3337: }
3338:
3339: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
3340: .nombre_colonnes; j++)
3341: {
3342: (((struct_complexe16 **) (*((struct_matrice *)
3343: (*s_objet_resultat).objet)).tableau)[i][j])
3344: .partie_reelle = 0;
3345: (((struct_complexe16 **) (*((struct_matrice *)
3346: (*s_objet_resultat).objet)).tableau)[i][j])
3347: .partie_imaginaire = 0;
3348:
3349: for(k = 0; k < (*((struct_matrice *) (*s_objet_argument_2)
3350: .objet)).nombre_lignes; k++)
3351: {
3352: if ((*s_objet_argument_2).type == MIN)
3353: {
3354: f77multiplicationci_(&(((struct_complexe16 **)
3355: (*((struct_matrice *) (*s_objet_argument_1)
3356: .objet)).tableau)[i][k]), &(((integer8 **)
3357: (*((struct_matrice *) (*s_objet_argument_2)
3358: .objet)).tableau)[k][j]), &accumulateur);
3359:
3360: f77additioncc_(&(((struct_complexe16 **)
3361: (*((struct_matrice *) (*s_objet_resultat)
3362: .objet)).tableau)[i][j]), &accumulateur,
3363: &(((struct_complexe16 **) (*((struct_matrice *)
3364: (*s_objet_resultat).objet)).tableau)[i][j]));
3365: }
3366: else
3367: {
3368: f77multiplicationcr_(&(((struct_complexe16 **)
3369: (*((struct_matrice *) (*s_objet_argument_1)
3370: .objet)).tableau)[i][k]), &(((real8 **)
3371: (*((struct_matrice *) (*s_objet_argument_2)
3372: .objet)).tableau)[k][j]), &accumulateur);
3373:
3374: f77additioncc_(&(((struct_complexe16 **)
3375: (*((struct_matrice *) (*s_objet_resultat)
3376: .objet)).tableau)[i][j]), &accumulateur,
3377: &(((struct_complexe16 **) (*((struct_matrice *)
3378: (*s_objet_resultat).objet)).tableau)[i][j]));
3379: }
3380: }
3381: }
3382: }
3383: }
3384:
3385: /*
3386: * Matrice de complexes / Matrice de complexes
3387: */
3388:
3389: else if (((*s_objet_argument_1).type == MCX) &&
3390: ((*s_objet_argument_2).type == MCX))
3391: {
3392: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
3393: .nombre_colonnes != (*(((struct_matrice *)
3394: (*s_objet_argument_2).objet))).nombre_lignes)
3395: {
3396: liberation(s_etat_processus, s_objet_argument_1);
3397: liberation(s_etat_processus, s_objet_argument_2);
3398:
3399: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3400: return;
3401: }
3402:
3403: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
3404: {
3405: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3406: return;
3407: }
3408:
3409: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3410: (*(((struct_matrice *) (*s_objet_argument_2)
3411: .objet))).nombre_lignes;
3412: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3413: (*(((struct_matrice *) (*s_objet_argument_2)
3414: .objet))).nombre_colonnes;
3415:
3416: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
3417: malloc((*((struct_matrice *)
3418: (*s_objet_resultat).objet)).nombre_lignes *
3419: sizeof(struct_complexe16))) == NULL)
3420: {
3421: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3422: return;
3423: }
3424:
3425: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
3426: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
3427: .nombre_colonnes)
3428: {
3429: liberation(s_etat_processus, s_objet_argument_1);
3430: liberation(s_etat_processus, s_objet_argument_2);
3431: liberation(s_etat_processus, s_objet_resultat);
3432:
3433: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3434: return;
3435: }
3436:
3437: inversion_matrice(s_etat_processus,
3438: (struct_matrice *) (*s_objet_argument_1).objet);
3439:
3440: if (((*s_etat_processus).exception != d_ep) ||
3441: ((*s_etat_processus).erreur_execution != d_ex))
3442: {
3443: liberation(s_etat_processus, s_objet_argument_1);
3444: liberation(s_etat_processus, s_objet_argument_2);
3445: liberation(s_etat_processus, s_objet_resultat);
3446: return;
3447: }
3448:
3449: if ((*s_etat_processus).erreur_systeme != d_es)
3450: {
3451: return;
3452: }
3453:
3454: for(i = 0; i < (*((struct_matrice *)
3455: (*s_objet_resultat).objet)).nombre_lignes; i++)
3456: {
3457: if ((((*((struct_matrice *) (*s_objet_resultat).objet)).tableau)[i]
3458: = malloc((*((struct_matrice *)
3459: (*s_objet_resultat).objet)).nombre_colonnes *
3460: sizeof(struct_complexe16))) == NULL)
3461: {
3462: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3463: return;
3464: }
3465:
3466: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
3467: .nombre_colonnes; j++)
3468: {
3469: (((struct_complexe16 **) (*((struct_matrice *)
3470: (*s_objet_resultat).objet)).tableau)[i][j])
3471: .partie_reelle = 0;
3472: (((struct_complexe16 **) (*((struct_matrice *)
3473: (*s_objet_resultat).objet)).tableau)[i][j])
3474: .partie_imaginaire = 0;
3475:
3476: for(k = 0; k < (*((struct_matrice *) (*s_objet_argument_2)
3477: .objet)).nombre_lignes; k++)
3478: {
3479: f77multiplicationcc_(&(((struct_complexe16 **)
3480: (*((struct_matrice *) (*s_objet_argument_1).objet))
3481: .tableau)[i][k]), &(((struct_complexe16 **)
3482: (*((struct_matrice *) (*s_objet_argument_2).objet))
3483: .tableau)[k][j]), &accumulateur);
3484:
3485: f77additioncc_(&(((struct_complexe16 **)
3486: (*((struct_matrice *) (*s_objet_resultat).objet))
3487: .tableau)[i][j]), &accumulateur,
3488: &(((struct_complexe16 **)
3489: (*((struct_matrice *) (*s_objet_resultat).objet))
3490: .tableau)[i][j]));
3491: }
3492: }
3493: }
3494: }
3495:
3496: /*
3497: * Matrice de complexes / Matrice d'entiers ou de réels
3498: */
3499:
3500: else if (((*s_objet_argument_2).type == MCX) &&
3501: (((*s_objet_argument_1).type == MRL) ||
3502: ((*s_objet_argument_1).type == MIN)))
3503: {
3504: if ((*s_objet_argument_1).type == MIN)
3505: {
3506: (*s_objet_argument_1).type = MRL;
3507: }
3508:
3509: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
3510: .nombre_colonnes != (*(((struct_matrice *)
3511: (*s_objet_argument_2).objet))).nombre_lignes)
3512: {
3513: liberation(s_etat_processus, s_objet_argument_1);
3514: liberation(s_etat_processus, s_objet_argument_2);
3515:
3516: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3517: return;
3518: }
3519:
3520: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
3521: {
3522: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3523: return;
3524: }
3525:
3526: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
3527: (*(((struct_matrice *) (*s_objet_argument_2)
3528: .objet))).nombre_lignes;
3529: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
3530: (*(((struct_matrice *) (*s_objet_argument_2)
3531: .objet))).nombre_colonnes;
3532:
3533: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
3534: malloc((*((struct_matrice *)
3535: (*s_objet_resultat).objet)).nombre_colonnes *
3536: sizeof(struct_complexe16))) == NULL)
3537: {
3538: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3539: return;
3540: }
3541:
3542: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
3543: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
3544: .nombre_colonnes)
3545: {
3546: liberation(s_etat_processus, s_objet_argument_1);
3547: liberation(s_etat_processus, s_objet_argument_2);
3548: liberation(s_etat_processus, s_objet_resultat);
3549:
3550: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
3551: return;
3552: }
3553:
3554: inversion_matrice(s_etat_processus,
3555: (struct_matrice *) (*s_objet_argument_1).objet);
3556:
3557: if (((*s_etat_processus).exception != d_ep) ||
3558: ((*s_etat_processus).erreur_execution != d_ex))
3559: {
3560: liberation(s_etat_processus, s_objet_argument_1);
3561: liberation(s_etat_processus, s_objet_argument_2);
3562: liberation(s_etat_processus, s_objet_resultat);
3563: return;
3564: }
3565:
3566: if ((*s_etat_processus).erreur_systeme != d_es)
3567: {
3568: return;
3569: }
3570:
3571: for(i = 0; i < (*((struct_matrice *)
3572: (*s_objet_resultat).objet)).nombre_lignes; i++)
3573: {
3574: if ((((*((struct_matrice *) (*s_objet_resultat).objet)).tableau)[i]
3575: = malloc((*((struct_matrice *)
3576: (*s_objet_resultat).objet)).nombre_colonnes *
3577: sizeof(struct_complexe16))) == NULL)
3578: {
3579: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3580: return;
3581: }
3582:
3583: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
3584: .nombre_colonnes; j++)
3585: {
3586: (((struct_complexe16 **) (*((struct_matrice *)
3587: (*s_objet_resultat).objet)).tableau)[i][j])
3588: .partie_reelle = 0;
3589: (((struct_complexe16 **) (*((struct_matrice *)
3590: (*s_objet_resultat).objet)).tableau)[i][j])
3591: .partie_imaginaire = 0;
3592:
3593: for(k = 0; k < (*((struct_matrice *) (*s_objet_argument_2)
3594: .objet)).nombre_lignes; k++)
3595: {
3596: if ((*s_objet_argument_1).type == MIN)
3597: {
3598: f77multiplicationci_(&(((struct_complexe16 **)
3599: (*((struct_matrice *) (*s_objet_argument_2)
3600: .objet)).tableau)[k][j]), &(((integer8 **)
3601: (*((struct_matrice *) (*s_objet_argument_1)
3602: .objet)).tableau)[i][k]), &accumulateur);
3603:
3604: f77additioncc_(&(((struct_complexe16 **)
3605: (*((struct_matrice *) (*s_objet_resultat)
3606: .objet)).tableau)[i][j]), &accumulateur,
3607: &(((struct_complexe16 **) (*((struct_matrice *)
3608: (*s_objet_resultat).objet))
3609: .tableau)[i][j]));
3610: }
3611: else
3612: {
3613: f77multiplicationcr_(&(((struct_complexe16 **)
3614: (*((struct_matrice *) (*s_objet_argument_2)
3615: .objet)).tableau)[k][j]), &(((real8 **)
3616: (*((struct_matrice *) (*s_objet_argument_1)
3617: .objet)).tableau)[i][k]), &accumulateur);
3618:
3619: f77additioncc_(&(((struct_complexe16 **)
3620: (*((struct_matrice *) (*s_objet_resultat)
3621: .objet)).tableau)[i][j]), &accumulateur,
3622: &(((struct_complexe16 **) (*((struct_matrice *)
3623: (*s_objet_resultat).objet))
3624: .tableau)[i][j]));
3625: }
3626: }
3627: }
3628: }
3629: }
3630:
3631: /*
3632: --------------------------------------------------------------------------------
3633: Division mettant en oeuvre des binaires
3634: --------------------------------------------------------------------------------
3635: */
3636: /*
3637: * Binaire / Binaire
3638: */
3639:
3640: else if (((*s_objet_argument_1).type == BIN) &&
3641: ((*s_objet_argument_2).type == BIN))
3642: {
3643: if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL)
3644: {
3645: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3646: return;
3647: }
3648:
3649: (*((logical8 *) (*s_objet_resultat).objet)) =
3650: (*((logical8 *) (*s_objet_argument_2).objet))
3651: / (*((logical8 *) (*s_objet_argument_1).objet));
3652: }
3653:
3654: /*
3655: * Binaire / Entier
3656: */
3657:
3658: else if ((((*s_objet_argument_1).type == BIN) &&
3659: ((*s_objet_argument_2).type == INT)) ||
3660: (((*s_objet_argument_1).type == INT) &&
3661: ((*s_objet_argument_2).type == BIN)))
3662: {
3663: if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL)
3664: {
3665: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3666: return;
3667: }
3668:
3669: if ((*s_objet_argument_1).type == BIN)
3670: {
3671: (*((logical8 *) (*s_objet_resultat).objet)) =
3672: (*((integer8 *) (*s_objet_argument_2).objet))
3673: / (*((logical8 *) (*s_objet_argument_1).objet));
3674: }
3675: else
3676: {
3677: (*((logical8 *) (*s_objet_resultat).objet)) =
3678: (*((logical8 *) (*s_objet_argument_2).objet))
3679: / (*((integer8 *) (*s_objet_argument_1).objet));
3680: }
3681: }
3682:
3683: /*
3684: --------------------------------------------------------------------------------
3685: Division impossible
3686: --------------------------------------------------------------------------------
3687: */
3688:
3689: else
3690: {
3691: liberation(s_etat_processus, s_objet_argument_1);
3692: liberation(s_etat_processus, s_objet_argument_2);
3693:
3694: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
3695: return;
3696: }
3697:
3698: liberation(s_etat_processus, s_objet_argument_1);
3699: liberation(s_etat_processus, s_objet_argument_2);
3700:
3701: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3702: s_objet_resultat) == d_erreur)
3703: {
3704: return;
3705: }
3706:
3707: return;
3708: }
3709:
3710:
3711: /*
3712: ================================================================================
3713: Fonction 'do'
3714: ================================================================================
3715: Entrées : structure processus
3716: --------------------------------------------------------------------------------
3717: Sorties :
3718: --------------------------------------------------------------------------------
3719: Effets de bord : néant
3720: ================================================================================
3721: */
3722:
3723: void
3724: instruction_do(struct_processus *s_etat_processus)
3725: {
3726: (*s_etat_processus).erreur_execution = d_ex;
3727:
3728: if ((*s_etat_processus).affichage_arguments == 'Y')
3729: {
3730: printf("\n DO ");
3731:
3732: if ((*s_etat_processus).langue == 'F')
3733: {
3734: printf("(structure de contrôle)\n\n");
3735: printf(" Utilisation :\n\n");
3736: }
3737: else
3738: {
3739: printf("(control statement)\n\n");
3740: printf(" Usage:\n\n");
3741: }
3742:
3743: printf(" DO\n");
3744: printf(" (expression 1)\n");
3745: printf(" EXIT\n");
3746: printf(" (expression 2)\n");
3747: printf(" UNTIL\n");
3748: printf(" (clause)\n");
3749: printf(" END\n\n");
3750:
3751: printf(" DO\n");
3752: printf(" (expression)\n");
3753: printf(" UNTIL\n");
3754: printf(" (clause)\n");
3755: printf(" END\n");
3756:
3757: return;
3758: }
3759: else if ((*s_etat_processus).test_instruction == 'Y')
3760: {
3761: (*s_etat_processus).nombre_arguments = -1;
3762: return;
3763: }
3764:
3765: empilement_pile_systeme(s_etat_processus);
3766:
3767: if ((*s_etat_processus).erreur_systeme != d_es)
3768: {
3769: return;
3770: }
3771:
3772: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'D';
3773: (*(*s_etat_processus).l_base_pile_systeme).clause = 'D';
3774:
3775: if ((*s_etat_processus).mode_execution_programme == 'Y')
3776: {
3777: (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
3778: (*s_etat_processus).position_courante;
3779: }
3780: else
3781: {
3782: if ((*s_etat_processus).expression_courante == NULL)
3783: {
3784: (*s_etat_processus).erreur_execution =
3785: d_ex_erreur_traitement_boucle;
3786: return;
3787: }
3788:
3789: (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
3790: (*s_etat_processus).expression_courante;
3791: }
3792:
3793: return;
3794: }
3795:
3796:
3797: /*
3798: ================================================================================
3799: Fonction 'default'
3800: ================================================================================
3801: Entrées : structure processus
3802: --------------------------------------------------------------------------------
3803: Sorties :
3804: --------------------------------------------------------------------------------
3805: Effets de bord : néant
3806: ================================================================================
3807: */
3808:
3809: void
3810: instruction_default(struct_processus *s_etat_processus)
3811: {
3812: logical1 drapeau_fin;
3813: logical1 erreur;
3814:
3815: unsigned char *instruction_majuscule;
3816: unsigned char *tampon;
3817:
3818: unsigned long niveau;
3819:
3820: (*s_etat_processus).erreur_execution = d_ex;
3821:
3822: if ((*s_etat_processus).affichage_arguments == 'Y')
3823: {
3824: printf("\n DEFAULT ");
3825:
3826: if ((*s_etat_processus).langue == 'F')
3827: {
3828: printf("(structure de contrôle)\n\n");
3829: printf(" Utilisation :\n\n");
3830: }
3831: else
3832: {
3833: printf("(control statement)\n\n");
3834: printf(" Usage:\n\n");
3835: }
3836:
3837: printf(" SELECT (expression test)\n");
3838: printf(" CASE (clause 1) THEN (expression 1) END\n");
3839: printf(" CASE (clause 2) THEN (expression 2) END\n");
3840: printf(" ...\n");
3841: printf(" CASE (clause n) THEN (expression n) END\n");
3842: printf(" DEFAULT\n");
3843: printf(" (expression)\n");
3844: printf(" END\n");
3845:
3846: return;
3847: }
3848: else if ((*s_etat_processus).test_instruction == 'Y')
3849: {
3850: (*s_etat_processus).nombre_arguments = -1;
3851: return;
3852: }
3853:
3854: if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'C')
3855: {
3856: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'C')
3857: {
3858: /*
3859: * Au moins un cas CASE a été traité et l'on saute au END
3860: * correspondant.
3861: */
3862:
3863: tampon = (*s_etat_processus).instruction_courante;
3864: niveau = 0;
3865:
3866: do
3867: {
3868: if ((*s_etat_processus).mode_execution_programme == 'Y')
3869: {
3870: erreur = recherche_instruction_suivante(s_etat_processus);
3871: }
3872: else
3873: {
3874: erreur = d_absence_erreur;
3875:
3876: if ((*s_etat_processus).expression_courante != NULL)
3877: {
3878: while(((*(*(*s_etat_processus)
3879: .expression_courante).donnee).type != FCT)
3880: && (erreur == d_absence_erreur))
3881: {
3882: if ((*s_etat_processus).expression_courante == NULL)
3883: {
3884: erreur = d_erreur;
3885: }
3886: else
3887: {
3888: (*s_etat_processus).expression_courante =
3889: (*(*s_etat_processus)
3890: .expression_courante).suivant;
3891: }
3892: }
3893: }
3894: else
3895: {
3896: erreur = d_erreur;
3897: }
3898:
3899: if (erreur == d_absence_erreur)
3900: {
3901: if (((*s_etat_processus).instruction_courante =
3902: malloc((strlen(
3903: (*((struct_fonction *) (*(*(*s_etat_processus)
3904: .expression_courante).donnee).objet))
3905: .nom_fonction) + 1) * sizeof(unsigned char)))
3906: == NULL)
3907: {
3908: (*s_etat_processus).erreur_systeme =
3909: d_es_allocation_memoire;
3910: return;
3911: }
3912:
3913: strcpy((*s_etat_processus).instruction_courante,
3914: (*((struct_fonction *) (*(*(*s_etat_processus)
3915: .expression_courante).donnee).objet))
3916: .nom_fonction);
3917: }
3918: }
3919:
3920: if (erreur != d_absence_erreur)
3921: {
3922: if ((*s_etat_processus).instruction_courante != NULL)
3923: {
3924: free((*s_etat_processus).instruction_courante);
3925: }
3926:
3927: (*s_etat_processus).instruction_courante = tampon;
3928: (*s_etat_processus).erreur_execution =
3929: d_ex_erreur_traitement_condition;
3930:
3931: return;
3932: }
3933:
3934: instruction_majuscule = conversion_majuscule(
3935: (*s_etat_processus).instruction_courante);
3936:
3937: if (niveau == 0)
3938: {
3939: if (strcmp(instruction_majuscule, "END") == 0)
3940: {
3941: if ((*s_etat_processus).mode_execution_programme == 'Y')
3942: {
3943: (*s_etat_processus).position_courante -= (strlen(
3944: instruction_majuscule) + 1);
3945: }
3946: else
3947: {
3948: instruction_end(s_etat_processus);
3949: }
3950:
3951: drapeau_fin = d_vrai;
3952: }
3953: else
3954: {
3955: drapeau_fin = d_faux;
3956: }
3957: }
3958: else
3959: {
3960: drapeau_fin = d_faux;
3961: }
3962:
3963: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
3964: (strcmp(instruction_majuscule, "DO") == 0) ||
3965: (strcmp(instruction_majuscule, "IF") == 0) ||
3966: (strcmp(instruction_majuscule, "IFERR") == 0) ||
3967: (strcmp(instruction_majuscule, "SELECT") == 0) ||
3968: (strcmp(instruction_majuscule, "WHILE") == 0))
3969: {
3970: niveau++;
3971: }
3972: else if (strcmp(instruction_majuscule, "END") == 0)
3973: {
3974: niveau--;
3975: }
3976:
3977: free(instruction_majuscule);
3978: free((*s_etat_processus).instruction_courante);
3979:
3980: if (((*s_etat_processus).mode_execution_programme != 'Y') &&
3981: (drapeau_fin == d_faux))
3982: {
3983: (*s_etat_processus).expression_courante =
3984: (*(*s_etat_processus)
3985: .expression_courante).suivant;
3986: }
3987: } while(drapeau_fin == d_faux);
3988:
3989: (*s_etat_processus).instruction_courante = tampon;
3990: }
3991: else
3992: {
3993: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'F')
3994: {
3995: (*s_etat_processus).erreur_execution =
3996: d_ex_erreur_traitement_condition;
3997: return;
3998: }
3999:
4000: (*(*s_etat_processus).l_base_pile_systeme).clause = 'F';
4001: }
4002: }
4003: else
4004: {
4005: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition;
4006: return;
4007: }
4008:
4009: return;
4010: }
4011:
4012: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_d1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src