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