Annotation of rpl/src/instructions_s1.c, revision 1.4
1.1 bertrand 1: /*
2: ================================================================================
1.3 bertrand 3: RPL/2 (R) version 4.0.11
1.1 bertrand 4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl.conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction 'swap'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_swap(struct_processus *s_etat_processus)
40: {
41: struct_liste_chainee *l_liste;
42:
43: (*s_etat_processus).erreur_execution = d_ex;
44:
45: if ((*s_etat_processus).affichage_arguments == 'Y')
46: {
47: printf("\n SWAP ");
48:
49: if ((*s_etat_processus).langue == 'F')
50: {
51: printf("(inversion de deux objets)\n\n");
52: }
53: else
54: {
55: printf("(swap two objects)\n\n");
56: }
57:
58: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
59: " %s, %s, %s, %s, %s,\n"
60: " %s, %s, %s, %s, %s,\n"
61: " %s, %s, %s, %s, %s,\n"
62: " %s\n",
63: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
64: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
65: d_SLB, d_PRC, d_MTX, d_SQL);
66: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
67: " %s, %s, %s, %s, %s,\n"
68: " %s, %s, %s, %s, %s,\n"
69: " %s, %s, %s, %s, %s,\n"
70: " %s\n",
71: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
72: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
73: d_SLB, d_PRC, d_MTX, d_SQL);
74: printf("-> 2: %s, %s, %s, %s, %s, %s,\n"
75: " %s, %s, %s, %s, %s,\n"
76: " %s, %s, %s, %s, %s,\n"
77: " %s, %s, %s, %s, %s,\n"
78: " %s\n",
79: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
80: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
81: d_SLB, d_PRC, d_MTX, d_SQL);
82: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
83: " %s, %s, %s, %s, %s,\n"
84: " %s, %s, %s, %s, %s,\n"
85: " %s, %s, %s, %s, %s,\n"
86: " %s\n",
87: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
88: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
89: d_SLB, d_PRC, d_MTX, d_SQL);
90:
91: return;
92: }
93: else if ((*s_etat_processus).test_instruction == 'Y')
94: {
95: (*s_etat_processus).nombre_arguments = -1;
96: return;
97: }
98:
99: if (test_cfsf(s_etat_processus, 31) == d_vrai)
100: {
101: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
102: {
103: return;
104: }
105: }
106:
107: if ((*s_etat_processus).hauteur_pile_operationnelle < 2)
108: {
109: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
110: return;
111: }
112:
113: l_liste = (*s_etat_processus).l_base_pile;
114: (*s_etat_processus).l_base_pile = (*l_liste).suivant;
115: (*l_liste).suivant = (*(*s_etat_processus).l_base_pile).suivant;
116: (*(*s_etat_processus).l_base_pile).suivant = l_liste;
117:
118: return;
119: }
120:
121:
122: /*
123: ================================================================================
124: Fonction 'sq'
125: ================================================================================
126: Entrées : pointeur sur une struct_processus
127: --------------------------------------------------------------------------------
128: Sorties :
129: --------------------------------------------------------------------------------
130: Effets de bord : néant
131: ================================================================================
132: */
133:
134: void
135: instruction_sq(struct_processus *s_etat_processus)
136: {
137: integer8 a;
138: integer8 r;
139:
140: logical1 depassement;
141: logical1 erreur_memoire;
142:
143: struct_liste_chainee *l_element_courant;
144: struct_liste_chainee *l_element_precedent;
145:
146: struct_objet *s_copie_argument;
147: struct_objet *s_objet_argument;
148: struct_objet *s_objet_resultat;
149:
150: unsigned long i;
151: unsigned long j;
152: unsigned long k;
153:
154: void *accumulateur;
155:
156: (*s_etat_processus).erreur_execution = d_ex;
157:
158: if ((*s_etat_processus).affichage_arguments == 'Y')
159: {
160: printf("\n SQ ");
161:
162: if ((*s_etat_processus).langue == 'F')
163: {
164: printf("(élevation au carré)\n\n");
165: }
166: else
167: {
168: printf("(square)\n\n");
169: }
170:
171: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
172: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
173:
174: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
175: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
176:
177: printf(" 1: %s, %s\n", d_NOM, d_ALG);
178: printf("-> 1: %s\n\n", d_ALG);
179:
180: printf(" 1: %s\n", d_RPN);
181: printf("-> 1: %s\n", d_RPN);
182:
183: return;
184: }
185: else if ((*s_etat_processus).test_instruction == 'Y')
186: {
187: (*s_etat_processus).nombre_arguments = 1;
188: return;
189: }
190:
191: if (test_cfsf(s_etat_processus, 31) == d_vrai)
192: {
193: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
194: {
195: return;
196: }
197: }
198:
199: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
200: &s_objet_argument) == d_erreur)
201: {
202: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
203: return;
204: }
205:
206: /*
207: --------------------------------------------------------------------------------
208: Carré d'un entier
209: --------------------------------------------------------------------------------
210: */
211:
212: if ((*s_objet_argument).type == INT)
213: {
214: a = (*((integer8 *) (*s_objet_argument).objet));
215:
216: if (depassement_multiplication(&a, &a, &r) == d_absence_erreur)
217: {
218: if ((s_objet_resultat = allocation(s_etat_processus, INT))
219: == NULL)
220: {
221: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
222: return;
223: }
224:
225: (*((integer8 *) (*s_objet_resultat).objet)) = r;
226: }
227: else
228: {
229: if ((s_objet_resultat = allocation(s_etat_processus, REL))
230: == NULL)
231: {
232: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
233: return;
234: }
235:
236: (*((real8 *) (*s_objet_resultat).objet)) =
237: ((double) (*((integer8 *) (*s_objet_argument).objet))) *
238: ((double) (*((integer8 *) (*s_objet_argument).objet)));
239: }
240: }
241:
242: /*
243: --------------------------------------------------------------------------------
244: Carré d'un réel
245: --------------------------------------------------------------------------------
246: */
247:
248: else if ((*s_objet_argument).type == REL)
249: {
250: if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
251: {
252: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
253: return;
254: }
255:
256: (*((real8 *) (*s_objet_resultat).objet)) =
257: (*((real8 *) (*s_objet_argument).objet)) *
258: (*((real8 *) (*s_objet_argument).objet));
259: }
260:
261: /*
262: --------------------------------------------------------------------------------
263: Carré d'un complexe
264: --------------------------------------------------------------------------------
265: */
266:
267: else if ((*s_objet_argument).type == CPL)
268: {
269: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
270: {
271: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
272: return;
273: }
274:
275: f77multiplicationcc_(&((*((struct_complexe16 *)
276: (*s_objet_argument).objet))), &((*((struct_complexe16 *)
277: (*s_objet_argument).objet))), &((*((struct_complexe16 *)
278: (*s_objet_resultat).objet))));
279: }
280:
281: /*
282: --------------------------------------------------------------------------------
283: Carré d'une matrice entière
284: --------------------------------------------------------------------------------
285: */
286:
287: else if ((*s_objet_argument).type == MIN)
288: {
289: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
290: (*((struct_matrice *) (*s_objet_argument).objet))
291: .nombre_colonnes)
292: {
293: liberation(s_etat_processus, s_objet_argument);
294:
295: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
296: return;
297: }
298:
299: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
300: {
301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
302: return;
303: }
304:
305: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
306: (*(((struct_matrice *) (*s_objet_argument)
307: .objet))).nombre_lignes;
308: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
309: (*(((struct_matrice *) (*s_objet_argument)
310: .objet))).nombre_colonnes;
311:
312: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
313: malloc((*(((struct_matrice *) (*s_objet_resultat)
314: .objet))).nombre_lignes * sizeof(integer8 *))) == NULL)
315: {
316: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
317: return;
318: }
319:
320: depassement = d_faux;
321:
322: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
323: .objet))).nombre_lignes; i++)
324: {
325: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
326: malloc((*(((struct_matrice *) (*s_objet_resultat)
327: .objet))).nombre_colonnes * sizeof(integer8))) == NULL)
328: {
329: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
330: return;
331: }
332:
333: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
334: .objet))).nombre_colonnes; j++)
335: {
336: ((integer8 **) (*((struct_matrice *)
337: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
338:
339: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
340: .objet))).nombre_colonnes; k++)
341: {
342: if (depassement_multiplication(&(((integer8 **)
343: (*((struct_matrice *) (*s_objet_argument).objet))
344: .tableau)[i][k]), &(((integer8 **)
345: (*((struct_matrice *) (*s_objet_argument).objet))
346: .tableau)[k][j]), &a) == d_erreur)
347: {
348: depassement = d_vrai;
349: }
350:
351: if (depassement_addition(&(((integer8 **)
352: (*((struct_matrice *) (*s_objet_resultat).objet))
353: .tableau)[i][j]), &a, &r) == d_erreur)
354: {
355: depassement = d_vrai;
356: }
357:
358: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
359: .objet)).tableau)[i][j] = r;
360: }
361: }
362: }
363:
364: if (depassement == d_vrai)
365: {
366: (*s_objet_resultat).type = MRL;
367: (*((struct_matrice *) (*s_objet_resultat).objet)).type = 'R';
368:
369: if ((accumulateur = malloc((*(((struct_matrice *)
370: (*s_objet_argument).objet))).nombre_colonnes *
371: sizeof(real8))) == NULL)
372: {
373: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
374: return;
375: }
376:
377: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
378: .objet))).nombre_lignes; i++)
379: {
380: free(((integer8 **) (*((struct_matrice *)
381: (*s_objet_resultat).objet)).tableau)[i]);
382:
383: if (((*((struct_matrice *) (*s_objet_resultat).objet))
384: .tableau[i] = malloc((*(((struct_matrice *)
385: (*s_objet_resultat).objet))).nombre_colonnes *
386: sizeof(real8))) == NULL)
387: {
388: (*s_etat_processus).erreur_systeme =
389: d_es_allocation_memoire;
390: return;
391: }
392:
393: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
394: .objet))).nombre_colonnes; j++)
395: {
396: ((real8 **) (*((struct_matrice *)
397: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
398:
399: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
400: .objet))).nombre_colonnes; k++)
401: {
402: ((real8 *) accumulateur)[k] = ((real8)
403: (((integer8 **) (*((struct_matrice *)
404: (*s_objet_argument).objet)).tableau)[i][k]) *
405: ((real8) ((integer8 **) (*((struct_matrice *)
406: (*s_objet_argument).objet)).tableau)[k][j]));
407: }
408:
409: ((real8 **) (*((struct_matrice *)
410: (*s_objet_resultat).objet)).tableau)[i][j] =
411: sommation_vecteur_reel(accumulateur,
412: &((*(((struct_matrice *) (*s_objet_argument)
413: .objet))).nombre_colonnes), &erreur_memoire);
414:
415: if (erreur_memoire == d_vrai)
416: {
417: (*s_etat_processus).erreur_systeme =
418: d_es_allocation_memoire;
419: return;
420: }
421: }
422: }
423:
424: free(accumulateur);
425: }
426: }
427:
428: /*
429: --------------------------------------------------------------------------------
430: Carré d'une matrice réelle
431: --------------------------------------------------------------------------------
432: */
433:
434: else if ((*s_objet_argument).type == MRL)
435: {
436: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
437: (*((struct_matrice *) (*s_objet_argument).objet))
438: .nombre_colonnes)
439: {
440: liberation(s_etat_processus, s_objet_argument);
441:
442: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
443: return;
444: }
445:
446: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
447: {
448: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
449: return;
450: }
451:
452: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
453: (*(((struct_matrice *) (*s_objet_argument)
454: .objet))).nombre_lignes;
455: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
456: (*(((struct_matrice *) (*s_objet_argument)
457: .objet))).nombre_colonnes;
458:
459: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
460: malloc((*(((struct_matrice *) (*s_objet_resultat)
461: .objet))).nombre_lignes * sizeof(real8 *))) == NULL)
462: {
463: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
464: return;
465: }
466:
467: if ((accumulateur = malloc((*(((struct_matrice *)
468: (*s_objet_argument).objet))).nombre_colonnes * sizeof(real8)))
469: == NULL)
470: {
471: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
472: return;
473: }
474:
475: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
476: .objet))).nombre_lignes; i++)
477: {
478: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
479: malloc((*(((struct_matrice *) (*s_objet_resultat)
480: .objet))).nombre_colonnes * sizeof(real8))) == NULL)
481: {
482: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
483: return;
484: }
485:
486: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
487: .objet))).nombre_colonnes; j++)
488: {
489: ((real8 **) (*((struct_matrice *)
490: (*s_objet_resultat).objet)).tableau)[i][j] = 0;
491:
492: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
493: .objet))).nombre_colonnes; k++)
494: {
495: ((real8 *) accumulateur)[k] =
496: (((real8 **) (*((struct_matrice *)
497: (*s_objet_argument).objet)).tableau)[i][k] *
498: ((real8 **) (*((struct_matrice *)
499: (*s_objet_argument).objet)).tableau)[k][j]);
500: }
501:
502: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
503: .tableau)[i][j] = sommation_vecteur_reel(
504: accumulateur, &((*(((struct_matrice *)
505: (*s_objet_argument).objet))).nombre_colonnes),
506: &erreur_memoire);
507:
508: if (erreur_memoire == d_vrai)
509: {
510: (*s_etat_processus).erreur_systeme =
511: d_es_allocation_memoire;
512: return;
513: }
514: }
515: }
516:
517: free(accumulateur);
518: }
519:
520: /*
521: --------------------------------------------------------------------------------
522: Carré d'une matrice complexe
523: --------------------------------------------------------------------------------
524: */
525:
526: else if ((*s_objet_argument).type == MCX)
527: {
528: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
529: (*((struct_matrice *) (*s_objet_argument).objet))
530: .nombre_colonnes)
531: {
532: liberation(s_etat_processus, s_objet_argument);
533:
534: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
535: return;
536: }
537:
538: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
539: {
540: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
541: return;
542: }
543:
544: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
545: (*(((struct_matrice *) (*s_objet_argument)
546: .objet))).nombre_lignes;
547: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
548: (*(((struct_matrice *) (*s_objet_argument)
549: .objet))).nombre_colonnes;
550:
551: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
552: malloc((*(((struct_matrice *) (*s_objet_resultat)
553: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
554: {
555: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
556: return;
557: }
558:
559: if ((accumulateur = malloc((*(((struct_matrice *)
560: (*s_objet_argument).objet))).nombre_colonnes *
561: sizeof(complex16))) == NULL)
562: {
563: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
564: return;
565: }
566:
567: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
568: .objet))).nombre_lignes; i++)
569: {
570: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
571: malloc((*(((struct_matrice *) (*s_objet_resultat)
572: .objet))).nombre_colonnes * sizeof(struct_complexe16)))
573: == NULL)
574: {
575: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
576: return;
577: }
578:
579: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
580: .objet))).nombre_colonnes; j++)
581: {
582: ((struct_complexe16 **) (*((struct_matrice *)
583: (*s_objet_resultat).objet)).tableau)[i][j]
584: .partie_reelle = 0;
585: ((struct_complexe16 **) (*((struct_matrice *)
586: (*s_objet_resultat).objet)).tableau)[i][j]
587: .partie_imaginaire = 0;
588:
589: for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
590: .objet))).nombre_colonnes; k++)
591: {
592: f77multiplicationcc_(&(((struct_complexe16 **)
593: (*((struct_matrice *) (*s_objet_argument).objet))
594: .tableau)[i][k]), &(((struct_complexe16 **)
595: (*((struct_matrice *) (*s_objet_argument).objet))
596: .tableau)[k][j]), &(((complex16 *)
597: accumulateur)[k]));
598: }
599:
600: ((complex16 **) (*((struct_matrice *)
601: (*s_objet_resultat).objet)).tableau)[i][j] =
602: sommation_vecteur_complexe(accumulateur,
603: &((*(((struct_matrice *)
604: (*s_objet_argument).objet))).nombre_colonnes),
605: &erreur_memoire);
606:
607: if (erreur_memoire == d_vrai)
608: {
609: (*s_etat_processus).erreur_systeme =
610: d_es_allocation_memoire;
611: return;
612: }
613: }
614: }
615:
616: free(accumulateur);
617: }
618:
619: /*
620: --------------------------------------------------------------------------------
621: Carré d'un nom
622: --------------------------------------------------------------------------------
623: */
624: else if ((*s_objet_argument).type == NOM)
625: {
626: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
627: {
628: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
629: return;
630: }
631:
632: if (((*s_objet_resultat).objet =
633: allocation_maillon(s_etat_processus)) == NULL)
634: {
635: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
636: return;
637: }
638:
639: l_element_courant = (*s_objet_resultat).objet;
640:
641: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
642: == NULL)
643: {
644: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
645: return;
646: }
647:
648: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
649: .nombre_arguments = 0;
650: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
651: .fonction = instruction_vers_niveau_superieur;
652:
653: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
654: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
655: {
656: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
657: return;
658: }
659:
660: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
661: .nom_fonction, "<<");
662:
663: if (((*l_element_courant).suivant =
664: allocation_maillon(s_etat_processus)) == NULL)
665: {
666: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
667: return;
668: }
669:
670: l_element_courant = (*l_element_courant).suivant;
671: (*l_element_courant).donnee = s_objet_argument;
672:
673: if (((*l_element_courant).suivant =
674: allocation_maillon(s_etat_processus)) == NULL)
675: {
676: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
677: return;
678: }
679:
680: l_element_courant = (*l_element_courant).suivant;
681:
682: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
683: == NULL)
684: {
685: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
686: return;
687: }
688:
689: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
690: .nombre_arguments = 1;
691: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
692: .fonction = instruction_sq;
693:
694: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
695: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
696: {
697: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
698: return;
699: }
700:
701: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
702: .nom_fonction, "SQ");
703:
704: if (((*l_element_courant).suivant =
705: allocation_maillon(s_etat_processus)) == NULL)
706: {
707: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
708: return;
709: }
710:
711: l_element_courant = (*l_element_courant).suivant;
712:
713: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
714: == NULL)
715: {
716: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
717: return;
718: }
719:
720: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
721: .nombre_arguments = 0;
722: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
723: .fonction = instruction_vers_niveau_inferieur;
724:
725: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
726: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
727: {
728: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
729: return;
730: }
731:
732: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
733: .nom_fonction, ">>");
734:
735: (*l_element_courant).suivant = NULL;
736: s_objet_argument = NULL;
737: }
738:
739: /*
740: --------------------------------------------------------------------------------
741: Carré d'une expression
742: --------------------------------------------------------------------------------
743: */
744:
745: else if (((*s_objet_argument).type == ALG) ||
746: ((*s_objet_argument).type == RPN))
747: {
748: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
749: 'N')) == NULL)
750: {
751: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
752: return;
753: }
754:
755: l_element_courant = (struct_liste_chainee *)
756: (*s_copie_argument).objet;
757: l_element_precedent = l_element_courant;
758:
759: while((*l_element_courant).suivant != NULL)
760: {
761: l_element_precedent = l_element_courant;
762: l_element_courant = (*l_element_courant).suivant;
763: }
764:
765: if (((*l_element_precedent).suivant =
766: allocation_maillon(s_etat_processus)) == NULL)
767: {
768: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
769: return;
770: }
771:
772: if (((*(*l_element_precedent).suivant).donnee =
773: allocation(s_etat_processus, FCT)) == NULL)
774: {
775: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
776: return;
777: }
778:
779: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
780: .donnee).objet)).nombre_arguments = 1;
781: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
782: .donnee).objet)).fonction = instruction_sq;
783:
784: if (((*((struct_fonction *) (*(*(*l_element_precedent)
785: .suivant).donnee).objet)).nom_fonction =
786: malloc(3 * sizeof(unsigned char))) == NULL)
787: {
788: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
789: return;
790: }
791:
792: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
793: .suivant).donnee).objet)).nom_fonction, "SQ");
794:
795: (*(*l_element_precedent).suivant).suivant = l_element_courant;
796:
797: s_objet_resultat = s_copie_argument;
798: }
799:
800: /*
801: --------------------------------------------------------------------------------
802: Carré impossible
803: --------------------------------------------------------------------------------
804: */
805:
806: else
807: {
808: liberation(s_etat_processus, s_objet_argument);
809:
810: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
811: return;
812: }
813:
814: liberation(s_etat_processus, s_objet_argument);
815:
816: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
817: s_objet_resultat) == d_erreur)
818: {
819: return;
820: }
821:
822: return;
823: }
824:
825:
826: /*
827: ================================================================================
828: Fonction 'sqrt'
829: ================================================================================
830: Entrées : pointeur sur une struct_processus
831: --------------------------------------------------------------------------------
832: Sorties :
833: --------------------------------------------------------------------------------
834: Effets de bord : néant
835: ================================================================================
836: */
837:
838: void
839: instruction_sqrt(struct_processus *s_etat_processus)
840: {
841: struct_liste_chainee *l_element_courant;
842: struct_liste_chainee *l_element_precedent;
843:
844: struct_objet *s_copie_argument;
845: struct_objet *s_objet_argument;
846: struct_objet *s_objet_resultat;
847:
848: (*s_etat_processus).erreur_execution = d_ex;
849:
850: if ((*s_etat_processus).affichage_arguments == 'Y')
851: {
852: printf("\n SQRT ");
853:
854: if ((*s_etat_processus).langue == 'F')
855: {
856: printf("(racine carrée)\n\n");
857: }
858: else
859: {
860: printf("(square root)\n\n");
861: }
862:
863: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
864: printf("-> 1: %s, %s\n\n", d_REL, d_CPL);
865:
866: printf(" 1: %s, %s\n", d_NOM, d_ALG);
867: printf("-> 1: %s\n\n", d_ALG);
868:
869: printf(" 1: %s\n", d_RPN);
870: printf("-> 1: %s\n", d_RPN);
871:
872: return;
873: }
874: else if ((*s_etat_processus).test_instruction == 'Y')
875: {
876: (*s_etat_processus).nombre_arguments = 1;
877: return;
878: }
879:
880: if (test_cfsf(s_etat_processus, 31) == d_vrai)
881: {
882: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
883: {
884: return;
885: }
886: }
887:
888: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
889: &s_objet_argument) == d_erreur)
890: {
891: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
892: return;
893: }
894:
895: /*
896: --------------------------------------------------------------------------------
897: Racine carrée d'un entier
898: --------------------------------------------------------------------------------
899: */
900:
901: if ((*s_objet_argument).type == INT)
902: {
903: if ((*((integer8 *) (*s_objet_argument).objet)) >= 0)
904: {
905: if ((s_objet_resultat = allocation(s_etat_processus, REL))
906: == NULL)
907: {
908: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
909: return;
910: }
911:
912: f77racinecarreeip_(&((*((integer8 *) (*s_objet_argument).objet))),
913: &((*((real8 *) (*s_objet_resultat).objet))));
914: }
915: else
916: {
917: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
918: == NULL)
919: {
920: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
921: return;
922: }
923:
924: f77racinecarreein_(&((*((integer8 *) (*s_objet_argument).objet))),
925: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
926: }
927: }
928:
929: /*
930: --------------------------------------------------------------------------------
931: Racine carré d'un réel
932: --------------------------------------------------------------------------------
933: */
934:
935: else if ((*s_objet_argument).type == REL)
936: {
937: if ((*((real8 *) (*s_objet_argument).objet)) >= 0)
938: {
939: if ((s_objet_resultat = allocation(s_etat_processus, REL))
940: == NULL)
941: {
942: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
943: return;
944: }
945:
946: f77racinecarreerp_(&((*((real8 *) (*s_objet_argument).objet))),
947: &((*((real8 *) (*s_objet_resultat).objet))));
948: }
949: else
950: {
951: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
952: == NULL)
953: {
954: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
955: return;
956: }
957:
958: f77racinecarreern_(&((*((real8 *) (*s_objet_argument).objet))),
959: &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
960: }
961: }
962:
963: /*
964: --------------------------------------------------------------------------------
965: Racine carrée d'un complexe
966: --------------------------------------------------------------------------------
967: */
968:
969: else if ((*s_objet_argument).type == CPL)
970: {
971: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
972: {
973: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
974: return;
975: }
976:
977: f77racinecarreec_(&((*((struct_complexe16 *) (*s_objet_argument)
978: .objet))), &((*((struct_complexe16 *) (*s_objet_resultat)
979: .objet))));
980: }
981:
982: /*
983: --------------------------------------------------------------------------------
984: Racine carrée d'un nom
985: --------------------------------------------------------------------------------
986: */
987:
988: else if ((*s_objet_argument).type == NOM)
989: {
990: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
991: {
992: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
993: return;
994: }
995:
996: if (((*s_objet_resultat).objet =
997: allocation_maillon(s_etat_processus)) == NULL)
998: {
999: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1000: return;
1001: }
1002:
1003: l_element_courant = (*s_objet_resultat).objet;
1004:
1005: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1006: == NULL)
1007: {
1008: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1009: return;
1010: }
1011:
1012: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1013: .nombre_arguments = 0;
1014: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1015: .fonction = instruction_vers_niveau_superieur;
1016:
1017: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1018: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1019: {
1020: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1021: return;
1022: }
1023:
1024: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1025: .nom_fonction, "<<");
1026:
1027: if (((*l_element_courant).suivant =
1028: allocation_maillon(s_etat_processus)) == NULL)
1029: {
1030: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1031: return;
1032: }
1033:
1034: l_element_courant = (*l_element_courant).suivant;
1035: (*l_element_courant).donnee = s_objet_argument;
1036:
1037: if (((*l_element_courant).suivant =
1038: allocation_maillon(s_etat_processus)) == NULL)
1039: {
1040: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1041: return;
1042: }
1043:
1044: l_element_courant = (*l_element_courant).suivant;
1045:
1046: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1047: == NULL)
1048: {
1049: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1050: return;
1051: }
1052:
1053: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1054: .nombre_arguments = 1;
1055: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1056: .fonction = instruction_sqrt;
1057:
1058: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1059: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
1060: {
1061: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1062: return;
1063: }
1064:
1065: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1066: .nom_fonction, "SQRT");
1067:
1068: if (((*l_element_courant).suivant =
1069: allocation_maillon(s_etat_processus)) == NULL)
1070: {
1071: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1072: return;
1073: }
1074:
1075: l_element_courant = (*l_element_courant).suivant;
1076:
1077: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
1078: == NULL)
1079: {
1080: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1081: return;
1082: }
1083:
1084: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1085: .nombre_arguments = 0;
1086: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1087: .fonction = instruction_vers_niveau_inferieur;
1088:
1089: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1090: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
1091: {
1092: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1093: return;
1094: }
1095:
1096: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
1097: .nom_fonction, ">>");
1098:
1099: (*l_element_courant).suivant = NULL;
1100: s_objet_argument = NULL;
1101: }
1102:
1103: /*
1104: --------------------------------------------------------------------------------
1105: Racine carrée d'une expression
1106: --------------------------------------------------------------------------------
1107: */
1108:
1109: else if (((*s_objet_argument).type == ALG) ||
1110: ((*s_objet_argument).type == RPN))
1111: {
1112: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
1113: 'N')) == NULL)
1114: {
1115: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1116: return;
1117: }
1118:
1119: l_element_courant = (struct_liste_chainee *)
1120: (*s_copie_argument).objet;
1121: l_element_precedent = l_element_courant;
1122:
1123: while((*l_element_courant).suivant != NULL)
1124: {
1125: l_element_precedent = l_element_courant;
1126: l_element_courant = (*l_element_courant).suivant;
1127: }
1128:
1129: if (((*l_element_precedent).suivant =
1130: allocation_maillon(s_etat_processus)) == NULL)
1131: {
1132: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1133: return;
1134: }
1135:
1136: if (((*(*l_element_precedent).suivant).donnee =
1137: allocation(s_etat_processus, FCT)) == NULL)
1138: {
1139: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1140: return;
1141: }
1142:
1143: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1144: .donnee).objet)).nombre_arguments = 1;
1145: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
1146: .donnee).objet)).fonction = instruction_sqrt;
1147:
1148: if (((*((struct_fonction *) (*(*(*l_element_precedent)
1149: .suivant).donnee).objet)).nom_fonction =
1150: malloc(5 * sizeof(unsigned char))) == NULL)
1151: {
1152: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1153: return;
1154: }
1155:
1156: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
1157: .suivant).donnee).objet)).nom_fonction, "SQRT");
1158:
1159: (*(*l_element_precedent).suivant).suivant = l_element_courant;
1160:
1161: s_objet_resultat = s_copie_argument;
1162: }
1163:
1164: /*
1165: --------------------------------------------------------------------------------
1166: Racine carrée impossible
1167: --------------------------------------------------------------------------------
1168: */
1169:
1170: else
1171: {
1172: liberation(s_etat_processus, s_objet_argument);
1173:
1174: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1175: return;
1176: }
1177:
1178: liberation(s_etat_processus, s_objet_argument);
1179:
1180: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1181: s_objet_resultat) == d_erreur)
1182: {
1183: return;
1184: }
1185:
1186: return;
1187: }
1188:
1189:
1190: /*
1191: ================================================================================
1192: Fonction 'same'
1193: ================================================================================
1194: Entrées : pointeur sur une structure struct_processus
1195: --------------------------------------------------------------------------------
1196: Sorties :
1197: --------------------------------------------------------------------------------
1198: Effets de bord : néant
1199: ================================================================================
1200: */
1201:
1202: void
1203: instruction_same(struct_processus *s_etat_processus)
1204: {
1205: struct_liste_chainee *l_element_courant;
1206: struct_liste_chainee *l_element_courant_1;
1207: struct_liste_chainee *l_element_courant_2;
1208: struct_liste_chainee *l_element_precedent;
1209:
1210: struct_objet *s_copie_argument_1;
1211: struct_objet *s_copie_argument_2;
1212: struct_objet *s_objet_argument_1;
1213: struct_objet *s_objet_argument_2;
1214: struct_objet *s_objet_resultat;
1215: struct_objet *s_objet_resultat_intermediaire;
1216:
1217: logical1 difference;
1218:
1219: unsigned long i;
1220: unsigned long j;
1221: unsigned long nombre_elements;
1222:
1223: (*s_etat_processus).erreur_execution = d_ex;
1224:
1225: if ((*s_etat_processus).affichage_arguments == 'Y')
1226: {
1227: printf("\n SAME ");
1228:
1229: if ((*s_etat_processus).langue == 'F')
1230: {
1231: printf("(opérateur égalité)\n\n");
1232: }
1233: else
1234: {
1235: printf("(equality operator)\n\n");
1236: }
1237:
1238: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1239: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
1240: printf("-> 1: %s\n\n", d_INT);
1241:
1242: printf(" 2: %s\n", d_BIN);
1243: printf(" 1: %s\n", d_BIN);
1244: printf("-> 1: %s\n\n", d_INT);
1245:
1246: printf(" 2: %s\n", d_LST);
1247: printf(" 1: %s\n", d_LST);
1248: printf("-> 1: %s\n\n", d_INT);
1249:
1250: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1251: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
1252: printf("-> 1: %s\n\n", d_INT);
1253:
1254: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1255: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
1256: printf("-> 1: %s\n\n", d_INT);
1257:
1258: printf(" 2: %s\n", d_TAB);
1259: printf(" 1: %s\n", d_TAB);
1260: printf("-> 1: %s\n\n", d_INT);
1261:
1262: printf(" 2: %s\n", d_NOM);
1263: printf(" 1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
1264: printf("-> 1: %s\n\n", d_ALG);
1265:
1266: printf(" 2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
1267: printf(" 1: %s\n", d_NOM);
1268: printf("-> 1: %s\n\n", d_ALG);
1269:
1270: printf(" 2: %s\n", d_ALG);
1271: printf(" 1: %s\n", d_ALG);
1272: printf("-> 1: %s\n\n", d_ALG);
1273:
1274: printf(" 2: %s\n", d_RPN);
1275: printf(" 1: %s\n", d_RPN);
1276: printf("-> 1: %s\n", d_RPN);
1277:
1278: return;
1279: }
1280: else if ((*s_etat_processus).test_instruction == 'Y')
1281: {
1282: (*s_etat_processus).nombre_arguments = -1;
1283: return;
1284: }
1285:
1286: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1287: {
1288: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
1289: {
1290: return;
1291: }
1292: }
1293:
1294: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1295: &s_objet_argument_1) == d_erreur)
1296: {
1297: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1298: return;
1299: }
1300:
1301: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1302: &s_objet_argument_2) == d_erreur)
1303: {
1304: liberation(s_etat_processus, s_objet_argument_1);
1305:
1306: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1307: return;
1308: }
1309:
1310: /*
1311: --------------------------------------------------------------------------------
1312: SAME sur des valeurs numériques
1313: --------------------------------------------------------------------------------
1314: */
1315:
1316: if ((((*s_objet_argument_1).type == INT) ||
1317: ((*s_objet_argument_1).type == REL)) &&
1318: (((*s_objet_argument_2).type == INT) ||
1319: ((*s_objet_argument_2).type == REL)))
1320: {
1321: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1322: {
1323: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1324: return;
1325: }
1326:
1327: if ((*s_objet_argument_1).type == INT)
1328: {
1329: if ((*s_objet_argument_2).type == INT)
1330: {
1331: (*((integer8 *) (*s_objet_resultat).objet)) =
1332: ((*((integer8 *) (*s_objet_argument_1).objet)) ==
1333: (*((integer8 *) (*s_objet_argument_2).objet)))
1334: ? -1 : 0;
1335: }
1336: else
1337: {
1338: (*((integer8 *) (*s_objet_resultat).objet)) =
1339: ((*((integer8 *) (*s_objet_argument_1).objet)) ==
1340: (*((real8 *) (*s_objet_argument_2).objet)))
1341: ? -1 : 0;
1342: }
1343: }
1344: else
1345: {
1346: if ((*s_objet_argument_2).type == INT)
1347: {
1348: (*((integer8 *) (*s_objet_resultat).objet)) =
1349: ((*((real8 *) (*s_objet_argument_1).objet)) ==
1350: (*((integer8 *) (*s_objet_argument_2).objet)))
1351: ? -1 : 0;
1352: }
1353: else
1354: {
1355: (*((integer8 *) (*s_objet_resultat).objet)) =
1356: ((*((real8 *) (*s_objet_argument_1).objet)) ==
1357: (*((real8 *) (*s_objet_argument_2).objet)))
1358: ? -1 : 0;
1359: }
1360: }
1361: }
1362:
1363: /*
1364: --------------------------------------------------------------------------------
1365: SAME Processus
1366: --------------------------------------------------------------------------------
1367: */
1368:
1369: else if (((*s_objet_argument_1).type == PRC) &&
1370: ((*s_objet_argument_2).type == PRC))
1371: {
1372: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1373: {
1374: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1375: return;
1376: }
1377:
1378: if ((*(*((struct_processus_fils *) (*s_objet_argument_1).objet)).thread)
1379: .processus_detache != (*(*((struct_processus_fils *)
1380: (*s_objet_argument_2).objet)).thread).processus_detache)
1381: {
1382: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1383: }
1384: else
1385: {
1386: if ((*(*((struct_processus_fils *) (*s_objet_argument_1).objet))
1387: .thread).processus_detache == d_vrai)
1388: {
1389: (*((integer8 *) (*s_objet_resultat).objet)) =
1390: ((*(*((struct_processus_fils *) (*s_objet_argument_1)
1391: .objet)).thread).pid ==
1392: (*(*((struct_processus_fils *) (*s_objet_argument_2)
1393: .objet)).thread).pid) ? -1 : 0;
1394: }
1395: else
1396: {
1397: (*((integer8 *) (*s_objet_resultat).objet)) =
1398: ((pthread_equal((*(*((struct_processus_fils *)
1399: (*s_objet_argument_1).objet)).thread).tid,
1400: (*(*((struct_processus_fils *) (*s_objet_argument_2)
1401: .objet)).thread).tid) != 0) &&
1402: ((*(*((struct_processus_fils *)
1403: (*s_objet_argument_1).objet)).thread).pid ==
1404: (*(*((struct_processus_fils *) (*s_objet_argument_2)
1405: .objet)).thread).pid)) ? -1 : 0;
1406: }
1407: }
1408: }
1409:
1410: /*
1411: --------------------------------------------------------------------------------
1412: SAME complexe
1413: --------------------------------------------------------------------------------
1414: */
1415:
1416: else if (((*s_objet_argument_1).type == CPL) &&
1417: ((*s_objet_argument_2).type == CPL))
1418: {
1419: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1420: {
1421: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1422: return;
1423: }
1424:
1425: (*((integer8 *) (*s_objet_resultat).objet)) =
1426: (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
1427: .partie_reelle == (*((struct_complexe16 *) (*s_objet_argument_2)
1428: .objet)).partie_reelle) && ((*((struct_complexe16 *)
1429: (*s_objet_argument_1).objet)).partie_imaginaire ==
1430: ((*((struct_complexe16 *) (*s_objet_argument_1).objet))
1431: .partie_imaginaire))) ? -1 : 0;
1432: }
1433:
1434: /*
1435: --------------------------------------------------------------------------------
1436: SAME binaire
1437: --------------------------------------------------------------------------------
1438: */
1439:
1440: else if (((*s_objet_argument_1).type == BIN) &&
1441: ((*s_objet_argument_2).type == BIN))
1442: {
1443: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1444: {
1445: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1446: return;
1447: }
1448:
1449: (*((integer8 *) (*s_objet_resultat).objet)) =
1450: ((*((logical8 *) (*s_objet_argument_1).objet)) ==
1451: (*((logical8 *) (*s_objet_argument_2).objet)))
1452: ? -1 : 0;
1453: }
1454:
1455: /*
1456: --------------------------------------------------------------------------------
1457: SAME portant sur des chaînes de caractères
1458: --------------------------------------------------------------------------------
1459: */
1460:
1461: else if (((*s_objet_argument_1).type == CHN) &&
1462: ((*s_objet_argument_2).type == CHN))
1463: {
1464: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1465: {
1466: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1467: return;
1468: }
1469:
1470: (*((integer8 *) (*s_objet_resultat).objet)) =
1471: (strcmp((unsigned char *) (*s_objet_argument_1).objet,
1472: (unsigned char *) (*s_objet_argument_2).objet) == 0) ? -1 : 0;
1473: }
1474:
1475: /*
1476: --------------------------------------------------------------------------------
1477: SAME portant sur des listes ou (instruction "SAME") des expressions
1478: --------------------------------------------------------------------------------
1479: */
1480:
1481: else if (((*s_objet_argument_1).type == FCT) &&
1482: ((*s_objet_argument_2).type == FCT))
1483: {
1484: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1485: {
1486: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1487: return;
1488: }
1489:
1490: if ((strcmp((*((struct_fonction *) (*s_objet_argument_1).objet))
1491: .nom_fonction, (*((struct_fonction *) (*s_objet_argument_2)
1492: .objet)).nom_fonction) == 0) &&
1493: ((*((struct_fonction *) (*s_objet_argument_1).objet))
1494: .nombre_arguments == (*((struct_fonction *)
1495: (*s_objet_argument_2).objet)).nombre_arguments))
1496: {
1497: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
1498: }
1499: else
1500: {
1501: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1502: }
1503: }
1504:
1505: /*
1506: * Il y a de la récursivité dans l'air...
1507: */
1508:
1509: else if ((((*s_objet_argument_1).type == LST) &&
1510: ((*s_objet_argument_2).type == LST)) ||
1511: (((((*s_objet_argument_1).type == ALG) &&
1512: ((*s_objet_argument_2).type == ALG)) ||
1513: (((*s_objet_argument_1).type == RPN) &&
1514: ((*s_objet_argument_2).type == RPN))) &&
1515: (strcmp((*s_etat_processus).instruction_courante, "==") != 0)))
1516: {
1517: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1518: {
1519: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1520: return;
1521: }
1522:
1523: l_element_courant_1 = (struct_liste_chainee *)
1524: (*s_objet_argument_1).objet;
1525: l_element_courant_2 = (struct_liste_chainee *)
1526: (*s_objet_argument_2).objet;
1527:
1528: difference = d_faux;
1529:
1530: while((l_element_courant_1 != NULL) && (l_element_courant_2 != NULL)
1531: && (difference == d_faux))
1532: {
1533: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
1534: (*l_element_courant_1).donnee, 'P')) == NULL)
1535: {
1536: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1537: return;
1538: }
1539:
1540: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1541: s_copie_argument_1) == d_erreur)
1542: {
1543: return;
1544: }
1545:
1546: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
1547: (*l_element_courant_2).donnee, 'P')) == NULL)
1548: {
1549: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1550: return;
1551: }
1552:
1553: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1554: s_copie_argument_2) == d_erreur)
1555: {
1556: return;
1557: }
1558:
1559: instruction_same(s_etat_processus);
1560:
1561: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1562: &s_objet_resultat_intermediaire) == d_erreur)
1563: {
1564: liberation(s_etat_processus, s_objet_argument_1);
1565: liberation(s_etat_processus, s_objet_argument_2);
1566: liberation(s_etat_processus, s_objet_resultat);
1567:
1568: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1569: return;
1570: }
1571:
1572: if ((*s_objet_resultat_intermediaire).type != INT)
1573: {
1574: liberation(s_etat_processus, s_objet_argument_1);
1575: liberation(s_etat_processus, s_objet_argument_2);
1576: liberation(s_etat_processus, s_objet_resultat);
1577:
1578: (*s_etat_processus).erreur_execution =
1579: d_ex_erreur_type_argument;
1580:
1581: return;
1582: }
1583:
1584: difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
1585: .objet)) == 0) ? d_vrai : d_faux;
1586:
1587: liberation(s_etat_processus, s_objet_resultat_intermediaire);
1588:
1589: l_element_courant_1 = (*l_element_courant_1).suivant;
1590: l_element_courant_2 = (*l_element_courant_2).suivant;
1591: }
1592:
1593: if ((difference == d_vrai) || ((l_element_courant_1 != NULL) &&
1594: (l_element_courant_2 == NULL)) ||
1595: ((l_element_courant_1 == NULL) &&
1596: (l_element_courant_2 != NULL)))
1597: {
1598: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1599: }
1600: else
1601: {
1602: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
1603: }
1604: }
1605:
1606: /*
1607: --------------------------------------------------------------------------------
1608: SAME portant sur des tables des expressions
1609: --------------------------------------------------------------------------------
1610: */
1611: /*
1612: * Il y a de la récursivité dans l'air...
1613: */
1614:
1615: else if (((*s_objet_argument_1).type == TBL) &&
1616: ((*s_objet_argument_2).type == TBL) &&
1617: (strcmp((*s_etat_processus).instruction_courante, "==") != 0))
1618: {
1619: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1620: {
1621: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1622: return;
1623: }
1624:
1625: if ((*((struct_tableau *) (*s_objet_argument_1).objet)).nombre_elements
1626: != (*((struct_tableau *) (*s_objet_argument_2).objet))
1627: .nombre_elements)
1628: {
1629: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1630: }
1631: else
1632: {
1633: difference = d_faux;
1634:
1635: for(i = 0; i < (*((struct_tableau *) (*s_objet_argument_1).objet))
1636: .nombre_elements; i++)
1637: {
1638: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
1639: (*((struct_tableau *)
1640: (*s_objet_argument_1).objet)).elements[i],
1641: 'P')) == NULL)
1642: {
1643: (*s_etat_processus).erreur_systeme =
1644: d_es_allocation_memoire;
1645: return;
1646: }
1647:
1648: if (empilement(s_etat_processus, &((*s_etat_processus)
1649: .l_base_pile), s_copie_argument_1) == d_erreur)
1650: {
1651: return;
1652: }
1653:
1654: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
1655: (*((struct_tableau *)
1656: (*s_objet_argument_2).objet)).elements[i],
1657: 'P')) == NULL)
1658: {
1659: (*s_etat_processus).erreur_systeme =
1660: d_es_allocation_memoire;
1661: return;
1662: }
1663:
1664: if (empilement(s_etat_processus, &((*s_etat_processus)
1665: .l_base_pile), s_copie_argument_2) == d_erreur)
1666: {
1667: return;
1668: }
1669:
1670: instruction_same(s_etat_processus);
1671:
1672: if (depilement(s_etat_processus, &((*s_etat_processus)
1673: .l_base_pile), &s_objet_resultat_intermediaire)
1674: == d_erreur)
1675: {
1676: liberation(s_etat_processus, s_objet_argument_1);
1677: liberation(s_etat_processus, s_objet_argument_2);
1678: liberation(s_etat_processus, s_objet_resultat);
1679:
1680: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1681: return;
1682: }
1683:
1684: if ((*s_objet_resultat_intermediaire).type != INT)
1685: {
1686: liberation(s_etat_processus, s_objet_argument_1);
1687: liberation(s_etat_processus, s_objet_argument_2);
1688: liberation(s_etat_processus, s_objet_resultat);
1689:
1690: (*s_etat_processus).erreur_execution =
1691: d_ex_erreur_type_argument;
1692: return;
1693: }
1694:
1695: difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
1696: .objet)) == 0) ? d_vrai : d_faux;
1697:
1698: liberation(s_etat_processus, s_objet_resultat_intermediaire);
1699: }
1700:
1701: if (difference == d_vrai)
1702: {
1703: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1704: }
1705: else
1706: {
1707: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
1708: }
1709: }
1710: }
1711:
1712:
1713: /*
1714: --------------------------------------------------------------------------------
1715: SAME portant sur des vecteurs
1716: --------------------------------------------------------------------------------
1717: */
1718: /*
1719: * Vecteurs d'entiers
1720: */
1721:
1722: else if (((*s_objet_argument_1).type == VIN) &&
1723: ((*s_objet_argument_2).type == VIN))
1724: {
1725: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1726: {
1727: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1728: return;
1729: }
1730:
1731: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
1732: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
1733: {
1734: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1735: }
1736: else
1737: {
1738: difference = d_faux;
1739:
1740: for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
1741: .taille) && (difference == d_faux); i++)
1742: {
1743: difference = (((integer8 *) (*((struct_vecteur *)
1744: (*s_objet_argument_1).objet)).tableau)[i] ==
1745: ((integer8 *) (*((struct_vecteur *)
1746: (*s_objet_argument_2).objet)).tableau)[i])
1747: ? d_faux : d_vrai;
1748: }
1749:
1750: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
1751: d_faux) ? -1 : 0;
1752: }
1753: }
1754:
1755: /*
1756: * Vecteurs de réels
1757: */
1758:
1759: else if (((*s_objet_argument_1).type == VRL) &&
1760: ((*s_objet_argument_2).type == VRL))
1761: {
1762: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1763: {
1764: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1765: return;
1766: }
1767:
1768: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
1769: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
1770: {
1771: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1772: }
1773: else
1774: {
1775: difference = d_faux;
1776:
1777: for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
1778: .taille) && (difference == d_faux); i++)
1779: {
1780: difference = (((real8 *) (*((struct_vecteur *)
1781: (*s_objet_argument_1).objet)).tableau)[i] ==
1782: ((real8 *) (*((struct_vecteur *)
1783: (*s_objet_argument_2).objet)).tableau)[i])
1784: ? d_faux : d_vrai;
1785: }
1786:
1787: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
1788: d_faux) ? -1 : 0;
1789: }
1790: }
1791:
1792: /*
1793: * Vecteurs de complexes
1794: */
1795:
1796: else if (((*s_objet_argument_1).type == VCX) &&
1797: ((*s_objet_argument_2).type == VCX))
1798: {
1799: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1800: {
1801: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1802: return;
1803: }
1804:
1805: if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
1806: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
1807: {
1808: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1809: }
1810: else
1811: {
1812: difference = d_faux;
1813:
1814: for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
1815: .taille) && (difference == d_faux); i++)
1816: {
1817: difference = ((((struct_complexe16 *) (*((struct_vecteur *)
1818: (*s_objet_argument_1).objet)).tableau)[i].partie_reelle
1819: == ((struct_complexe16 *) (*((struct_vecteur *)
1820: (*s_objet_argument_2).objet)).tableau)[i].partie_reelle)
1821: && (((struct_complexe16 *) (*((struct_vecteur *)
1822: (*s_objet_argument_1).objet)).tableau)[i]
1823: .partie_imaginaire == ((struct_complexe16 *)
1824: (*((struct_vecteur *) (*s_objet_argument_2).objet))
1825: .tableau)[i].partie_imaginaire)) ? d_faux : d_vrai;
1826: }
1827:
1828: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
1829: d_faux) ? -1 : 0;
1830: }
1831: }
1832:
1833: /*
1834: --------------------------------------------------------------------------------
1835: SAME portant sur des matrices
1836: --------------------------------------------------------------------------------
1837: */
1838: /*
1839: * Matrice d'entiers
1840: */
1841:
1842: else if (((*s_objet_argument_1).type == MIN) &&
1843: ((*s_objet_argument_2).type == MIN))
1844: {
1845: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1846: {
1847: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1848: return;
1849: }
1850:
1851: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
1852: != (*((struct_matrice *) (*s_objet_argument_2).objet))
1853: .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
1854: .objet)).nombre_colonnes != (*((struct_matrice *)
1855: (*s_objet_argument_2).objet)).nombre_colonnes))
1856: {
1857: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1858: }
1859: else
1860: {
1861: difference = d_faux;
1862:
1863: for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
1864: .nombre_lignes) && (difference == d_faux); i++)
1865: {
1866: for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
1867: .objet)).nombre_colonnes) && (difference == d_faux);
1868: j++)
1869: {
1870: difference = (((integer8 **) (*((struct_matrice *)
1871: (*s_objet_argument_1).objet)).tableau)[i][j] ==
1872: ((integer8 **) (*((struct_matrice *)
1873: (*s_objet_argument_2).objet)).tableau)[i][j])
1874: ? d_faux : d_vrai;
1875: }
1876: }
1877:
1878: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
1879: d_faux) ? -1 : 0;
1880: }
1881: }
1882:
1883: /*
1884: * Matrice de réels
1885: */
1886:
1887: else if (((*s_objet_argument_1).type == MRL) &&
1888: ((*s_objet_argument_2).type == MRL))
1889: {
1890: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1891: {
1892: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1893: return;
1894: }
1895:
1896: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
1897: != (*((struct_matrice *) (*s_objet_argument_2).objet))
1898: .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
1899: .objet)).nombre_colonnes != (*((struct_matrice *)
1900: (*s_objet_argument_2).objet)).nombre_colonnes))
1901: {
1902: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1903: }
1904: else
1905: {
1906: difference = d_faux;
1907:
1908: for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
1909: .nombre_lignes) && (difference == d_faux); i++)
1910: {
1911: for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
1912: .objet)).nombre_colonnes) && (difference == d_faux);
1913: j++)
1914: {
1915: difference = (((real8 **) (*((struct_matrice *)
1916: (*s_objet_argument_1).objet)).tableau)[i][j] ==
1917: ((real8 **) (*((struct_matrice *)
1918: (*s_objet_argument_2).objet)).tableau)[i][j])
1919: ? d_faux : d_vrai;
1920: }
1921: }
1922:
1923: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
1924: d_faux) ? -1 : 0;
1925: }
1926: }
1927:
1928: /*
1929: * Matrice de complexes
1930: */
1931:
1932: else if (((*s_objet_argument_1).type == MCX) &&
1933: ((*s_objet_argument_2).type == MCX))
1934: {
1935: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1936: {
1937: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1938: return;
1939: }
1940:
1941: if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
1942: != (*((struct_matrice *) (*s_objet_argument_2).objet))
1943: .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
1944: .objet)).nombre_colonnes != (*((struct_matrice *)
1945: (*s_objet_argument_2).objet)).nombre_colonnes))
1946: {
1947: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
1948: }
1949: else
1950: {
1951: difference = d_faux;
1952:
1953: for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
1954: .nombre_lignes) && (difference == d_faux); i++)
1955: {
1956: for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
1957: .objet)).nombre_colonnes) && (difference == d_faux);
1958: j++)
1959: {
1960: difference = ((((struct_complexe16 **) (*((struct_matrice *)
1961: (*s_objet_argument_1).objet)).tableau)[i][j]
1962: .partie_reelle == ((struct_complexe16 **)
1963: (*((struct_matrice *) (*s_objet_argument_2).objet))
1964: .tableau)[i][j].partie_reelle) &&
1965: (((struct_complexe16 **) (*((struct_matrice *)
1966: (*s_objet_argument_1).objet)).tableau)[i][j]
1967: .partie_imaginaire == ((struct_complexe16 **)
1968: (*((struct_matrice *) (*s_objet_argument_2).objet))
1969: .tableau)[i][j].partie_imaginaire))
1970: ? d_faux : d_vrai;
1971: }
1972: }
1973:
1974: (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
1975: d_faux) ? -1 : 0;
1976: }
1977: }
1978:
1979: /*
1980: --------------------------------------------------------------------------------
1981: SAME portant sur des noms (instruction "SAME")
1982: --------------------------------------------------------------------------------
1983: */
1984:
1985: else if (((*s_objet_argument_1).type == NOM) &&
1986: ((*s_objet_argument_2).type == NOM) &&
1987: (strcmp((*s_etat_processus).instruction_courante, "==") != 0))
1988: {
1989: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
1990: {
1991: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1992: return;
1993: }
1994:
1995: (*((integer8 *) (*s_objet_resultat).objet)) =
1996: (strcmp((*((struct_nom *) (*s_objet_argument_1).objet)).nom,
1997: (*((struct_nom *) (*s_objet_argument_2).objet)).nom) == 0)
1998: ? -1 : 0;
1999: }
2000:
2001: /*
2002: --------------------------------------------------------------------------------
2003: SAME entre des arguments complexes (instruction '==')
2004: --------------------------------------------------------------------------------
2005: */
2006:
2007: /*
2008: * Nom ou valeur numérique / Nom ou valeur numérique
2009: */
2010:
2011: else if (((((*s_objet_argument_1).type == NOM) &&
2012: (((*s_objet_argument_2).type == NOM) ||
2013: ((*s_objet_argument_2).type == INT) ||
2014: ((*s_objet_argument_2).type == REL))) ||
2015: (((*s_objet_argument_2).type == NOM) &&
2016: (((*s_objet_argument_1).type == INT) ||
2017: ((*s_objet_argument_1).type == REL)))) &&
2018: (strcmp((*s_etat_processus).instruction_courante, "==") == 0))
2019: {
2020: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
2021: {
2022: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2023: return;
2024: }
2025:
2026: if (((*s_objet_resultat).objet =
2027: allocation_maillon(s_etat_processus)) == NULL)
2028: {
2029: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2030: return;
2031: }
2032:
2033: l_element_courant = (*s_objet_resultat).objet;
2034:
2035: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2036: == NULL)
2037: {
2038: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2039: return;
2040: }
2041:
2042: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2043: .nombre_arguments = 0;
2044: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2045: .fonction = instruction_vers_niveau_superieur;
2046:
2047: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2048: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2049: {
2050: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2051: return;
2052: }
2053:
2054: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2055: .nom_fonction, "<<");
2056:
2057: if (((*l_element_courant).suivant =
2058: allocation_maillon(s_etat_processus)) == NULL)
2059: {
2060: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2061: return;
2062: }
2063:
2064: l_element_courant = (*l_element_courant).suivant;
2065: (*l_element_courant).donnee = s_objet_argument_2;
2066:
2067: if (((*l_element_courant).suivant =
2068: allocation_maillon(s_etat_processus)) == NULL)
2069: {
2070: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2071: return;
2072: }
2073:
2074: l_element_courant = (*l_element_courant).suivant;
2075: (*l_element_courant).donnee = s_objet_argument_1;
2076:
2077: if (((*l_element_courant).suivant =
2078: allocation_maillon(s_etat_processus)) == NULL)
2079: {
2080: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2081: return;
2082: }
2083:
2084: l_element_courant = (*l_element_courant).suivant;
2085:
2086: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2087: == NULL)
2088: {
2089: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2090: return;
2091: }
2092:
2093: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2094: .nombre_arguments = 0;
2095: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2096: .fonction = instruction_same;
2097:
2098: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2099: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2100: {
2101: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2102: return;
2103: }
2104:
2105: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2106: .nom_fonction, "==");
2107:
2108: if (((*l_element_courant).suivant =
2109: allocation_maillon(s_etat_processus)) == NULL)
2110: {
2111: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2112: return;
2113: }
2114:
2115: l_element_courant = (*l_element_courant).suivant;
2116:
2117: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2118: == NULL)
2119: {
2120: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2121: return;
2122: }
2123:
2124: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2125: .nombre_arguments = 0;
2126: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2127: .fonction = instruction_vers_niveau_inferieur;
2128:
2129: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2130: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
2131: {
2132: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2133: return;
2134: }
2135:
2136: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2137: .nom_fonction, ">>");
2138:
2139: (*l_element_courant).suivant = NULL;
2140:
2141: s_objet_argument_1 = NULL;
2142: s_objet_argument_2 = NULL;
2143: }
2144:
2145: /*
2146: * Nom ou valeur numérique / Expression
2147: */
2148:
2149: else if (((((*s_objet_argument_1).type == ALG) ||
2150: ((*s_objet_argument_1).type == RPN)) &&
2151: (strcmp((*s_etat_processus).instruction_courante, "==") == 0)) &&
2152: (((*s_objet_argument_2).type == NOM) ||
2153: ((*s_objet_argument_2).type == INT) ||
2154: ((*s_objet_argument_2).type == REL)))
2155: {
2156: nombre_elements = 0;
2157: l_element_courant = (struct_liste_chainee *)
2158: (*s_objet_argument_1).objet;
2159:
2160: while(l_element_courant != NULL)
2161: {
2162: nombre_elements++;
2163: l_element_courant = (*l_element_courant).suivant;
2164: }
2165:
2166: if (nombre_elements == 2)
2167: {
2168: liberation(s_etat_processus, s_objet_argument_1);
2169: liberation(s_etat_processus, s_objet_argument_2);
2170:
2171: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2172: return;
2173: }
2174:
2175: if ((s_objet_resultat = copie_objet(s_etat_processus,
2176: s_objet_argument_1, 'N')) == NULL)
2177: {
2178: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2179: return;
2180: }
2181:
2182: l_element_courant = (struct_liste_chainee *)
2183: (*s_objet_resultat).objet;
2184: l_element_precedent = l_element_courant;
2185: l_element_courant = (*l_element_courant).suivant;
2186:
2187: if (((*l_element_precedent).suivant =
2188: allocation_maillon(s_etat_processus)) == NULL)
2189: {
2190: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2191: return;
2192: }
2193:
2194: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
2195: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2196:
2197: while((*l_element_courant).suivant != NULL)
2198: {
2199: l_element_precedent = l_element_courant;
2200: l_element_courant = (*l_element_courant).suivant;
2201: }
2202:
2203: if (((*l_element_precedent).suivant =
2204: allocation_maillon(s_etat_processus)) == NULL)
2205: {
2206: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2207: return;
2208: }
2209:
2210: if (((*(*l_element_precedent).suivant).donnee =
2211: allocation(s_etat_processus, FCT)) == NULL)
2212: {
2213: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2214: return;
2215: }
2216:
2217: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2218: .donnee).objet)).nombre_arguments = 0;
2219: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2220: .donnee).objet)).fonction = instruction_same;
2221:
2222: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2223: .suivant).donnee).objet)).nom_fonction =
2224: malloc((strlen((*s_etat_processus).instruction_courante) + 1) *
2225: sizeof(unsigned char))) == NULL)
2226: {
2227: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2228: return;
2229: }
2230:
2231: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2232: .suivant).donnee).objet)).nom_fonction,
2233: (*s_etat_processus).instruction_courante);
2234:
2235: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2236:
2237: s_objet_argument_2 = NULL;
2238: }
2239:
2240: /*
2241: * Expression / Nom ou valeur numérique
2242: */
2243:
2244: else if ((((*s_objet_argument_1).type == NOM) ||
2245: ((*s_objet_argument_1).type == INT) ||
2246: ((*s_objet_argument_1).type == REL)) &&
2247: ((((*s_objet_argument_2).type == ALG) ||
2248: ((*s_objet_argument_2).type == RPN)) &&
2249: (strcmp((*s_etat_processus).instruction_courante, "==") == 0)))
2250: {
2251: nombre_elements = 0;
2252: l_element_courant = (struct_liste_chainee *)
2253: (*s_objet_argument_2).objet;
2254:
2255: while(l_element_courant != NULL)
2256: {
2257: nombre_elements++;
2258: l_element_courant = (*l_element_courant).suivant;
2259: }
2260:
2261: if (nombre_elements == 2)
2262: {
2263: liberation(s_etat_processus, s_objet_argument_1);
2264: liberation(s_etat_processus, s_objet_argument_2);
2265:
2266: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2267: return;
2268: }
2269:
2270: if ((s_objet_resultat = copie_objet(s_etat_processus,
2271: s_objet_argument_2, 'N')) == NULL)
2272: {
2273: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2274: return;
2275: }
2276:
2277: l_element_courant = (struct_liste_chainee *)
2278: (*s_objet_resultat).objet;
2279: l_element_precedent = l_element_courant;
2280:
2281: while((*l_element_courant).suivant != NULL)
2282: {
2283: l_element_precedent = l_element_courant;
2284: l_element_courant = (*l_element_courant).suivant;
2285: }
2286:
2287: if (((*l_element_precedent).suivant =
2288: allocation_maillon(s_etat_processus)) == NULL)
2289: {
2290: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2291: return;
2292: }
2293:
2294: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
2295: l_element_precedent = (*l_element_precedent).suivant;
2296:
2297: if (((*l_element_precedent).suivant =
2298: allocation_maillon(s_etat_processus)) == NULL)
2299: {
2300: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2301: return;
2302: }
2303:
2304: if (((*(*l_element_precedent).suivant).donnee =
2305: allocation(s_etat_processus, FCT)) == NULL)
2306: {
2307: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2308: return;
2309: }
2310:
2311: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2312: .donnee).objet)).nombre_arguments = 0;
2313: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
2314: .donnee).objet)).fonction = instruction_same;
2315:
2316: if (((*((struct_fonction *) (*(*(*l_element_precedent)
2317: .suivant).donnee).objet)).nom_fonction =
2318: malloc((strlen((*s_etat_processus).instruction_courante) + 1) *
2319: sizeof(unsigned char))) == NULL)
2320: {
2321: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2322: return;
2323: }
2324:
2325: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
2326: .suivant).donnee).objet)).nom_fonction,
2327: (*s_etat_processus).instruction_courante);
2328:
2329: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2330:
2331: s_objet_argument_1 = NULL;
2332: }
2333:
2334: /*
2335: * Expression / Expression
2336: */
2337:
2338: else if ((((*s_objet_argument_1).type == ALG) &&
2339: ((*s_objet_argument_2).type == ALG) &&
2340: (strcmp((*s_etat_processus).instruction_courante, "==") == 0)) ||
2341: (((*s_objet_argument_1).type == RPN) &&
2342: ((*s_objet_argument_2).type == RPN)))
2343: {
2344: nombre_elements = 0;
2345: l_element_courant = (struct_liste_chainee *)
2346: (*s_objet_argument_1).objet;
2347:
2348: while(l_element_courant != NULL)
2349: {
2350: nombre_elements++;
2351: l_element_courant = (*l_element_courant).suivant;
2352: }
2353:
2354: if (nombre_elements == 2)
2355: {
2356: liberation(s_etat_processus, s_objet_argument_1);
2357: liberation(s_etat_processus, s_objet_argument_2);
2358:
2359: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2360: return;
2361: }
2362:
2363: nombre_elements = 0;
2364: l_element_courant = (struct_liste_chainee *)
2365: (*s_objet_argument_2).objet;
2366:
2367: while(l_element_courant != NULL)
2368: {
2369: nombre_elements++;
2370: l_element_courant = (*l_element_courant).suivant;
2371: }
2372:
2373: if (nombre_elements == 2)
2374: {
2375: liberation(s_etat_processus, s_objet_argument_1);
2376: liberation(s_etat_processus, s_objet_argument_2);
2377:
2378: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
2379: return;
2380: }
2381:
2382: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
2383: s_objet_argument_1, 'N')) == NULL)
2384: {
2385: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2386: return;
2387: }
2388:
2389: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
2390: s_objet_argument_2, 'N')) == NULL)
2391: {
2392: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2393: return;
2394: }
2395:
2396: l_element_courant = (struct_liste_chainee *)
2397: (*s_copie_argument_1).objet;
2398: (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
2399: (*s_copie_argument_1).objet)).suivant;
2400:
2401: liberation(s_etat_processus, (*l_element_courant).donnee);
2402: free(l_element_courant);
2403:
2404: l_element_courant = (struct_liste_chainee *)
2405: (*s_copie_argument_2).objet;
2406: l_element_precedent = l_element_courant;
2407: s_objet_resultat = s_copie_argument_2;
2408:
2409: while((*l_element_courant).suivant != NULL)
2410: {
2411: l_element_precedent = l_element_courant;
2412: l_element_courant = (*l_element_courant).suivant;
2413: }
2414:
2415: liberation(s_etat_processus, (*l_element_courant).donnee);
2416: free(l_element_courant);
2417:
2418: (*l_element_precedent).suivant = (struct_liste_chainee *)
2419: (*s_copie_argument_1).objet;
2420: free(s_copie_argument_1);
2421:
2422: l_element_courant = (*l_element_precedent).suivant;
2423: while((*l_element_courant).suivant != NULL)
2424: {
2425: l_element_precedent = l_element_courant;
2426: l_element_courant = (*l_element_courant).suivant;
2427: }
2428:
2429: if (((*l_element_precedent).suivant =
2430: allocation_maillon(s_etat_processus)) == NULL)
2431: {
2432: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2433: return;
2434: }
2435:
2436: (*(*l_element_precedent).suivant).suivant = l_element_courant;
2437: l_element_courant = (*l_element_precedent).suivant;
2438:
2439: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
2440: == NULL)
2441: {
2442: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2443: return;
2444: }
2445:
2446: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2447: .nombre_arguments = 0;
2448: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2449: .fonction = instruction_same;
2450:
2451: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2452: .nom_fonction = malloc((strlen(
2453: (*s_etat_processus).instruction_courante) + 1) *
2454: sizeof(unsigned char))) == NULL)
2455: {
2456: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2457: return;
2458: }
2459:
2460: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
2461: .nom_fonction, (*s_etat_processus).instruction_courante);
2462: }
2463:
2464: /*
2465: --------------------------------------------------------------------------------
2466: SAME nul
2467: --------------------------------------------------------------------------------
2468: */
2469:
2470: else
2471: {
2472: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
2473: {
2474: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2475: return;
2476: }
2477:
2478: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
2479: }
2480:
2481: liberation(s_etat_processus, s_objet_argument_1);
2482: liberation(s_etat_processus, s_objet_argument_2);
2483:
2484: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2485: s_objet_resultat) == d_erreur)
2486: {
2487: return;
2488: }
2489:
2490: return;
2491: }
2492:
2493:
2494: /*
2495: ================================================================================
2496: Fonction 'start'
2497: ================================================================================
2498: Entrées : structure processus
2499: --------------------------------------------------------------------------------
2500: Sorties :
2501: --------------------------------------------------------------------------------
2502: Effets de bord : néant
2503: ================================================================================
2504: */
2505:
2506: void
2507: instruction_start(struct_processus *s_etat_processus)
2508: {
2509: struct_objet *s_objet_1;
2510: struct_objet *s_objet_2;
2511:
2512: (*s_etat_processus).erreur_execution = d_ex;
2513:
2514: if ((*s_etat_processus).affichage_arguments == 'Y')
2515: {
2516: printf("\n START ");
2517:
2518: if ((*s_etat_processus).langue == 'F')
2519: {
2520: printf("(boucle définie sans compteur)\n\n");
2521: }
2522: else
2523: {
2524: printf("(define a loop without counter)\n\n");
2525: }
2526:
2527: if ((*s_etat_processus).langue == 'F')
2528: {
2529: printf(" Utilisation :\n\n");
2530: }
2531: else
2532: {
2533: printf(" Usage:\n\n");
2534: }
2535:
2536: printf(" %s/%s %s/%s START\n", d_INT, d_REL,
2537: d_INT, d_REL);
2538: printf(" (expression)\n");
2539: printf(" [EXIT]/[CYCLE]\n");
2540: printf(" ...\n");
2541: printf(" NEXT\n\n");
2542:
2543: printf(" %s/%s %s/%s START\n", d_INT, d_REL,
2544: d_INT, d_REL);
2545: printf(" (expression)\n");
2546: printf(" [EXIT]/[CYCLE]\n");
2547: printf(" ...\n");
2548: printf(" %s/%s STEP\n", d_INT, d_REL);
2549:
2550: return;
2551: }
2552: else if ((*s_etat_processus).test_instruction == 'Y')
2553: {
2554: (*s_etat_processus).nombre_arguments = -1;
2555: return;
2556: }
2557:
2558: if ((*s_etat_processus).erreur_systeme != d_es)
2559: {
2560: return;
2561: }
2562:
2563: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2564: {
2565: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
2566: {
2567: return;
2568: }
2569: }
2570:
2571: empilement_pile_systeme(s_etat_processus);
2572: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'S';
2573:
2574: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2575: &s_objet_1) == d_erreur)
2576: {
2577: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2578: return;
2579: }
2580:
2581: if (((*s_objet_1).type != INT) &&
2582: ((*s_objet_1).type != REL))
2583: {
2584: liberation(s_etat_processus, s_objet_1);
2585:
2586: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
2587: return;
2588: }
2589:
2590: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2591: &s_objet_2) == d_erreur)
2592: {
2593: liberation(s_etat_processus, s_objet_1);
2594:
2595: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2596: return;
2597: }
2598:
2599: if (((*s_objet_2).type != INT) &&
2600: ((*s_objet_2).type != REL))
2601: {
2602: liberation(s_etat_processus, s_objet_1);
2603: liberation(s_etat_processus, s_objet_2);
2604:
2605: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
2606: return;
2607: }
2608:
2609: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet_2;
2610: (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
2611:
2612: if ((*s_etat_processus).mode_execution_programme == 'Y')
2613: {
2614: (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
2615: (*s_etat_processus).position_courante;
2616: (*(*s_etat_processus).l_base_pile_systeme)
2617: .origine_routine_evaluation = 'N';
2618: }
2619: else
2620: {
2621: (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
2622: (*s_etat_processus).expression_courante;
2623: (*(*s_etat_processus).l_base_pile_systeme)
2624: .origine_routine_evaluation = 'Y';
2625: }
2626:
2627: return;
2628: }
2629:
2630:
2631: /*
2632: ================================================================================
2633: Fonction 'step'
2634: ================================================================================
2635: Entrées : structure processus
2636: --------------------------------------------------------------------------------
2637: Sorties :
2638: --------------------------------------------------------------------------------
2639: Effets de bord : néant
2640: ================================================================================
2641: */
2642:
2643: void
2644: instruction_step(struct_processus *s_etat_processus)
2645: {
2646: struct_objet *s_objet;
2647: struct_objet *s_copie_objet;
2648:
2649: logical1 incrementation;
2650: logical1 presence_compteur;
2651:
2652: (*s_etat_processus).erreur_execution = d_ex;
2653:
2654: if ((*s_etat_processus).affichage_arguments == 'Y')
2655: {
2656: printf("\n STEP ");
2657:
2658: if ((*s_etat_processus).langue == 'F')
2659: {
2660: printf("(fin d'une boucle définie)\n\n");
2661: }
2662: else
2663: {
2664: printf("(end of defined loop)\n\n");
2665: }
2666:
2667: if ((*s_etat_processus).langue == 'F')
2668: {
2669: printf(" Utilisation :\n\n");
2670: }
2671: else
2672: {
2673: printf(" Usage:\n\n");
2674: }
2675:
2676: printf(" %s/%s %s/%s START\n", d_INT, d_REL,
2677: d_INT, d_REL);
2678: printf(" (expression)\n");
2679: printf(" [EXIT]/[CYCLE]\n");
2680: printf(" ...\n");
2681: printf(" (value) STEP\n\n");
2682:
2683: printf(" %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
2684: d_INT, d_REL);
2685: printf(" (expression)\n");
2686: printf(" [EXIT]/[CYCLE]\n");
2687: printf(" ...\n");
2688: printf(" (value) STEP\n");
2689:
2690: return;
2691: }
2692: else if ((*s_etat_processus).test_instruction == 'Y')
2693: {
2694: (*s_etat_processus).nombre_arguments = -1;
2695: return;
2696: }
2697:
2698: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2699: {
2700: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2701: {
2702: return;
2703: }
2704: }
2705:
2706: presence_compteur = ((*(*s_etat_processus).l_base_pile_systeme)
2707: .type_cloture == 'F') ? d_vrai : d_faux;
2708:
2709: if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'S')
2710: && (presence_compteur == d_faux))
2711: {
2712: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
2713: return;
2714: }
2715:
2716: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2717: &s_objet) == d_erreur)
2718: {
2719: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2720: return;
2721: }
2722:
2723: if (((*s_objet).type != INT) &&
2724: ((*s_objet).type != REL))
2725: {
2726: liberation(s_etat_processus, s_objet);
2727:
2728: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
2729: return;
2730: }
2731:
2732: if ((*s_objet).type == INT)
2733: {
2734: incrementation = ((*((integer8 *) (*s_objet).objet)) >= 0)
2735: ? d_vrai : d_faux;
2736: }
2737: else
2738: {
2739: incrementation = ((*((real8 *) (*s_objet).objet)) >= 0)
2740: ? d_vrai : d_faux;
2741: }
2742:
2743: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2744: s_objet) == d_erreur)
2745: {
2746: return;
2747: }
2748:
2749: /*
2750: * Pour une boucle avec indice, on fait pointer
2751: * (*(*s_etat_processus).l_base_pile_systeme).indice_boucle sur
2752: * la variable correspondante. Remarque, le contenu de la variable
2753: * est détruit au courant de l'opération.
2754: */
2755:
2756: if (presence_compteur == d_vrai)
2757: {
2758: if (recherche_variable(s_etat_processus, (*(*s_etat_processus)
2759: .l_base_pile_systeme).nom_variable) == d_faux)
2760: {
2761: liberation(s_etat_processus, s_objet);
2762:
2763: (*s_etat_processus).erreur_systeme = d_es;
2764: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
2765: return;
2766: }
2767:
2768: if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)
2769: .position_variable_courante]).variable_verrouillee == d_vrai)
2770: {
2771: liberation(s_etat_processus, s_objet);
2772:
2773: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
2774: return;
2775: }
2776:
2777: if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)
2778: .position_variable_courante]).objet == NULL)
2779: {
2780: liberation(s_etat_processus, s_objet);
2781:
2782: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
2783: return;
2784: }
2785:
2786: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
2787: ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
2788: .position_variable_courante]).objet;
2789: }
2790:
2791: /*
2792: * Empilement pour calculer le nouvel indice. Au passage, la
2793: * variable (*(*s_etat_processus).l_base_pile_systeme).indice_boucle
2794: * est libérée.
2795: */
2796:
2797: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2798: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle)
2799: == d_erreur)
2800: {
2801: return;
2802: }
2803:
2804: instruction_plus(s_etat_processus);
2805:
2806: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2807: &s_objet) == d_erreur)
2808: {
2809: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2810: return;
2811: }
2812:
2813: if (((*s_objet).type != INT) &&
2814: ((*s_objet).type != REL))
2815: {
2816: liberation(s_etat_processus, s_objet);
2817:
2818: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
2819: return;
2820: }
2821:
2822: if (presence_compteur == d_vrai)
2823: {
2824: /*
2825: * L'addition crée si besoin une copie de l'objet
2826: */
2827:
2828: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
2829: ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
2830: .position_variable_courante]).objet = s_objet;
2831: }
2832: else
2833: {
2834: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet;
2835: }
2836:
2837: if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'P')) == NULL)
2838: {
2839: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2840: return;
2841: }
2842:
2843: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2844: s_copie_objet) == d_erreur)
2845: {
2846: return;
2847: }
2848:
2849: if ((s_copie_objet = copie_objet(s_etat_processus,
2850: (*(*s_etat_processus).l_base_pile_systeme)
2851: .limite_indice_boucle, 'P')) == NULL)
2852: {
2853: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
2854: return;
2855: }
2856:
2857: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2858: s_copie_objet) == d_erreur)
2859: {
2860: return;
2861: }
2862:
2863: if (incrementation == d_vrai)
2864: {
2865: instruction_le(s_etat_processus);
2866: }
2867: else
2868: {
2869: instruction_ge(s_etat_processus);
2870: }
2871:
2872: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2873: &s_objet) == d_erreur)
2874: {
2875: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2876: return;
2877: }
2878:
2879: if ((*s_objet).type != INT)
2880: {
2881: liberation(s_etat_processus, s_objet);
2882:
2883: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
2884: return;
2885: }
2886:
2887: if ((*((integer8 *) (*s_objet).objet)) != 0)
2888: {
2889: if ((*(*s_etat_processus).l_base_pile_systeme)
2890: .origine_routine_evaluation == 'N')
2891: {
2892: (*s_etat_processus).position_courante = (*(*s_etat_processus)
2893: .l_base_pile_systeme).adresse_retour;
2894: }
2895: else
2896: {
2897: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
2898: .l_base_pile_systeme).pointeur_objet_retour;
2899: }
2900: }
2901: else
2902: {
2903: depilement_pile_systeme(s_etat_processus);
2904:
2905: if ((*s_etat_processus).erreur_systeme != d_es)
2906: {
2907: return;
2908: }
2909:
2910: if (presence_compteur == d_vrai)
2911: {
2912: (*s_etat_processus).niveau_courant--;
2913:
2914: if (retrait_variable_par_niveau(s_etat_processus) == d_erreur)
2915: {
2916: return;
2917: }
2918: }
2919: }
2920:
2921: liberation(s_etat_processus, s_objet);
2922:
2923: return;
2924: }
2925:
2926:
2927: /*
2928: ================================================================================
2929: Fonction 'sf'
2930: ================================================================================
2931: Entrées : structure processus
2932: --------------------------------------------------------------------------------
2933: Sorties :
2934: --------------------------------------------------------------------------------
2935: Effets de bord : néant
2936: ================================================================================
2937: */
2938:
2939: void
2940: instruction_sf(struct_processus *s_etat_processus)
2941: {
2942: struct_objet *s_objet;
2943:
2944: (*s_etat_processus).erreur_execution = d_ex;
2945:
2946: if ((*s_etat_processus).affichage_arguments == 'Y')
2947: {
2948: printf("\n SF ");
2949:
2950: if ((*s_etat_processus).langue == 'F')
2951: {
2952: printf("(positionne un indicateur binaire)\n\n");
2953: }
2954: else
2955: {
2956: printf("(set flag)\n\n");
2957: }
2958:
2959: printf(" 1: 1 <= %s <= 64\n", d_INT);
2960:
2961: return;
2962: }
2963: else if ((*s_etat_processus).test_instruction == 'Y')
2964: {
2965: (*s_etat_processus).nombre_arguments = -1;
2966: return;
2967: }
2968:
2969: if (test_cfsf(s_etat_processus, 31) == d_vrai)
2970: {
2971: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
2972: {
2973: return;
2974: }
2975: }
2976:
2977: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
2978: &s_objet) == d_erreur)
2979: {
2980: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
2981: return;
2982: }
2983:
2984: if ((*s_objet).type == INT)
2985: {
2986: if (((*((integer8 *) (*s_objet).objet)) < 1) || ((*((integer8 *)
2987: (*s_objet).objet)) > 64))
2988: {
2989: liberation(s_etat_processus, s_objet);
2990:
2991: (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
2992: return;
2993: }
2994:
2995: sf(s_etat_processus, (unsigned char) (*((integer8 *)
2996: (*s_objet).objet)));
2997: }
2998: else
2999: {
3000: liberation(s_etat_processus, s_objet);
3001:
3002: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
3003: return;
3004: }
3005:
3006: liberation(s_etat_processus, s_objet);
3007:
3008: return;
3009: }
3010:
3011:
3012: /*
3013: ================================================================================
3014: Fonction 'stof'
3015: ================================================================================
3016: Entrées : structure processus
3017: --------------------------------------------------------------------------------
3018: Sorties :
3019: --------------------------------------------------------------------------------
3020: Effets de bord : néant
3021: ================================================================================
3022: */
3023:
3024: void
3025: instruction_stof(struct_processus *s_etat_processus)
3026: {
3027: struct_objet *s_objet;
3028:
3029: t_8_bits masque;
3030:
3031: unsigned char indice_bit;
3032: unsigned char indice_bloc;
3033: unsigned char indice_drapeau;
3034: unsigned char taille_bloc;
3035:
3036: unsigned long i;
3037:
3038: (*s_etat_processus).erreur_execution = d_ex;
3039:
3040: if ((*s_etat_processus).affichage_arguments == 'Y')
3041: {
3042: printf("\n STOF ");
3043:
3044: if ((*s_etat_processus).langue == 'F')
3045: {
3046: printf("(positionne les drapeaux d'état)\n\n");
3047: }
3048: else
3049: {
3050: printf("(set flags)\n\n");
3051: }
3052:
3053: printf("-> 1: %s\n", d_BIN);
3054:
3055: return;
3056: }
3057: else if ((*s_etat_processus).test_instruction == 'Y')
3058: {
3059: (*s_etat_processus).nombre_arguments = -1;
3060: return;
3061: }
3062:
3063: if (test_cfsf(s_etat_processus, 31) == d_vrai)
3064: {
3065: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
3066: {
3067: return;
3068: }
3069: }
3070:
3071: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3072: &s_objet) == d_erreur)
3073: {
3074: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3075: return;
3076: }
3077:
3078: if ((*s_objet).type == BIN)
3079: {
3080: taille_bloc = sizeof(t_8_bits) * 8;
3081:
3082: for(i = 0; i < 8; (*s_etat_processus).drapeaux_etat[i++] = 0);
3083:
3084: for(i = 1; i <= 64; i++)
3085: {
3086: indice_drapeau = i - 1;
3087: indice_bloc = indice_drapeau / taille_bloc;
3088: indice_bit = indice_drapeau % taille_bloc;
3089: masque = ((t_8_bits) 1) << (taille_bloc - indice_bit - 1);
3090:
3091: if (((*((logical8 *) (*s_objet).objet)) &
3092: ((logical8) 1) << indice_drapeau) != 0)
3093: {
3094: (*s_etat_processus).drapeaux_etat[indice_bloc] |= masque;
3095: }
3096: }
3097: }
3098: else
3099: {
3100: liberation(s_etat_processus, s_objet);
3101:
3102: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
3103: return;
3104: }
3105:
3106: liberation(s_etat_processus, s_objet);
3107:
3108: return;
3109: }
3110:
3111:
3112: /*
3113: ================================================================================
3114: Fonction 'sto'
3115: ================================================================================
3116: Entrées : structure processus
3117: --------------------------------------------------------------------------------
3118: Sorties :
3119: --------------------------------------------------------------------------------
3120: Effets de bord : néant
3121: ================================================================================
3122: */
3123:
3124: void
3125: instruction_sto(struct_processus *s_etat_processus)
3126: {
3127: struct_objet *s_objet_1;
3128: struct_objet *s_objet_2;
3129:
3130: struct_variable s_variable;
3131:
3132: (*s_etat_processus).erreur_execution = d_ex;
3133:
3134: if ((*s_etat_processus).affichage_arguments == 'Y')
3135: {
3136: printf("\n STO ");
3137:
3138: if ((*s_etat_processus).langue == 'F')
3139: {
3140: printf("(affecte un objet à une variable)\n\n");
3141: }
3142: else
3143: {
3144: printf("(store an object in a variable)\n\n");
3145: }
3146:
3147: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
3148: " %s, %s, %s, %s, %s,\n"
3149: " %s, %s, %s, %s, %s,\n"
3150: " %s, %s, %s, %s, %s,\n"
3151: " %s\n",
3152: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
3153: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
3154: d_SLB, d_PRC, d_MTX, d_SQL);
3155: printf(" 1: %s\n", d_NOM);
3156:
3157: return;
3158: }
3159: else if ((*s_etat_processus).test_instruction == 'Y')
3160: {
3161: (*s_etat_processus).nombre_arguments = -1;
3162: return;
3163: }
3164:
3165: if (test_cfsf(s_etat_processus, 31) == d_vrai)
3166: {
3167: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
3168: {
3169: return;
3170: }
3171: }
3172:
3173: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3174: &s_objet_1) == d_erreur)
3175: {
3176: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3177: return;
3178: }
3179:
3180: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3181: &s_objet_2) == d_erreur)
3182: {
3183: liberation(s_etat_processus, s_objet_1);
3184:
3185: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3186: return;
3187: }
3188:
3189: if ((*s_objet_1).type != NOM)
3190: {
3191: liberation(s_etat_processus, s_objet_1);
3192: liberation(s_etat_processus, s_objet_2);
3193:
3194: (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
3195: return;
3196: }
3197:
3198: if (recherche_variable(s_etat_processus, (*((struct_nom *)
3199: (*s_objet_1).objet)).nom) == d_vrai)
3200: {
3201: /*
3202: * La variable est accessible.
3203: */
3204:
3205: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
3206: .position_variable_courante].variable_verrouillee == d_vrai)
3207: {
3208: liberation(s_etat_processus, s_objet_1);
3209: liberation(s_etat_processus, s_objet_2);
3210:
3211: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
3212: return;
3213: }
3214:
3215: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
3216: .position_variable_courante].objet == NULL)
3217: {
3218: if (pthread_mutex_lock(&((*(*s_etat_processus)
3219: .s_liste_variables_partagees).mutex)) != 0)
3220: {
3221: (*s_etat_processus).erreur_systeme = d_es_processus;
3222: return;
3223: }
3224:
3225: if (recherche_variable_partagee(s_etat_processus,
3226: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
3227: .position_variable_courante].nom,
3228: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
3229: .position_variable_courante].variable_partagee,
3230: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
3231: .position_variable_courante].origine) == d_faux)
3232: {
3233: if (pthread_mutex_unlock(&((*(*s_etat_processus)
3234: .s_liste_variables_partagees).mutex)) != 0)
3235: {
3236: (*s_etat_processus).erreur_systeme = d_es_processus;
3237: return;
3238: }
3239:
3240: if ((s_variable.nom = malloc((strlen((*((struct_nom *)
3241: (*s_objet_1).objet)).nom) + 1) *
3242: sizeof(unsigned char))) == NULL)
3243: {
3244: (*s_etat_processus).erreur_systeme =
3245: d_es_allocation_memoire;
3246: return;
3247: }
3248:
3249: strcpy(s_variable.nom, (*((struct_nom *)
3250: (*s_objet_1).objet)).nom);
3251: s_variable.niveau = 1;
3252:
3253: /*
3254: * Le niveau 0 correspond aux définitions. Les variables
3255: * commencent à 1 car elles sont toujours incluses dans
3256: * une définition.
3257: */
3258:
3259: s_variable.objet = s_objet_2;
3260:
3261: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
3262: == d_erreur)
3263: {
3264: return;
3265: }
3266:
3267: (*s_etat_processus).erreur_systeme = d_es;
3268: }
3269: else
3270: {
3271: liberation(s_etat_processus, (*(*s_etat_processus)
3272: .s_liste_variables_partagees).table
3273: [(*(*s_etat_processus).s_liste_variables_partagees)
3274: .position_variable].objet);
3275:
3276: (*(*s_etat_processus).s_liste_variables_partagees).table
3277: [(*(*s_etat_processus).s_liste_variables_partagees)
3278: .position_variable].objet = s_objet_2;
3279:
3280: if (pthread_mutex_unlock(&((*(*s_etat_processus)
3281: .s_liste_variables_partagees).mutex)) != 0)
3282: {
3283: (*s_etat_processus).erreur_systeme = d_es_processus;
3284: return;
3285: }
3286: }
3287: }
3288: else
3289: {
3290: liberation(s_etat_processus,
3291: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
3292: .position_variable_courante].objet);
3293:
3294: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
3295: .position_variable_courante].objet = s_objet_2;
3296: }
3297: }
3298: else
3299: {
3300: /*
3301: * La variable n'est pas accessible ou n'existe pas et on crée
3302: * une variable globale.
3303: */
3304:
3305: if ((s_variable.nom = malloc((strlen((*((struct_nom *)
3306: (*s_objet_1).objet)).nom) + 1) * sizeof(unsigned char)))
3307: == NULL)
3308: {
3309: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3310: return;
3311: }
3312:
3313: strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_1).objet)).nom);
3314: s_variable.niveau = 1;
3315:
3316: /*
3317: * Le niveau 0 correspond aux définitions. Les variables
3318: * commencent à 1 car elles sont toujours incluses dans
3319: * une définition.
3320: */
3321:
3322: s_variable.objet = s_objet_2;
3323:
3324: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
3325: == d_erreur)
3326: {
3327: return;
3328: }
3329:
3330: (*s_etat_processus).erreur_systeme = d_es;
3331: }
3332:
3333: liberation(s_etat_processus, s_objet_1);
3334:
3335: return;
3336: }
3337:
3338:
3339: /*
3340: ================================================================================
3341: Fonction 'syseval'
3342: ================================================================================
3343: Entrées : pointeur sur une struct_processus
3344: --------------------------------------------------------------------------------
3345: Sorties :
3346: --------------------------------------------------------------------------------
3347: Effets de bord : néant
3348: ================================================================================
3349: */
3350:
3351: void
3352: instruction_syseval(struct_processus *s_etat_processus)
3353: {
3354: char **arguments;
3355:
3356: int ios;
3357: int pipes_entree[2];
3358: int pipes_erreur[2];
3359: int pipes_sortie[2];
3360: int status;
3361:
3362: logical1 drapeau_fin;
3363: logical1 presence_stdin;
3364:
3365: long i;
3366: long nombre_arguments;
3367:
3368: pid_t pid;
3369:
3370: sigset_t oldset;
3371: sigset_t set;
3372:
3373: ssize_t longueur_ecriture;
3374:
3375: struct_liste_chainee *l_element_courant;
3376: struct_liste_chainee *l_element_precedent;
3377: struct_liste_chainee *l_element_stdin;
3378:
3379: struct_objet *s_objet;
3380: struct_objet *s_objet_composite;
3381: struct_objet *s_objet_resultat;
3382: struct_objet *s_objet_temporaire;
3383:
3384: struct sigaction action_courante;
3385: struct sigaction action_passee;
3386:
3387: unsigned char *ptr;
3388: unsigned char *ptr2;
3389: unsigned char registre_autorisation_empilement_programme;
3390: unsigned char *registre_instruction_courante;
3391: unsigned char *registre_programme;
3392: unsigned char *tampon;
3393:
3394: unsigned long longueur_lecture;
3395: unsigned long longueur_tampon;
3396: unsigned long nombre_iterations;
3397: unsigned long nombre_lignes;
3398: unsigned long pointeur;
3399: unsigned long registre_position_courante;
3400:
3401: (*s_etat_processus).erreur_execution = d_ex;
3402:
3403: if ((*s_etat_processus).affichage_arguments == 'Y')
3404: {
3405: printf("\n SYSEVAL ");
3406:
3407: if ((*s_etat_processus).langue == 'F')
3408: {
3409: printf("(exécute une commande système)\n\n");
3410: }
3411: else
3412: {
3413: printf("(execute a shell command)\n\n");
3414: }
3415:
3416: printf(" 1: %s\n", d_CHN);
3417: printf("-> 1: %s\n\n", d_LST);
3418:
3419: printf(" 1: %s\n", d_LST);
3420: printf("-> 1: %s\n", d_LST);
3421:
3422: return;
3423: }
3424: else if ((*s_etat_processus).test_instruction == 'Y')
3425: {
3426: (*s_etat_processus).nombre_arguments = -1;
3427: return;
3428: }
3429:
3430: if (test_cfsf(s_etat_processus, 31) == d_vrai)
3431: {
3432: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
3433: {
3434: return;
3435: }
3436: }
3437:
3438: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3439: &s_objet) == d_erreur)
3440: {
3441: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
3442: return;
3443: }
3444:
3445: s_objet_composite = NULL;
3446: l_element_stdin = NULL;
3447: presence_stdin = d_faux;
3448:
3449: if ((*s_objet).type == LST)
3450: {
3451: s_objet_composite = s_objet;
3452: s_objet = (*((struct_liste_chainee *) (*s_objet_composite)
3453: .objet)).donnee;
3454: l_element_stdin = (*((struct_liste_chainee *) (*s_objet_composite)
3455: .objet)).suivant;
3456:
3457: l_element_courant = l_element_stdin;
3458:
3459: if (l_element_courant == NULL)
3460: {
3461: liberation(s_etat_processus, s_objet_composite);
3462:
3463: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
3464: return;
3465: }
3466:
3467: while(l_element_courant != NULL)
3468: {
3469: if ((*(*l_element_courant).donnee).type != CHN)
3470: {
3471: liberation(s_etat_processus, s_objet_composite);
3472:
3473: (*s_etat_processus).erreur_execution =
3474: d_ex_erreur_type_argument;
3475: return;
3476: }
3477:
3478: l_element_courant = (*l_element_courant).suivant;
3479: }
3480:
3481: presence_stdin = d_vrai;
3482: }
3483:
3484: if ((*s_objet).type == CHN)
3485: {
3486: registre_autorisation_empilement_programme =
3487: (*s_etat_processus).autorisation_empilement_programme;
3488: registre_instruction_courante =
3489: (*s_etat_processus).instruction_courante;
3490: registre_programme = (*s_etat_processus).definitions_chainees;
3491: registre_position_courante = (*s_etat_processus).position_courante;
3492:
3493: (*s_etat_processus).definitions_chainees =
3494: (unsigned char *) (*s_objet).objet;
3495: (*s_etat_processus).position_courante = 0;
3496: (*s_etat_processus).autorisation_empilement_programme = 'N';
3497:
3498: /*
3499: * Échappement des guillemets
3500: */
3501:
3502: ptr = (*s_etat_processus).definitions_chainees;
3503: ptr2 = ptr;
3504: i = 0;
3505:
3506: while((*ptr) != d_code_fin_chaine)
3507: {
3508: if ((*ptr) == '\\')
3509: {
3510: switch (*(ptr + 1))
3511: {
3512: case '"':
3513: case '\\':
3514: {
3515: ptr++;
3516: break;
3517: }
3518: }
3519: }
3520:
3521: *ptr2++ = *ptr++;
3522: }
3523:
3524: *ptr2 = d_code_fin_chaine;
3525:
3526: /*
3527: * Scission de la chaîne en différents arguments
3528: */
3529:
3530: nombre_arguments = 0;
3531: drapeau_fin = d_faux;
3532:
3533: do
3534: {
3535: if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
3536: {
3537: (*s_etat_processus).autorisation_empilement_programme =
3538: registre_autorisation_empilement_programme;
3539: (*s_etat_processus).instruction_courante =
3540: registre_instruction_courante;
3541: (*s_etat_processus).definitions_chainees = registre_programme;
3542: (*s_etat_processus).position_courante =
3543: registre_position_courante;
3544:
3545: return;
3546: }
3547:
3548: if ((*(*s_etat_processus).instruction_courante) !=
3549: d_code_fin_chaine)
3550: {
3551: if ((s_objet_temporaire = allocation(s_etat_processus, CHN))
3552: == NULL)
3553: {
3554: (*s_etat_processus).autorisation_empilement_programme =
3555: registre_autorisation_empilement_programme;
3556: (*s_etat_processus).instruction_courante =
3557: registre_instruction_courante;
3558: (*s_etat_processus).definitions_chainees =
3559: registre_programme;
3560: (*s_etat_processus).position_courante =
3561: registre_position_courante;
3562:
3563: (*s_etat_processus).erreur_systeme =
3564: d_es_allocation_memoire;
3565: return;
3566: }
3567:
3568: (*s_objet_temporaire).objet = (*s_etat_processus)
3569: .instruction_courante;
3570:
3571: /*
3572: * S'il y a des guillemets en début de chaîne, il y en
3573: * a aussi à la fin de la chaîne et on les ôte. Les
3574: * guillements intermédiaires sont protégés par une
3575: * séquence d'échappement qui est enlevée.
3576: */
3577:
3578: if ((*s_etat_processus).instruction_courante[0] == '"')
3579: {
3580: if (strlen((*s_etat_processus).instruction_courante) >= 2)
3581: {
3582: ptr = (*s_etat_processus).instruction_courante;
3583: ptr2 = ptr + 1;
3584:
3585: while((*ptr2) != d_code_fin_chaine)
3586: {
3587: *ptr++ = *ptr2++;
3588: }
3589:
3590: (*(--ptr)) = d_code_fin_chaine;
3591: }
3592: }
3593:
3594: if (empilement(s_etat_processus,
3595: &((*s_etat_processus).l_base_pile),
3596: s_objet_temporaire) == d_erreur)
3597: {
3598: return;
3599: }
3600: }
3601: else
3602: {
3603: free((*s_etat_processus).instruction_courante);
3604: drapeau_fin = d_vrai;
3605: }
3606:
3607: nombre_arguments++;
3608: } while(drapeau_fin == d_faux);
3609:
3610: (*s_etat_processus).autorisation_empilement_programme =
3611: registre_autorisation_empilement_programme;
3612: (*s_etat_processus).instruction_courante =
3613: registre_instruction_courante;
3614: (*s_etat_processus).definitions_chainees = registre_programme;
3615: (*s_etat_processus).position_courante = registre_position_courante;
3616:
3617: if ((arguments = malloc(nombre_arguments * sizeof(char *))) == NULL)
3618: {
3619: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3620: return;
3621: }
3622:
3623: l_element_courant = (*s_etat_processus).l_base_pile;
3624: nombre_arguments--;
3625:
3626: for(i = nombre_arguments, arguments[i--] = NULL; i >= 0; i--)
3627: {
3628: arguments[i] = (char *) (*(*l_element_courant).donnee).objet;
3629: l_element_courant = (*l_element_courant).suivant;
3630: }
3631:
3632: action_courante.sa_handler = SIG_IGN;
3633: action_courante.sa_flags = SA_NODEFER | SA_ONSTACK;
3634:
3635: if (sigaction(SIGINT, &action_courante, &action_passee) != 0)
3636: {
3637: for(i = 0; i < nombre_arguments; i++)
3638: {
3639: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3640: &s_objet_temporaire);
3641: liberation(s_etat_processus, s_objet_temporaire);
3642: }
3643:
3644: free(arguments);
3645: (*s_etat_processus).erreur_systeme = d_es_signal;
3646: return;
3647: }
3648:
3649: if (pipe(pipes_entree) != 0)
3650: {
3651: (*s_etat_processus).erreur_systeme = d_es_processus;
3652: return;
3653: }
3654:
3655: if (pipe(pipes_sortie) != 0)
3656: {
3657: (*s_etat_processus).erreur_systeme = d_es_processus;
3658: return;
3659: }
3660:
3661: if (pipe(pipes_erreur) != 0)
3662: {
3663: (*s_etat_processus).erreur_systeme = d_es_processus;
3664: return;
3665: }
3666:
3667: fflush(NULL);
3668:
3669: sigfillset(&set);
3670: pthread_sigmask(SIG_BLOCK, &set, &oldset);
3671:
3672: verrouillage_threads_concurrents(s_etat_processus);
3673: pid = fork();
3674: deverrouillage_threads_concurrents(s_etat_processus);
3675:
3676: pthread_sigmask(SIG_SETMASK, &oldset, NULL);
3677: sigpending(&set);
3678:
3679: if (pid < 0)
3680: {
3681: if (close(pipes_entree[0]) != 0)
3682: {
3683: (*s_etat_processus).erreur_systeme = d_es_processus;
3684: return;
3685: }
3686:
3687: if (close(pipes_entree[1]) != 0)
3688: {
3689: (*s_etat_processus).erreur_systeme = d_es_processus;
3690: return;
3691: }
3692:
3693: if (close(pipes_sortie[0]) != 0)
3694: {
3695: (*s_etat_processus).erreur_systeme = d_es_processus;
3696: return;
3697: }
3698:
3699: if (close(pipes_sortie[1]) != 0)
3700: {
3701: (*s_etat_processus).erreur_systeme = d_es_processus;
3702: return;
3703: }
3704:
3705: if (close(pipes_erreur[0]) != 0)
3706: {
3707: (*s_etat_processus).erreur_systeme = d_es_processus;
3708: return;
3709: }
3710:
3711: if (close(pipes_erreur[1]) != 0)
3712: {
3713: (*s_etat_processus).erreur_systeme = d_es_processus;
3714: return;
3715: }
3716:
3717: (*s_etat_processus).erreur_systeme = d_es_processus;
3718: return;
3719: }
3720: else if (pid == 0)
3721: {
3722: if (close(pipes_entree[1]) != 0)
3723: {
3724: (*s_etat_processus).erreur_systeme = d_es_processus;
3725: return;
3726: }
3727:
3728: if (close(pipes_sortie[0]) != 0)
3729: {
3730: (*s_etat_processus).erreur_systeme = d_es_processus;
3731: return;
3732: }
3733:
3734: if (close(pipes_erreur[0]) != 0)
3735: {
3736: (*s_etat_processus).erreur_systeme = d_es_processus;
3737: return;
3738: }
3739:
3740: if (pipes_entree[0] != STDIN_FILENO)
3741: {
3742: if (dup2(pipes_entree[0], STDIN_FILENO) == -1)
3743: {
3744: (*s_etat_processus).erreur_systeme = d_es_processus;
3745: return;
3746: }
3747: }
3748:
3749: if (pipes_sortie[1] != STDOUT_FILENO)
3750: {
3751: if (dup2(pipes_sortie[1], STDOUT_FILENO) == -1)
3752: {
3753: (*s_etat_processus).erreur_systeme = d_es_processus;
3754: return;
3755: }
3756: }
3757:
3758: if (pipes_sortie[1] != STDERR_FILENO)
3759: {
3760: if (dup2(pipes_sortie[1], STDERR_FILENO) == -1)
3761: {
3762: (*s_etat_processus).erreur_systeme = d_es_processus;
3763: return;
3764: }
3765: }
3766:
3767: if (nombre_arguments != 0)
3768: {
3769: execvp(arguments[0], arguments);
3770: }
3771: else
3772: {
3773: exit(EXIT_SUCCESS);
3774: }
3775:
3776: /*
3777: * L'appel système execvp() a généré une erreur et n'a pu exécuter
3778: * argument[0] (fichier non exécutable ou inexistant).
3779: */
3780:
3781: close(pipes_entree[0]);
3782: close(pipes_sortie[1]);
3783:
3784: for(i = 0; i < nombre_arguments; i++)
3785: {
3786: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3787: &s_objet_temporaire);
3788: liberation(s_etat_processus, s_objet_temporaire);
3789: }
3790:
3791: free(arguments);
3792: (*s_etat_processus).erreur_systeme = d_es_processus;
3793:
3794: /*
3795: * Envoi d'une erreur dans le pipe idoine. On ne regarde pas
3796: * le nombre d'octets écrits car l'erreur ne pourra de toute
3797: * façon pas être traitée.
3798: */
3799:
3800: write_atomic(s_etat_processus, pipes_erreur[1], " ", 1);
3801: close(pipes_erreur[1]);
3802:
3803: exit(EXIT_SUCCESS);
3804: }
3805: else
3806: {
3807: if (close(pipes_entree[0]) != 0)
3808: {
3809: (*s_etat_processus).erreur_systeme = d_es_processus;
3810: return;
3811: }
3812:
3813: if (close(pipes_sortie[1]) != 0)
3814: {
3815: (*s_etat_processus).erreur_systeme = d_es_processus;
3816: return;
3817: }
3818:
3819: if (close(pipes_erreur[1]) != 0)
3820: {
3821: (*s_etat_processus).erreur_systeme = d_es_processus;
3822: return;
3823: }
3824:
3825: if (presence_stdin == d_vrai)
3826: {
3827: l_element_courant = l_element_stdin;
3828:
3829: while(l_element_courant != NULL)
3830: {
3831: longueur_ecriture = strlen((unsigned char *)
3832: (*(*l_element_courant).donnee).objet);
3833:
3834: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
3835: {
3836: (*s_etat_processus).erreur_systeme = d_es_processus;
3837: return;
3838: }
3839:
3840: while(write_atomic(s_etat_processus,
3841: pipes_entree[1], (unsigned char *)
3842: (*(*l_element_courant).donnee).objet,
3843: longueur_ecriture) != longueur_ecriture)
3844: {
3845: while(sem_wait(&((*s_etat_processus)
3846: .semaphore_fork)) == -1)
3847: {
3848: if (errno != EINTR)
3849: {
3850: (*s_etat_processus).erreur_systeme =
3851: d_es_processus;
3852: return;
3853: }
3854: }
3855:
3856: if (longueur_ecriture == -1)
3857: {
3858: (*s_etat_processus).erreur_systeme = d_es_processus;
3859: return;
3860: }
3861:
3862: if (sem_post(&((*s_etat_processus)
3863: .semaphore_fork)) != 0)
3864: {
3865: (*s_etat_processus).erreur_systeme = d_es_processus;
3866: return;
3867: }
3868: }
3869:
3870: while(write_atomic(s_etat_processus,
3871: pipes_entree[1], "\n", 1) != 1)
3872: {
3873: while(sem_wait(&((*s_etat_processus)
3874: .semaphore_fork)) == -1)
3875: {
3876: if (errno != EINTR)
3877: {
3878: (*s_etat_processus).erreur_systeme =
3879: d_es_processus;
3880: return;
3881: }
3882: }
3883:
3884: if (longueur_ecriture == -1)
3885: {
3886: (*s_etat_processus).erreur_systeme = d_es_processus;
3887: return;
3888: }
3889:
3890: if (sem_post(&((*s_etat_processus)
3891: .semaphore_fork)) != 0)
3892: {
3893: (*s_etat_processus).erreur_systeme = d_es_processus;
3894: return;
3895: }
3896: }
3897:
3898: while(sem_wait(&((*s_etat_processus).semaphore_fork))
3899: == -1)
3900: {
3901: if (errno != EINTR)
3902: {
3903: (*s_etat_processus).erreur_systeme = d_es_processus;
3904: return;
3905: }
3906: }
3907:
3908: l_element_courant = (*l_element_courant).suivant;
3909: }
3910: }
3911:
3912: if (close(pipes_entree[1]) != 0)
3913: {
3914: (*s_etat_processus).erreur_systeme = d_es_processus;
3915: return;
3916: }
3917:
3918: do
3919: {
3920: if (kill(pid, 0) != 0)
3921: {
3922: break;
3923: }
3924:
3925: /*
3926: * Récupération de la valeur de retour du processus détaché
3927: */
3928:
3929: if (sem_post(&((*s_etat_processus).semaphore_fork))
3930: != 0)
3931: {
3932: (*s_etat_processus).erreur_systeme = d_es_processus;
3933: return;
3934: }
3935:
3936: if (waitpid(pid, &status, 0) == -1)
3937: {
3938: if (sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
3939: {
3940: if (errno != EINTR)
3941: {
3942: (*s_etat_processus).erreur_systeme = d_es_processus;
3943: return;
3944: }
3945: }
3946:
3947: (*s_etat_processus).erreur_systeme = d_es_processus;
3948: return;
3949: }
3950:
3951: if (sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
3952: {
3953: if (errno != EINTR)
3954: {
3955: (*s_etat_processus).erreur_systeme = d_es_processus;
3956: return;
3957: }
3958: }
3959: } while((!WIFEXITED(status)) && (!WIFSIGNALED(status)));
3960:
3961: longueur_lecture = 256;
3962: pointeur = 0;
3963: nombre_iterations = 1;
3964:
3965: if ((tampon = malloc((longueur_lecture + 1) *
3966: sizeof(unsigned char))) == NULL)
3967: {
3968: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3969: return;
3970: }
3971:
3972: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
3973: {
3974: (*s_etat_processus).erreur_systeme = d_es_processus;
3975: return;
3976: }
3977:
3978: while((ios = read_atomic(s_etat_processus,
3979: pipes_sortie[0], &(tampon[pointeur]),
3980: longueur_lecture)) > 0)
3981: {
3982: while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
3983: {
3984: if (errno != EINTR)
3985: {
3986: (*s_etat_processus).erreur_systeme = d_es_processus;
3987: return;
3988: }
3989: }
3990:
3991: tampon[pointeur + ios] = d_code_fin_chaine;
3992: pointeur += longueur_lecture;
3993: nombre_iterations++;
3994:
3995: if ((tampon = realloc(tampon,
3996: ((nombre_iterations * longueur_lecture) + 1) *
3997: sizeof(unsigned char))) == NULL)
3998: {
3999: (*s_etat_processus).erreur_systeme =
4000: d_es_allocation_memoire;
4001: return;
4002: }
4003:
4004: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
4005: {
4006: (*s_etat_processus).erreur_systeme = d_es_processus;
4007: return;
4008: }
4009: }
4010:
4011: while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
4012: {
4013: if (errno != EINTR)
4014: {
4015: (*s_etat_processus).erreur_systeme = d_es_processus;
4016: return;
4017: }
4018: }
4019:
4020: if ((tampon = realloc(tampon, (strlen(tampon) + 1) *
4021: sizeof(unsigned char))) == NULL)
4022: {
4023: (*s_etat_processus).erreur_systeme =
4024: d_es_allocation_memoire;
4025: return;
4026: }
4027:
4028: if (ios == -1)
4029: {
4030: (*s_etat_processus).erreur_systeme = d_es_processus;
4031: return;
4032: }
4033:
4034: if (close(pipes_sortie[0]) != 0)
4035: {
4036: (*s_etat_processus).erreur_systeme = d_es_processus;
4037: return;
4038: }
4039:
4040: /*
4041: * Transformation de la chaîne en liste
4042: */
4043:
4044: longueur_tampon = strlen(tampon);
4045:
4046: for(i = 0, ptr = tampon, nombre_lignes = 0;
4047: i < (long) longueur_tampon; i++, ptr++)
4048: {
4049: if ((*ptr) == d_code_retour_chariot)
4050: {
4051: nombre_lignes++;
4052: (*ptr) = d_code_fin_chaine;
4053: }
4054: }
4055:
4056: if ((s_objet_resultat = allocation(s_etat_processus, LST))
4057: == NULL)
4058: {
4059: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4060: return;
4061: }
4062:
4063: if (nombre_lignes == 0)
4064: {
4065: (*s_objet_resultat).objet = NULL;
4066: }
4067: else
4068: {
4069: if (((*s_objet_resultat).objet =
4070: allocation_maillon(s_etat_processus)) == NULL)
4071: {
4072: (*s_etat_processus).erreur_systeme =
4073: d_es_allocation_memoire;
4074: return;
4075: }
4076:
4077: l_element_precedent = NULL;
4078: l_element_courant = (struct_liste_chainee *)
4079: (*s_objet_resultat).objet;
4080:
4081: for(i = 0, ptr = tampon; i < (long) nombre_lignes; i++)
4082: {
4083: if (((*l_element_courant).donnee =
4084: allocation(s_etat_processus, CHN)) == NULL)
4085: {
4086: (*s_etat_processus).erreur_systeme =
4087: d_es_allocation_memoire;
4088: return;
4089: }
4090:
4091: if (((*(*l_element_courant).donnee).objet =
4092: malloc((strlen(ptr) + 1) * sizeof(unsigned char)))
4093: == NULL)
4094: {
4095: (*s_etat_processus).erreur_systeme =
4096: d_es_allocation_memoire;
4097: return;
4098: }
4099:
4100: strcpy((*(*l_element_courant).donnee).objet, ptr);
4101:
4102: while((*ptr) != d_code_fin_chaine)
4103: {
4104: ptr++;
4105: }
4106:
4107: ptr++;
4108:
4109: if (((*l_element_courant).suivant =
4110: allocation_maillon(s_etat_processus)) == NULL)
4111: {
4112: (*s_etat_processus).erreur_systeme =
4113: d_es_allocation_memoire;
4114: return;
4115: }
4116:
4117: l_element_precedent = l_element_courant;
4118: l_element_courant = (*l_element_courant).suivant;
4119: }
4120:
4121: free(l_element_courant);
4122:
4123: if (l_element_precedent != NULL)
4124: {
4125: (*l_element_precedent).suivant = NULL;
4126: }
4127: }
4128:
4129: free(tampon);
4130: }
4131:
4132: if (sigaction(SIGINT, &action_passee, NULL) != 0)
4133: {
4134: for(i = 0; i < nombre_arguments; i++)
4135: {
4136: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
4137: &s_objet_temporaire);
4138: liberation(s_etat_processus, s_objet_temporaire);
4139: }
4140:
4141: free(arguments);
4142: (*s_etat_processus).erreur_systeme = d_es_signal;
4143: return;
4144: }
4145:
4146: for(i = 0; i < nombre_arguments; i++)
4147: {
4148: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
4149: &s_objet_temporaire);
4150: liberation(s_etat_processus, s_objet_temporaire);
4151: }
4152:
4153: if ((tampon = malloc(sizeof(unsigned char))) == NULL)
4154: {
4155: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4156: return;
4157: }
4158:
4159: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
4160: {
4161: (*s_etat_processus).erreur_systeme = d_es_processus;
4162: return;
4163: }
4164:
4165: if (read_atomic(s_etat_processus, pipes_erreur[0], tampon, 1) > 0)
4166: {
4167: // Le processus fils renvoie une erreur.
4168:
4169: (*s_etat_processus).erreur_execution = d_ex_erreur_processus;
4170: liberation(s_etat_processus, s_objet_resultat);
4171: }
4172: else if (empilement(s_etat_processus,
4173: &((*s_etat_processus).l_base_pile), s_objet_resultat)
4174: == d_erreur)
4175: {
4176: while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
4177: {
4178: if (errno != EINTR)
4179: {
4180: (*s_etat_processus).erreur_systeme = d_es_processus;
4181: return;
4182: }
4183: }
4184:
4185: if (close(pipes_erreur[0]) != 0)
4186: {
4187: (*s_etat_processus).erreur_systeme = d_es_processus;
4188: return;
4189: }
4190:
4191: free(tampon);
4192: return;
4193: }
4194:
4195: while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
4196: {
4197: if (errno != EINTR)
4198: {
4199: (*s_etat_processus).erreur_systeme = d_es_processus;
4200: return;
4201: }
4202: }
4203:
4204: if (close(pipes_erreur[0]) != 0)
4205: {
4206: (*s_etat_processus).erreur_systeme = d_es_processus;
4207: return;
4208: }
4209:
4210: free(arguments);
4211: free(tampon);
4212: }
4213: else
4214: {
4215: if (presence_stdin == d_vrai)
4216: {
4217: s_objet = s_objet_composite;
4218: }
4219:
4220: liberation(s_etat_processus, s_objet);
4221:
4222: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
4223: return;
4224: }
4225:
4226: if (presence_stdin == d_vrai)
4227: {
4228: s_objet = s_objet_composite;
4229: }
4230:
4231: liberation(s_etat_processus, s_objet);
4232:
4233: return;
4234: }
4235:
4236:
4237: /*
4238: ================================================================================
4239: Fonction 'sign'
4240: ================================================================================
4241: Entrées :
4242: --------------------------------------------------------------------------------
4243: Sorties :
4244: --------------------------------------------------------------------------------
4245: Effets de bord : néant
4246: ================================================================================
4247: */
4248:
4249: void
4250: instruction_sign(struct_processus *s_etat_processus)
4251: {
4252: real8 norme;
4253:
4254: struct_liste_chainee *l_element_courant;
4255: struct_liste_chainee *l_element_precedent;
4256:
4257: struct_objet *s_copie_argument;
4258: struct_objet *s_objet_argument;
4259: struct_objet *s_objet_resultat;
4260:
4261: (*s_etat_processus).erreur_execution = d_ex;
4262:
4263: if ((*s_etat_processus).affichage_arguments == 'Y')
4264: {
4265: printf("\n SIGN ");
4266:
4267: if ((*s_etat_processus).langue == 'F')
4268: {
4269: printf("(signe)\n\n");
4270: }
4271: else
4272: {
4273: printf("(sign)\n\n");
4274: }
4275:
4276: printf(" 1: %s, %s\n", d_INT, d_REL);
4277: printf("-> 1: %s\n\n", d_INT);
4278:
4279: printf(" 1: %s\n", d_CPL);
4280: printf("-> 1: %s\n\n", d_CPL);
4281:
4282: printf(" 1: %s, %s\n", d_NOM, d_ALG);
4283: printf("-> 1: %s\n\n", d_ALG);
4284:
4285: printf(" 1: %s\n", d_RPN);
4286: printf("-> 1: %s\n", d_RPN);
4287:
4288: return;
4289: }
4290: else if ((*s_etat_processus).test_instruction == 'Y')
4291: {
4292: (*s_etat_processus).nombre_arguments = 1;
4293: return;
4294: }
4295:
4296: if (test_cfsf(s_etat_processus, 31) == d_vrai)
4297: {
4298: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
4299: {
4300: return;
4301: }
4302: }
4303:
4304: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
4305: &s_objet_argument) == d_erreur)
4306: {
4307: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
4308: return;
4309: }
4310:
4311: /*
4312: --------------------------------------------------------------------------------
4313: Signe d'un entier
4314: --------------------------------------------------------------------------------
4315: */
4316:
4317: if ((*s_objet_argument).type == INT)
4318: {
4319: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
4320: {
4321: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4322: return;
4323: }
4324:
4325: if ((*((integer8 *) (*s_objet_argument).objet)) > 0)
4326: {
4327: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
4328: }
4329: else if ((*((integer8 *) (*s_objet_argument).objet)) < 0)
4330: {
4331: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
4332: }
4333: else
4334: {
4335: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
4336: }
4337: }
4338:
4339: /*
4340: --------------------------------------------------------------------------------
4341: Signe d'un réel
4342: --------------------------------------------------------------------------------
4343: */
4344:
4345: else if ((*s_objet_argument).type == REL)
4346: {
4347: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
4348: {
4349: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4350: return;
4351: }
4352:
4353: if ((*((real8 *) (*s_objet_argument).objet)) > 0)
4354: {
4355: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
4356: }
4357: else if ((*((real8 *) (*s_objet_argument).objet)) < 0)
4358: {
4359: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
4360: }
4361: else
4362: {
4363: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
4364: }
4365: }
4366:
4367: /*
4368: --------------------------------------------------------------------------------
4369: Vecteur unité dans la direction du complexe
4370: --------------------------------------------------------------------------------
4371: */
4372:
4373: else if ((*s_objet_argument).type == CPL)
4374: {
4375: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
4376: {
4377: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4378: return;
4379: }
4380:
1.4 ! bertrand 4381: if (((*((struct_complexe16 *) (*s_objet_argument).objet)).partie_reelle
! 4382: != 0) || ((*((struct_complexe16 *) (*s_objet_argument).objet))
! 4383: .partie_imaginaire != 0))
! 4384: {
! 4385: f77absc_((struct_complexe16 *) (*s_objet_argument).objet, &norme);
! 4386: f77divisioncr_((struct_complexe16 *) (*s_objet_argument).objet,
! 4387: &norme, (struct_complexe16 *) (*s_objet_resultat).objet);
! 4388: }
! 4389: else
! 4390: {
! 4391: (*((struct_complexe16 *) (*s_objet_argument).objet))
! 4392: .partie_reelle = 0;
! 4393: (*((struct_complexe16 *) (*s_objet_argument).objet))
! 4394: .partie_imaginaire = 0;
! 4395: }
1.1 bertrand 4396: }
4397:
4398: /*
4399: --------------------------------------------------------------------------------
4400: Signe d'un nom
4401: --------------------------------------------------------------------------------
4402: */
4403:
4404: else if ((*s_objet_argument).type == NOM)
4405: {
4406: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
4407: {
4408: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4409: return;
4410: }
4411:
4412: if (((*s_objet_resultat).objet =
4413: allocation_maillon(s_etat_processus)) == NULL)
4414: {
4415: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4416: return;
4417: }
4418:
4419: l_element_courant = (*s_objet_resultat).objet;
4420:
4421: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
4422: == NULL)
4423: {
4424: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4425: return;
4426: }
4427:
4428: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4429: .nombre_arguments = 0;
4430: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4431: .fonction = instruction_vers_niveau_superieur;
4432:
4433: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4434: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
4435: {
4436: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4437: return;
4438: }
4439:
4440: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4441: .nom_fonction, "<<");
4442:
4443: if (((*l_element_courant).suivant =
4444: allocation_maillon(s_etat_processus)) == NULL)
4445: {
4446: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4447: return;
4448: }
4449:
4450: l_element_courant = (*l_element_courant).suivant;
4451: (*l_element_courant).donnee = s_objet_argument;
4452:
4453: if (((*l_element_courant).suivant =
4454: allocation_maillon(s_etat_processus)) == NULL)
4455: {
4456: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4457: return;
4458: }
4459:
4460: l_element_courant = (*l_element_courant).suivant;
4461:
4462: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
4463: == NULL)
4464: {
4465: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4466: return;
4467: }
4468:
4469: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4470: .nombre_arguments = 1;
4471: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4472: .fonction = instruction_sign;
4473:
4474: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4475: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
4476: {
4477: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4478: return;
4479: }
4480:
4481: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4482: .nom_fonction, "SIGN");
4483:
4484: if (((*l_element_courant).suivant =
4485: allocation_maillon(s_etat_processus)) == NULL)
4486: {
4487: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4488: return;
4489: }
4490:
4491: l_element_courant = (*l_element_courant).suivant;
4492:
4493: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
4494: == NULL)
4495: {
4496: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4497: return;
4498: }
4499:
4500: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4501: .nombre_arguments = 0;
4502: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4503: .fonction = instruction_vers_niveau_inferieur;
4504:
4505: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4506: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
4507: {
4508: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4509: return;
4510: }
4511:
4512: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4513: .nom_fonction, ">>");
4514:
4515: (*l_element_courant).suivant = NULL;
4516: s_objet_argument = NULL;
4517: }
4518:
4519: /*
4520: --------------------------------------------------------------------------------
4521: Signe d'une expression
4522: --------------------------------------------------------------------------------
4523: */
4524:
4525: else if (((*s_objet_argument).type == ALG) ||
4526: ((*s_objet_argument).type == RPN))
4527: {
4528: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
4529: 'N')) == NULL)
4530: {
4531: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4532: return;
4533: }
4534:
4535: l_element_courant = (struct_liste_chainee *)
4536: (*s_copie_argument).objet;
4537: l_element_precedent = l_element_courant;
4538:
4539: while((*l_element_courant).suivant != NULL)
4540: {
4541: l_element_precedent = l_element_courant;
4542: l_element_courant = (*l_element_courant).suivant;
4543: }
4544:
4545: if (((*l_element_precedent).suivant =
4546: allocation_maillon(s_etat_processus)) == NULL)
4547: {
4548: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4549: return;
4550: }
4551:
4552: if (((*(*l_element_precedent).suivant).donnee =
4553: allocation(s_etat_processus, FCT)) == NULL)
4554: {
4555: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4556: return;
4557: }
4558:
4559: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
4560: .donnee).objet)).nombre_arguments = 1;
4561: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
4562: .donnee).objet)).fonction = instruction_sign;
4563:
4564: if (((*((struct_fonction *) (*(*(*l_element_precedent)
4565: .suivant).donnee).objet)).nom_fonction =
4566: malloc(5 * sizeof(unsigned char))) == NULL)
4567: {
4568: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4569: return;
4570: }
4571:
4572: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
4573: .suivant).donnee).objet)).nom_fonction, "SIGN");
4574:
4575: (*(*l_element_precedent).suivant).suivant = l_element_courant;
4576:
4577: s_objet_resultat = s_copie_argument;
4578: }
4579:
4580: /*
4581: --------------------------------------------------------------------------------
4582: Fonction signe impossible à réaliser
4583: --------------------------------------------------------------------------------
4584: */
4585:
4586: else
4587: {
4588: liberation(s_etat_processus, s_objet_argument);
4589:
4590: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
4591: return;
4592: }
4593:
4594: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
4595: s_objet_resultat) == d_erreur)
4596: {
4597: return;
4598: }
4599:
4600: liberation(s_etat_processus, s_objet_argument);
4601:
4602: return;
4603: }
4604:
4605:
4606: /*
4607: ================================================================================
4608: Fonction 'select'
4609: ================================================================================
4610: Entrées : pointeur sur une struct_processus
4611: --------------------------------------------------------------------------------
4612: Sorties :
4613: --------------------------------------------------------------------------------
4614: Effets de bord : néant
4615: ================================================================================
4616: */
4617:
4618: void
4619: instruction_select(struct_processus *s_etat_processus)
4620: {
4621: (*s_etat_processus).erreur_execution = d_ex;
4622:
4623: if ((*s_etat_processus).affichage_arguments == 'Y')
4624: {
4625: printf("\n SELECT ");
4626:
4627: if ((*s_etat_processus).langue == 'F')
4628: {
4629: printf("(structure de contrôle)\n\n");
4630: printf(" Utilisation :\n\n");
4631: }
4632: else
4633: {
4634: printf("(control statement)\n\n");
4635: printf(" Usage:\n\n");
4636: }
4637:
4638: printf(" SELECT (expression test)\n");
4639: printf(" CASE (clause 1) THEN (expression 1) END\n");
4640: printf(" CASE (clause 2) THEN (expression 2) END\n");
4641: printf(" ...\n");
4642: printf(" CASE (clause n) THEN (expression n) END\n");
4643: printf(" DEFAULT\n");
4644: printf(" (expression)\n");
4645: printf(" END\n\n");
4646:
4647: printf(" SELECT (expression test)\n");
4648: printf(" CASE (clause 1) THEN (expression 1) END\n");
4649: printf(" (expression)\n");
4650: printf(" CASE (clause 2) THEN (expression 2) END\n");
4651: printf(" END\n");
4652:
4653: return;
4654: }
4655: else if ((*s_etat_processus).test_instruction == 'Y')
4656: {
4657: (*s_etat_processus).nombre_arguments = -1;
4658: return;
4659: }
4660:
4661: empilement_pile_systeme(s_etat_processus);
4662:
4663: if ((*s_etat_processus).erreur_systeme != d_es)
4664: {
4665: return;
4666: }
4667:
4668: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'C';
4669: (*(*s_etat_processus).l_base_pile_systeme).clause = 'S';
4670:
4671: return;
4672: }
4673:
4674:
4675: /*
4676: ================================================================================
4677: Fonction 'std'
4678: ================================================================================
4679: Entrées : pointeur sur une struct_processus
4680: --------------------------------------------------------------------------------
4681: Sorties :
4682: --------------------------------------------------------------------------------
4683: Effets de bord : néant
4684: ================================================================================
4685: */
4686:
4687: void
4688: instruction_std(struct_processus *s_etat_processus)
4689: {
4690: (*s_etat_processus).erreur_execution = d_ex;
4691:
4692: if ((*s_etat_processus).affichage_arguments == 'Y')
4693: {
4694: printf("\n STD ");
4695:
4696: if ((*s_etat_processus).langue == 'F')
4697: {
4698: printf("(format standard)\n\n");
4699: printf(" Aucun argument\n");
4700: }
4701: else
4702: {
4703: printf("(standard format)\n\n");
4704: printf(" No argument\n");
4705: }
4706:
4707: return;
4708: }
4709: else if ((*s_etat_processus).test_instruction == 'Y')
4710: {
4711: (*s_etat_processus).nombre_arguments = -1;
4712: return;
4713: }
4714:
4715: if (test_cfsf(s_etat_processus, 31) == d_vrai)
4716: {
4717: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
4718: {
4719: return;
4720: }
4721: }
4722:
4723: cf(s_etat_processus, 49);
4724: cf(s_etat_processus, 50);
4725:
4726: return;
4727: }
4728:
4729:
4730: /*
4731: ================================================================================
4732: Fonction 'sci'
4733: ================================================================================
4734: Entrées : pointeur sur une struct_processus
4735: --------------------------------------------------------------------------------
4736: Sorties :
4737: --------------------------------------------------------------------------------
4738: Effets de bord : néant
4739: ================================================================================
4740: */
4741:
4742: void
4743: instruction_sci(struct_processus *s_etat_processus)
4744: {
4745: struct_objet *s_objet_argument;
4746: struct_objet *s_objet;
4747:
4748: logical1 i43;
4749: logical1 i44;
4750:
4751: unsigned char *valeur_binaire;
4752:
4753: unsigned long i;
4754: unsigned long j;
4755:
4756: (*s_etat_processus).erreur_execution = d_ex;
4757:
4758: if ((*s_etat_processus).affichage_arguments == 'Y')
4759: {
4760: printf("\n SCI ");
4761:
4762: if ((*s_etat_processus).langue == 'F')
4763: {
4764: printf("(format scientifique)\n\n");
4765: }
4766: else
4767: {
4768: printf("(scientific format)\n\n");
4769: }
4770:
4771: printf(" 1: %s\n", d_INT);
4772:
4773: return;
4774: }
4775: else if ((*s_etat_processus).test_instruction == 'Y')
4776: {
4777: (*s_etat_processus).nombre_arguments = -1;
4778: return;
4779: }
4780:
4781: if (test_cfsf(s_etat_processus, 31) == d_vrai)
4782: {
4783: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
4784: {
4785: return;
4786: }
4787: }
4788:
4789: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
4790: &s_objet_argument) == d_erreur)
4791: {
4792: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
4793: return;
4794: }
4795:
4796: if ((*s_objet_argument).type == INT)
4797: {
4798: if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
4799: ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
4800: {
4801: if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
4802: {
4803: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4804: return;
4805: }
4806:
4807: (*((logical8 *) (*s_objet).objet)) =
4808: (*((integer8 *) (*s_objet_argument).objet));
4809:
4810: i43 = test_cfsf(s_etat_processus, 43);
4811: i44 = test_cfsf(s_etat_processus, 44);
4812:
4813: sf(s_etat_processus, 44);
4814: cf(s_etat_processus, 43);
4815:
4816: if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
4817: == NULL)
4818: {
4819: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4820: return;
4821: }
4822:
4823: if (i43 == d_vrai)
4824: {
4825: sf(s_etat_processus, 43);
4826: }
4827: else
4828: {
4829: cf(s_etat_processus, 43);
4830: }
4831:
4832: if (i44 == d_vrai)
4833: {
4834: sf(s_etat_processus, 44);
4835: }
4836: else
4837: {
4838: cf(s_etat_processus, 44);
4839: }
4840:
4841: for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
4842: {
4843: if (valeur_binaire[i] == '0')
4844: {
4845: cf(s_etat_processus, j++);
4846: }
4847: else
4848: {
4849: sf(s_etat_processus, j++);
4850: }
4851: }
4852:
4853: for(; j <= 56; cf(s_etat_processus, j++));
4854:
4855: cf(s_etat_processus, 49);
4856: sf(s_etat_processus, 50);
4857:
4858: free(valeur_binaire);
4859: liberation(s_etat_processus, s_objet);
4860: }
4861: else
4862: {
4863: liberation(s_etat_processus, s_objet_argument);
4864:
4865: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
4866: return;
4867: }
4868: }
4869: else
4870: {
4871: liberation(s_etat_processus, s_objet_argument);
4872:
4873: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
4874: return;
4875: }
4876:
4877: liberation(s_etat_processus, s_objet_argument);
4878:
4879: return;
4880: }
4881:
4882: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>