--- rpl/src/instructions_f3.c 2012/10/01 11:05:04 1.50 +++ rpl/src/instructions_f3.c 2024/01/09 07:33:51 1.89 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.11 - Copyright (C) 1989-2012 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.35 + Copyright (C) 1989-2024 Dr. BERTRAND Joël This file is part of RPL/2. @@ -72,7 +72,7 @@ instruction_format(struct_processus *s_e } printf(" { \"STANDARD*(*)\" }\n"); - printf(" { { \"NAME\" \"lambda\" } \"SEQUENTIAL\" \"NEW\"" + printf(" { { \"NAME\" \"lambda\" } \"SEQUENTIAL\" \"NEW\" " "\"WRITEONLY\" \"FORMATTED\" } OPEN\n FORMAT\n\n"); if ((*s_etat_processus).langue == 'F') @@ -96,7 +96,8 @@ instruction_format(struct_processus *s_e printf(" { \"CHARACTER*(*)\" }\n"); printf(" { \"CHARACTER*(%s)\" }\n", d_INT); printf(" { \"BINARY*%s(*)\" }\n", d_INT); - printf(" { \"BINARY*%s(%s)\" }\n\n", d_INT, d_INT); + printf(" { \"BINARY*%s(%s)\" }\n", d_INT, d_INT); + printf(" { \"NATIVE*(*)\" }\n\n"); printf(" UNFORMATTED\n"); printf(" { \"INTEGER*1\", \"INTEGER*2\", \"INTEGER*4\", " @@ -105,11 +106,13 @@ instruction_format(struct_processus *s_e "\"LOGICAL*8\" }\n"); printf(" { \"REAL*4\", \"REAL*8\" }\n"); printf(" { \"COMPLEX*8\", \"COMPLEX*16\" }\n"); - printf(" { \"CHARACTER\" }\n\n"); + printf(" { \"CHARACTER*(*)\", \"CHARACTER*(%s)\" }\n", d_INT); + printf(" { \"NATIVE*(*)\" }\n\n"); printf(" FLOW\n"); printf(" { \"LENGTH*(*)\" }\n"); printf(" { \"LENGTH*(%s)\" }\n", d_INT); + printf(" { \"LINE*(*)\" }\n", d_INT); return; } @@ -540,7 +543,7 @@ instruction_fleche_q(struct_processus *s if (y != 0) { - z = fabs(objectif - (r1 / r2)); + z = abs(objectif - (r1 / r2)); x = ((real8) 1) / y; } else @@ -954,7 +957,7 @@ instruction_fleche_row(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(integer8 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(integer8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -969,7 +972,7 @@ instruction_fleche_row(struct_processus } if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(integer8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1000,7 +1003,7 @@ instruction_fleche_row(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(real8 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(real8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -1015,7 +1018,7 @@ instruction_fleche_row(struct_processus } if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1027,7 +1030,7 @@ instruction_fleche_row(struct_processus for(j = 0; j < nombre_colonnes; j++) { ((real8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i][j] = ((integer8 **) + .objet)).tableau)[i][j] = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)) .tableau)[0][j]; } @@ -1060,7 +1063,7 @@ instruction_fleche_row(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(complex16 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(complex16 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -1075,7 +1078,7 @@ instruction_fleche_row(struct_processus } if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(complex16))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1087,7 +1090,7 @@ instruction_fleche_row(struct_processus for(j = 0; j < nombre_colonnes; j++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i][j]).partie_reelle = + .objet)).tableau)[i][j]).partie_reelle = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j]; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) @@ -1349,7 +1352,7 @@ instruction_fleche_col(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(integer8 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(integer8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -1358,7 +1361,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(integer8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1398,7 +1401,7 @@ instruction_fleche_col(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(real8 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(real8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -1407,7 +1410,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1428,7 +1431,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { ((real8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i][j] = ((integer8 **) + .objet)).tableau)[i][j] = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)) .tableau)[i][0]; } @@ -1461,7 +1464,7 @@ instruction_fleche_col(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(complex16 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(complex16 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -1470,7 +1473,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(complex16))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1491,7 +1494,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i][j]).partie_reelle = + .objet)).tableau)[i][j]).partie_reelle = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0]; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) @@ -1640,28 +1643,73 @@ instruction_fleche_num(struct_processus return; } - if ((s_objet_simplifie = simplification(s_etat_processus, s_objet)) == NULL) + if (test_cfsf(s_etat_processus, 46) == d_vrai) { - if (last_valide == d_vrai) + if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur) { - sf(s_etat_processus, 31); + if (last_valide == d_vrai) + { + sf(s_etat_processus, 31); + } + + if (registre_type_evaluation == 'E') + { + sf(s_etat_processus, 35); + } + else + { + cf(s_etat_processus, 35); + } + + liberation(s_etat_processus, s_objet); + return; } - if (registre_type_evaluation == 'E') + if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), + &s_objet) == d_erreur) { - sf(s_etat_processus, 35); + if (last_valide == d_vrai) + { + sf(s_etat_processus, 31); + } + + if (registre_type_evaluation == 'E') + { + sf(s_etat_processus, 35); + } + else + { + cf(s_etat_processus, 35); + } + + (*s_etat_processus).erreur_execution = d_ex_manque_argument; + return; } - else + + if ((s_objet_simplifie = simplification(s_etat_processus, s_objet)) + == NULL) { - cf(s_etat_processus, 35); + if (last_valide == d_vrai) + { + sf(s_etat_processus, 31); + } + + if (registre_type_evaluation == 'E') + { + sf(s_etat_processus, 35); + } + else + { + cf(s_etat_processus, 35); + } + + return; } - return; + liberation(s_etat_processus, s_objet); + s_objet = s_objet_simplifie; } - liberation(s_etat_processus, s_objet); - s_objet = s_objet_simplifie; - if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur) { if (last_valide == d_vrai)