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