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