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