Annotation of rpl/src/instructions_f4.c, revision 1.1
1.1 ! bertrand 1: /*
! 2: ================================================================================
! 3: RPL/2 (R) version 4.0.9
! 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 '->table'
! 29: ================================================================================
! 30: Entrées : structure processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_fleche_table(struct_processus *s_etat_processus)
! 40: {
! 41: struct_objet *s_objet;
! 42:
! 43: signed long i;
! 44: signed long nombre_elements;
! 45:
! 46: (*s_etat_processus).erreur_execution = d_ex;
! 47:
! 48: if ((*s_etat_processus).affichage_arguments == 'Y')
! 49: {
! 50: printf("\n ->TABLE ");
! 51:
! 52: if ((*s_etat_processus).langue == 'F')
! 53: {
! 54: printf("(création d'une table)\n\n");
! 55: }
! 56: else
! 57: {
! 58: printf("(create table)\n\n");
! 59: }
! 60:
! 61: printf(" n: %s, %s, %s, %s, %s, %s,\n"
! 62: " %s, %s, %s, %s, %s,\n"
! 63: " %s, %s, %s, %s, %s,\n"
! 64: " %s, %s\n",
! 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_SLB);
! 67: printf(" ...\n");
! 68: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 69: " %s, %s, %s, %s, %s,\n"
! 70: " %s, %s, %s, %s, %s,\n"
! 71: " %s, %s\n",
! 72: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 73: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
! 74: printf(" 1: %s\n", d_INT);
! 75: printf("-> 1: %s\n", d_TAB);
! 76:
! 77: return;
! 78: }
! 79: else if ((*s_etat_processus).test_instruction == 'Y')
! 80: {
! 81: (*s_etat_processus).nombre_arguments = -1;
! 82: return;
! 83: }
! 84:
! 85: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 86: {
! 87: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 88: {
! 89: return;
! 90: }
! 91: }
! 92:
! 93: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
! 94: {
! 95: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 96: return;
! 97: }
! 98:
! 99: if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
! 100: {
! 101: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 102: return;
! 103: }
! 104:
! 105: nombre_elements = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
! 106: .donnee).objet));
! 107:
! 108: if (nombre_elements < 0)
! 109: {
! 110:
! 111: /*
! 112: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
! 113: */
! 114:
! 115: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 116: return;
! 117: }
! 118:
! 119: if ((unsigned long) nombre_elements >=
! 120: (*s_etat_processus).hauteur_pile_operationnelle)
! 121: {
! 122: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 123: return;
! 124: }
! 125:
! 126: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 127: {
! 128: if (empilement_pile_last(s_etat_processus, nombre_elements + 1)
! 129: == d_erreur)
! 130: {
! 131: return;
! 132: }
! 133: }
! 134:
! 135: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 136: &s_objet) == d_erreur)
! 137: {
! 138: return;
! 139: }
! 140:
! 141: liberation(s_etat_processus, s_objet);
! 142:
! 143: if ((s_objet = allocation(s_etat_processus, TBL)) == NULL)
! 144: {
! 145: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 146: return;
! 147: }
! 148:
! 149: (*((struct_tableau *) (*s_objet).objet)).nombre_elements =
! 150: nombre_elements;
! 151:
! 152: if (((*((struct_tableau *) (*s_objet).objet)).elements = malloc(
! 153: nombre_elements * sizeof(struct_objet *))) == NULL)
! 154: {
! 155: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 156: return;
! 157: }
! 158:
! 159: for(i = 0; i < nombre_elements; i++)
! 160: {
! 161: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 162: &((*((struct_tableau *) (*s_objet).objet)).elements
! 163: [nombre_elements - (i + 1)])) == d_erreur)
! 164: {
! 165: return;
! 166: }
! 167: }
! 168:
! 169: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 170: s_objet) == d_erreur)
! 171: {
! 172: return;
! 173: }
! 174:
! 175: return;
! 176: }
! 177:
! 178:
! 179: /*
! 180: ================================================================================
! 181: Fonction '->diag'
! 182: ================================================================================
! 183: Entrées : pointeur sur une structure struct_processus
! 184: --------------------------------------------------------------------------------
! 185: Sorties :
! 186: --------------------------------------------------------------------------------
! 187: Effets de bord : néant
! 188: ================================================================================
! 189: */
! 190:
! 191: void
! 192: instruction_fleche_diag(struct_processus *s_etat_processus)
! 193: {
! 194: struct_objet *s_objet_argument;
! 195: struct_objet *s_objet_resultat;
! 196:
! 197: unsigned long i;
! 198: unsigned long j;
! 199:
! 200: (*s_etat_processus).erreur_execution = d_ex;
! 201:
! 202: if ((*s_etat_processus).affichage_arguments == 'Y')
! 203: {
! 204: printf("\n ->DIAG ");
! 205:
! 206: if ((*s_etat_processus).langue == 'F')
! 207: {
! 208: printf("(conversion d'un vecteur en matrice diaginale)\n\n");
! 209: }
! 210: else
! 211: {
! 212: printf("(vector to diagonal matrix conversion)\n\n");
! 213: }
! 214:
! 215: printf("-> 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 216: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 217:
! 218: return;
! 219: }
! 220: else if ((*s_etat_processus).test_instruction == 'Y')
! 221: {
! 222: (*s_etat_processus).nombre_arguments = -1;
! 223: return;
! 224: }
! 225:
! 226: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 227: {
! 228: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 229: {
! 230: return;
! 231: }
! 232: }
! 233:
! 234: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 235: &s_objet_argument) == d_erreur)
! 236: {
! 237: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 238: return;
! 239: }
! 240:
! 241: /*
! 242: * Conversion d'un vecteur
! 243: */
! 244:
! 245: if ((*s_objet_argument).type == VIN)
! 246: {
! 247: if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
! 248: {
! 249: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 250: return;
! 251: }
! 252:
! 253: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 254: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
! 255: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 256: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
! 257:
! 258: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 259: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
! 260: .nombre_lignes * sizeof(integer8 *))) == NULL)
! 261: {
! 262: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 263: return;
! 264: }
! 265:
! 266: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 267: .nombre_lignes; i++)
! 268: {
! 269: if ((((integer8 **) (*((struct_matrice *)
! 270: (*s_objet_resultat).objet)).tableau)[i] =
! 271: malloc((*((struct_matrice *)
! 272: (*s_objet_resultat).objet)).nombre_colonnes *
! 273: sizeof(integer8))) == NULL)
! 274: {
! 275: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 276: return;
! 277: }
! 278:
! 279: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 280: .nombre_colonnes; j++)
! 281: {
! 282: if (i != j)
! 283: {
! 284: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 285: .objet)).tableau)[i][j] = 0;
! 286: }
! 287: else
! 288: {
! 289: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 290: .objet)).tableau)[i][j] = ((integer8 *)
! 291: (*((struct_vecteur *) (*s_objet_argument)
! 292: .objet)).tableau)[i];
! 293: }
! 294: }
! 295: }
! 296: }
! 297: else if ((*s_objet_argument).type == VRL)
! 298: {
! 299: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
! 300: {
! 301: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 302: return;
! 303: }
! 304:
! 305: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 306: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
! 307: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 308: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
! 309:
! 310: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 311: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
! 312: .nombre_lignes * sizeof(real8 *))) == NULL)
! 313: {
! 314: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 315: return;
! 316: }
! 317:
! 318: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 319: .nombre_lignes; i++)
! 320: {
! 321: if ((((real8 **) (*((struct_matrice *)
! 322: (*s_objet_resultat).objet)).tableau)[i] =
! 323: malloc((*((struct_matrice *)
! 324: (*s_objet_resultat).objet)).nombre_colonnes *
! 325: sizeof(real8))) == NULL)
! 326: {
! 327: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 328: return;
! 329: }
! 330:
! 331: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 332: .nombre_colonnes; j++)
! 333: {
! 334: if (i != j)
! 335: {
! 336: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 337: .objet)).tableau)[i][j] = 0;
! 338: }
! 339: else
! 340: {
! 341: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 342: .objet)).tableau)[i][j] = ((real8 *)
! 343: (*((struct_vecteur *) (*s_objet_argument)
! 344: .objet)).tableau)[i];
! 345: }
! 346: }
! 347: }
! 348: }
! 349: else if ((*s_objet_argument).type == VCX)
! 350: {
! 351: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 352: {
! 353: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 354: return;
! 355: }
! 356:
! 357: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 358: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
! 359: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 360: (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
! 361:
! 362: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 363: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
! 364: .nombre_lignes * sizeof(complex16 *))) == NULL)
! 365: {
! 366: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 367: return;
! 368: }
! 369:
! 370: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 371: .nombre_lignes; i++)
! 372: {
! 373: if ((((complex16 **) (*((struct_matrice *)
! 374: (*s_objet_resultat).objet)).tableau)[i] =
! 375: malloc((*((struct_matrice *)
! 376: (*s_objet_resultat).objet)).nombre_colonnes *
! 377: sizeof(complex16))) == NULL)
! 378: {
! 379: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 380: return;
! 381: }
! 382:
! 383: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 384: .nombre_colonnes; j++)
! 385: {
! 386: if (i != j)
! 387: {
! 388: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 389: .objet)).tableau)[i][j].partie_reelle = 0;
! 390: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 391: .objet)).tableau)[i][j].partie_imaginaire = 0;
! 392: }
! 393: else
! 394: {
! 395: ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
! 396: .objet)).tableau)[i][j] = ((complex16 *)
! 397: (*((struct_vecteur *) (*s_objet_argument)
! 398: .objet)).tableau)[i];
! 399: }
! 400: }
! 401: }
! 402: }
! 403:
! 404: /*
! 405: * Conversion impossible impossible
! 406: */
! 407:
! 408: else
! 409: {
! 410: liberation(s_etat_processus, s_objet_argument);
! 411:
! 412: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 413: return;
! 414: }
! 415:
! 416: liberation(s_etat_processus, s_objet_argument);
! 417:
! 418: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 419: s_objet_resultat) == d_erreur)
! 420: {
! 421: return;
! 422: }
! 423:
! 424: return;
! 425: }
! 426:
! 427: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_f4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src