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