Annotation of rpl/src/instructions_s4.c, revision 1.9
1.1 bertrand 1: /*
2: ================================================================================
1.9 ! bertrand 3: RPL/2 (R) version 4.0.16
1.1 bertrand 4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl.conv.h"
24:
25:
26: /*
27: ================================================================================
28: Fonction 'steq'
29: ================================================================================
30: Entrées : structure processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_steq(struct_processus *s_etat_processus)
40: {
41: logical1 presence_variable;
42:
43: long i;
44:
45: struct_objet *s_objet;
46:
47: struct_variable s_variable;
48:
49: (*s_etat_processus).erreur_execution = d_ex;
50:
51: if ((*s_etat_processus).affichage_arguments == 'Y')
52: {
53: printf("\n STEQ ");
54:
55: if ((*s_etat_processus).langue == 'F')
56: {
57: printf("(affecte un objet à la variable EQ)\n\n");
58: }
59: else
60: {
61: printf("(store an object in EQ variable)\n\n");
62: }
63:
64: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
65: " %s, %s, %s, %s, %s,\n"
66: " %s, %s, %s, %s, %s,\n"
67: " %s, %s, %s, %s,\n"
68: " %s, %s\n",
69: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
70: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
71: d_SQL, d_SLB, d_PRC, d_MTX);
72:
73: return;
74: }
75: else if ((*s_etat_processus).test_instruction == 'Y')
76: {
77: (*s_etat_processus).nombre_arguments = -1;
78: return;
79: }
80:
81: if (test_cfsf(s_etat_processus, 31) == d_vrai)
82: {
83: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
84: {
85: return;
86: }
87: }
88:
89: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
90: &s_objet) == d_erreur)
91: {
92: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
93: return;
94: }
95:
96: if (recherche_variable(s_etat_processus, "EQ") == d_vrai)
97: {
98: /*
99: * La variable préexiste. Il faut tester si celle-ci est globale
100: * (de niveau 1).
101: */
102:
103: i = (*s_etat_processus).position_variable_courante;
104: presence_variable = d_faux;
105:
106: while(i >= 0)
107: {
108: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom, "EQ")
109: == 0) && ((*s_etat_processus).s_liste_variables[i]
110: .niveau == 1))
111: {
112: presence_variable = d_vrai;
113: break;
114: }
115: i--;
116: }
117:
118: (*s_etat_processus).position_variable_courante = i;
119:
120: if (presence_variable == d_vrai)
121: {
122: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
123: .position_variable_courante].variable_verrouillee ==
124: d_vrai)
125: {
126: liberation(s_etat_processus, s_objet);
127:
128: (*s_etat_processus).erreur_execution =
129: d_ex_variable_verrouillee;
130: return;
131: }
132:
133: if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
134: {
135: liberation(s_etat_processus, s_objet);
136:
137: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
138: return;
139: }
140:
141: liberation(s_etat_processus,
142: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
143: .position_variable_courante].objet);
144:
145: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
146: .position_variable_courante].objet = s_objet;
147: }
148: else
149: {
150: if ((s_variable.nom = malloc(3 * sizeof(unsigned char))) == NULL)
151: {
152: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
153: return;
154: }
155:
156: strcpy(s_variable.nom, "EQ");
157: s_variable.niveau = 1;
158:
159: /*
160: * Le niveau 0 correspond aux définitions. Les variables
161: * commencent à 1 car elles sont toujours incluses dans
162: * une définition.
163: */
164:
165: s_variable.objet = s_objet;
166:
167: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
168: == d_erreur)
169: {
170: return;
171: }
172: }
173: }
174: else
175: {
176: /*
177: * La variable n'existe pas et on crée une variable globale.
178: */
179:
180: if ((s_variable.nom = malloc(3 * sizeof(unsigned char))) == NULL)
181: {
182: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
183: return;
184: }
185:
186: strcpy(s_variable.nom, "EQ");
187: s_variable.niveau = 1;
188:
189: /*
190: * Le niveau 0 correspond aux définitions. Les variables
191: * commencent à 1 car elles sont toujours incluses dans
192: * une définition.
193: */
194:
195: s_variable.objet = s_objet;
196:
197: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
198: == d_erreur)
199: {
200: return;
201: }
202:
203: (*s_etat_processus).erreur_systeme = d_es;
204: }
205:
206: return;
207: }
208:
209:
210: /*
211: ================================================================================
212: Fonction '*w'
213: ================================================================================
214: Entrées : pointeur sur une structure struct_processus
215: --------------------------------------------------------------------------------
216: Sorties :
217: --------------------------------------------------------------------------------
218: Effets de bord : néant
219: ================================================================================
220: */
221:
222: void
223: instruction_star_w(struct_processus *s_etat_processus)
224: {
225: struct_objet *s_objet_argument;
226:
227: (*s_etat_processus).erreur_execution = d_ex;
228:
229: if ((*s_etat_processus).affichage_arguments == 'Y')
230: {
231: printf("\n *W ");
232:
233: if ((*s_etat_processus).langue == 'F')
234: {
235: printf("(multiplie la largeur de la fenêtre graphique)\n\n");
236: }
237: else
238: {
239: printf("(multiply width of graphical window)\n\n");
240: }
241:
242: printf(" 1: %s, %s\n", d_INT, d_REL);
243:
244: return;
245: }
246: else if ((*s_etat_processus).test_instruction == 'Y')
247: {
248: (*s_etat_processus).nombre_arguments = -1;
249: return;
250: }
251:
252: if (test_cfsf(s_etat_processus, 31) == d_vrai)
253: {
254: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
255: {
256: return;
257: }
258: }
259:
260: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
261: &s_objet_argument) == d_erreur)
262: {
263: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
264: return;
265: }
266:
267: if ((*s_objet_argument).type == INT)
268: {
269: if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
270: {
271: liberation(s_etat_processus, s_objet_argument);
272:
273: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
274: return;
275: }
276:
277: if ((*s_etat_processus).systeme_axes == 0)
278: {
279: (*s_etat_processus).x_min *= (real8) (*((integer8 *)
280: (*s_objet_argument).objet));
281: (*s_etat_processus).x_max *= (real8) (*((integer8 *)
282: (*s_objet_argument).objet));
283: }
284: else
285: {
286: (*s_etat_processus).x2_min *= (real8) (*((integer8 *)
287: (*s_objet_argument).objet));
288: (*s_etat_processus).x2_max *= (real8) (*((integer8 *)
289: (*s_objet_argument).objet));
290: }
291: }
292: else if ((*s_objet_argument).type == REL)
293: {
294: if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
295: {
296: liberation(s_etat_processus, s_objet_argument);
297:
298: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
299: return;
300: }
301:
302: if ((*s_etat_processus).systeme_axes == 0)
303: {
304: (*s_etat_processus).x_min *= (*((real8 *)
305: (*s_objet_argument).objet));
306: (*s_etat_processus).x_max *= (*((real8 *)
307: (*s_objet_argument).objet));
308: }
309: else
310: {
311: (*s_etat_processus).x2_min *= (*((real8 *)
312: (*s_objet_argument).objet));
313: (*s_etat_processus).x2_max *= (*((real8 *)
314: (*s_objet_argument).objet));
315: }
316: }
317: else
318: {
319: liberation(s_etat_processus, s_objet_argument);
320:
321: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
322: return;
323: }
324:
325: liberation(s_etat_processus, s_objet_argument);
326:
327: if (test_cfsf(s_etat_processus, 52) == d_faux)
328: {
329: if ((*s_etat_processus).fichiers_graphiques != NULL)
330: {
331: appel_gnuplot(s_etat_processus, 'N');
332: }
333: }
334:
335: return;
336: }
337:
338:
339: /*
340: ================================================================================
341: Fonction '*h'
342: ================================================================================
343: Entrées : pointeur sur une structure struct_processus
344: --------------------------------------------------------------------------------
345: Sorties :
346: --------------------------------------------------------------------------------
347: Effets de bord : néant
348: ================================================================================
349: */
350:
351: void
352: instruction_star_h(struct_processus *s_etat_processus)
353: {
354: struct_objet *s_objet_argument;
355:
356: (*s_etat_processus).erreur_execution = d_ex;
357:
358: if ((*s_etat_processus).affichage_arguments == 'Y')
359: {
360: printf("\n *H ");
361:
362: if ((*s_etat_processus).langue == 'F')
363: {
364: printf("(multiplie la hauteur de la fenêtre graphique)\n\n");
365: }
366: else
367: {
368: printf("(multiply heigh of graphical window)\n\n");
369: }
370:
371: printf(" 1: %s, %s\n", d_INT, d_REL);
372:
373: return;
374: }
375: else if ((*s_etat_processus).test_instruction == 'Y')
376: {
377: (*s_etat_processus).nombre_arguments = -1;
378: return;
379: }
380:
381: if (test_cfsf(s_etat_processus, 31) == d_vrai)
382: {
383: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
384: {
385: return;
386: }
387: }
388:
389: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
390: &s_objet_argument) == d_erreur)
391: {
392: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
393: return;
394: }
395:
396: if ((*s_objet_argument).type == INT)
397: {
398: if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
399: {
400: liberation(s_etat_processus, s_objet_argument);
401:
402: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
403: return;
404: }
405:
406: if ((*s_etat_processus).systeme_axes == 0)
407: {
408: (*s_etat_processus).y_min *= (real8) (*((integer8 *)
409: (*s_objet_argument).objet));
410: (*s_etat_processus).y_max *= (real8) (*((integer8 *)
411: (*s_objet_argument).objet));
412: }
413: else
414: {
415: (*s_etat_processus).y2_min *= (real8) (*((integer8 *)
416: (*s_objet_argument).objet));
417: (*s_etat_processus).y2_max *= (real8) (*((integer8 *)
418: (*s_objet_argument).objet));
419: }
420: }
421: else if ((*s_objet_argument).type == REL)
422: {
423: if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
424: {
425: liberation(s_etat_processus, s_objet_argument);
426:
427: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
428: return;
429: }
430:
431: if ((*s_etat_processus).systeme_axes == 0)
432: {
433: (*s_etat_processus).y_min *= (*((real8 *)
434: (*s_objet_argument).objet));
435: (*s_etat_processus).y_max *= (*((real8 *)
436: (*s_objet_argument).objet));
437: }
438: else
439: {
440: (*s_etat_processus).y2_min *= (*((real8 *)
441: (*s_objet_argument).objet));
442: (*s_etat_processus).y2_max *= (*((real8 *)
443: (*s_objet_argument).objet));
444: }
445: }
446: else
447: {
448: liberation(s_etat_processus, s_objet_argument);
449:
450: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
451: return;
452: }
453:
454: liberation(s_etat_processus, s_objet_argument);
455:
456: if (test_cfsf(s_etat_processus, 52) == d_faux)
457: {
458: if ((*s_etat_processus).fichiers_graphiques != NULL)
459: {
460: appel_gnuplot(s_etat_processus, 'N');
461: }
462: }
463:
464: return;
465: }
466:
467:
468: /*
469: ================================================================================
470: Fonction '*d'
471: ================================================================================
472: Entrées : pointeur sur une structure struct_processus
473: --------------------------------------------------------------------------------
474: Sorties :
475: --------------------------------------------------------------------------------
476: Effets de bord : néant
477: ================================================================================
478: */
479:
480: void
481: instruction_star_d(struct_processus *s_etat_processus)
482: {
483: struct_objet *s_objet_argument;
484:
485: (*s_etat_processus).erreur_execution = d_ex;
486:
487: if ((*s_etat_processus).affichage_arguments == 'Y')
488: {
489: printf("\n *D ");
490:
491: if ((*s_etat_processus).langue == 'F')
492: {
493: printf("(multiplie la profondeur de la fenêtre graphique)\n\n");
494: }
495: else
496: {
497: printf("(multiply depth of graphical window)\n\n");
498: }
499:
500: printf(" 1: %s, %s\n", d_INT, d_REL);
501:
502: return;
503: }
504: else if ((*s_etat_processus).test_instruction == 'Y')
505: {
506: (*s_etat_processus).nombre_arguments = -1;
507: return;
508: }
509:
510: if (test_cfsf(s_etat_processus, 31) == d_vrai)
511: {
512: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
513: {
514: return;
515: }
516: }
517:
518: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
519: &s_objet_argument) == d_erreur)
520: {
521: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
522: return;
523: }
524:
525: if ((*s_objet_argument).type == INT)
526: {
527: if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
528: {
529: liberation(s_etat_processus, s_objet_argument);
530:
531: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
532: return;
533: }
534:
535: if ((*s_etat_processus).systeme_axes == 0)
536: {
537: (*s_etat_processus).z_min *= (real8) (*((integer8 *)
538: (*s_objet_argument).objet));
539: (*s_etat_processus).z_max *= (real8) (*((integer8 *)
540: (*s_objet_argument).objet));
541: }
542: else
543: {
544: (*s_etat_processus).z2_min *= (real8) (*((integer8 *)
545: (*s_objet_argument).objet));
546: (*s_etat_processus).z2_max *= (real8) (*((integer8 *)
547: (*s_objet_argument).objet));
548: }
549: }
550: else if ((*s_objet_argument).type == REL)
551: {
552: if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
553: {
554: liberation(s_etat_processus, s_objet_argument);
555:
556: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
557: return;
558: }
559:
560: if ((*s_etat_processus).systeme_axes == 0)
561: {
562: (*s_etat_processus).z_min *= (*((real8 *)
563: (*s_objet_argument).objet));
564: (*s_etat_processus).z_max *= (*((real8 *)
565: (*s_objet_argument).objet));
566: }
567: else
568: {
569: (*s_etat_processus).z2_min *= (*((real8 *)
570: (*s_objet_argument).objet));
571: (*s_etat_processus).z2_max *= (*((real8 *)
572: (*s_objet_argument).objet));
573: }
574: }
575: else
576: {
577: liberation(s_etat_processus, s_objet_argument);
578:
579: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
580: return;
581: }
582:
583: liberation(s_etat_processus, s_objet_argument);
584:
585: if (test_cfsf(s_etat_processus, 52) == d_faux)
586: {
587: if ((*s_etat_processus).fichiers_graphiques != NULL)
588: {
589: appel_gnuplot(s_etat_processus, 'N');
590: }
591: }
592:
593: return;
594: }
595:
596: /*
597: ================================================================================
598: Fonction 'store'
599: ================================================================================
600: Entrées : structure processus
601: --------------------------------------------------------------------------------
602: Sorties :
603: --------------------------------------------------------------------------------
604: Effets de bord : néant
605: ================================================================================
606: */
607:
608: void
609: instruction_store(struct_processus *s_etat_processus)
610: {
611: file *fichier;
612:
613: logical1 i45;
1.5 bertrand 614: logical1 i48;
1.1 bertrand 615: logical1 i49;
616: logical1 i50;
617:
618: struct_objet *s_objet_argument_1;
619: struct_objet *s_objet_argument_2;
620:
621: unsigned char *ligne;
1.5 bertrand 622: unsigned char *ligne_convertie;
623: unsigned char registre;
1.1 bertrand 624:
625: (*s_etat_processus).erreur_execution = d_ex;
626:
627: if ((*s_etat_processus).affichage_arguments == 'Y')
628: {
629: printf("\n STORE ");
630:
631: if ((*s_etat_processus).langue == 'F')
632: {
633: printf("(enregistre une variable sur disque)\n\n");
634: }
635: else
636: {
637: printf("(store a variable on disk)\n\n");
638: }
639:
640: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
641: " %s, %s, %s, %s, %s,\n"
642: " %s, %s, %s, %s, %s\n",
643: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
644: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
645: printf(" 1: %s\n", d_CHN);
646:
647: return;
648: }
649: else if ((*s_etat_processus).test_instruction == 'Y')
650: {
651: (*s_etat_processus).nombre_arguments = -1;
652: return;
653: }
654:
655: if (test_cfsf(s_etat_processus, 31) == d_vrai)
656: {
657: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
658: {
659: return;
660: }
661: }
662:
663: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
664: &s_objet_argument_1) == d_erreur)
665: {
666: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
667: return;
668: }
669:
670: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
671: &s_objet_argument_2) == d_erreur)
672: {
673: liberation(s_etat_processus, s_objet_argument_1);
674:
675: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
676: return;
677: }
678:
679: if (((*s_objet_argument_2).type != INT) &&
680: ((*s_objet_argument_2).type != REL) &&
681: ((*s_objet_argument_2).type != CPL) &&
682: ((*s_objet_argument_2).type != VIN) &&
683: ((*s_objet_argument_2).type != VRL) &&
684: ((*s_objet_argument_2).type != VCX) &&
685: ((*s_objet_argument_2).type != MIN) &&
686: ((*s_objet_argument_2).type != MRL) &&
687: ((*s_objet_argument_2).type != MCX) &&
688: ((*s_objet_argument_2).type != TBL) &&
689: ((*s_objet_argument_2).type != BIN) &&
690: ((*s_objet_argument_2).type != NOM) &&
691: ((*s_objet_argument_2).type != CHN) &&
692: ((*s_objet_argument_2).type != LST) &&
693: ((*s_objet_argument_2).type != ALG) &&
694: ((*s_objet_argument_2).type != RPN))
695: {
696: liberation(s_etat_processus, s_objet_argument_1);
697: liberation(s_etat_processus, s_objet_argument_2);
698:
699: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
700: return;
701: }
702:
703: if ((*s_objet_argument_1).type == CHN)
704: {
705: if ((fichier = fopen((unsigned char *) (*s_objet_argument_1).objet,
706: "w")) == NULL)
707: {
708: liberation(s_etat_processus, s_objet_argument_1);
709: liberation(s_etat_processus, s_objet_argument_2);
710:
711: (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
712: return;
713: }
714:
715: i45 = test_cfsf(s_etat_processus, 45);
1.5 bertrand 716: i48 = test_cfsf(s_etat_processus, 48);
1.1 bertrand 717: i49 = test_cfsf(s_etat_processus, 49);
718: i50 = test_cfsf(s_etat_processus, 50);
719:
720: cf(s_etat_processus, 45);
1.5 bertrand 721: cf(s_etat_processus, 48);
1.1 bertrand 722: cf(s_etat_processus, 49);
723: cf(s_etat_processus, 50);
724:
725: if (fprintf(fichier, "// RPL/2 disk variable\n") < 0)
726: {
727: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
728: return;
729: }
730:
1.5 bertrand 731: registre = (*s_etat_processus).autorisation_conversion_chaine;
732: (*s_etat_processus).autorisation_conversion_chaine = 'N';
733:
734: ligne = formateur(s_etat_processus, 0, s_objet_argument_2);
735:
736: if ((ligne_convertie = transliteration(s_etat_processus,
737: ligne, d_locale, "UTF-8")) == NULL)
738: {
739: free(ligne);
740:
741: liberation(s_etat_processus, s_objet_argument_1);
742: liberation(s_etat_processus, s_objet_argument_2);
743: return;
744: }
745:
746: free(ligne);
747: ligne = ligne_convertie;
748:
749: (*s_etat_processus).autorisation_conversion_chaine = registre;
750:
1.1 bertrand 751: if ((*s_objet_argument_2).type == CHN)
752: {
1.5 bertrand 753: if (fprintf(fichier, "\"%s\"\n", ligne) < 0)
1.1 bertrand 754: {
755: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
756: return;
757: }
1.5 bertrand 758:
759: (*s_etat_processus).autorisation_conversion_chaine = registre;
1.1 bertrand 760: }
761: else
762: {
1.5 bertrand 763: if (fprintf(fichier, "%s\n", ligne) < 0)
1.1 bertrand 764: {
765: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
766: return;
767: }
1.5 bertrand 768:
769: (*s_etat_processus).autorisation_conversion_chaine = registre;
1.1 bertrand 770: }
771:
772: free(ligne);
773:
774: if (fclose(fichier) != 0)
775: {
776: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
777: return;
778: }
779:
780: if (i45 == d_vrai)
781: {
782: sf(s_etat_processus, 45);
783: }
784: else
785: {
786: cf(s_etat_processus, 45);
787: }
788:
1.5 bertrand 789: if (i48 == d_vrai)
790: {
791: sf(s_etat_processus, 48);
792: }
793: else
794: {
795: cf(s_etat_processus, 48);
796: }
797:
1.1 bertrand 798: if (i49 == d_vrai)
799: {
800: sf(s_etat_processus, 49);
801: }
802: else
803: {
804: cf(s_etat_processus, 49);
805: }
806:
807: if (i50 == d_vrai)
808: {
809: sf(s_etat_processus, 50);
810: }
811: else
812: {
813: cf(s_etat_processus, 50);
814: }
815: }
816: else
817: {
818: liberation(s_etat_processus, s_objet_argument_1);
819: liberation(s_etat_processus, s_objet_argument_2);
820:
821: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
822: return;
823: }
824:
825: liberation(s_etat_processus, s_objet_argument_1);
826: liberation(s_etat_processus, s_objet_argument_2);
827:
828: return;
829: }
830:
831:
832: /*
833: ================================================================================
834: Fonction 'stws'
835: ================================================================================
836: Entrées : structure processus
837: --------------------------------------------------------------------------------
838: Sorties :
839: --------------------------------------------------------------------------------
840: Effets de bord : néant
841: ================================================================================
842: */
843:
844: void
845: instruction_stws(struct_processus *s_etat_processus)
846: {
847: logical1 i43;
848: logical1 i44;
849:
850: struct_objet *s_objet_argument;
851: struct_objet *s_objet_binaire;
852:
853: unsigned char *valeur_binaire;
854:
855: unsigned long i;
856: unsigned long j;
857:
858: (*s_etat_processus).erreur_execution = d_ex;
859:
860: if ((*s_etat_processus).affichage_arguments == 'Y')
861: {
862: printf("\n STWS ");
863:
864: if ((*s_etat_processus).langue == 'F')
865: {
866: printf("(affectation de la longueur des entiers binaires)\n\n");
867: }
868: else
869: {
870: printf("(set the length of the binary integers)\n\n");
871: }
872:
873: printf(" 1: %s\n", d_INT);
874:
875: return;
876: }
877: else if ((*s_etat_processus).test_instruction == 'Y')
878: {
879: (*s_etat_processus).nombre_arguments = -1;
880: return;
881: }
882:
883: if (test_cfsf(s_etat_processus, 31) == d_vrai)
884: {
885: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
886: {
887: return;
888: }
889: }
890:
891: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
892: &s_objet_argument) == d_erreur)
893: {
894: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
895: return;
896: }
897:
898: if ((*s_objet_argument).type == INT)
899: {
900: if (((*((integer8 *) (*s_objet_argument).objet)) < 1 ) ||
901: ((*((integer8 *) (*s_objet_argument).objet)) > 64))
902: {
903: liberation(s_etat_processus, s_objet_argument);
904:
905: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
906: return;
907: }
908:
909: if ((s_objet_binaire = allocation(s_etat_processus, BIN)) == NULL)
910: {
911: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
912: return;
913: }
914:
915: (*((logical8 *) (*s_objet_binaire).objet)) = (*((integer8 *)
916: (*s_objet_argument).objet)) - 1;
917:
918: i43 = test_cfsf(s_etat_processus, 43);
919: i44 = test_cfsf(s_etat_processus, 44);
920:
921: sf(s_etat_processus, 44);
922: cf(s_etat_processus, 43);
923:
924: valeur_binaire = formateur(s_etat_processus, 0, s_objet_binaire);
925:
926: liberation(s_etat_processus, s_objet_binaire);
927:
928: if (i43 == d_vrai)
929: {
930: sf(s_etat_processus, 43);
931: }
932: else
933: {
934: cf(s_etat_processus, 43);
935: }
936:
937: if (i44 == d_vrai)
938: {
939: sf(s_etat_processus, 44);
940: }
941: else
942: {
943: cf(s_etat_processus, 44);
944: }
945:
946: for(j = 37, i = strlen(valeur_binaire) - 2; i >= 2; i--)
947: {
948: if (valeur_binaire[i] == '0')
949: {
950: cf(s_etat_processus, j++);
951: }
952: else
953: {
954: sf(s_etat_processus, j++);
955: }
956: }
957:
958: for(; j <= 42; cf(s_etat_processus, j++));
959:
960: free(valeur_binaire);
961: }
962: else
963: {
964: liberation(s_etat_processus, s_objet_argument);
965:
966: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
967: return;
968: }
969:
970: liberation(s_etat_processus, s_objet_argument);
971:
972: return;
973: }
974:
975:
976: /*
977: ================================================================================
978: Fonction 'sl'
979: ================================================================================
980: Entrées : pointeur sur une structure struct_processus
981: --------------------------------------------------------------------------------
982: Sorties :
983: --------------------------------------------------------------------------------
984: Effets de bord : néant
985: ================================================================================
986: */
987:
988: void
989: instruction_sl(struct_processus *s_etat_processus)
990: {
991: logical8 masque;
992: logical8 tampon;
993:
994: struct_objet *s_copie;
995: struct_objet *s_objet;
996:
997: unsigned long i;
998: unsigned long j;
999: unsigned long longueur;
1000:
1001: (*s_etat_processus).erreur_execution = d_ex;
1002:
1003: if ((*s_etat_processus).affichage_arguments == 'Y')
1004: {
1005: printf("\n SL ");
1006:
1007: if ((*s_etat_processus).langue == 'F')
1008: {
1009: printf("(déplacement à gauche)\n\n");
1010: }
1011: else
1012: {
1013: printf("(shift left)\n\n");
1014: }
1015:
1016: printf(" 1: %s\n", d_BIN);
1017: printf("-> 1: %s\n", d_BIN);
1018:
1019: return;
1020: }
1021: else if ((*s_etat_processus).test_instruction == 'Y')
1022: {
1023: (*s_etat_processus).nombre_arguments = -1;
1024: return;
1025: }
1026:
1027: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1028: {
1029: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1030: {
1031: return;
1032: }
1033: }
1034:
1035: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1036: &s_objet) == d_erreur)
1037: {
1038: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1039: return;
1040: }
1041:
1042: if ((*s_objet).type == BIN)
1043: {
1044: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
1045: {
1046: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1047: return;
1048: }
1049:
1050: longueur = 1;
1051: j = 1;
1052:
1053: for(i = 37; i <= 42; i++)
1054: {
1055: longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
1056: == d_vrai) ? j : 0;
1057: j *= 2;
1058: }
1059:
1060: tampon = (*((logical8 *) (*s_copie).objet));
1061: tampon <<= 1;
1062:
1063: for(masque = 0, i = 1; i < longueur; i++)
1064: {
1065: masque <<= 1;
1066: masque |= (logical8) 1;
1067: }
1068:
1069: masque <<= 1;
1070: tampon &= masque;
1071: (*((logical8 *) (*s_copie).objet)) = tampon;
1072:
1073: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1074: s_copie) == d_erreur)
1075: {
1076: return;
1077: }
1078: }
1079: else
1080: {
1081: liberation(s_etat_processus, s_objet);
1082:
1083: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1084: return;
1085: }
1086:
1087: liberation(s_etat_processus, s_objet);
1088:
1089: return;
1090: }
1091:
1092:
1093: /*
1094: ================================================================================
1095: Fonction 'slb'
1096: ================================================================================
1097: Entrées : pointeur sur une structure struct_processus
1098: --------------------------------------------------------------------------------
1099: Sorties :
1100: --------------------------------------------------------------------------------
1101: Effets de bord : néant
1102: ================================================================================
1103: */
1104:
1105: void
1106: instruction_slb(struct_processus *s_etat_processus)
1107: {
1108: struct_liste_chainee *l_base_pile;
1109:
1110: unsigned long i;
1111:
1112: if ((*s_etat_processus).affichage_arguments == 'Y')
1113: {
1114: printf("\n SLB ");
1115:
1116: if ((*s_etat_processus).langue == 'F')
1117: {
1118: printf("(déplacement d'un octet à gauche)\n\n");
1119: }
1120: else
1121: {
1122: printf("(shift left byte)\n\n");
1123: }
1124:
1125: printf(" 1: %s\n", d_BIN);
1126: printf("-> 1: %s\n", d_BIN);
1127:
1128: return;
1129: }
1130: else if ((*s_etat_processus).test_instruction == 'Y')
1131: {
1132: (*s_etat_processus).nombre_arguments = -1;
1133: return;
1134: }
1135:
1136: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1137: {
1138: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1139: {
1140: return;
1141: }
1142: }
1143:
1144: l_base_pile = (*s_etat_processus).l_base_pile_last;
1145: (*s_etat_processus).l_base_pile_last = NULL;
1146:
1147: for(i = 0; i < 8; i++)
1148: {
1149: instruction_sl(s_etat_processus);
1150:
1151: if (((*s_etat_processus).erreur_systeme != d_es) ||
1152: ((*s_etat_processus).erreur_execution != d_ex))
1153: {
1154: break;
1155: }
1156: }
1157:
1158: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1159: {
1160: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1161: {
1162: return;
1163: }
1164: }
1165:
1166: (*s_etat_processus).l_base_pile_last = l_base_pile;
1167: return;
1168: }
1169:
1170:
1171: /*
1172: ================================================================================
1173: Fonction 'sr'
1174: ================================================================================
1175: Entrées : pointeur sur une structure struct_processus
1176: --------------------------------------------------------------------------------
1177: Sorties :
1178: --------------------------------------------------------------------------------
1179: Effets de bord : néant
1180: ================================================================================
1181: */
1182:
1183: void
1184: instruction_sr(struct_processus *s_etat_processus)
1185: {
1186: logical8 masque;
1187: logical8 tampon;
1188:
1189: struct_objet *s_copie;
1190: struct_objet *s_objet;
1191:
1192: unsigned long i;
1193: unsigned long j;
1194: unsigned long longueur;
1195:
1196: (*s_etat_processus).erreur_execution = d_ex;
1197:
1198: if ((*s_etat_processus).affichage_arguments == 'Y')
1199: {
1200: printf("\n SR ");
1201:
1202: if ((*s_etat_processus).langue == 'F')
1203: {
1204: printf("(déplacement à droite)\n\n");
1205: }
1206: else
1207: {
1208: printf("(shift right)\n\n");
1209: }
1210:
1211: printf(" 1: %s\n", d_BIN);
1212: printf("-> 1: %s\n", d_BIN);
1213:
1214: return;
1215: }
1216: else if ((*s_etat_processus).test_instruction == 'Y')
1217: {
1218: (*s_etat_processus).nombre_arguments = -1;
1219: return;
1220: }
1221:
1222: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1223: {
1224: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1225: {
1226: return;
1227: }
1228: }
1229:
1230: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1231: &s_objet) == d_erreur)
1232: {
1233: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1234: return;
1235: }
1236:
1237: if ((*s_objet).type == BIN)
1238: {
1239: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
1240: {
1241: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1242: return;
1243: }
1244:
1245: longueur = 1;
1246: j = 1;
1247:
1248: for(i = 37; i <= 42; i++)
1249: {
1250: longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
1251: == d_vrai) ? j : 0;
1252: j *= 2;
1253: }
1254:
1255: tampon = (*((logical8 *) (*s_copie).objet));
1256: tampon >>= 1;
1257:
1258: for(masque = 0, i = 0; i < longueur; i++)
1259: {
1260: masque <<= 1;
1261: masque |= 1;
1262: }
1263:
1264: tampon &= masque;
1265: (*((logical8 *) (*s_copie).objet)) = tampon;
1266:
1267: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1268: s_copie) == d_erreur)
1269: {
1270: return;
1271: }
1272: }
1273: else
1274: {
1275: liberation(s_etat_processus, s_objet);
1276:
1277: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1278: return;
1279: }
1280:
1281: liberation(s_etat_processus, s_objet);
1282:
1283: return;
1284: }
1285:
1286:
1287: /*
1288: ================================================================================
1289: Fonction 'srb'
1290: ================================================================================
1291: Entrées : pointeur sur une structure struct_processus
1292: --------------------------------------------------------------------------------
1293: Sorties :
1294: --------------------------------------------------------------------------------
1295: Effets de bord : néant
1296: ================================================================================
1297: */
1298:
1299: void
1300: instruction_srb(struct_processus *s_etat_processus)
1301: {
1302: struct_liste_chainee *l_base_pile;
1303:
1304: unsigned long i;
1305:
1306: if ((*s_etat_processus).affichage_arguments == 'Y')
1307: {
1308: printf("\n SRB ");
1309:
1310: if ((*s_etat_processus).langue == 'F')
1311: {
1312: printf("(déplacement d'un octet à droite)\n\n");
1313: }
1314: else
1315: {
1316: printf("(shift right byte)\n\n");
1317: }
1318:
1319: printf(" 1: %s\n", d_BIN);
1320: printf("-> 1: %s\n", d_BIN);
1321:
1322: return;
1323: }
1324: else if ((*s_etat_processus).test_instruction == 'Y')
1325: {
1326: (*s_etat_processus).nombre_arguments = -1;
1327: return;
1328: }
1329:
1330: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1331: {
1332: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1333: {
1334: return;
1335: }
1336: }
1337:
1338: l_base_pile = (*s_etat_processus).l_base_pile_last;
1339: (*s_etat_processus).l_base_pile_last = NULL;
1340:
1341: for(i = 0; i < 8; i++)
1342: {
1343: instruction_sr(s_etat_processus);
1344:
1345: if (((*s_etat_processus).erreur_systeme != d_es) ||
1346: ((*s_etat_processus).erreur_execution != d_ex))
1347: {
1348: break;
1349: }
1350: }
1351:
1352: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1353: {
1354: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
1355: {
1356: return;
1357: }
1358: }
1359:
1360: (*s_etat_processus).l_base_pile_last = l_base_pile;
1361: return;
1362: }
1363:
1364:
1365: /*
1366: ================================================================================
1367: Fonction 'scatter' (passe en mode d'affichage échantilloné)
1368: ================================================================================
1369: Entrées : structure processus
1370: --------------------------------------------------------------------------------
1371: Sorties :
1372: --------------------------------------------------------------------------------
1373: Effets de bord : néant
1374: ================================================================================
1375: */
1376:
1377: void
1378: instruction_scatter(struct_processus *s_etat_processus)
1379: {
1380: (*s_etat_processus).erreur_execution = d_ex;
1381:
1382: if ((*s_etat_processus).affichage_arguments == 'Y')
1383: {
1384: printf("\n SCATTER ");
1385:
1386: if ((*s_etat_processus).langue == 'F')
1387: {
1388: printf("(graphique statistique de type nuage de points)\n\n");
1389: printf(" Aucun argument\n");
1390: }
1391: else
1392: {
1393: printf("(scatter statistical graphic)\n\n");
1394: printf(" No argument\n");
1395: }
1396:
1397: return;
1398: }
1399: else if ((*s_etat_processus).test_instruction == 'Y')
1400: {
1401: (*s_etat_processus).nombre_arguments = -1;
1402: return;
1403: }
1404:
1405: strcpy((*s_etat_processus).type_trace_sigma, "POINTS");
1406:
1407: return;
1408: }
1409:
1410:
1411: /*
1412: ================================================================================
1413: Fonction '*s' (modifie les échelles verticale et horizontale)
1414: ================================================================================
1415: Entrées : structure processus
1416: --------------------------------------------------------------------------------
1417: Sorties :
1418: --------------------------------------------------------------------------------
1419: Effets de bord : néant
1420: ================================================================================
1421: */
1422:
1423: void
1424: instruction_star_s(struct_processus *s_etat_processus)
1425: {
1426: struct_objet *s_objet_argument;
1427:
1428: (*s_etat_processus).erreur_execution = d_ex;
1429:
1430: if ((*s_etat_processus).affichage_arguments == 'Y')
1431: {
1432: printf("\n *S ");
1433:
1434: if ((*s_etat_processus).langue == 'F')
1435: {
1436: printf("(multiplie les dimensions de la fenêtre graphique)\n\n");
1437: }
1438: else
1439: {
1440: printf("()\n\n");
1441: }
1442:
1443: printf(" 1: %s, %s\n", d_INT, d_REL);
1444:
1445: return;
1446: }
1447: else if ((*s_etat_processus).test_instruction == 'Y')
1448: {
1449: (*s_etat_processus).nombre_arguments = -1;
1450: return;
1451: }
1452:
1453: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1454: {
1455: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1456: {
1457: return;
1458: }
1459: }
1460:
1461: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1462: &s_objet_argument) == d_erreur)
1463: {
1464: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1465: return;
1466: }
1467:
1468: if ((*s_objet_argument).type == INT)
1469: {
1470: if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
1471: {
1472: liberation(s_etat_processus, s_objet_argument);
1473:
1474: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1475: return;
1476: }
1477:
1478: if ((*s_etat_processus).systeme_axes == 0)
1479: {
1480: (*s_etat_processus).x_min *= (real8) (*((integer8 *)
1481: (*s_objet_argument).objet));
1482: (*s_etat_processus).x_max *= (real8) (*((integer8 *)
1483: (*s_objet_argument).objet));
1484: (*s_etat_processus).y_min *= (real8) (*((integer8 *)
1485: (*s_objet_argument).objet));
1486: (*s_etat_processus).y_max *= (real8) (*((integer8 *)
1487: (*s_objet_argument).objet));
1488: (*s_etat_processus).z_min *= (real8) (*((integer8 *)
1489: (*s_objet_argument).objet));
1490: (*s_etat_processus).z_max *= (real8) (*((integer8 *)
1491: (*s_objet_argument).objet));
1492: }
1493: else
1494: {
1495: (*s_etat_processus).x2_min *= (real8) (*((integer8 *)
1496: (*s_objet_argument).objet));
1497: (*s_etat_processus).x2_max *= (real8) (*((integer8 *)
1498: (*s_objet_argument).objet));
1499: (*s_etat_processus).y2_min *= (real8) (*((integer8 *)
1500: (*s_objet_argument).objet));
1501: (*s_etat_processus).y2_max *= (real8) (*((integer8 *)
1502: (*s_objet_argument).objet));
1503: (*s_etat_processus).z2_min *= (real8) (*((integer8 *)
1504: (*s_objet_argument).objet));
1505: (*s_etat_processus).z2_max *= (real8) (*((integer8 *)
1506: (*s_objet_argument).objet));
1507: }
1508: }
1509: else if ((*s_objet_argument).type == REL)
1510: {
1511: if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
1512: {
1513: liberation(s_etat_processus, s_objet_argument);
1514:
1515: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
1516: return;
1517: }
1518:
1519: if ((*s_etat_processus).systeme_axes == 0)
1520: {
1521: (*s_etat_processus).x_min *= (*((real8 *)
1522: (*s_objet_argument).objet));
1523: (*s_etat_processus).x_max *= (*((real8 *)
1524: (*s_objet_argument).objet));
1525: (*s_etat_processus).y_min *= (*((real8 *)
1526: (*s_objet_argument).objet));
1527: (*s_etat_processus).y_max *= (*((real8 *)
1528: (*s_objet_argument).objet));
1529: (*s_etat_processus).z_min *= (*((real8 *)
1530: (*s_objet_argument).objet));
1531: (*s_etat_processus).z_max *= (*((real8 *)
1532: (*s_objet_argument).objet));
1533: }
1534: else
1535: {
1536: (*s_etat_processus).x2_min *= (*((real8 *)
1537: (*s_objet_argument).objet));
1538: (*s_etat_processus).x2_max *= (*((real8 *)
1539: (*s_objet_argument).objet));
1540: (*s_etat_processus).y2_min *= (*((real8 *)
1541: (*s_objet_argument).objet));
1542: (*s_etat_processus).y2_max *= (*((real8 *)
1543: (*s_objet_argument).objet));
1544: (*s_etat_processus).z2_min *= (*((real8 *)
1545: (*s_objet_argument).objet));
1546: (*s_etat_processus).z2_max *= (*((real8 *)
1547: (*s_objet_argument).objet));
1548: }
1549: }
1550: else
1551: {
1552: liberation(s_etat_processus, s_objet_argument);
1553:
1554: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
1555: return;
1556: }
1557:
1558: liberation(s_etat_processus, s_objet_argument);
1559:
1560: if (test_cfsf(s_etat_processus, 52) == d_faux)
1561: {
1562: if ((*s_etat_processus).fichiers_graphiques != NULL)
1563: {
1564: appel_gnuplot(s_etat_processus, 'N');
1565: }
1566: }
1567:
1568: return;
1569: }
1570:
1571:
1572: /*
1573: ================================================================================
1574: Fonction 'stos'
1575: ================================================================================
1576: Entrées : structure processus
1577: --------------------------------------------------------------------------------
1578: Sorties :
1579: --------------------------------------------------------------------------------
1580: Effets de bord : néant
1581: ================================================================================
1582: */
1583:
1584: void
1585: instruction_stos(struct_processus *s_etat_processus)
1586: {
1587: logical1 presence_variable;
1588:
1589: long i;
1590:
1591: struct_objet *s_objet;
1592:
1593: struct_variable s_variable;
1594:
1595: (*s_etat_processus).erreur_execution = d_ex;
1596:
1597: if ((*s_etat_processus).affichage_arguments == 'Y')
1598: {
1599: printf("\n STOS ");
1600:
1601: if ((*s_etat_processus).langue == 'F')
1602: {
1603: printf("(affectation de la variable %s)\n\n", ds_sdat);
1604: }
1605: else
1606: {
1607: printf("(store %s variable)\n\n", ds_sdat);
1608: }
1609:
1610: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
1611: " %s, %s, %s, %s, %s,\n"
1612: " %s, %s, %s, %s, %s,\n"
1613: " %s\n",
1614: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
1615: d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
1616:
1617: return;
1618: }
1619: else if ((*s_etat_processus).test_instruction == 'Y')
1620: {
1621: (*s_etat_processus).nombre_arguments = -1;
1622: return;
1623: }
1624:
1625: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1626: {
1627: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
1628: {
1629: return;
1630: }
1631: }
1632:
1633: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1634: &s_objet) == d_erreur)
1635: {
1636: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
1637: return;
1638: }
1639:
1640: if (recherche_variable(s_etat_processus, ds_sdat) == d_vrai)
1641: {
1642: /*
1643: * La variable préexiste. Il faut tester si celle-ci est globale
1644: * (de niveau 1).
1645: */
1646:
1647: i = (*s_etat_processus).position_variable_courante;
1648: presence_variable = d_faux;
1649:
1650: while(i >= 0)
1651: {
1652: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom, ds_sdat)
1653: == 0) && ((*s_etat_processus).s_liste_variables[i]
1654: .niveau == 1))
1655: {
1656: presence_variable = d_vrai;
1657: break;
1658: }
1659: i--;
1660: }
1661:
1662: (*s_etat_processus).position_variable_courante = i;
1663:
1664: if (presence_variable == d_vrai)
1665: {
1666: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
1667: .position_variable_courante].variable_verrouillee ==
1668: d_vrai)
1669: {
1670: liberation(s_etat_processus, s_objet);
1671:
1672: (*s_etat_processus).erreur_execution =
1673: d_ex_variable_verrouillee;
1674: return;
1675: }
1676:
1677: if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
1678: {
1679: liberation(s_etat_processus, s_objet);
1680:
1681: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
1682: return;
1683: }
1684:
1685: liberation(s_etat_processus,
1686: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
1687: .position_variable_courante].objet);
1688:
1689: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
1690: .position_variable_courante].objet = s_objet;
1691: }
1692: else
1693: {
1694: if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
1695: {
1696: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1697: return;
1698: }
1699:
1700: strcpy(s_variable.nom, ds_sdat);
1701: s_variable.niveau = 1;
1702:
1703: /*
1704: * Le niveau 0 correspond aux définitions. Les variables
1705: * commencent à 1 car elles sont toujours incluses dans
1706: * une définition.
1707: */
1708:
1709: s_variable.objet = s_objet;
1710:
1711: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
1712: == d_erreur)
1713: {
1714: return;
1715: }
1716: }
1717: }
1718: else
1719: {
1720: /*
1721: * La variable n'existe pas et on crée une variable globale.
1722: */
1723:
1724: if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
1725: {
1726: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1727: return;
1728: }
1729:
1730: strcpy(s_variable.nom, ds_sdat);
1731: s_variable.niveau = 1;
1732:
1733: /*
1734: * Le niveau 0 correspond aux définitions. Les variables
1735: * commencent à 1 car elles sont toujours incluses dans
1736: * une définition.
1737: */
1738:
1739: s_variable.objet = s_objet;
1740:
1741: if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
1742: == d_erreur)
1743: {
1744: return;
1745: }
1746:
1747: (*s_etat_processus).erreur_systeme = d_es;
1748: }
1749:
1750: return;
1751: }
1752:
1753: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_s4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src