--- rpl/src/rplexternals.h 2017/07/12 15:42:43 1.84 +++ rpl/src/rplexternals.h 2023/08/07 17:43:00 1.100 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.1.27 - Copyright (C) 1989-2017 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.35 + Copyright (C) 1989-2023 Dr. BERTRAND Joël This file is part of RPL/2. @@ -105,7 +105,8 @@ #define initializeObject(a, b) do { \ (*a).descripteur_bibliotheque = (*b).descripteur_bibliotheque; \ (*a).extension_type = (*b).extension_type; } while(0) -#define objectContainer(a) ((*a).objet) +#define objectContainer(type, a) ((type *) ((*a).objet)) +#define objectOf(a) ((*a).objet) #define ifIsExternal(a, b) if (((*a).type == EXT) && ((*a).extension_type == b)) #define elseIfIsExternal(a, b) } else if (((*a).type == EXT) && \ ((*a).extension_type == b)) @@ -149,6 +150,10 @@ ({ __CATCH_SYSTEM_ERROR__; typeof(daisyChain) __daisyChain = daisyChain; \ if (__daisyChain == NULL) executionError("End of daisy chain"); \ (__daisyChain == NULL) ? NULL : (*__daisyChain).suivant; }) + +#define next suivant +#define data donnee +#define daisyChain struct_liste_chainee #define null NULL #define nullify(ptr) __CATCH_SYSTEM_ERROR__; do { ptr = NULL; } while(0) @@ -223,6 +228,8 @@ unsigned char __taille_bloc; \ unsigned char __type; \ t_8_bits __masque; \ + void *s_etat_processus = (*rpl_arguments).s_etat_processus; \ + DISABLE_SET_BUT_NOT_USED_WARNING(s_etat_processus); \ { \ (*rpl_arguments).instruction_valide = 'Y'; \ (*rpl_arguments).erreur = 0; \ @@ -976,6 +983,54 @@ #define createComplexMatrixObject +// Array + +#define isArray(rpl_object) \ + ((*rpl_object).type == TBL) + +#define ifIsArray(rpl_object) if (isArray(rpl_object)) +#define elseIfIsArray(rpl_object) } else if (isArray(rpl_object)) + +#define createArray(rpl_object, size) do { \ + int __i; \ + if (rpl_object != NULL) systemError("Reallocated object"); \ + if ((rpl_object = _allocation(TBL)) == NULL) \ + systemError("Memory allocation error"); \ + (*((struct_tableau *) (*rpl_object).objet)).nombre_elements = size; \ + if (((*((struct_tableau *) (*rpl_object).objet)).elements = malloc( \ + size * sizeof(struct_objet *))) == NULL) \ + systemError("Memory allocation error"); \ + for(__i = 0; __i < size; __i++) { \ + nullify((*((struct_tableau *) (*rpl_object).objet)).elements[__i]); \ + createIntegerObject((*((struct_tableau *) (*rpl_object).objet)) \ + .elements[__i]); } \ + } while(0) + +#define setObjectIntoArray(rpl_array, pos, rpl_object) do { \ + typeof(pos) __position = pos; __position--; \ + ifIsArray(rpl_array) { \ + if ((__position < 0) || (__position >= (*((struct_tableau *) \ + (*rpl_array).objet)).nombre_elements)) \ + executionError("Element out of range"); \ + if ((*rpl_array).nombre_occurrences > 1) \ + { \ + struct_objet *__tmp_rpl_object; \ + if ((__tmp_rpl_object = _copie_objet(rpl_array, 'O')) == NULL) \ + systemError("Memory allocation error"); \ + _liberation(rpl_array); \ + rpl_array = __tmp_rpl_object; \ + } \ + _liberation((*((struct_tableau *) (*rpl_array).objet)) \ + .elements[__position]); \ + (*((struct_tableau *) (*rpl_array).objet)).elements[__position] = \ + rpl_object; \ + } \ + else executionError("Type mistmatch error"); \ + nullify(rpl_object); \ + } while(0) + +#define getObjectFromArray() + // Binary integer #define setBinaryInteger(rpl_object, value) do { \ @@ -1098,6 +1153,22 @@ ifIsString(rpl_object) string = (char *) (*rpl_object).objet; \ else executionError("Type mismatch error"); } while(0) +#define unEscString(s) ({ \ + unsigned char *__a; integer8 __l; \ + __a = formateur_flux((*rpl_arguments).s_etat_processus, \ + (unsigned char *) s, &__l); \ + if (nullified(__a)) systemError("Memory allocation error"); \ + (string) __a; \ + }) + +#define escString(rpl_object) ({ \ + unsigned char *__a; integer8 __l; \ + __a = analyse_flux((*rpl_arguments).s_etat_processus, \ + (unsigned char *) s, strlen(s)); \ + if (nullified(__a)) systemError("Memory allocation error"); \ + (string) __a; \ + }) + #define createStringObject(rpl_object) do { \ struct_processus *s_etat_processus; \ s_etat_processus = (*rpl_arguments).s_etat_processus; \