--- rpl/src/instructions_t1.c 2010/03/04 10:17:53 1.4 +++ rpl/src/instructions_t1.c 2020/01/10 11:15:48 1.75 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.12 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.32 + Copyright (C) 1989-2020 Dr. BERTRAND Joël This file is part of RPL/2. @@ -20,7 +20,7 @@ */ -#include "rpl.conv.h" +#include "rpl-conv.h" /* @@ -59,12 +59,64 @@ instruction_type(struct_processus *s_eta printf(" 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" - " %s, %s, %s, %s\n", + " %s, %s, %s, %s,\n" + " %s, %s, %s, %s\n" + " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, - d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB, d_SCK, - d_PRC); - printf("-> 1: %s\n", d_INT); + d_PRC, d_TAB, d_SQL, d_MTX, d_SPH, d_REC); + printf("-> 1: %s\n\n", d_INT); + + if ((*s_etat_processus).langue == 'F') + { + printf(" Valeurs renvoyées : \n\n"); + printf(" 0 : scalaire (entier ou réel)\n"); + printf(" 1 : complexe\n"); + printf(" 2 : chaîne de caractères\n"); + printf(" 3 : vecteur ou matrice de scalaires\n"); + printf(" 4 : vecteur ou matrice de complexes\n"); + printf(" 5 : liste\n"); + printf(" 6 : adresse\n"); + printf(" 7 : nom\n"); + printf(" 8 : expression en notation polonaire inversée\n"); + printf(" 9 : expression algébrique\n"); + printf(" 10 : entier binaire\n"); + printf(" 11 : descripteur de fichier\n"); + printf(" 12 : descripteur de bibliothèque partagée\n"); + printf(" 13 : descripteur de socket\n"); + printf(" 14 : processus\n"); + printf(" 15 : fonction\n"); + printf(" 16 : table\n"); + printf(" 17 : connecteur SQL\n"); + printf(" 18 : mutex\n"); + printf(" 19 : sémaphore\n"); + printf(" 20 : enregistrement\n"); + } + else + { + printf(" Returned values : \n\n"); + printf(" 0 : scalar, integer or real number\n"); + printf(" 1 : complex\n"); + printf(" 2 : string\n"); + printf(" 3 : scalar vector or scalar matrix\n"); + printf(" 4 : complex vector or complex matrix\n"); + printf(" 5 : list\n"); + printf(" 6 : address\n"); + printf(" 7 : name\n"); + printf(" 8 : RPN expression\n"); + printf(" 9 : algebraic expression\n"); + printf(" 10 : binary integer\n"); + printf(" 11 : file descriptor\n"); + printf(" 12 : shared library descriptor\n"); + printf(" 13 : socket descriptor\n"); + printf(" 14 : process\n"); + printf(" 15 : function\n"); + printf(" 16 : table\n"); + printf(" 17 : SQL connector\n"); + printf(" 18 : mutex\n"); + printf(" 19 : semaphore\n"); + printf(" 20 : record\n"); + } return; } @@ -168,6 +220,26 @@ instruction_type(struct_processus *s_eta { (*((integer8 *) (*s_objet_resultat).objet)) = 16; } + else if ((*s_objet_argument).type == SQL) + { + (*((integer8 *) (*s_objet_resultat).objet)) = 17; + } + else if ((*s_objet_argument).type == MTX) + { + (*((integer8 *) (*s_objet_resultat).objet)) = 18; + } + else if ((*s_objet_argument).type == SPH) + { + (*((integer8 *) (*s_objet_resultat).objet)) = 19; + } + else if ((*s_objet_argument).type == REC) + { + (*((integer8 *) (*s_objet_resultat).objet)) = 20; + } + else if ((*s_objet_argument).type == EXT) + { + (*((integer8 *) (*s_objet_resultat).objet)) = 21; + } else { /* @@ -214,12 +286,14 @@ instruction_then(struct_processus *s_eta struct_liste_chainee *s_registre; + struct_liste_pile_systeme *l_element_courant; + struct_objet *s_objet; unsigned char *instruction_majuscule; unsigned char *tampon; - unsigned long niveau; + integer8 niveau; void (*fonction)(); @@ -343,8 +417,7 @@ instruction_then(struct_processus *s_eta return; } - if (((*s_objet).type == INT) || - ((*s_objet).type == REL)) + if (((*s_objet).type == INT) || ((*s_objet).type == REL)) { if ((*s_objet).type == INT) { @@ -365,15 +438,33 @@ instruction_then(struct_processus *s_eta * THEN et ELSE ou END. */ - if (((*(*s_etat_processus).l_base_pile_systeme).clause != - 'K') && ((*(*s_etat_processus).l_base_pile_systeme) - .clause != 'C')) + if (((*(*s_etat_processus).l_base_pile_systeme).clause == + 'I') || ((*(*s_etat_processus).l_base_pile_systeme).clause + == 'X')) { (*(*s_etat_processus).l_base_pile_systeme).clause = 'T'; } else { - (*(*s_etat_processus).l_base_pile_systeme).clause = 'Q'; + if ((*s_etat_processus).l_base_pile_systeme == NULL) + { + (*s_etat_processus).erreur_systeme = d_es_pile_vide; + return; + } + + l_element_courant = (*(*s_etat_processus).l_base_pile_systeme) + .suivant; + + while(l_element_courant != NULL) + { + if ((*l_element_courant).clause == 'K') + { + (*l_element_courant).clause = 'Q'; + break; + } + + l_element_courant = (*l_element_courant).suivant; + } } } else @@ -423,6 +514,7 @@ instruction_then(struct_processus *s_eta } if ((instruction_majuscule = conversion_majuscule( + s_etat_processus, (*s_etat_processus).instruction_courante)) == NULL) { liberation(s_etat_processus, s_objet); @@ -451,7 +543,8 @@ instruction_then(struct_processus *s_eta "ELSEIF") == 0)) { (*s_etat_processus).position_courante - -= (strlen(instruction_majuscule) + 1); + -= (integer8) (strlen( + instruction_majuscule) + 1); drapeau_fin = d_vrai; } else @@ -480,6 +573,7 @@ instruction_then(struct_processus *s_eta } else if (strcmp(instruction_majuscule, "END") == 0) { + instruction_end(s_etat_processus); drapeau_fin = d_vrai; } else @@ -592,9 +686,8 @@ instruction_then(struct_processus *s_eta if (((*(*s_etat_processus).l_base_pile_systeme) .clause != 'K') && ((*(*s_etat_processus) - .l_base_pile_systeme) .clause != 'C')) + .l_base_pile_systeme).clause != 'C')) { - /* * Traitement de IF/THEN/ELSEIF/THEN/ * ELSE/END @@ -640,6 +733,8 @@ instruction_then(struct_processus *s_eta } else if (fonction == instruction_end) { + fonction(s_etat_processus); + execution = d_vrai; drapeau_fin = d_vrai; } else @@ -699,7 +794,6 @@ instruction_then(struct_processus *s_eta } liberation(s_etat_processus, s_objet); - return; }