Annotation of rpl/src/instructions_s1.c, revision 1.118
1.1 bertrand 1: /*
2: ================================================================================
1.118 ! bertrand 3: RPL/2 (R) version 4.1.33
! 4: Copyright (C) 1989-2021 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: /*
1.117 bertrand 3670: * S'il y a des guillemets ou une apostrophe en début de
3671: * chaîne, il y en * a aussi à la fin de la chaîne et on les
3672: * ôte. Les guillements intermédiaires sont protégés par une
1.1 bertrand 3673: * séquence d'échappement qui est enlevée.
3674: */
3675:
1.117 bertrand 3676: if (((*s_etat_processus).instruction_courante[0] == '"') ||
3677: ((*s_etat_processus).instruction_courante[0] == '\''))
1.1 bertrand 3678: {
3679: if (strlen((*s_etat_processus).instruction_courante) >= 2)
3680: {
3681: ptr = (*s_etat_processus).instruction_courante;
3682: ptr2 = ptr + 1;
3683:
3684: while((*ptr2) != d_code_fin_chaine)
3685: {
3686: *ptr++ = *ptr2++;
3687: }
3688:
3689: (*(--ptr)) = d_code_fin_chaine;
3690: }
3691: }
3692:
3693: if (empilement(s_etat_processus,
3694: &((*s_etat_processus).l_base_pile),
3695: s_objet_temporaire) == d_erreur)
3696: {
1.50 bertrand 3697: free((*s_etat_processus).definitions_chainees);
3698:
3699: (*s_etat_processus).autorisation_empilement_programme =
3700: registre_autorisation_empilement_programme;
3701: (*s_etat_processus).instruction_courante =
3702: registre_instruction_courante;
3703: (*s_etat_processus).definitions_chainees =
3704: registre_programme;
3705: (*s_etat_processus).position_courante =
3706: registre_position_courante;
1.1 bertrand 3707: return;
3708: }
3709: }
3710: else
3711: {
3712: free((*s_etat_processus).instruction_courante);
3713: drapeau_fin = d_vrai;
3714: }
3715:
3716: nombre_arguments++;
3717: } while(drapeau_fin == d_faux);
3718:
1.50 bertrand 3719: free((*s_etat_processus).definitions_chainees);
3720:
1.1 bertrand 3721: (*s_etat_processus).autorisation_empilement_programme =
3722: registre_autorisation_empilement_programme;
3723: (*s_etat_processus).instruction_courante =
3724: registre_instruction_courante;
3725: (*s_etat_processus).definitions_chainees = registre_programme;
3726: (*s_etat_processus).position_courante = registre_position_courante;
3727:
1.65 bertrand 3728: if ((arguments = malloc(((size_t) nombre_arguments) * sizeof(char *)))
3729: == NULL)
1.1 bertrand 3730: {
3731: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
3732: return;
3733: }
3734:
3735: l_element_courant = (*s_etat_processus).l_base_pile;
3736: nombre_arguments--;
3737:
3738: for(i = nombre_arguments, arguments[i--] = NULL; i >= 0; i--)
3739: {
3740: arguments[i] = (char *) (*(*l_element_courant).donnee).objet;
3741: l_element_courant = (*l_element_courant).suivant;
3742: }
3743:
3744: if (pipe(pipes_entree) != 0)
3745: {
3746: (*s_etat_processus).erreur_systeme = d_es_processus;
3747: return;
3748: }
3749:
3750: if (pipe(pipes_sortie) != 0)
3751: {
3752: (*s_etat_processus).erreur_systeme = d_es_processus;
3753: return;
3754: }
3755:
3756: if (pipe(pipes_erreur) != 0)
3757: {
3758: (*s_etat_processus).erreur_systeme = d_es_processus;
3759: return;
3760: }
3761:
3762: fflush(NULL);
3763:
1.102 bertrand 3764: attente.tv_sec = 0;
3765: attente.tv_nsec = GRANULARITE_us * 1000;
3766:
3767: while(pthread_mutex_trylock(&mutex_sigaction) != 0)
3768: {
3769: # ifndef SEMAPHORES_NOMMES
3770: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
3771: # else
3772: if (sem_post((*s_etat_processus).semaphore_fork) != 0)
3773: # endif
3774: {
3775: (*s_etat_processus).erreur_systeme = d_es_processus;
3776: return;
3777: }
3778:
3779: nanosleep(&attente, NULL);
3780: INCR_GRANULARITE(attente.tv_nsec);
3781:
3782: # ifndef SEMAPHORES_NOMMES
3783: while(sem_wait(&((*s_etat_processus).semaphore_fork)) != 0)
3784: # else
3785: while(sem_wait((*s_etat_processus).semaphore_fork) != 0)
3786: # endif
3787: {
3788: (*s_etat_processus).erreur_systeme = d_es_processus;
3789: return;
3790: }
3791: }
1.99 bertrand 3792:
1.100 bertrand 3793: action_courante.sa_handler = SIG_IGN;
3794: action_courante.sa_flags = 0;
3795:
3796: if (sigaction(SIGINT, &action_courante, &action_passee) != 0)
3797: {
3798: for(i = 0; i < nombre_arguments; i++)
3799: {
3800: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3801: &s_objet_temporaire);
3802: liberation(s_etat_processus, s_objet_temporaire);
3803: }
3804:
3805: free(arguments);
3806: (*s_etat_processus).erreur_systeme = d_es_signal;
3807: return;
3808: }
3809:
1.102 bertrand 3810: verrouillage_threads_concurrents(s_etat_processus);
3811:
1.1 bertrand 3812: pid = fork();
3813:
3814: if (pid < 0)
3815: {
3816: if (close(pipes_entree[0]) != 0)
3817: {
3818: (*s_etat_processus).erreur_systeme = d_es_processus;
3819: return;
3820: }
3821:
3822: if (close(pipes_entree[1]) != 0)
3823: {
3824: (*s_etat_processus).erreur_systeme = d_es_processus;
3825: return;
3826: }
3827:
3828: if (close(pipes_sortie[0]) != 0)
3829: {
3830: (*s_etat_processus).erreur_systeme = d_es_processus;
3831: return;
3832: }
3833:
3834: if (close(pipes_sortie[1]) != 0)
3835: {
3836: (*s_etat_processus).erreur_systeme = d_es_processus;
3837: return;
3838: }
3839:
3840: if (close(pipes_erreur[0]) != 0)
3841: {
3842: (*s_etat_processus).erreur_systeme = d_es_processus;
3843: return;
3844: }
3845:
3846: if (close(pipes_erreur[1]) != 0)
3847: {
3848: (*s_etat_processus).erreur_systeme = d_es_processus;
3849: return;
3850: }
3851:
3852: (*s_etat_processus).erreur_systeme = d_es_processus;
3853: return;
3854: }
3855: else if (pid == 0)
3856: {
1.83 bertrand 3857: (*s_etat_processus).erreur_systeme = d_es;
3858:
1.1 bertrand 3859: if (close(pipes_entree[1]) != 0)
3860: {
3861: (*s_etat_processus).erreur_systeme = d_es_processus;
1.105 bertrand 3862: printf("%d\n",__LINE__);
1.1 bertrand 3863: }
3864:
3865: if (close(pipes_sortie[0]) != 0)
3866: {
3867: (*s_etat_processus).erreur_systeme = d_es_processus;
1.105 bertrand 3868: printf("%d\n",__LINE__);
1.1 bertrand 3869: }
3870:
3871: if (close(pipes_erreur[0]) != 0)
3872: {
3873: (*s_etat_processus).erreur_systeme = d_es_processus;
1.105 bertrand 3874: printf("%d\n",__LINE__);
1.1 bertrand 3875: }
3876:
3877: if (pipes_entree[0] != STDIN_FILENO)
3878: {
3879: if (dup2(pipes_entree[0], STDIN_FILENO) == -1)
3880: {
3881: (*s_etat_processus).erreur_systeme = d_es_processus;
1.112 bertrand 3882: printf("%d\n",__LINE__);
1.1 bertrand 3883: }
3884: }
3885:
3886: if (pipes_sortie[1] != STDOUT_FILENO)
3887: {
3888: if (dup2(pipes_sortie[1], STDOUT_FILENO) == -1)
3889: {
3890: (*s_etat_processus).erreur_systeme = d_es_processus;
1.112 bertrand 3891: printf("%d\n",__LINE__);
1.1 bertrand 3892: }
3893: }
3894:
3895: if (pipes_sortie[1] != STDERR_FILENO)
3896: {
3897: if (dup2(pipes_sortie[1], STDERR_FILENO) == -1)
3898: {
3899: (*s_etat_processus).erreur_systeme = d_es_processus;
1.112 bertrand 3900: printf("%d\n",__LINE__);
1.1 bertrand 3901: }
3902: }
3903:
1.105 bertrand 3904: if ((nombre_arguments != 0) && ((*s_etat_processus).erreur_systeme
3905: == d_es))
1.1 bertrand 3906: {
3907: execvp(arguments[0], arguments);
3908: }
3909:
3910: /*
3911: * L'appel système execvp() a généré une erreur et n'a pu exécuter
3912: * argument[0] (fichier non exécutable ou inexistant).
3913: */
3914:
3915: close(pipes_entree[0]);
3916: close(pipes_sortie[1]);
3917:
3918: for(i = 0; i < nombre_arguments; i++)
3919: {
3920: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
3921: &s_objet_temporaire);
3922: liberation(s_etat_processus, s_objet_temporaire);
3923: }
3924:
3925: free(arguments);
3926: (*s_etat_processus).erreur_systeme = d_es_processus;
3927:
3928: /*
3929: * Envoi d'une erreur dans le pipe idoine. On ne regarde pas
3930: * le nombre d'octets écrits car l'erreur ne pourra de toute
3931: * façon pas être traitée.
3932: */
3933:
3934: write_atomic(s_etat_processus, pipes_erreur[1], " ", 1);
3935: close(pipes_erreur[1]);
3936:
1.105 bertrand 3937: if ((*s_etat_processus).langue == 'F')
3938: {
1.109 bertrand 3939: printf("+++Système : erreur interne dans SYSEVAL [%d]\n",
1.105 bertrand 3940: (int) getpid());
3941: }
3942: else
3943: {
3944: printf("+++System : SYSEVAL internal error [%d]\n",
3945: (int) getpid());
3946: }
3947:
1.1 bertrand 3948: exit(EXIT_SUCCESS);
3949: }
3950: else
3951: {
1.100 bertrand 3952: if (sigaction(SIGINT, &action_passee, NULL) != 0)
3953: {
3954: for(i = 0; i < nombre_arguments; i++)
3955: {
3956: depilement(s_etat_processus,
3957: &((*s_etat_processus).l_base_pile),
3958: &s_objet_temporaire);
3959: liberation(s_etat_processus, s_objet_temporaire);
3960: }
3961:
3962: free(arguments);
3963: (*s_etat_processus).erreur_systeme = d_es_signal;
3964: return;
3965: }
3966:
1.101 bertrand 3967: if (pthread_mutex_unlock(&mutex_sigaction) != 0)
3968: {
3969: (*s_etat_processus).erreur_systeme = d_es_processus;
3970: return;
3971: }
3972:
1.99 bertrand 3973: deverrouillage_threads_concurrents(s_etat_processus);
3974:
1.1 bertrand 3975: if (close(pipes_entree[0]) != 0)
3976: {
3977: (*s_etat_processus).erreur_systeme = d_es_processus;
3978: return;
3979: }
3980:
3981: if (close(pipes_sortie[1]) != 0)
3982: {
3983: (*s_etat_processus).erreur_systeme = d_es_processus;
3984: return;
3985: }
3986:
3987: if (close(pipes_erreur[1]) != 0)
3988: {
3989: (*s_etat_processus).erreur_systeme = d_es_processus;
3990: return;
3991: }
3992:
3993: if (presence_stdin == d_vrai)
3994: {
1.103 bertrand 3995: // L'écriture sur stdin est dans un thread séparé pour
3996: // ne pas bloquer.
1.1 bertrand 3997:
1.103 bertrand 3998: if (pthread_attr_init(&attributs) != 0)
1.1 bertrand 3999: {
1.103 bertrand 4000: (*s_etat_processus).erreur_systeme = d_es_processus;
4001: return;
4002: }
1.1 bertrand 4003:
1.103 bertrand 4004: if (pthread_attr_setdetachstate(&attributs,
4005: PTHREAD_CREATE_JOINABLE) != 0)
4006: {
4007: (*s_etat_processus).erreur_systeme = d_es_processus;
4008: return;
4009: }
1.1 bertrand 4010:
1.103 bertrand 4011: arguments_stdin.s_etat_processus = s_etat_processus;
1.104 bertrand 4012: arguments_stdin.fd_stdin = l_element_stdin;
1.103 bertrand 4013: arguments_stdin.pipe_entree = pipes_entree[1];
1.1 bertrand 4014:
1.103 bertrand 4015: if (pthread_create(&thread_stdin_tid, &attributs, thread_stdin,
4016: &arguments_stdin) != 0)
4017: {
4018: (*s_etat_processus).erreur_systeme = d_es_processus;
4019: return;
4020: }
1.1 bertrand 4021:
1.103 bertrand 4022: if (pthread_attr_destroy(&attributs) != 0)
4023: {
4024: (*s_etat_processus).erreur_systeme = d_es_processus;
4025: return;
1.1 bertrand 4026: }
4027: }
4028:
1.94 bertrand 4029: longueur_lecture = 65536;
1.95 bertrand 4030: longueur_lue = 0;
1.1 bertrand 4031: pointeur = 0;
4032:
1.65 bertrand 4033: if ((tampon = malloc(((size_t) (longueur_lecture + 1)) *
1.1 bertrand 4034: sizeof(unsigned char))) == NULL)
4035: {
4036: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4037: return;
4038: }
4039:
1.49 bertrand 4040: tampon[0] = d_code_fin_chaine;
4041:
1.41 bertrand 4042: # ifndef SEMAPHORES_NOMMES
4043: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
4044: # else
4045: if (sem_post((*s_etat_processus).semaphore_fork) != 0)
4046: # endif
1.8 bertrand 4047: {
4048: (*s_etat_processus).erreur_systeme = d_es_processus;
4049: return;
4050: }
1.1 bertrand 4051:
1.113 bertrand 4052: processus_tue = d_faux;
4053:
1.107 bertrand 4054: while((ios = (int) read_atomic_signal(s_etat_processus,
1.1 bertrand 4055: pipes_sortie[0], &(tampon[pointeur]),
1.109 bertrand 4056: (size_t) longueur_lecture)) >= 0)
1.1 bertrand 4057: {
1.111 bertrand 4058: if ((ios == 0) && ((*s_etat_processus)
4059: .var_volatile_requete_arret == 0))
4060: {
4061: // Correspond à un buffer vide en l'absence
4062: // d'interruption. On ne boucle pas, il n'y a rien à
4063: // lire.
4064:
4065: break;
4066: }
4067:
1.41 bertrand 4068: # ifndef SEMAPHORES_NOMMES
4069: while(sem_wait(&((*s_etat_processus).semaphore_fork)) != 0)
4070: # else
4071: while(sem_wait((*s_etat_processus).semaphore_fork) != 0)
4072: # endif
1.1 bertrand 4073: {
1.37 bertrand 4074: (*s_etat_processus).erreur_systeme = d_es_processus;
4075: return;
1.1 bertrand 4076: }
4077:
1.95 bertrand 4078: longueur_lue += ios;
1.1 bertrand 4079: tampon[pointeur + ios] = d_code_fin_chaine;
1.94 bertrand 4080: pointeur += ios;
1.1 bertrand 4081:
4082: if ((tampon = realloc(tampon,
1.95 bertrand 4083: ((size_t) ((longueur_lue + longueur_lecture) + 1))
1.65 bertrand 4084: * sizeof(unsigned char))) == NULL)
1.1 bertrand 4085: {
4086: (*s_etat_processus).erreur_systeme =
4087: d_es_allocation_memoire;
4088: return;
4089: }
4090:
1.41 bertrand 4091: # ifndef SEMAPHORES_NOMMES
4092: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
4093: # else
4094: if (sem_post((*s_etat_processus).semaphore_fork) != 0)
4095: # endif
1.1 bertrand 4096: {
4097: (*s_etat_processus).erreur_systeme = d_es_processus;
4098: return;
4099: }
1.107 bertrand 4100:
4101: if ((*s_etat_processus).var_volatile_requete_arret == -1)
4102: {
1.108 bertrand 4103: gettimeofday(&horodatage_initial, NULL);
1.113 bertrand 4104: kill(pid, SIGTERM);
1.108 bertrand 4105:
4106: if ((fpipe = fdopen(pipes_sortie[0], "r")) == NULL)
4107: {
4108: (*s_etat_processus).erreur_systeme =
4109: d_es_erreur_fichier;
4110: return;
4111: }
4112:
1.112 bertrand 4113: attente.tv_sec = 0;
4114: attente.tv_nsec = GRANULARITE_us * 1000;
4115:
1.113 bertrand 4116: if (kill(pid, 0) == 0)
1.108 bertrand 4117: {
1.113 bertrand 4118: while(feof(fpipe) == 0)
1.112 bertrand 4119: {
1.113 bertrand 4120: fds.fd = pipes_sortie[0];
4121: fds.events = POLLIN;
4122:
4123: if (poll(&fds, 1, 0) > 0)
4124: {
4125: getc(fpipe);
4126: attente.tv_sec = 0;
4127: attente.tv_nsec = GRANULARITE_us * 1000;
4128: }
4129: else
4130: {
4131: nanosleep(&attente, NULL);
4132: INCR_GRANULARITE(attente.tv_nsec);
4133: }
1.112 bertrand 4134:
1.108 bertrand 4135: gettimeofday(&horodatage_final, NULL);
4136:
4137: // Si au bout de 10 secondes après le premier
4138: // signal, il reste des données à lire, le processus
4139: // est sans doute encore actif. On envoie donc
4140: // un signal 9.
4141:
4142: if ((horodatage_final.tv_sec -
4143: horodatage_initial.tv_sec) > 10)
4144: {
4145: kill(pid, SIGKILL);
4146: gettimeofday(&horodatage_initial, NULL);
1.113 bertrand 4147: processus_tue = d_vrai;
1.108 bertrand 4148: }
4149: }
4150: }
1.113 bertrand 4151: }
1.108 bertrand 4152:
1.113 bertrand 4153: if (processus_tue == d_vrai)
4154: {
1.108 bertrand 4155: break;
1.107 bertrand 4156: }
1.1 bertrand 4157: }
4158:
1.98 bertrand 4159: # ifndef SEMAPHORES_NOMMES
1.100 bertrand 4160: while(sem_wait(&((*s_etat_processus).semaphore_fork)) != 0)
1.98 bertrand 4161: # else
1.100 bertrand 4162: while(sem_wait((*s_etat_processus).semaphore_fork) != 0)
1.98 bertrand 4163: # endif
4164: {
1.100 bertrand 4165: if (errno != EINTR)
4166: {
4167: (*s_etat_processus).erreur_systeme = d_es_processus;
4168: return;
4169: }
1.98 bertrand 4170: }
4171:
1.103 bertrand 4172: if (presence_stdin == d_vrai)
4173: {
4174: if (pthread_join(thread_stdin_tid, NULL) != 0)
4175: {
4176: (*s_etat_processus).erreur_systeme = d_es_processus;
4177: return;
4178: }
4179:
4180: if (arguments_stdin.erreur != d_es)
4181: {
4182: (*s_etat_processus).erreur_systeme = arguments_stdin.erreur;
4183: return;
4184: }
4185: }
4186: else
4187: {
4188: if (close(pipes_entree[1]) != 0)
4189: {
4190: (*s_etat_processus).erreur_systeme = d_es_processus;
4191: return;
4192: }
4193: }
4194:
1.94 bertrand 4195: do
4196: {
4197: if (kill(pid, 0) != 0)
4198: {
1.98 bertrand 4199: // Le processus n'existe plus.
1.94 bertrand 4200: break;
4201: }
4202:
4203: /*
4204: * Récupération de la valeur de retour du processus détaché
4205: */
4206:
4207: # ifndef SEMAPHORES_NOMMES
4208: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
4209: # else
4210: if (sem_post((*s_etat_processus).semaphore_fork) != 0)
4211: # endif
4212: {
4213: (*s_etat_processus).erreur_systeme = d_es_processus;
4214: return;
4215: }
4216:
4217: while(waitpid(pid, &status, 0) == -1)
4218: {
4219: if (errno != EINTR)
4220: {
4221: (*s_etat_processus).erreur_systeme = d_es_processus;
4222: return;
4223: }
4224: }
4225:
4226: # ifndef SEMAPHORES_NOMMES
4227: while(sem_wait(&((*s_etat_processus).semaphore_fork)) != 0)
4228: # else
4229: while(sem_wait((*s_etat_processus).semaphore_fork) != 0)
4230: # endif
4231: {
4232: if (errno != EINTR)
4233: {
4234: (*s_etat_processus).erreur_systeme = d_es_processus;
4235: return;
4236: }
4237: }
4238: } while((!WIFEXITED(status)) && (!WIFSIGNALED(status)));
4239:
1.1 bertrand 4240: if (ios == -1)
4241: {
4242: (*s_etat_processus).erreur_systeme = d_es_processus;
4243: return;
4244: }
4245:
4246: if (close(pipes_sortie[0]) != 0)
4247: {
4248: (*s_etat_processus).erreur_systeme = d_es_processus;
4249: return;
4250: }
4251:
4252: /*
4253: * Transformation de la chaîne en liste
4254: */
4255:
1.65 bertrand 4256: longueur_tampon = (integer8) strlen(tampon);
1.1 bertrand 4257:
4258: for(i = 0, ptr = tampon, nombre_lignes = 0;
1.66 bertrand 4259: i < longueur_tampon; i++, ptr++)
1.1 bertrand 4260: {
4261: if ((*ptr) == d_code_retour_chariot)
4262: {
4263: nombre_lignes++;
4264: (*ptr) = d_code_fin_chaine;
4265: }
4266: }
4267:
4268: if ((s_objet_resultat = allocation(s_etat_processus, LST))
4269: == NULL)
4270: {
4271: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4272: return;
4273: }
4274:
4275: if (nombre_lignes == 0)
4276: {
4277: (*s_objet_resultat).objet = NULL;
4278: }
4279: else
4280: {
4281: if (((*s_objet_resultat).objet =
4282: allocation_maillon(s_etat_processus)) == NULL)
4283: {
4284: (*s_etat_processus).erreur_systeme =
4285: d_es_allocation_memoire;
4286: return;
4287: }
4288:
4289: l_element_precedent = NULL;
4290: l_element_courant = (struct_liste_chainee *)
4291: (*s_objet_resultat).objet;
4292:
1.66 bertrand 4293: for(i = 0, ptr = tampon; i < nombre_lignes; i++)
1.1 bertrand 4294: {
4295: if (((*l_element_courant).donnee =
4296: allocation(s_etat_processus, CHN)) == NULL)
4297: {
4298: (*s_etat_processus).erreur_systeme =
4299: d_es_allocation_memoire;
4300: return;
4301: }
4302:
4303: if (((*(*l_element_courant).donnee).objet =
1.50 bertrand 4304: analyse_flux(s_etat_processus, ptr,
1.65 bertrand 4305: (integer8) strlen(ptr))) == NULL)
1.1 bertrand 4306: {
4307: (*s_etat_processus).erreur_systeme =
4308: d_es_allocation_memoire;
4309: return;
4310: }
4311:
4312: while((*ptr) != d_code_fin_chaine)
4313: {
4314: ptr++;
4315: }
4316:
4317: ptr++;
4318:
4319: if (((*l_element_courant).suivant =
4320: allocation_maillon(s_etat_processus)) == NULL)
4321: {
4322: (*s_etat_processus).erreur_systeme =
4323: d_es_allocation_memoire;
4324: return;
4325: }
4326:
4327: l_element_precedent = l_element_courant;
4328: l_element_courant = (*l_element_courant).suivant;
4329: }
4330:
4331: free(l_element_courant);
4332:
4333: if (l_element_precedent != NULL)
4334: {
4335: (*l_element_precedent).suivant = NULL;
4336: }
4337: }
4338:
4339: free(tampon);
4340: }
4341:
4342: for(i = 0; i < nombre_arguments; i++)
4343: {
4344: depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
4345: &s_objet_temporaire);
4346: liberation(s_etat_processus, s_objet_temporaire);
4347: }
4348:
1.99 bertrand 4349: free(arguments);
4350:
1.1 bertrand 4351: if ((tampon = malloc(sizeof(unsigned char))) == NULL)
4352: {
4353: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4354: return;
4355: }
4356:
1.41 bertrand 4357: # ifndef SEMAPHORES_NOMMES
4358: if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
4359: # else
4360: if (sem_post((*s_etat_processus).semaphore_fork) != 0)
4361: # endif
1.1 bertrand 4362: {
4363: (*s_etat_processus).erreur_systeme = d_es_processus;
4364: return;
4365: }
4366:
4367: if (read_atomic(s_etat_processus, pipes_erreur[0], tampon, 1) > 0)
4368: {
4369: // Le processus fils renvoie une erreur.
4370:
4371: (*s_etat_processus).erreur_execution = d_ex_erreur_processus;
4372: liberation(s_etat_processus, s_objet_resultat);
4373: }
4374: else if (empilement(s_etat_processus,
4375: &((*s_etat_processus).l_base_pile), s_objet_resultat)
4376: == d_erreur)
4377: {
1.41 bertrand 4378: # ifndef SEMAPHORES_NOMMES
4379: while(sem_wait(&((*s_etat_processus).semaphore_fork)) != 0)
4380: # else
4381: while(sem_wait((*s_etat_processus).semaphore_fork) != 0)
4382: # endif
1.1 bertrand 4383: {
1.40 bertrand 4384: if (errno != EINTR)
4385: {
4386: (*s_etat_processus).erreur_systeme = d_es_processus;
4387: return;
4388: }
1.1 bertrand 4389: }
4390:
4391: if (close(pipes_erreur[0]) != 0)
4392: {
4393: (*s_etat_processus).erreur_systeme = d_es_processus;
4394: return;
4395: }
4396:
4397: free(tampon);
4398: return;
4399: }
4400:
1.41 bertrand 4401: # ifndef SEMAPHORES_NOMMES
4402: while(sem_wait(&((*s_etat_processus).semaphore_fork)) != 0)
4403: # else
4404: while(sem_wait((*s_etat_processus).semaphore_fork) != 0)
4405: # endif
1.1 bertrand 4406: {
1.40 bertrand 4407: if (errno != EINTR)
4408: {
4409: (*s_etat_processus).erreur_systeme = d_es_processus;
4410: return;
4411: }
1.1 bertrand 4412: }
4413:
4414: if (close(pipes_erreur[0]) != 0)
4415: {
4416: (*s_etat_processus).erreur_systeme = d_es_processus;
4417: return;
4418: }
4419:
4420: free(tampon);
4421: }
4422: else
4423: {
4424: if (presence_stdin == d_vrai)
4425: {
4426: s_objet = s_objet_composite;
4427: }
4428:
4429: liberation(s_etat_processus, s_objet);
4430:
4431: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
4432: return;
4433: }
4434:
4435: if (presence_stdin == d_vrai)
4436: {
4437: s_objet = s_objet_composite;
4438: }
4439:
4440: liberation(s_etat_processus, s_objet);
4441:
4442: return;
4443: }
4444:
4445:
4446: /*
4447: ================================================================================
4448: Fonction 'sign'
4449: ================================================================================
4450: Entrées :
4451: --------------------------------------------------------------------------------
4452: Sorties :
4453: --------------------------------------------------------------------------------
4454: Effets de bord : néant
4455: ================================================================================
4456: */
4457:
4458: void
4459: instruction_sign(struct_processus *s_etat_processus)
4460: {
4461: real8 norme;
4462:
4463: struct_liste_chainee *l_element_courant;
4464: struct_liste_chainee *l_element_precedent;
4465:
4466: struct_objet *s_copie_argument;
4467: struct_objet *s_objet_argument;
4468: struct_objet *s_objet_resultat;
4469:
4470: (*s_etat_processus).erreur_execution = d_ex;
4471:
4472: if ((*s_etat_processus).affichage_arguments == 'Y')
4473: {
4474: printf("\n SIGN ");
4475:
4476: if ((*s_etat_processus).langue == 'F')
4477: {
4478: printf("(signe)\n\n");
4479: }
4480: else
4481: {
4482: printf("(sign)\n\n");
4483: }
4484:
4485: printf(" 1: %s, %s\n", d_INT, d_REL);
4486: printf("-> 1: %s\n\n", d_INT);
4487:
4488: printf(" 1: %s\n", d_CPL);
4489: printf("-> 1: %s\n\n", d_CPL);
4490:
4491: printf(" 1: %s, %s\n", d_NOM, d_ALG);
4492: printf("-> 1: %s\n\n", d_ALG);
4493:
4494: printf(" 1: %s\n", d_RPN);
4495: printf("-> 1: %s\n", d_RPN);
4496:
4497: return;
4498: }
4499: else if ((*s_etat_processus).test_instruction == 'Y')
4500: {
4501: (*s_etat_processus).nombre_arguments = 1;
4502: return;
4503: }
4504:
4505: if (test_cfsf(s_etat_processus, 31) == d_vrai)
4506: {
4507: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
4508: {
4509: return;
4510: }
4511: }
4512:
4513: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
4514: &s_objet_argument) == d_erreur)
4515: {
4516: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
4517: return;
4518: }
4519:
4520: /*
4521: --------------------------------------------------------------------------------
4522: Signe d'un entier
4523: --------------------------------------------------------------------------------
4524: */
4525:
4526: if ((*s_objet_argument).type == INT)
4527: {
4528: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
4529: {
4530: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4531: return;
4532: }
4533:
4534: if ((*((integer8 *) (*s_objet_argument).objet)) > 0)
4535: {
4536: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
4537: }
4538: else if ((*((integer8 *) (*s_objet_argument).objet)) < 0)
4539: {
4540: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
4541: }
4542: else
4543: {
4544: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
4545: }
4546: }
4547:
4548: /*
4549: --------------------------------------------------------------------------------
4550: Signe d'un réel
4551: --------------------------------------------------------------------------------
4552: */
4553:
4554: else if ((*s_objet_argument).type == REL)
4555: {
4556: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
4557: {
4558: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4559: return;
4560: }
4561:
4562: if ((*((real8 *) (*s_objet_argument).objet)) > 0)
4563: {
4564: (*((integer8 *) (*s_objet_resultat).objet)) = 1;
4565: }
4566: else if ((*((real8 *) (*s_objet_argument).objet)) < 0)
4567: {
4568: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
4569: }
4570: else
4571: {
4572: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
4573: }
4574: }
4575:
4576: /*
4577: --------------------------------------------------------------------------------
4578: Vecteur unité dans la direction du complexe
4579: --------------------------------------------------------------------------------
4580: */
4581:
4582: else if ((*s_objet_argument).type == CPL)
4583: {
4584: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
4585: {
4586: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4587: return;
4588: }
4589:
1.4 bertrand 4590: if (((*((struct_complexe16 *) (*s_objet_argument).objet)).partie_reelle
4591: != 0) || ((*((struct_complexe16 *) (*s_objet_argument).objet))
4592: .partie_imaginaire != 0))
4593: {
4594: f77absc_((struct_complexe16 *) (*s_objet_argument).objet, &norme);
4595: f77divisioncr_((struct_complexe16 *) (*s_objet_argument).objet,
4596: &norme, (struct_complexe16 *) (*s_objet_resultat).objet);
4597: }
4598: else
4599: {
4600: (*((struct_complexe16 *) (*s_objet_argument).objet))
4601: .partie_reelle = 0;
4602: (*((struct_complexe16 *) (*s_objet_argument).objet))
4603: .partie_imaginaire = 0;
4604: }
1.1 bertrand 4605: }
4606:
4607: /*
4608: --------------------------------------------------------------------------------
4609: Signe d'un nom
4610: --------------------------------------------------------------------------------
4611: */
4612:
4613: else if ((*s_objet_argument).type == NOM)
4614: {
4615: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
4616: {
4617: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4618: return;
4619: }
4620:
4621: if (((*s_objet_resultat).objet =
4622: allocation_maillon(s_etat_processus)) == NULL)
4623: {
4624: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4625: return;
4626: }
4627:
4628: l_element_courant = (*s_objet_resultat).objet;
4629:
4630: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
4631: == NULL)
4632: {
4633: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4634: return;
4635: }
4636:
4637: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4638: .nombre_arguments = 0;
4639: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4640: .fonction = instruction_vers_niveau_superieur;
4641:
4642: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4643: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
4644: {
4645: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4646: return;
4647: }
4648:
4649: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4650: .nom_fonction, "<<");
4651:
4652: if (((*l_element_courant).suivant =
4653: allocation_maillon(s_etat_processus)) == NULL)
4654: {
4655: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4656: return;
4657: }
4658:
4659: l_element_courant = (*l_element_courant).suivant;
4660: (*l_element_courant).donnee = s_objet_argument;
4661:
4662: if (((*l_element_courant).suivant =
4663: allocation_maillon(s_etat_processus)) == NULL)
4664: {
4665: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4666: return;
4667: }
4668:
4669: l_element_courant = (*l_element_courant).suivant;
4670:
4671: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
4672: == NULL)
4673: {
4674: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4675: return;
4676: }
4677:
4678: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4679: .nombre_arguments = 1;
4680: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4681: .fonction = instruction_sign;
4682:
4683: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4684: .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
4685: {
4686: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4687: return;
4688: }
4689:
4690: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4691: .nom_fonction, "SIGN");
4692:
4693: if (((*l_element_courant).suivant =
4694: allocation_maillon(s_etat_processus)) == NULL)
4695: {
4696: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4697: return;
4698: }
4699:
4700: l_element_courant = (*l_element_courant).suivant;
4701:
4702: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
4703: == NULL)
4704: {
4705: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4706: return;
4707: }
4708:
4709: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4710: .nombre_arguments = 0;
4711: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4712: .fonction = instruction_vers_niveau_inferieur;
4713:
4714: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4715: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
4716: {
4717: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4718: return;
4719: }
4720:
4721: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
4722: .nom_fonction, ">>");
4723:
4724: (*l_element_courant).suivant = NULL;
4725: s_objet_argument = NULL;
4726: }
4727:
4728: /*
4729: --------------------------------------------------------------------------------
4730: Signe d'une expression
4731: --------------------------------------------------------------------------------
4732: */
4733:
4734: else if (((*s_objet_argument).type == ALG) ||
4735: ((*s_objet_argument).type == RPN))
4736: {
4737: if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
4738: 'N')) == NULL)
4739: {
4740: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4741: return;
4742: }
4743:
4744: l_element_courant = (struct_liste_chainee *)
4745: (*s_copie_argument).objet;
4746: l_element_precedent = l_element_courant;
4747:
4748: while((*l_element_courant).suivant != NULL)
4749: {
4750: l_element_precedent = l_element_courant;
4751: l_element_courant = (*l_element_courant).suivant;
4752: }
4753:
4754: if (((*l_element_precedent).suivant =
4755: allocation_maillon(s_etat_processus)) == NULL)
4756: {
4757: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4758: return;
4759: }
4760:
4761: if (((*(*l_element_precedent).suivant).donnee =
4762: allocation(s_etat_processus, FCT)) == NULL)
4763: {
4764: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4765: return;
4766: }
4767:
4768: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
4769: .donnee).objet)).nombre_arguments = 1;
4770: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
4771: .donnee).objet)).fonction = instruction_sign;
4772:
4773: if (((*((struct_fonction *) (*(*(*l_element_precedent)
4774: .suivant).donnee).objet)).nom_fonction =
4775: malloc(5 * sizeof(unsigned char))) == NULL)
4776: {
4777: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
4778: return;
4779: }
4780:
4781: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
4782: .suivant).donnee).objet)).nom_fonction, "SIGN");
4783:
4784: (*(*l_element_precedent).suivant).suivant = l_element_courant;
4785:
4786: s_objet_resultat = s_copie_argument;
4787: }
4788:
4789: /*
4790: --------------------------------------------------------------------------------
4791: Fonction signe impossible à réaliser
4792: --------------------------------------------------------------------------------
4793: */
4794:
4795: else
4796: {
4797: liberation(s_etat_processus, s_objet_argument);
4798:
4799: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
4800: return;
4801: }
4802:
4803: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
4804: s_objet_resultat) == d_erreur)
4805: {
4806: return;
4807: }
4808:
4809: liberation(s_etat_processus, s_objet_argument);
4810:
4811: return;
4812: }
4813:
4814:
4815: /*
4816: ================================================================================
4817: Fonction 'select'
4818: ================================================================================
4819: Entrées : pointeur sur une struct_processus
4820: --------------------------------------------------------------------------------
4821: Sorties :
4822: --------------------------------------------------------------------------------
4823: Effets de bord : néant
4824: ================================================================================
4825: */
4826:
4827: void
4828: instruction_select(struct_processus *s_etat_processus)
4829: {
4830: (*s_etat_processus).erreur_execution = d_ex;
4831:
4832: if ((*s_etat_processus).affichage_arguments == 'Y')
4833: {
4834: printf("\n SELECT ");
4835:
4836: if ((*s_etat_processus).langue == 'F')
4837: {
4838: printf("(structure de contrôle)\n\n");
4839: printf(" Utilisation :\n\n");
4840: }
4841: else
4842: {
4843: printf("(control statement)\n\n");
4844: printf(" Usage:\n\n");
4845: }
4846:
4847: printf(" SELECT (expression test)\n");
4848: printf(" CASE (clause 1) THEN (expression 1) END\n");
4849: printf(" CASE (clause 2) THEN (expression 2) END\n");
4850: printf(" ...\n");
4851: printf(" CASE (clause n) THEN (expression n) END\n");
4852: printf(" DEFAULT\n");
4853: printf(" (expression)\n");
4854: printf(" END\n\n");
4855:
4856: printf(" SELECT (expression test)\n");
4857: printf(" CASE (clause 1) THEN (expression 1) END\n");
4858: printf(" (expression)\n");
4859: printf(" CASE (clause 2) THEN (expression 2) END\n");
4860: printf(" END\n");
4861:
4862: return;
4863: }
4864: else if ((*s_etat_processus).test_instruction == 'Y')
4865: {
4866: (*s_etat_processus).nombre_arguments = -1;
4867: return;
4868: }
4869:
4870: empilement_pile_systeme(s_etat_processus);
4871:
4872: if ((*s_etat_processus).erreur_systeme != d_es)
4873: {
4874: return;
4875: }
4876:
4877: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'C';
4878: (*(*s_etat_processus).l_base_pile_systeme).clause = 'S';
4879:
4880: return;
4881: }
4882:
4883:
4884: /*
4885: ================================================================================
4886: Fonction 'std'
4887: ================================================================================
4888: Entrées : pointeur sur une struct_processus
4889: --------------------------------------------------------------------------------
4890: Sorties :
4891: --------------------------------------------------------------------------------
4892: Effets de bord : néant
4893: ================================================================================
4894: */
4895:
4896: void
4897: instruction_std(struct_processus *s_etat_processus)
4898: {
4899: (*s_etat_processus).erreur_execution = d_ex;
4900:
4901: if ((*s_etat_processus).affichage_arguments == 'Y')
4902: {
4903: printf("\n STD ");
4904:
4905: if ((*s_etat_processus).langue == 'F')
4906: {
4907: printf("(format standard)\n\n");
4908: printf(" Aucun argument\n");
4909: }
4910: else
4911: {
4912: printf("(standard format)\n\n");
4913: printf(" No argument\n");
4914: }
4915:
4916: return;
4917: }
4918: else if ((*s_etat_processus).test_instruction == 'Y')
4919: {
4920: (*s_etat_processus).nombre_arguments = -1;
4921: return;
4922: }
4923:
4924: if (test_cfsf(s_etat_processus, 31) == d_vrai)
4925: {
4926: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
4927: {
4928: return;
4929: }
4930: }
4931:
4932: cf(s_etat_processus, 49);
4933: cf(s_etat_processus, 50);
4934:
4935: return;
4936: }
4937:
4938:
4939: /*
4940: ================================================================================
4941: Fonction 'sci'
4942: ================================================================================
4943: Entrées : pointeur sur une struct_processus
4944: --------------------------------------------------------------------------------
4945: Sorties :
4946: --------------------------------------------------------------------------------
4947: Effets de bord : néant
4948: ================================================================================
4949: */
4950:
4951: void
4952: instruction_sci(struct_processus *s_etat_processus)
4953: {
4954: struct_objet *s_objet_argument;
4955: struct_objet *s_objet;
4956:
4957: logical1 i43;
4958: logical1 i44;
4959:
4960: unsigned char *valeur_binaire;
4961:
4962: unsigned long i;
4963: unsigned long j;
4964:
4965: (*s_etat_processus).erreur_execution = d_ex;
4966:
4967: if ((*s_etat_processus).affichage_arguments == 'Y')
4968: {
4969: printf("\n SCI ");
4970:
4971: if ((*s_etat_processus).langue == 'F')
4972: {
4973: printf("(format scientifique)\n\n");
4974: }
4975: else
4976: {
4977: printf("(scientific format)\n\n");
4978: }
4979:
4980: printf(" 1: %s\n", d_INT);
4981:
4982: return;
4983: }
4984: else if ((*s_etat_processus).test_instruction == 'Y')
4985: {
4986: (*s_etat_processus).nombre_arguments = -1;
4987: return;
4988: }
4989:
4990: if (test_cfsf(s_etat_processus, 31) == d_vrai)
4991: {
4992: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
4993: {
4994: return;
4995: }
4996: }
4997:
4998: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
4999: &s_objet_argument) == d_erreur)
5000: {
5001: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
5002: return;
5003: }
5004:
5005: if ((*s_objet_argument).type == INT)
5006: {
5007: if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
5008: ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
5009: {
5010: if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
5011: {
5012: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5013: return;
5014: }
5015:
1.65 bertrand 5016: (*((logical8 *) (*s_objet).objet)) = (logical8)
1.1 bertrand 5017: (*((integer8 *) (*s_objet_argument).objet));
5018:
5019: i43 = test_cfsf(s_etat_processus, 43);
5020: i44 = test_cfsf(s_etat_processus, 44);
5021:
5022: sf(s_etat_processus, 44);
5023: cf(s_etat_processus, 43);
5024:
5025: if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
5026: == NULL)
5027: {
5028: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
5029: return;
5030: }
5031:
5032: if (i43 == d_vrai)
5033: {
5034: sf(s_etat_processus, 43);
5035: }
5036: else
5037: {
5038: cf(s_etat_processus, 43);
5039: }
5040:
5041: if (i44 == d_vrai)
5042: {
5043: sf(s_etat_processus, 44);
5044: }
5045: else
5046: {
5047: cf(s_etat_processus, 44);
5048: }
5049:
5050: for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
5051: {
5052: if (valeur_binaire[i] == '0')
5053: {
1.65 bertrand 5054: cf(s_etat_processus, (unsigned char) j++);
1.1 bertrand 5055: }
5056: else
5057: {
1.65 bertrand 5058: sf(s_etat_processus, (unsigned char) j++);
1.1 bertrand 5059: }
5060: }
5061:
1.65 bertrand 5062: for(; j <= 56; cf(s_etat_processus, (unsigned char) j++));
1.1 bertrand 5063:
5064: cf(s_etat_processus, 49);
5065: sf(s_etat_processus, 50);
5066:
5067: free(valeur_binaire);
5068: liberation(s_etat_processus, s_objet);
5069: }
5070: else
5071: {
5072: liberation(s_etat_processus, s_objet_argument);
5073:
5074: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
5075: return;
5076: }
5077: }
5078: else
5079: {
5080: liberation(s_etat_processus, s_objet_argument);
5081:
5082: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
5083: return;
5084: }
5085:
5086: liberation(s_etat_processus, s_objet_argument);
5087:
5088: return;
5089: }
5090:
5091: // 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