![]() ![]() | ![]() |
Passage de la branche 4.1 en branche stable.
1: /* 2: ================================================================================ 3: RPL/2 (R) version 4.1.0 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: 22: 23: #include "rpl-conv.h" 24: 25: 26: /* 27: ================================================================================ 28: Fonction 'inquire' 29: ================================================================================ 30: Entrées : 31: -------------------------------------------------------------------------------- 32: Sorties : 33: -------------------------------------------------------------------------------- 34: Effets de bord : néant 35: ================================================================================ 36: */ 37: 38: void 39: instruction_inquire(struct_processus *s_etat_processus) 40: { 41: file *fichier; 42: 43: logical1 erreur; 44: logical1 existence; 45: logical1 ouverture; 46: 47: logical1 fin_fichier; 48: 49: long position_courante; 50: 51: struct_descripteur_fichier *dfichier; 52: 53: struct flock lock; 54: 55: struct_objet *s_objet_argument_1; 56: struct_objet *s_objet_argument_2; 57: struct_objet *s_objet_resultat; 58: 59: unsigned char caractere; 60: unsigned char *nom; 61: unsigned char *requete; 62: unsigned char verrou; 63: 64: unsigned long unite; 65: 66: (*s_etat_processus).erreur_execution = d_ex; 67: 68: if ((*s_etat_processus).affichage_arguments == 'Y') 69: { 70: printf("\n INQUIRE "); 71: 72: if ((*s_etat_processus).langue == 'F') 73: { 74: printf("(caractéristiques d'un fichier)\n\n"); 75: } 76: else 77: { 78: printf("(file properties)\n\n"); 79: } 80: 81: printf(" 2: %s, %s\n", d_FCH, d_CHN); 82: printf(" 1: %s\n", d_CHN); 83: printf("-> 1: %s, %s, %s\n\n", d_INT, d_CHN, d_LST); 84: 85: if ((*s_etat_processus).langue == 'F') 86: { 87: printf(" Requêtes par descripteur :\n\n"); 88: } 89: else 90: { 91: printf(" Queries by descriptor:\n\n"); 92: } 93: 94: printf(" END OF FILE : %s (true/false)\n", d_INT); 95: printf(" ACCESS : %s (SEQUENTIAL/DIRECT/KEYED)\n", d_CHN); 96: printf(" NAME : %s\n", d_CHN); 97: printf(" FORMATTED : %s (true/false)\n", d_INT); 98: printf(" KEY FIELD : %s\n", d_INT); 99: printf(" PROTECTION : %s (WRITEONLY/READONLY/READWRITE)\n\n", 100: d_CHN); 101: 102: if ((*s_etat_processus).langue == 'F') 103: { 104: printf(" Requêtes par nom :\n\n"); 105: } 106: else 107: { 108: printf(" Queries by name:\n\n"); 109: } 110: 111: printf(" FORMAT : %s\n", d_LST); 112: printf(" EXISTENCE : %s (true/false)\n", d_INT); 113: printf(" LOCK : %s (NONE/READ/WRITE)\n", d_CHN); 114: 115: return; 116: } 117: else if ((*s_etat_processus).test_instruction == 'Y') 118: { 119: (*s_etat_processus).nombre_arguments = -1; 120: return; 121: } 122: 123: if (test_cfsf(s_etat_processus, 31) == d_vrai) 124: { 125: if (empilement_pile_last(s_etat_processus, 2) == d_erreur) 126: { 127: return; 128: } 129: } 130: 131: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 132: &s_objet_argument_1) == d_erreur) 133: { 134: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 135: return; 136: } 137: 138: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 139: &s_objet_argument_2) == d_erreur) 140: { 141: liberation(s_etat_processus, s_objet_argument_1); 142: 143: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 144: return; 145: } 146: 147: if ((*s_objet_argument_1).type != CHN) 148: { 149: liberation(s_etat_processus, s_objet_argument_1); 150: liberation(s_etat_processus, s_objet_argument_2); 151: 152: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 153: return; 154: } 155: 156: if ((requete = conversion_majuscule((unsigned char *) 157: (*s_objet_argument_1).objet)) == NULL) 158: { 159: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 160: return; 161: } 162: 163: if ((*s_objet_argument_2).type == FCH) 164: { 165: /* 166: * La question porte sur un fichier ouvert. 167: */ 168: 169: if (strcmp(requete, "END OF FILE") == 0) 170: { 171: if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces 172: != 'S') 173: { 174: liberation(s_etat_processus, s_objet_argument_1); 175: liberation(s_etat_processus, s_objet_argument_2); 176: 177: free(requete); 178: 179: (*s_etat_processus).erreur_execution = 180: d_ex_erreur_requete_fichier; 181: return; 182: } 183: 184: if ((s_objet_resultat = allocation(s_etat_processus, INT)) 185: == NULL) 186: { 187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 188: return; 189: } 190: 191: /* 192: * La fin du fichier renvoyée ne correspond pas à la fin physique 193: * du fichier mais à un défaut d'enregistrement. 194: */ 195: 196: if ((dfichier = descripteur_fichier(s_etat_processus, 197: (struct_fichier *) (*s_objet_argument_2).objet)) == NULL) 198: { 199: return; 200: } 201: 202: if ((*dfichier).type != 'C') 203: { 204: liberation(s_etat_processus, s_objet_argument_1); 205: liberation(s_etat_processus, s_objet_argument_2); 206: 207: free(requete); 208: 209: (*s_etat_processus).erreur_execution = d_ex_erreur_type_fichier; 210: return; 211: } 212: 213: if ((position_courante = ftell((*dfichier).descripteur_c)) == -1) 214: { 215: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; 216: return; 217: } 218: 219: fin_fichier = d_vrai; 220: 221: while(feof((*dfichier).descripteur_c) == 0) 222: { 223: if (fread(&caractere, sizeof(unsigned char), (size_t) 1, 224: (*dfichier).descripteur_c) > 0) 225: { 226: if (caractere == '{') 227: { 228: fin_fichier = d_faux; 229: break; 230: } 231: } 232: } 233: 234: if (fseek((*dfichier).descripteur_c, position_courante, SEEK_SET) 235: != 0) 236: { 237: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; 238: return; 239: } 240: 241: if (fin_fichier == d_faux) 242: { 243: /* 244: * Fichier à suivre 245: */ 246: 247: (*((integer8 *) (*s_objet_resultat).objet)) = 0; 248: } 249: else 250: { 251: /* 252: * Fin de fichier 253: */ 254: 255: (*((integer8 *) (*s_objet_resultat).objet)) = -1; 256: } 257: } 258: else if (strcmp(requete, "ACCESS") == 0) 259: { 260: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) 261: == NULL) 262: { 263: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 264: return; 265: } 266: 267: if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces 268: == 'S') 269: { 270: if (((*s_objet_resultat).objet = malloc(11 * 271: sizeof(unsigned char))) == NULL) 272: { 273: (*s_etat_processus).erreur_systeme = 274: d_es_allocation_memoire; 275: return; 276: } 277: 278: strcpy((unsigned char *) (*s_objet_resultat).objet, 279: "SEQUENTIAL"); 280: } 281: else if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces 282: == 'D') 283: { 284: if (((*s_objet_resultat).objet = malloc(7 * 285: sizeof(unsigned char))) == NULL) 286: { 287: (*s_etat_processus).erreur_systeme = 288: d_es_allocation_memoire; 289: return; 290: } 291: 292: strcpy((unsigned char *) (*s_objet_resultat).objet, 293: "DIRECT"); 294: } 295: else 296: { 297: if (((*s_objet_resultat).objet = malloc(6 * 298: sizeof(unsigned char))) == NULL) 299: { 300: (*s_etat_processus).erreur_systeme = 301: d_es_allocation_memoire; 302: return; 303: } 304: 305: strcpy((unsigned char *) (*s_objet_resultat).objet, 306: "KEYED"); 307: } 308: } 309: else if (strcmp(requete, "NAME") == 0) 310: { 311: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) 312: == NULL) 313: { 314: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 315: return; 316: } 317: 318: if (((*s_objet_resultat).objet = malloc( 319: (strlen((*((struct_fichier *) (*s_objet_argument_2).objet)) 320: .nom) + 1) * 321: sizeof(unsigned char))) == NULL) 322: { 323: (*s_etat_processus).erreur_systeme = 324: d_es_allocation_memoire; 325: return; 326: } 327: 328: strcpy((unsigned char *) (*s_objet_resultat).objet, 329: (*((struct_fichier *) (*s_objet_argument_2).objet)).nom); 330: } 331: else if (strcmp(requete, "FORMATTED") == 0) 332: { 333: if ((s_objet_resultat = allocation(s_etat_processus, INT)) 334: == NULL) 335: { 336: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 337: return; 338: } 339: 340: (*((integer8 *) (*s_objet_resultat).objet)) = 341: ((*((struct_fichier *) (*s_objet_argument_2).objet)).binaire 342: == 'N') ? -1 : 0; 343: } 344: else if (strcmp(requete, "KEY FIELD") == 0) 345: { 346: if ((*((struct_fichier *) (*s_objet_argument_2).objet)) 347: .acces == 'S') 348: { 349: free(requete); 350: 351: liberation(s_etat_processus, s_objet_argument_1); 352: liberation(s_etat_processus, s_objet_argument_2); 353: 354: (*s_etat_processus).erreur_execution = 355: d_ex_erreur_requete_fichier; 356: return; 357: } 358: 359: if ((s_objet_resultat = allocation(s_etat_processus, INT)) 360: == NULL) 361: { 362: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 363: return; 364: } 365: 366: (*((integer8 *) (*s_objet_resultat).objet)) = 367: (*((struct_fichier *) (*s_objet_argument_2).objet)) 368: .position_clef; 369: } 370: else if (strcmp(requete, "PROTECTION") == 0) 371: { 372: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) 373: == NULL) 374: { 375: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 376: return; 377: } 378: 379: if ((*((struct_fichier *) (*s_objet_argument_2).objet)).protection 380: == 'W') 381: { 382: if (((*s_objet_resultat).objet = malloc(10 * 383: sizeof(unsigned char))) == NULL) 384: { 385: (*s_etat_processus).erreur_systeme = 386: d_es_allocation_memoire; 387: return; 388: } 389: 390: strcpy((unsigned char *) (*s_objet_argument_2).objet, 391: "WRITEONLY"); 392: } 393: else if ((*((struct_fichier *) (*s_objet_argument_2).objet)).acces 394: == 'R') 395: { 396: if (((*s_objet_resultat).objet = malloc(9 * 397: sizeof(unsigned char))) == NULL) 398: { 399: (*s_etat_processus).erreur_systeme = 400: d_es_allocation_memoire; 401: return; 402: } 403: 404: strcpy((unsigned char *) (*s_objet_argument_2).objet, 405: "READONLY"); 406: } 407: else 408: { 409: if (((*s_objet_resultat).objet = malloc(10 * 410: sizeof(unsigned char))) == NULL) 411: { 412: (*s_etat_processus).erreur_systeme = 413: d_es_allocation_memoire; 414: return; 415: } 416: 417: strcpy((unsigned char *) (*s_objet_resultat).objet, 418: "READWRITE"); 419: } 420: } 421: else if (strcmp(requete, "FORMAT") == 0) 422: { 423: if ((s_objet_resultat = copie_objet(s_etat_processus, 424: (*((struct_fichier *) (*s_objet_argument_2).objet)).format, 425: 'O')) == NULL) 426: { 427: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 428: return; 429: } 430: } 431: else 432: { 433: free(requete); 434: 435: liberation(s_etat_processus, s_objet_argument_1); 436: liberation(s_etat_processus, s_objet_argument_2); 437: 438: (*s_etat_processus).erreur_execution = d_ex_erreur_requete_fichier; 439: return; 440: } 441: } 442: else if ((*s_objet_argument_2).type == CHN) 443: { 444: /* 445: * La question porte sur un fichier fermé. 446: */ 447: 448: if ((nom = transliteration(s_etat_processus, 449: (unsigned char *) (*s_objet_argument_2).objet, 450: d_locale, "UTF-8")) == NULL) 451: { 452: liberation(s_etat_processus, s_objet_argument_1); 453: liberation(s_etat_processus, s_objet_argument_2); 454: return; 455: } 456: 457: if (strcmp(requete, "EXISTENCE") == 0) 458: { 459: erreur = caracteristiques_fichier(s_etat_processus, nom, 460: &existence, &ouverture, &unite); 461: 462: if (erreur != d_absence_erreur) 463: { 464: free(nom); 465: free(requete); 466: 467: liberation(s_etat_processus, s_objet_argument_1); 468: liberation(s_etat_processus, s_objet_argument_2); 469: 470: (*s_etat_processus).erreur_execution = 471: d_ex_erreur_acces_fichier; 472: return; 473: } 474: 475: if ((s_objet_resultat = allocation(s_etat_processus, INT)) 476: == NULL) 477: { 478: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 479: return; 480: } 481: 482: if (existence == d_faux) 483: { 484: /* 485: * Fichier inexistant 486: */ 487: 488: (*((integer8 *) (*s_objet_resultat).objet)) = 0; 489: } 490: else 491: { 492: /* 493: * Fichier existant 494: */ 495: 496: (*((integer8 *) (*s_objet_resultat).objet)) = -1; 497: } 498: } 499: else if (strcmp(requete, "LOCK") == 0) 500: { 501: erreur = caracteristiques_fichier(s_etat_processus, nom, 502: &existence, &ouverture, &unite); 503: 504: if (erreur != d_absence_erreur) 505: { 506: free(requete); 507: free(nom); 508: 509: liberation(s_etat_processus, s_objet_argument_1); 510: liberation(s_etat_processus, s_objet_argument_2); 511: 512: (*s_etat_processus).erreur_execution = 513: d_ex_erreur_acces_fichier; 514: return; 515: } 516: 517: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) 518: == NULL) 519: { 520: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 521: return; 522: } 523: 524: if (existence == d_faux) 525: { 526: /* 527: * Fichier inexistant 528: */ 529: 530: free(requete); 531: free(nom); 532: 533: liberation(s_etat_processus, s_objet_argument_1); 534: liberation(s_etat_processus, s_objet_argument_2); 535: liberation(s_etat_processus, s_objet_resultat); 536: 537: (*s_etat_processus).erreur_execution = 538: d_ex_erreur_acces_fichier; 539: return; 540: } 541: else 542: { 543: /* 544: * Fichier existant 545: */ 546: 547: if ((fichier = fopen(nom, "r+")) == NULL) 548: { 549: free(requete); 550: free(nom); 551: 552: liberation(s_etat_processus, s_objet_argument_1); 553: liberation(s_etat_processus, s_objet_argument_2); 554: liberation(s_etat_processus, s_objet_resultat); 555: 556: (*s_etat_processus).erreur_execution = 557: d_ex_erreur_acces_fichier; 558: return; 559: } 560: 561: lock.l_whence = SEEK_SET; 562: lock.l_start = 0; 563: lock.l_len = 0; 564: lock.l_pid = getpid(); 565: lock.l_type = F_RDLCK; 566: 567: if (fcntl(fileno(fichier), F_GETLK, &lock) == -1) 568: { 569: free(nom); 570: 571: if (fclose(fichier) != 0) 572: { 573: free(requete); 574: 575: liberation(s_etat_processus, s_objet_argument_1); 576: liberation(s_etat_processus, s_objet_argument_2); 577: liberation(s_etat_processus, s_objet_resultat); 578: 579: (*s_etat_processus).erreur_systeme = 580: d_es_erreur_fichier; 581: return; 582: } 583: 584: free(requete); 585: 586: liberation(s_etat_processus, s_objet_argument_1); 587: liberation(s_etat_processus, s_objet_argument_2); 588: liberation(s_etat_processus, s_objet_resultat); 589: 590: (*s_etat_processus).erreur_systeme = 591: d_es_erreur_fichier; 592: return; 593: } 594: 595: if (lock.l_type == F_UNLCK) 596: { 597: verrou = 'N'; 598: } 599: else 600: { 601: verrou = 'R'; 602: } 603: 604: if (verrou == 'N') 605: { 606: lock.l_type = F_WRLCK; 607: 608: if (fcntl(fileno(fichier), F_GETLK, &lock) == -1) 609: { 610: free(nom); 611: 612: if (fclose(fichier) != 0) 613: { 614: free(requete); 615: 616: liberation(s_etat_processus, s_objet_argument_1); 617: liberation(s_etat_processus, s_objet_argument_2); 618: liberation(s_etat_processus, s_objet_resultat); 619: 620: (*s_etat_processus).erreur_systeme = 621: d_es_erreur_fichier; 622: return; 623: } 624: 625: free(requete); 626: 627: liberation(s_etat_processus, s_objet_argument_1); 628: liberation(s_etat_processus, s_objet_argument_2); 629: liberation(s_etat_processus, s_objet_resultat); 630: 631: (*s_etat_processus).erreur_systeme = 632: d_es_erreur_fichier; 633: return; 634: } 635: 636: if (lock.l_type == F_UNLCK) 637: { 638: verrou = 'N'; 639: } 640: else 641: { 642: verrou = 'W'; 643: } 644: } 645: 646: switch(verrou) 647: { 648: case 'N' : 649: { 650: if (((*s_objet_resultat).objet = 651: malloc(5 * sizeof(unsigned char))) == NULL) 652: { 653: (*s_etat_processus).erreur_systeme = 654: d_es_allocation_memoire; 655: return; 656: } 657: 658: strcpy((unsigned char *) (*s_objet_resultat).objet, 659: "NONE"); 660: 661: break; 662: } 663: 664: case 'R' : 665: { 666: if (((*s_objet_resultat).objet = 667: malloc(5 * sizeof(unsigned char))) == NULL) 668: { 669: (*s_etat_processus).erreur_systeme = 670: d_es_allocation_memoire; 671: return; 672: } 673: 674: strcpy((unsigned char *) (*s_objet_resultat).objet, 675: "READ"); 676: 677: break; 678: } 679: 680: case 'W' : 681: { 682: if (((*s_objet_resultat).objet = 683: malloc(6 * sizeof(unsigned char))) == NULL) 684: { 685: (*s_etat_processus).erreur_systeme = 686: d_es_allocation_memoire; 687: return; 688: } 689: 690: strcpy((unsigned char *) (*s_objet_resultat).objet, 691: "WRITE"); 692: 693: break; 694: } 695: } 696: 697: if (fclose(fichier) != 0) 698: { 699: free(requete); 700: free(nom); 701: 702: liberation(s_etat_processus, s_objet_argument_1); 703: liberation(s_etat_processus, s_objet_argument_2); 704: liberation(s_etat_processus, s_objet_resultat); 705: 706: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier; 707: return; 708: } 709: } 710: } 711: else 712: { 713: free(nom); 714: free(requete); 715: 716: liberation(s_etat_processus, s_objet_argument_1); 717: liberation(s_etat_processus, s_objet_argument_2); 718: 719: (*s_etat_processus).erreur_execution = d_ex_erreur_requete_fichier; 720: return; 721: } 722: 723: free(nom); 724: } 725: else 726: { 727: free(requete); 728: 729: liberation(s_etat_processus, s_objet_argument_1); 730: liberation(s_etat_processus, s_objet_argument_2); 731: 732: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 733: return; 734: } 735: 736: free(requete); 737: 738: liberation(s_etat_processus, s_objet_argument_1); 739: liberation(s_etat_processus, s_objet_argument_2); 740: 741: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 742: s_objet_resultat) == d_erreur) 743: { 744: return; 745: } 746: 747: return; 748: } 749: 750: 751: /* 752: ================================================================================ 753: Fonction 'IDFT' 754: ================================================================================ 755: Entrées : structure processus 756: -------------------------------------------------------------------------------- 757: Sorties : 758: -------------------------------------------------------------------------------- 759: Effets de bord : néant 760: ================================================================================ 761: */ 762: 763: void 764: instruction_idft(struct_processus *s_etat_processus) 765: { 766: integer4 erreur; 767: integer4 inverse; 768: integer4 nombre_colonnes; 769: integer4 nombre_lignes; 770: 771: logical1 presence_longueur_dft; 772: 773: long longueur_dft_signee; 774: 775: struct_complexe16 *matrice_f77; 776: 777: struct_objet *s_objet_argument; 778: struct_objet *s_objet_longueur_dft; 779: struct_objet *s_objet_resultat; 780: 781: unsigned long i; 782: unsigned long j; 783: unsigned long k; 784: unsigned long longueur_dft; 785: 786: (*s_etat_processus).erreur_execution = d_ex; 787: 788: if ((*s_etat_processus).affichage_arguments == 'Y') 789: { 790: printf("\n IDFT "); 791: 792: if ((*s_etat_processus).langue == 'F') 793: { 794: printf("(transformée de Fourier inverse discrète)\n\n"); 795: } 796: else 797: { 798: printf("(inverse of discrete Fourier transform)\n\n"); 799: } 800: 801: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX); 802: printf("-> 1: %s\n\n", d_VCX); 803: 804: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX); 805: printf(" 1: %s\n", d_INT); 806: printf("-> 1: %s\n\n", d_VCX); 807: 808: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 809: printf("-> 1: %s\n\n", d_VCX); 810: 811: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); 812: printf(" 1: %s\n", d_INT); 813: printf("-> 1: %s\n", d_MCX); 814: 815: return; 816: } 817: else if ((*s_etat_processus).test_instruction == 'Y') 818: { 819: (*s_etat_processus).nombre_arguments = -1; 820: return; 821: } 822: 823: /* 824: * Il est possible d'imposer une longueur de DFT au premier niveau 825: * de la pile. 826: */ 827: 828: if ((*s_etat_processus).l_base_pile == NULL) 829: { 830: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 831: return; 832: } 833: 834: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT) 835: { 836: presence_longueur_dft = d_vrai; 837: 838: if (test_cfsf(s_etat_processus, 31) == d_vrai) 839: { 840: if (empilement_pile_last(s_etat_processus, 2) == d_erreur) 841: { 842: return; 843: } 844: } 845: 846: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 847: &s_objet_longueur_dft) == d_erreur) 848: { 849: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 850: return; 851: } 852: 853: longueur_dft_signee = (*((integer8 *) (*s_objet_longueur_dft).objet)); 854: 855: liberation(s_etat_processus, s_objet_longueur_dft); 856: 857: if (longueur_dft_signee <= 0) 858: { 859: (*s_etat_processus).erreur_execution = d_ex_longueur_dft; 860: return; 861: } 862: 863: longueur_dft = longueur_dft_signee; 864: } 865: else 866: { 867: presence_longueur_dft = d_faux; 868: longueur_dft = 0; 869: 870: if (test_cfsf(s_etat_processus, 31) == d_vrai) 871: { 872: if (empilement_pile_last(s_etat_processus, 1) == d_erreur) 873: { 874: return; 875: } 876: } 877: } 878: 879: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 880: &s_objet_argument) == d_erreur) 881: { 882: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 883: return; 884: } 885: 886: /* 887: -------------------------------------------------------------------------------- 888: Vecteur 889: -------------------------------------------------------------------------------- 890: */ 891: 892: if (((*s_objet_argument).type == VIN) || 893: ((*s_objet_argument).type == VRL) || 894: ((*s_objet_argument).type == VCX)) 895: { 896: if (presence_longueur_dft == d_faux) 897: { 898: longueur_dft = (*((struct_vecteur *) 899: (*s_objet_argument).objet)).taille; 900: } 901: 902: if ((matrice_f77 = malloc(longueur_dft * 903: sizeof(struct_complexe16))) == NULL) 904: { 905: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 906: return; 907: } 908: 909: if ((*s_objet_argument).type == VIN) 910: { 911: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)) 912: .taille; i++) 913: { 914: matrice_f77[i].partie_reelle = (real8) ((integer8 *) 915: (*((struct_vecteur *) (*s_objet_argument).objet)) 916: .tableau)[i]; 917: matrice_f77[i].partie_imaginaire = (real8) 0; 918: } 919: } 920: else if ((*s_objet_argument).type == VRL) 921: { 922: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)) 923: .taille; i++) 924: { 925: matrice_f77[i].partie_reelle = ((real8 *) 926: (*((struct_vecteur *) (*s_objet_argument).objet)) 927: .tableau)[i]; 928: matrice_f77[i].partie_imaginaire = (real8) 0; 929: } 930: } 931: else 932: { 933: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)) 934: .taille; i++) 935: { 936: matrice_f77[i].partie_reelle = ((struct_complexe16 *) 937: (*((struct_vecteur *) (*s_objet_argument).objet)) 938: .tableau)[i].partie_reelle; 939: matrice_f77[i].partie_imaginaire = ((struct_complexe16 *) 940: (*((struct_vecteur *) (*s_objet_argument).objet)) 941: .tableau)[i].partie_imaginaire; 942: } 943: } 944: 945: for(; i < longueur_dft; i++) 946: { 947: matrice_f77[i].partie_reelle = (real8) 0; 948: matrice_f77[i].partie_imaginaire = (real8) 0; 949: } 950: 951: nombre_lignes = 1; 952: nombre_colonnes = longueur_dft; 953: inverse = -1; 954: 955: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur); 956: 957: if (erreur != 0) 958: { 959: liberation(s_etat_processus, s_objet_argument); 960: free(matrice_f77); 961: 962: (*s_etat_processus).erreur_execution = d_ex_longueur_dft; 963: return; 964: } 965: 966: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL) 967: { 968: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 969: return; 970: } 971: 972: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_dft; 973: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77; 974: } 975: 976: /* 977: -------------------------------------------------------------------------------- 978: Matrice 979: -------------------------------------------------------------------------------- 980: */ 981: 982: else if (((*s_objet_argument).type == MIN) || 983: ((*s_objet_argument).type == MRL) || 984: ((*s_objet_argument).type == MCX)) 985: { 986: if (presence_longueur_dft == d_faux) 987: { 988: longueur_dft = (*((struct_matrice *) 989: (*s_objet_argument).objet)).nombre_colonnes; 990: } 991: 992: if ((matrice_f77 = malloc(longueur_dft * 993: (*((struct_matrice *) (*s_objet_argument).objet)) 994: .nombre_lignes * sizeof(struct_complexe16))) == NULL) 995: { 996: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 997: return; 998: } 999: 1000: if ((*s_objet_argument).type == MIN) 1001: { 1002: for(k = 0, j = 0; j < (*((struct_matrice *) (*s_objet_argument) 1003: .objet)).nombre_lignes; j++) 1004: { 1005: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument) 1006: .objet)).nombre_colonnes; i++) 1007: { 1008: matrice_f77[k].partie_reelle = (real8) ((integer8 **) 1009: (*((struct_matrice *) (*s_objet_argument).objet)) 1010: .tableau)[j][i]; 1011: matrice_f77[k++].partie_imaginaire = (real8) 0; 1012: } 1013: } 1014: 1015: for(; k < longueur_dft * (*((struct_matrice *) (*s_objet_argument) 1016: .objet)).nombre_lignes; k++) 1017: { 1018: matrice_f77[k].partie_reelle = (real8) 0; 1019: matrice_f77[k].partie_imaginaire = (real8) 0; 1020: } 1021: } 1022: else if ((*s_objet_argument).type == MRL) 1023: { 1024: for(k = 0, j = 0; j < (*((struct_matrice *) (*s_objet_argument) 1025: .objet)).nombre_lignes; j++) 1026: { 1027: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument) 1028: .objet)).nombre_colonnes; i++) 1029: { 1030: matrice_f77[k].partie_reelle = ((real8 **) 1031: (*((struct_matrice *) (*s_objet_argument).objet)) 1032: .tableau)[j][i]; 1033: matrice_f77[k++].partie_imaginaire = (real8) 0; 1034: } 1035: } 1036: 1037: for(; k < longueur_dft * (*((struct_matrice *) (*s_objet_argument) 1038: .objet)).nombre_lignes; k++) 1039: { 1040: matrice_f77[k].partie_reelle = (real8) 0; 1041: matrice_f77[k].partie_imaginaire = (real8) 0; 1042: } 1043: } 1044: else 1045: { 1046: for(k = 0, j = 0; j < (*((struct_matrice *) (*s_objet_argument) 1047: .objet)).nombre_lignes; j++) 1048: { 1049: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument) 1050: .objet)).nombre_colonnes; i++) 1051: { 1052: matrice_f77[k].partie_reelle = ((struct_complexe16 **) 1053: (*((struct_matrice *) (*s_objet_argument).objet)) 1054: .tableau)[j][i].partie_reelle; 1055: matrice_f77[k++].partie_imaginaire = 1056: ((struct_complexe16 **) (*((struct_matrice *) 1057: (*s_objet_argument).objet)).tableau)[j][i] 1058: .partie_imaginaire; 1059: } 1060: } 1061: 1062: for(; k < longueur_dft * (*((struct_matrice *) (*s_objet_argument) 1063: .objet)).nombre_lignes; k++) 1064: { 1065: matrice_f77[k].partie_reelle = (real8) 0; 1066: matrice_f77[k].partie_imaginaire = (real8) 0; 1067: } 1068: } 1069: 1070: nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet)) 1071: .nombre_lignes; 1072: nombre_colonnes = longueur_dft; 1073: inverse = -1; 1074: 1075: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur); 1076: 1077: if (erreur != 0) 1078: { 1079: liberation(s_etat_processus, s_objet_argument); 1080: free(matrice_f77); 1081: 1082: (*s_etat_processus).erreur_execution = d_ex_longueur_dft; 1083: return; 1084: } 1085: 1086: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL) 1087: { 1088: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 1089: return; 1090: } 1091: 1092: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes = 1093: (*((struct_matrice *) (*s_objet_argument).objet)) 1094: .nombre_lignes; 1095: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes = 1096: longueur_dft; 1097: 1098: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = 1099: malloc((*((struct_matrice *) (*s_objet_resultat).objet)) 1100: .nombre_lignes * sizeof(struct_complexe16 *))) == NULL) 1101: { 1102: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 1103: return; 1104: } 1105: 1106: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet)) 1107: .nombre_lignes; i++) 1108: { 1109: if ((((struct_complexe16 **) (*((struct_matrice *) 1110: (*s_objet_resultat).objet)).tableau)[i] = 1111: malloc((*((struct_matrice *) 1112: (*s_objet_resultat).objet)).nombre_colonnes * 1113: sizeof(struct_complexe16))) == NULL) 1114: { 1115: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 1116: return; 1117: } 1118: } 1119: 1120: for(k = 0, j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet)) 1121: .nombre_lignes; j++) 1122: { 1123: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet)) 1124: .nombre_colonnes; i++) 1125: { 1126: ((struct_complexe16 **) (*((struct_matrice *) 1127: (*s_objet_resultat).objet)).tableau)[j][i] 1128: .partie_reelle = matrice_f77[k].partie_reelle; 1129: ((struct_complexe16 **) (*((struct_matrice *) 1130: (*s_objet_resultat).objet)).tableau)[j][i] 1131: .partie_imaginaire = matrice_f77[k++].partie_imaginaire; 1132: } 1133: } 1134: 1135: free(matrice_f77); 1136: } 1137: 1138: /* 1139: -------------------------------------------------------------------------------- 1140: Calcul de DFT impossible 1141: -------------------------------------------------------------------------------- 1142: */ 1143: 1144: else 1145: { 1146: liberation(s_etat_processus, s_objet_argument); 1147: 1148: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 1149: return; 1150: } 1151: 1152: liberation(s_etat_processus, s_objet_argument); 1153: 1154: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 1155: s_objet_resultat) == d_erreur) 1156: { 1157: return; 1158: } 1159: 1160: return; 1161: } 1162: 1163: 1164: /* 1165: ================================================================================ 1166: Fonction 'ISWI' 1167: ================================================================================ 1168: Entrées : structure processus 1169: -------------------------------------------------------------------------------- 1170: Sorties : 1171: -------------------------------------------------------------------------------- 1172: Effets de bord : néant 1173: ================================================================================ 1174: */ 1175: 1176: void 1177: instruction_iswi(struct_processus *s_etat_processus) 1178: { 1179: (*s_etat_processus).erreur_execution = d_ex; 1180: 1181: if ((*s_etat_processus).affichage_arguments == 'Y') 1182: { 1183: printf("\n ISWI "); 1184: 1185: if ((*s_etat_processus).langue == 'F') 1186: { 1187: printf("(autorise le traitement interruptif des interruptions)" 1188: "\n\n"); 1189: printf(" Aucun argument\n"); 1190: } 1191: else 1192: { 1193: printf("(authorize interrupts called from interrupts)\n\n"); 1194: printf(" No argument\n"); 1195: } 1196: 1197: return; 1198: } 1199: else if ((*s_etat_processus).test_instruction == 'Y') 1200: { 1201: (*s_etat_processus).nombre_arguments = -1; 1202: return; 1203: } 1204: 1205: if (test_cfsf(s_etat_processus, 31) == d_vrai) 1206: { 1207: if (empilement_pile_last(s_etat_processus, 0) == d_erreur) 1208: { 1209: return; 1210: } 1211: } 1212: 1213: if ((*s_etat_processus).traitement_interruption == 'Y') 1214: { 1215: (*s_etat_processus).traitement_interruption = 'N'; 1216: } 1217: else 1218: { 1219: (*s_etat_processus).erreur_execution = d_ex_iswi_hors_interruption; 1220: } 1221: 1222: return; 1223: } 1224: 1225: 1226: /* 1227: ================================================================================ 1228: Fonction 'ITRACE' 1229: ================================================================================ 1230: Entrées : structure processus 1231: -------------------------------------------------------------------------------- 1232: Sorties : 1233: -------------------------------------------------------------------------------- 1234: Effets de bord : néant 1235: ================================================================================ 1236: */ 1237: 1238: void 1239: instruction_itrace(struct_processus *s_etat_processus) 1240: { 1241: struct_objet *s_objet_argument; 1242: 1243: (*s_etat_processus).erreur_execution = d_ex; 1244: 1245: if ((*s_etat_processus).affichage_arguments == 'Y') 1246: { 1247: printf("\n ITRACE "); 1248: 1249: if ((*s_etat_processus).langue == 'F') 1250: { 1251: printf("(trace interne)" 1252: "\n\n"); 1253: } 1254: else 1255: { 1256: printf("(internal trace)\n\n"); 1257: } 1258: 1259: printf(" 1: %s\n\n", d_BIN); 1260: 1261: if ((*s_etat_processus).langue == 'F') 1262: { 1263: printf(" Drapeaux :\n\n"); 1264: } 1265: else 1266: { 1267: printf(" Flags:\n\n"); 1268: } 1269: 1270: printf(" 0000 : none\n"); 1271: printf(" 0001 : user stack\n"); 1272: printf(" 0002 : system stack\n"); 1273: printf(" 0004 : function calls\n"); 1274: printf(" 0008 : process management\n"); 1275: printf(" 0010 : analyze\n"); 1276: printf(" 0020 : fuse management\n"); 1277: printf(" 0040 : variables management\n"); 1278: printf(" 0080 : intrinsic functions\n"); 1279: printf(" 0100 : execution levels\n"); 1280: printf(" 0200 : algebraic to RPN conversion\n"); 1281: printf(" 0400 : interruptions supervision\n"); 1282: printf(" 0800 : signals\n"); 1283: 1284: return; 1285: } 1286: else if ((*s_etat_processus).test_instruction == 'Y') 1287: { 1288: (*s_etat_processus).nombre_arguments = -1; 1289: return; 1290: } 1291: 1292: if (test_cfsf(s_etat_processus, 31) == d_vrai) 1293: { 1294: if (empilement_pile_last(s_etat_processus, 1) == d_erreur) 1295: { 1296: return; 1297: } 1298: } 1299: 1300: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 1301: &s_objet_argument) == d_erreur) 1302: { 1303: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 1304: return; 1305: } 1306: 1307: if ((*s_objet_argument).type == BIN) 1308: { 1309: if ((*((logical8 *) (*s_objet_argument).objet)) == 0) 1310: { 1311: (*s_etat_processus).debug = d_faux; 1312: (*s_etat_processus).type_debug = 0; 1313: } 1314: else 1315: { 1316: (*s_etat_processus).debug = d_vrai; 1317: (*s_etat_processus).type_debug = (*((logical8 *) 1318: (*s_objet_argument).objet)); 1319: } 1320: } 1321: else 1322: { 1323: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 1324: liberation(s_etat_processus, s_objet_argument); 1325: } 1326: 1327: return; 1328: } 1329: 1330: 1331: // vim: ts=4