![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_t3.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src|
Return to instructions_t3.c CVS log | Up to [local] / rpl / src |
1.1 bertrand 1: /*
2: ================================================================================
1.3 ! bertrand 3: RPL/2 (R) version 4.0.11
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 'trnc'
29: ================================================================================
30: Entrées : pointeur sur une structure struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_trnc(struct_processus *s_etat_processus)
40: {
41: int parametre;
42:
43: logical1 i43;
44: logical1 i44;
45: logical1 i49;
46: logical1 i50;
47: logical1 i53;
48: logical1 i54;
49: logical1 i55;
50: logical1 i56;
51:
52: struct_objet *s_objet_argument_1;
53: struct_objet *s_objet_argument_2;
54: struct_objet *s_objet_parametre;
55:
56: unsigned char *instruction_courante;
57: unsigned char *valeur_binaire;
58:
59: unsigned long i;
60: unsigned long j;
61:
62: (*s_etat_processus).erreur_execution = d_ex;
63:
64: if ((*s_etat_processus).affichage_arguments == 'Y')
65: {
66: printf("\n TRNC ");
67:
68: if ((*s_etat_processus).langue == 'F')
69: {
70: printf("(troncature)\n\n");
71: }
72: else
73: {
74: printf("(truncation)\n\n");
75: }
76:
77: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
78: " %s, %s, %s\n",
79: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX);
80: printf(" 1: %s\n", d_INT);
81: printf("-> 1: %s, %s, %s, %s, %s, %s,\n"
82: " %s, %s, %s\n",
83: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX);
84:
85: return;
86: }
87: else if ((*s_etat_processus).test_instruction == 'Y')
88: {
89: (*s_etat_processus).nombre_arguments = -1;
90: return;
91: }
92:
93: if (test_cfsf(s_etat_processus, 31) == d_vrai)
94: {
95: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
96: {
97: return;
98: }
99: }
100:
101: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
102: &s_objet_argument_1) == d_erreur)
103: {
104: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
105: return;
106: }
107:
108: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
109: &s_objet_argument_2) == d_erreur)
110: {
111: liberation(s_etat_processus, s_objet_argument_1);
112:
113: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
114: return;
115: }
116:
117: if (((*s_objet_argument_1).type == INT) &&
118: (((*s_objet_argument_2).type == INT) ||
119: ((*s_objet_argument_2).type == REL) ||
120: ((*s_objet_argument_2).type == CPL) ||
121: ((*s_objet_argument_2).type == VIN) ||
122: ((*s_objet_argument_2).type == VRL) ||
123: ((*s_objet_argument_2).type == VCX) ||
124: ((*s_objet_argument_2).type == MIN) ||
125: ((*s_objet_argument_2).type == MRL) ||
126: ((*s_objet_argument_2).type == MCX)))
127: {
128: parametre = (*((integer8 *) (*s_objet_argument_1).objet));
129:
130: if ((parametre >= -15) && (parametre <= 15))
131: {
132: if ((s_objet_parametre = allocation(s_etat_processus, BIN))
133: == NULL)
134: {
135: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
136: return;
137: }
138:
139: (*((integer8 *) (*s_objet_parametre).objet)) =
140: abs((*((integer8 *) (*s_objet_argument_1).objet)));
141:
142: i43 = test_cfsf(s_etat_processus, 43);
143: i44 = test_cfsf(s_etat_processus, 44);
144:
145: sf(s_etat_processus, 44);
146: cf(s_etat_processus, 43);
147:
148: if ((valeur_binaire = formateur(s_etat_processus, 0,
149: s_objet_parametre)) == NULL)
150: {
151: liberation(s_etat_processus, s_objet_parametre);
152:
153: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
154: return;
155: }
156:
157: liberation(s_etat_processus, s_objet_parametre);
158:
159: if (i43 == d_vrai)
160: {
161: sf(s_etat_processus, 43);
162: }
163: else
164: {
165: cf(s_etat_processus, 43);
166: }
167:
168: if (i44 == d_vrai)
169: {
170: sf(s_etat_processus, 44);
171: }
172: else
173: {
174: cf(s_etat_processus, 44);
175: }
176:
177: i53 = test_cfsf(s_etat_processus, 53);
178: i54 = test_cfsf(s_etat_processus, 54);
179: i55 = test_cfsf(s_etat_processus, 55);
180: i56 = test_cfsf(s_etat_processus, 56);
181:
182: for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
183: {
184: if (valeur_binaire[i] == '0')
185: {
186: cf(s_etat_processus, j++);
187: }
188: else
189: {
190: sf(s_etat_processus, j++);
191: }
192: }
193:
194: for(; j <= 56; cf(s_etat_processus, j++));
195:
196: free(valeur_binaire);
197:
198: i49 = test_cfsf(s_etat_processus, 49);
199: i50 = test_cfsf(s_etat_processus, 50);
200:
201: if (parametre >= 0)
202: {
203: // Troncature FIX
204: sf(s_etat_processus, 49);
205: cf(s_etat_processus, 50);
206: }
207: else
208: {
209: // Troncature SCI
210: cf(s_etat_processus, 49);
211: sf(s_etat_processus, 50);
212: }
213:
214: instruction_courante = (*s_etat_processus).instruction_courante;
215:
216: if (((*s_etat_processus).instruction_courante =
217: formateur(s_etat_processus, 0, s_objet_argument_2)) == NULL)
218: {
219: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
220: (*s_etat_processus).instruction_courante = instruction_courante;
221: return;
222: }
223:
224: if (i49 == d_vrai)
225: {
226: sf(s_etat_processus, 49);
227: }
228: else
229: {
230: cf(s_etat_processus, 49);
231: }
232:
233: if (i50 == d_vrai)
234: {
235: sf(s_etat_processus, 50);
236: }
237: else
238: {
239: cf(s_etat_processus, 50);
240: }
241:
242: if (i53 == d_vrai)
243: {
244: sf(s_etat_processus, 53);
245: }
246: else
247: {
248: cf(s_etat_processus, 53);
249: }
250:
251: if (i54 == d_vrai)
252: {
253: sf(s_etat_processus, 54);
254: }
255: else
256: {
257: cf(s_etat_processus, 54);
258: }
259:
260: if (i55 == d_vrai)
261: {
262: sf(s_etat_processus, 55);
263: }
264: else
265: {
266: cf(s_etat_processus, 55);
267: }
268:
269: if (i56 == d_vrai)
270: {
271: sf(s_etat_processus, 56);
272: }
273: else
274: {
275: cf(s_etat_processus, 56);
276: }
277:
278: recherche_type(s_etat_processus);
279:
280: free((*s_etat_processus).instruction_courante);
281: (*s_etat_processus).instruction_courante = instruction_courante;
282:
283: if ((*s_etat_processus).erreur_systeme != d_es)
284: {
285: return;
286: }
287:
288: if ((*s_etat_processus).erreur_execution != d_ex)
289: {
290: liberation(s_etat_processus, s_objet_argument_1);
291: liberation(s_etat_processus, s_objet_argument_2);
292: return;
293: }
294: }
295: else
296: {
297: liberation(s_etat_processus, s_objet_argument_1);
298: liberation(s_etat_processus, s_objet_argument_2);
299:
300: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
301: return;
302: }
303: }
304:
305: /*
306: --------------------------------------------------------------------------------
307: Fonction troncature impossible à réaliser
308: --------------------------------------------------------------------------------
309: */
310:
311: else
312: {
313: liberation(s_etat_processus, s_objet_argument_1);
314: liberation(s_etat_processus, s_objet_argument_2);
315:
316: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
317: return;
318: }
319:
320: liberation(s_etat_processus, s_objet_argument_1);
321: liberation(s_etat_processus, s_objet_argument_2);
322:
323: return;
324: }
325:
326:
327: /*
328: ================================================================================
329: Fonction 'table->'
330: ================================================================================
331: Entrées : structure processus
332: --------------------------------------------------------------------------------
333: Sorties :
334: --------------------------------------------------------------------------------
335: Effets de bord : néant
336: ================================================================================
337: */
338:
339: void
340: instruction_table_fleche(struct_processus *s_etat_processus)
341: {
342: struct_objet *s_objet;
343: struct_objet *s_objet_resultat;
344:
345: unsigned long i;
346:
347: (*s_etat_processus).erreur_execution = d_ex;
348:
349: if ((*s_etat_processus).affichage_arguments == 'Y')
350: {
351: printf("\n TABLE-> ");
352:
353: if ((*s_etat_processus).langue == 'F')
354: {
355: printf("(expansion d'une table)\n\n");
356: }
357: else
358: {
359: printf("(expand table)\n\n");
360: }
361:
362: printf(" 1: %s\n", d_TAB);
363: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
364: " %s, %s, %s, %s, %s,\n"
365: " %s, %s, %s, %s, %s,\n"
366: " %s, %s\n",
367: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
368: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
369: printf(" ...\n");
370: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
371: " %s, %s, %s, %s, %s,\n"
372: " %s, %s, %s, %s, %s,\n"
373: " %s, %s\n",
374: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
375: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
376: printf(" 1: %s\n", d_INT);
377:
378: return;
379: }
380: else if ((*s_etat_processus).test_instruction == 'Y')
381: {
382: (*s_etat_processus).nombre_arguments = -1;
383: return;
384: }
385:
386: if (test_cfsf(s_etat_processus, 31) == d_vrai)
387: {
388: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
389: {
390: return;
391: }
392: }
393:
394: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
395: &s_objet) == d_erreur)
396: {
397: return;
398: }
399:
400: if ((*s_objet).type != TBL)
401: {
402: liberation(s_etat_processus, s_objet);
403:
404: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
405: return;
406: }
407:
408: for(i = 0; i < (*((struct_tableau *) (*s_objet).objet))
409: .nombre_elements; i++)
410: {
411: if (((*((struct_tableau *) (*s_objet).objet)).elements[i] =
412: copie_objet(s_etat_processus, (*((struct_tableau *)
413: (*s_objet).objet)).elements[i], 'P')) == NULL)
414: {
415: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
416: return;
417: }
418:
419: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
420: (*((struct_tableau *) (*s_objet).objet)).elements[i])
421: == d_erreur)
422: {
423: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
424: return;
425: }
426: }
427:
428: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
429: {
430: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
431: return;
432: }
433:
434: (*((integer8 *) ((*s_objet_resultat).objet))) = (integer8)
435: (*((struct_tableau *) (*s_objet).objet)).nombre_elements;
436:
437: liberation(s_etat_processus, s_objet);
438:
439: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
440: s_objet_resultat) == d_erreur)
441: {
442: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
443: return;
444: }
445:
446: return;
447: }
448:
449:
450: /*
451: ================================================================================
452: Fonction 'trim'
453: ================================================================================
454: Entrées : pointeur sur une structure struct_processus
455: --------------------------------------------------------------------------------
456: Sorties :
457: --------------------------------------------------------------------------------
458: Effets de bord : néant
459: ================================================================================
460: */
461:
462: void
463: instruction_trim(struct_processus *s_etat_processus)
464: {
465: struct_objet *s_objet_argument;
466: struct_objet *s_objet_resultat;
467:
468: unsigned char *debut;
469: unsigned char *fin;
470:
471: (*s_etat_processus).erreur_execution = d_ex;
472:
473: if ((*s_etat_processus).affichage_arguments == 'Y')
474: {
475: printf("\n TRIM ");
476:
477: if ((*s_etat_processus).langue == 'F')
478: {
479: printf("(suppression des espaces initiaux et finaux d'une "
480: "chaîne)\n\n");
481: }
482: else
483: {
484: printf("(delete initial and final spaces from string)\n\n");
485: }
486:
487: printf(" 1: %s\n", d_CHN);
488: printf("-> 1: %s\n", d_CHN);
489:
490: return;
491: }
492: else if ((*s_etat_processus).test_instruction == 'Y')
493: {
494: (*s_etat_processus).nombre_arguments = -1;
495: return;
496: }
497:
498: if (test_cfsf(s_etat_processus, 31) == d_vrai)
499: {
500: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
501: {
502: return;
503: }
504: }
505:
506: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
507: &s_objet_argument) == d_erreur)
508: {
509: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
510: return;
511: }
512:
513: if ((*s_objet_argument).type == CHN)
514: {
515: debut = (unsigned char *) (*s_objet_argument).objet;
516:
517: while(((*debut) != d_code_fin_chaine) && ((*debut) == d_code_espace))
518: {
519: debut++;
520: }
521:
522: fin = &(((unsigned char *) (*s_objet_argument).objet)
523: [strlen((unsigned char *) (*s_objet_argument).objet) - 1]);
524:
525: while((fin > debut) && ((*fin) == d_code_espace))
526: {
527: fin--;
528: }
529:
530: (*(++fin)) = d_code_fin_chaine;
531:
532: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
533: {
534: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
535: return;
536: }
537:
538: if (((*s_objet_resultat).objet = malloc((1 + fin - debut)
539: * sizeof(unsigned char))) == NULL)
540: {
541: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
542: return;
543: }
544:
545: strcpy((unsigned char *) (*s_objet_resultat).objet, debut);
546: }
547:
548: /*
549: --------------------------------------------------------------------------------
550: Fonction TRIM impossible à réaliser
551: --------------------------------------------------------------------------------
552: */
553:
554: else
555: {
556: liberation(s_etat_processus, s_objet_argument);
557:
558: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
559: return;
560: }
561:
562: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
563: s_objet_resultat) == d_erreur)
564: {
565: return;
566: }
567:
568: liberation(s_etat_processus, s_objet_argument);
569:
570: return;
571: }
572:
573:
574: /*
575: ================================================================================
576: Fonction 'tokenize'
577: ================================================================================
578: Entrées : pointeur sur une structure struct_processus
579: --------------------------------------------------------------------------------
580: Sorties :
581: --------------------------------------------------------------------------------
582: Effets de bord : néant
583: ================================================================================
584: */
585:
586: void
587: instruction_tokenize(struct_processus *s_etat_processus)
588: {
589: struct_objet *s_objet_argument;
590: struct_objet *s_objet_resultat;
591:
592: struct_liste_chainee *l_element_courant;
593:
594: unsigned char *registre_instruction_courante;
595: unsigned char *registre_definitions_chainees;
596:
597: unsigned long registre_longueur_definitions_chainees;
598: unsigned long registre_position_courante;
599:
600: (*s_etat_processus).erreur_execution = d_ex;
601:
602: if ((*s_etat_processus).affichage_arguments == 'Y')
603: {
604: printf("\n TOKENIZE ");
605:
606: if ((*s_etat_processus).langue == 'F')
607: {
608: printf("(extraction d'objets en sous-chaînes)\n\n");
609: }
610: else
611: {
612: printf("(extract objects in substrings)\n\n");
613: }
614:
615: printf(" 1: %s\n", d_CHN);
616: printf("-> 1: %s\n", d_LST);
617:
618: return;
619: }
620: else if ((*s_etat_processus).test_instruction == 'Y')
621: {
622: (*s_etat_processus).nombre_arguments = -1;
623: return;
624: }
625:
626: if (test_cfsf(s_etat_processus, 31) == d_vrai)
627: {
628: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
629: {
630: return;
631: }
632: }
633:
634: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
635: &s_objet_argument) == d_erreur)
636: {
637: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
638: return;
639: }
640:
641: if ((*s_objet_argument).type == CHN)
642: {
643: if ((s_objet_resultat = allocation(s_etat_processus, LST)) == NULL)
644: {
645: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
646: return;
647: }
648:
649: registre_instruction_courante = (*s_etat_processus)
650: .instruction_courante;
651: registre_definitions_chainees = (*s_etat_processus)
652: .definitions_chainees;
653: registre_longueur_definitions_chainees = (*s_etat_processus)
654: .longueur_definitions_chainees;
655: registre_position_courante = (*s_etat_processus).position_courante;
656:
657: (*s_etat_processus).definitions_chainees = (unsigned char *)
658: (*s_objet_argument).objet;
659: (*s_etat_processus).longueur_definitions_chainees =
660: strlen((*s_etat_processus).definitions_chainees);
661: (*s_etat_processus).position_courante = 0;
662:
663: l_element_courant = NULL;
664:
665: while((*s_etat_processus).position_courante
666: < (*s_etat_processus).longueur_definitions_chainees)
667: {
668: if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
669: {
670: free((*s_etat_processus).instruction_courante);
671:
672: (*s_etat_processus).instruction_courante =
673: registre_instruction_courante;
674: (*s_etat_processus).definitions_chainees =
675: registre_definitions_chainees;
676: (*s_etat_processus).longueur_definitions_chainees =
677: registre_longueur_definitions_chainees;
678: (*s_etat_processus).position_courante =
679: registre_position_courante;
680:
681: liberation(s_etat_processus, s_objet_argument);
682: liberation(s_etat_processus, s_objet_resultat);
683:
684: return;
685: }
686:
687: if ((*s_etat_processus).instruction_courante[0] !=
688: d_code_fin_chaine)
689: {
690: if (l_element_courant == NULL)
691: {
692: if (((*s_objet_resultat).objet =
693: allocation_maillon(s_etat_processus)) == NULL)
694: {
695: (*s_etat_processus).erreur_systeme =
696: d_es_allocation_memoire;
697: return;
698: }
699:
700: l_element_courant = (*s_objet_resultat).objet;
701: }
702: else
703: {
704: if (((*l_element_courant).suivant =
705: allocation_maillon(s_etat_processus)) == NULL)
706: {
707: (*s_etat_processus).erreur_systeme =
708: d_es_allocation_memoire;
709: return;
710: }
711:
712: l_element_courant = (*l_element_courant).suivant;
713: }
714:
715: if (((*l_element_courant).donnee = allocation(s_etat_processus,
716: CHN)) == NULL)
717: {
718: (*s_etat_processus).erreur_systeme =
719: d_es_allocation_memoire;
720: return;
721: }
722:
723: (*(*l_element_courant).donnee).objet = (*s_etat_processus)
724: .instruction_courante;
725: (*l_element_courant).suivant = NULL;
726: }
727: else
728: {
729: free((*s_etat_processus).instruction_courante);
730: }
731: }
732:
733: (*s_etat_processus).instruction_courante =
734: registre_instruction_courante;
735: (*s_etat_processus).definitions_chainees =
736: registre_definitions_chainees;
737: (*s_etat_processus).longueur_definitions_chainees =
738: registre_longueur_definitions_chainees;
739: (*s_etat_processus).position_courante = registre_position_courante;
740: }
741:
742: /*
743: --------------------------------------------------------------------------------
744: Fonction TOKENIZE impossible à réaliser
745: --------------------------------------------------------------------------------
746: */
747:
748: else
749: {
750: liberation(s_etat_processus, s_objet_argument);
751:
752: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
753: return;
754: }
755:
756: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
757: s_objet_resultat) == d_erreur)
758: {
759: return;
760: }
761:
762: liberation(s_etat_processus, s_objet_argument);
763:
764: return;
765: }
766:
767: // vim: ts=4