Annotation of rpl/src/interface_cas.cpp, revision 1.4
1.1 bertrand 1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.0.prerelease.3
4: Copyright (C) 1989-2011 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:
1.2 bertrand 22:
23: #include "giac.h"
24:
1.3 bertrand 25: #undef PACKAGE
26: #undef PACKAGE_NAME
27: #undef PACKAGE_STRING
28: #undef PACKAGE_TARNAME
29: #undef PACKAGE_VERSION
30: #undef VERSION
31:
1.1 bertrand 32: extern "C"
33: {
1.3 bertrand 34: # define __RPLCAS
1.1 bertrand 35: # include "rpl-conv.h"
36: }
37:
38: #include <iostream>
39:
40: using namespace std;
1.2 bertrand 41: using namespace giac;
42:
1.1 bertrand 43:
1.4 ! bertrand 44: static unsigned char *
! 45: conversion_rpl_vers_cas(struct_processus *s_etat_processus,
! 46: struct_objet **s_objet)
! 47: {
! 48: struct_liste_chainee *l_element_courant;
! 49:
! 50: struct_objet *s_objet_temporaire;
! 51:
! 52: t_8_bits registre[8];
! 53:
! 54: unsigned char *resultat;
! 55:
! 56: for(int i = 0; i < 8; i++)
! 57: {
! 58: registre[i] = s_etat_processus->drapeaux_etat[i];
! 59: }
! 60:
! 61: cf(s_etat_processus, 48);
! 62: cf(s_etat_processus, 49);
! 63: cf(s_etat_processus, 50);
! 64: cf(s_etat_processus, 53);
! 65: cf(s_etat_processus, 54);
! 66: cf(s_etat_processus, 55);
! 67: cf(s_etat_processus, 56);
! 68:
! 69: // GIAC considère que les fonctions sont écrites en minuscules. Le RPL/2
! 70: // part de l'hypothèse inverse. Il faut donc convertir en minuscules tous
! 71: // les noms de fonction. Les fonctions ne peuvent apparaître que dans le
! 72: // cas d'un objet de type ALG.
! 73:
! 74: if ((*s_objet)->type == ALG)
! 75: {
! 76: if ((*s_objet)->nombre_occurrences > 1)
! 77: {
! 78: if ((s_objet_temporaire = copie_objet(s_etat_processus,
! 79: (*s_objet), 'O')) == NULL)
! 80: {
! 81: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
! 82: return(NULL);
! 83: }
! 84:
! 85: liberation(s_etat_processus, (*s_objet));
! 86: (*s_objet) = s_objet_temporaire;
! 87: }
! 88:
! 89: l_element_courant = reinterpret_cast<struct_liste_chainee *>(
! 90: (*s_objet)->objet);
! 91:
! 92: while(l_element_courant != NULL)
! 93: {
! 94: if (l_element_courant->donnee->type == FCT)
! 95: {
! 96: unsigned char *ptr;
! 97:
! 98: ptr = reinterpret_cast<unsigned char *>(((struct_fonction *)
! 99: l_element_courant->donnee->objet)->nom_fonction);
! 100:
! 101: while((*ptr) != d_code_fin_chaine)
! 102: {
! 103: int c = (*ptr);
! 104:
! 105: if (isalpha(c))
! 106: {
! 107: c = tolower(c);
! 108: (*ptr) = (unsigned char) c;
! 109: }
! 110:
! 111: ptr++;
! 112: }
! 113: }
! 114:
! 115: l_element_courant = l_element_courant->suivant;
! 116: }
! 117: }
! 118:
! 119: resultat = formateur(s_etat_processus, 0, (*s_objet));
! 120: resultat[0] = ' ';
! 121: resultat[strlen((const char *) resultat) - 1] = ' ';
! 122:
! 123: for(int i = 0; i < 8; i++)
! 124: {
! 125: s_etat_processus->drapeaux_etat[i] = registre[i];
! 126: }
! 127:
! 128: return(resultat);
! 129: }
! 130:
! 131:
! 132: static void
! 133: conversion_cas_vers_rpl(struct_processus *s_etat_processus,
! 134: struct_objet *s_objet)
! 135: {
! 136: struct_liste_chainee *l_element_courant;
! 137: struct_liste_chainee *l_element_precedent;
! 138:
! 139: if ((s_objet->type == ALG) || (s_objet->type == RPN))
! 140: {
! 141: // On transcrit les fonctions de GIAC vers le RPL/2.
! 142:
! 143: l_element_precedent = NULL;
! 144: l_element_courant = reinterpret_cast<struct_liste_chainee *>(
! 145: s_objet->objet);
! 146:
! 147: while(l_element_courant != NULL)
! 148: {
! 149: if (l_element_courant->donnee->type == FCT)
! 150: {
! 151: // Nous sommes en présence d'un nom, donc de quelque chose
! 152: // qui n'est pas reconnu comme un mot-clef du RPL/2. S'il
! 153: // s'agit d'un mot-clef de GIAC, on le convertit.
! 154:
! 155: if (strcmp(const_cast<const char *>(reinterpret_cast<char *>(
! 156: ((struct_fonction *) l_element_courant->donnee
! 157: ->objet)->nom_fonction)), "quote") == 0)
! 158: {
! 159: liberation(s_etat_processus, l_element_courant->donnee);
! 160:
! 161: if ((l_element_courant->donnee =
! 162: allocation(s_etat_processus, FCT)) == NULL)
! 163: {
! 164: s_etat_processus->erreur_systeme =
! 165: d_es_allocation_memoire;
! 166: return;
! 167: }
! 168:
! 169: if ((((struct_fonction *) l_element_courant->donnee->objet)
! 170: ->nom_fonction = reinterpret_cast<unsigned char *>(
! 171: malloc(6 * sizeof(unsigned char))))
! 172: == NULL)
! 173: {
! 174: s_etat_processus->erreur_systeme =
! 175: d_es_allocation_memoire;
! 176: return;
! 177: }
! 178:
! 179: strcpy(reinterpret_cast<char *>(((struct_fonction *)
! 180: l_element_courant->donnee->objet)->nom_fonction),
! 181: "RELAX");
! 182: }
! 183: }
! 184:
! 185: l_element_precedent = l_element_courant;
! 186: l_element_courant = l_element_courant->suivant;
! 187: }
! 188: }
! 189:
! 190: return;
! 191: }
! 192:
! 193:
1.1 bertrand 194: /*
195: ================================================================================
196: Fonction 'interface_cas'
197: ================================================================================
1.4 ! bertrand 198: Entrées : commande à effectuer.
! 199: Le contrôle des types est effectué dans la fonction appelant interface_cas().
1.1 bertrand 200: --------------------------------------------------------------------------------
1.4 ! bertrand 201: Sorties : retour par la pile.
1.1 bertrand 202: --------------------------------------------------------------------------------
203: Effets de bord : néant
204: ================================================================================
205: */
206:
1.3 bertrand 207: void
1.1 bertrand 208: interface_cas(struct_processus *s_etat_processus,
1.3 bertrand 209: enum t_rplcas_commandes commande)
1.1 bertrand 210: {
1.4 ! bertrand 211: struct_objet *s_objet_argument_1;
! 212: struct_objet *s_objet_argument_2;
! 213:
1.3 bertrand 214: unsigned char *argument_1;
1.4 ! bertrand 215: unsigned char *argument_2;
! 216: unsigned char *registre;
1.3 bertrand 217:
218: switch(commande)
219: {
1.4 ! bertrand 220: case RPLCAS_INTEGRATION:
! 221: {
! 222: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
! 223: &s_objet_argument_1) == d_erreur)
! 224: {
! 225: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 226: return;
! 227: }
! 228:
! 229: if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
! 230: &s_objet_argument_2) == d_erreur)
! 231: {
! 232: liberation(s_etat_processus, s_objet_argument_1);
! 233: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 234: return;
! 235: }
! 236:
! 237: if ((argument_1 = conversion_rpl_vers_cas(s_etat_processus,
! 238: &s_objet_argument_1)) == NULL)
! 239: {
! 240: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
! 241: return;
! 242: }
! 243:
! 244: if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
! 245: &s_objet_argument_2)) == NULL)
! 246: {
! 247: s_etat_processus->erreur_systeme = d_es_allocation_memoire;
! 248: return;
! 249: }
! 250:
! 251: liberation(s_etat_processus, s_objet_argument_1);
! 252: liberation(s_etat_processus, s_objet_argument_2);
! 253:
! 254: gen variable(string(reinterpret_cast<const char *>(argument_1)),
! 255: giac::context0);
! 256: gen expression(string(reinterpret_cast<const char *>(argument_2)),
! 257: giac::context0);
! 258:
! 259: free(argument_1);
! 260: free(argument_2);
! 261:
! 262: gen resultat = integrate(expression, variable, giac::context0);
! 263: string chaine = "'" + resultat.print() + "'";
! 264:
! 265: registre = s_etat_processus->instruction_courante;
! 266: s_etat_processus->instruction_courante =
! 267: reinterpret_cast<unsigned char*>(const_cast<char *>
! 268: (chaine.c_str()));
! 269:
! 270: recherche_type(s_etat_processus);
! 271:
! 272: if (s_etat_processus->l_base_pile != NULL)
! 273: {
! 274: conversion_cas_vers_rpl(s_etat_processus,
! 275: s_etat_processus->l_base_pile->donnee);
! 276: }
! 277:
! 278: s_etat_processus->instruction_courante = registre;
! 279:
! 280: break;
! 281: }
! 282:
1.3 bertrand 283: case RPLCAS_LIMITE:
284: {
285: break;
286: }
287: }
1.1 bertrand 288:
1.3 bertrand 289: return;
1.1 bertrand 290: }
291:
292: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to interface_cas.cpp CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src