diff options
author | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
---|---|---|
committer | Erlang/OTP <[email protected]> | 2009-11-20 14:54:40 +0000 |
commit | 84adefa331c4159d432d22840663c38f155cd4c1 (patch) | |
tree | bff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/erl_interface/src/legacy/erl_marshal.c | |
download | otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2 otp-84adefa331c4159d432d22840663c38f155cd4c1.zip |
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/erl_interface/src/legacy/erl_marshal.c')
-rw-r--r-- | lib/erl_interface/src/legacy/erl_marshal.c | 2117 |
1 files changed, 2117 insertions, 0 deletions
diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c new file mode 100644 index 0000000000..4b5f28178f --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_marshal.c @@ -0,0 +1,2117 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: Decoding and encoding Erlang terms. + */ +#include "eidef.h" + +#include <stdio.h> +#include <stdlib.h> +#include <ctype.h> +#include <sys/types.h> +#include <string.h> + +#include "erl_interface.h" +#include "erl_marshal.h" +#include "erl_eterm.h" +#include "erl_malloc.h" +#include "erl_error.h" +#include "erl_internal.h" + +#include "eiext.h" /* replaces external.h */ +#include "putget.h" + +static int is_string(ETERM* term); +#if defined(VXWORKS) && CPU == PPC860 +int erl_fp_compare(unsigned *a, unsigned *b); +static void erl_long_to_fp(long l, unsigned *d); +#endif + +/* Used when comparing two encoded byte arrays */ +/* this global data is ok (from threading point of view) since it is + * initialized once and never changed + */ + +#define CMP_ARRAY_SIZE 256 +/* FIXME problem for threaded ? */ +static char cmp_array[CMP_ARRAY_SIZE]; +static int init_cmp_array_p=1; /* initialize array, the first time */ + +#if defined(VXWORKS) && CPU == PPC860 +#include <limits.h> +#endif + +#if defined(__GNUC__) +# define INLINE __inline__ +#elif defined(__WIN32__) +# define INLINE __inline +#else +# define INLINE +#endif + +static int cmp_floats(double f1, double f2); +static INLINE double to_float(long l); + +#define ERL_NUM_CMP 1 +#define ERL_REF_CMP 3 + +#define IS_ERL_NUM(t) (cmp_array[t]==ERL_NUM_CMP) + +#define CMP_NUM_CLASS_SIZE 256 +static unsigned char cmp_num_class[CMP_NUM_CLASS_SIZE]; +static int init_cmp_num_class_p=1; /* initialize array, the first time */ + +#define MK_CMP_NUM_CODE(x,y) (((x)<<2)|(y)) +#define CMP_NUM_CLASS(x) (cmp_num_class[x] & 0x03) +#define CMP_NUM_CODE(x,y) (MK_CMP_NUM_CODE(CMP_NUM_CLASS(x),CMP_NUM_CLASS(y))) + +#define SMALL 1 +#define FLOAT 2 +#define BIG 3 + +#define SMALL_SMALL MK_CMP_NUM_CODE(SMALL,SMALL) +#define SMALL_FLOAT MK_CMP_NUM_CODE(SMALL,FLOAT) +#define SMALL_BIG MK_CMP_NUM_CODE(SMALL,BIG) +#define FLOAT_SMALL MK_CMP_NUM_CODE(FLOAT,SMALL) +#define FLOAT_FLOAT MK_CMP_NUM_CODE(FLOAT,FLOAT) +#define FLOAT_BIG MK_CMP_NUM_CODE(FLOAT,BIG) +#define BIG_SMALL MK_CMP_NUM_CODE(BIG,SMALL) +#define BIG_FLOAT MK_CMP_NUM_CODE(BIG,FLOAT) +#define BIG_BIG MK_CMP_NUM_CODE(BIG,BIG) + +void erl_init_marshal(void) +{ + if (init_cmp_array_p) { + memset(cmp_array, 0, CMP_ARRAY_SIZE); + cmp_array[ERL_SMALL_INTEGER_EXT] = 1; + cmp_array[ERL_INTEGER_EXT] = 1; + cmp_array[ERL_FLOAT_EXT] = 1; + cmp_array[ERL_SMALL_BIG_EXT] = 1; + cmp_array[ERL_LARGE_BIG_EXT] = 1; + cmp_array[ERL_ATOM_EXT] = 2; + cmp_array[ERL_REFERENCE_EXT] = 3; + cmp_array[ERL_NEW_REFERENCE_EXT] = 3; + cmp_array[ERL_FUN_EXT] = 4; + cmp_array[ERL_NEW_FUN_EXT] = 4; + cmp_array[ERL_PORT_EXT] = 5; + cmp_array[ERL_PID_EXT] = 6; + cmp_array[ERL_SMALL_TUPLE_EXT] = 7; + cmp_array[ERL_LARGE_TUPLE_EXT] = 7; + cmp_array[ERL_NIL_EXT] = 8; + cmp_array[ERL_STRING_EXT] = 9; + cmp_array[ERL_LIST_EXT] = 9; + cmp_array[ERL_BINARY_EXT] = 10; + init_cmp_array_p = 0; + } + if (init_cmp_num_class_p) { + memset(cmp_num_class, 0, CMP_NUM_CLASS_SIZE); + cmp_num_class[ERL_SMALL_INTEGER_EXT] = SMALL; + cmp_num_class[ERL_INTEGER_EXT] = SMALL; + cmp_num_class[ERL_FLOAT_EXT] = FLOAT; + cmp_num_class[ERL_SMALL_BIG_EXT] = BIG; + cmp_num_class[ERL_LARGE_BIG_EXT] = BIG; + init_cmp_num_class_p = 0; + } +} + +/* The encoder calls length, if erl_length() should return */ +/* -1 for dotted pairs (why !!!!) we can't use erl_length() */ +/* from the encoder in erl_marshal.c */ + +static int erl_length_x(const ETERM *ep) { + int n = 0; + + if (!ep) return -1; + + while (ERL_TYPE(ep) == ERL_LIST) { + n++; + ep = TAIL(ep); + } + + return n; +} + + +/*============================================================== + * Marshalling routines. + *============================================================== + */ + +/* + * The actual ENCODE engine. + * Returns 0 on success, otherwise 1. + */ +int erl_encode_it(ETERM *ep, unsigned char **ext, int dist) +{ + int i; + unsigned int u; + long long l; + unsigned long long ul; + + switch(ERL_TYPE(ep)) + { + case ERL_ATOM: + i = ep->uval.aval.len; + *(*ext)++ = ERL_ATOM_EXT; + *(*ext)++ = (i >>8) &0xff; + *(*ext)++ = i &0xff; + memcpy((void *) *ext, (const void *) ep->uval.aval.a, i); + *ext += i; + return 0; + + case ERL_INTEGER: + i = ep->uval.ival.i; + /* ERL_SMALL_BIG */ + if ((i > ERL_MAX) || (i < ERL_MIN)) { + *(*ext)++ = ERL_SMALL_BIG_EXT; + *(*ext)++ = 4; /* four bytes */ + if ((*(*ext)++ = ((i>>31) & 0x01))) /* sign byte */ + i = -i; + *(*ext)++ = i & 0xff; /* LSB first */ + *(*ext)++ = (i >> 8) & 0xff; + *(*ext)++ = (i >> 16) & 0xff; + *(*ext)++ = (i >> 24) & 0x7f; /* Don't include the sign bit */ + return 0; + } + /* SMALL_INTEGER */ + if ((i < 256) && (i >= 0)) { + *(*ext)++ = ERL_SMALL_INTEGER_EXT; + *(*ext)++ = i & 0xff; + return 0; + } + /* INTEGER */ + *(*ext)++ = ERL_INTEGER_EXT; + *(*ext)++ = (i >> 24) & 0xff; + *(*ext)++ = (i >> 16) & 0xff; + *(*ext)++ = (i >> 8) & 0xff; + *(*ext)++ = i & 0xff; + return 0; + + case ERL_U_INTEGER: + u = ep->uval.uival.u; + /* ERL_U_SMALL_BIG */ + if (u > ERL_MAX) { + *(*ext)++ = ERL_SMALL_BIG_EXT; + *(*ext)++ = 4; /* four bytes */ + *(*ext)++ = 0; /* sign byte */ + *(*ext)++ = u & 0xff; /* LSB first */ + *(*ext)++ = (u >> 8) & 0xff; + *(*ext)++ = (u >> 16) & 0xff; + *(*ext)++ = (u >> 24) & 0xff; + return 0; + } + /* SMALL_INTEGER */ + if ((u < 256) && (u >= 0)) { + *(*ext)++ = ERL_SMALL_INTEGER_EXT; + *(*ext)++ = u & 0xff; + return 0; + } + /* INTEGER */ + *(*ext)++ = ERL_INTEGER_EXT; + *(*ext)++ = (u >> 24) & 0xff; + *(*ext)++ = (u >> 16) & 0xff; + *(*ext)++ = (u >> 8) & 0xff; + *(*ext)++ = u & 0xff; + return 0; + case ERL_LONGLONG: + l = ep->uval.llval.i; + /* ERL_SMALL_BIG */ + if ((l > ((long long) ERL_MAX)) || + (l < ((long long) ERL_MIN))) { + *(*ext)++ = ERL_SMALL_BIG_EXT; + *(*ext)++ = 8; /* eight bytes */ + if ((*(*ext)++ = ((l>>63) & 0x01))) /* sign byte */ + l = -l; + *(*ext)++ = l & 0xff; /* LSB first */ + *(*ext)++ = (l >> 8) & 0xff; + *(*ext)++ = (l >> 16) & 0xff; + *(*ext)++ = (l >> 24) & 0xff; + *(*ext)++ = (l >> 32) & 0xff; + *(*ext)++ = (l >> 40) & 0xff; + *(*ext)++ = (l >> 48) & 0xff; + *(*ext)++ = (l >> 56) & 0x7f; /* Don't include the sign bit */ + return 0; + } + /* SMALL_INTEGER */ + if ((l < 256) && (l >= 0)) { + *(*ext)++ = ERL_SMALL_INTEGER_EXT; + *(*ext)++ = l & 0xff; + return 0; + } + /* INTEGER */ + *(*ext)++ = ERL_INTEGER_EXT; + *(*ext)++ = (l >> 24) & 0xff; + *(*ext)++ = (l >> 16) & 0xff; + *(*ext)++ = (l >> 8) & 0xff; + *(*ext)++ = l & 0xff; + return 0; + + case ERL_U_LONGLONG: + ul = ep->uval.ullval.u; + /* ERL_U_SMALL_BIG */ + if (ul > ((unsigned long long) ERL_MAX)) { + *(*ext)++ = ERL_SMALL_BIG_EXT; + *(*ext)++ = 8; /* eight bytes */ + *(*ext)++ = 0; /* sign byte */ + *(*ext)++ = ul & 0xff; /* LSB first */ + *(*ext)++ = (ul >> 8) & 0xff; + *(*ext)++ = (ul >> 16) & 0xff; + *(*ext)++ = (ul >> 24) & 0xff; + *(*ext)++ = (ul >> 32) & 0xff; + *(*ext)++ = (ul >> 40) & 0xff; + *(*ext)++ = (ul >> 48) & 0xff; + *(*ext)++ = (ul >> 56) & 0xff; + return 0; + } + /* SMALL_INTEGER */ + if ((ul < 256) && (ul >= 0)) { + *(*ext)++ = ERL_SMALL_INTEGER_EXT; + *(*ext)++ = ul & 0xff; + return 0; + } + /* INTEGER */ + *(*ext)++ = ERL_INTEGER_EXT; + *(*ext)++ = (ul >> 24) & 0xff; + *(*ext)++ = (ul >> 16) & 0xff; + *(*ext)++ = (ul >> 8) & 0xff; + *(*ext)++ = ul & 0xff; + return 0; + + case ERL_PID: + *(*ext)++ = ERL_PID_EXT; + /* First poke in node as an atom */ + i = strlen((char *)ERL_PID_NODE(ep)); + *(*ext)++ = ERL_ATOM_EXT; + *(*ext)++ = (i >>8) &0xff; + *(*ext)++ = i &0xff; + memcpy(*ext, ERL_PID_NODE(ep), i); + *ext += i; + /* And then fill in the integer fields */ + i = ERL_PID_NUMBER(ep); + *(*ext)++ = (i >> 24) &0xff; + *(*ext)++ = (i >> 16) &0xff; + *(*ext)++ = (i >> 8) &0xff; + *(*ext)++ = i &0xff; + i = ERL_PID_SERIAL(ep); + *(*ext)++ = (i >> 24) &0xff; + *(*ext)++ = (i >> 16) &0xff; + *(*ext)++ = (i >> 8) &0xff; + *(*ext)++ = i &0xff; + *(*ext)++ = ERL_PID_CREATION(ep); + return 0; + case ERL_REF: { + int len, j; + + /* Always encode as an extended reference; all + participating parties are now expected to be + able to decode extended references. */ + + *(*ext)++ = ERL_NEW_REFERENCE_EXT; + + i = strlen((char *)ERL_REF_NODE(ep)); + len = ERL_REF_LEN(ep); + *(*ext)++ = (len >> 8) &0xff; + *(*ext)++ = len &0xff; + + *(*ext)++ = ERL_ATOM_EXT; + *(*ext)++ = (i >> 8) &0xff; + *(*ext)++ = i &0xff; + memcpy(*ext, ERL_REF_NODE(ep), i); + *ext += i; + *(*ext)++ = ERL_REF_CREATION(ep); + /* Then the integer fields */ + for (j = 0; j < ERL_REF_LEN(ep); j++) { + i = ERL_REF_NUMBERS(ep)[j]; + *(*ext)++ = (i >> 24) &0xff; + *(*ext)++ = (i >> 16) &0xff; + *(*ext)++ = (i >> 8) &0xff; + *(*ext)++ = i &0xff; + } + } + return 0; + case ERL_PORT: + *(*ext)++ = ERL_PORT_EXT; + /* First poke in node as an atom */ + i = strlen((char *)ERL_PORT_NODE(ep)); + *(*ext)++ = ERL_ATOM_EXT; + *(*ext)++ = (i >>8) &0xff; + *(*ext)++ = i &0xff; + memcpy(*ext, ERL_PORT_NODE(ep), i); + *ext += i; + /* Then the integer fields */ + i = ERL_PORT_NUMBER(ep); + *(*ext)++ = (i >> 24) &0xff; + *(*ext)++ = (i >> 16) &0xff; + *(*ext)++ = (i >> 8) &0xff; + *(*ext)++ = i &0xff; + *(*ext)++ = ERL_PORT_CREATION(ep); + return 0; + case ERL_EMPTY_LIST: + *(*ext)++ = ERL_NIL_EXT; + break; + case ERL_LIST: + i = is_string(ep); + if (0 < i && i < 0x10000) { /* String. */ + *(*ext)++ = ERL_STRING_EXT; + *(*ext)++ = (i >>8) &0xff; + *(*ext)++ = i &0xff; + while (ERL_TYPE(ep) == ERL_LIST) { + *(*ext)++ = HEAD(ep)->uval.ival.i; + ep = TAIL(ep); + } + break; + } else { /* List. */ + i = erl_length_x(ep); + *(*ext)++ = ERL_LIST_EXT; + *(*ext)++ = (i >> 24) &0xff; + *(*ext)++ = (i >> 16) &0xff; + *(*ext)++ = (i >> 8) &0xff; + *(*ext)++ = i &0xff; + while (ERL_TYPE(ep) == ERL_LIST) { + if (erl_encode_it(HEAD(ep), ext, dist)) + return 1; + ep = TAIL(ep); + } + i = erl_encode_it(ep, ext, dist); + return i; + } + case ERL_TUPLE: + i = ep->uval.tval.size; + if (i <= 0xff) { + *(*ext)++ = ERL_SMALL_TUPLE_EXT; + *(*ext)++ = i & 0xff; + } + else { + *(*ext)++ = ERL_LARGE_TUPLE_EXT; + *(*ext)++ = (i >> 24) & 0xff; + *(*ext)++ = (i >> 16) & 0xff; + *(*ext)++ = (i >> 8) & 0xff; + *(*ext)++ = i & 0xff; + } + for (i=0; i<ep->uval.tval.size; i++) + if (erl_encode_it(ep->uval.tval.elems[i], ext, dist)) + return 1; + break; + case ERL_FLOAT: + *(*ext)++ = ERL_FLOAT_EXT; + memset(*ext, 0, 31); + sprintf((char *) *ext, "%.20e", ep->uval.fval.f); + *ext += 31; + break; + case ERL_BINARY: + *(*ext)++ = ERL_BINARY_EXT; + i = ep->uval.bval.size; + *(*ext)++ = (i >> 24) & 0xff; + *(*ext)++ = (i >> 16) & 0xff; + *(*ext)++ = (i >> 8) & 0xff; + *(*ext)++ = i & 0xff; + memcpy((char *) *ext, (char*) ep->uval.bval.b, i); + *ext += i; + break; + case ERL_FUNCTION: + if (ERL_FUN_ARITY(ep) != -1) { + unsigned char *size_p = *ext + 1; + *(*ext)++ = ERL_NEW_FUN_EXT; + *ext += 4; + i = ERL_FUN_ARITY(ep); + put8(*ext, i); + memcpy(*ext, ERL_FUN_MD5(ep), 16); + *ext += 16; + i = ERL_FUN_NEW_INDEX(ep); + put32be(*ext, i); + i = ERL_CLOSURE_SIZE(ep); + put32be(*ext, i); + erl_encode_it(ERL_FUN_MODULE(ep), ext, dist); + erl_encode_it(ERL_FUN_INDEX(ep), ext, dist); + erl_encode_it(ERL_FUN_UNIQ(ep), ext, dist); + erl_encode_it(ERL_FUN_CREATOR(ep), ext, dist); + for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) + erl_encode_it(ep->uval.funcval.closure[i], ext, dist); + if (size_p != NULL) { + i = *ext - size_p; + put32be(size_p, i); + } + } else { + *(*ext)++ = ERL_FUN_EXT; + i = ERL_CLOSURE_SIZE(ep); + *(*ext)++ = (i >> 24) & 0xff; + *(*ext)++ = (i >> 16) & 0xff; + *(*ext)++ = (i >> 8) & 0xff; + *(*ext)++ = i & 0xff; + erl_encode_it(ERL_FUN_CREATOR(ep), ext, dist); + erl_encode_it(ERL_FUN_MODULE(ep), ext, dist); + erl_encode_it(ERL_FUN_INDEX(ep), ext, dist); + erl_encode_it(ERL_FUN_UNIQ(ep), ext, dist); + for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) + erl_encode_it(ep->uval.funcval.closure[i], ext, dist); + } + break; + default: + return 1; + } + return 0; +} + +/* + * ENCODE an ETERM into a BUFFER, assuming BUFFER is of + * enough size. At success return number of bytes written + * into it, otherwise return 0. + */ +static int erl_encode3(ETERM *ep, unsigned char *t, int dist) +{ + unsigned char *x = t; + + *x++ = ERL_VERSION_MAGIC; + if (erl_encode_it(ep, &x, dist)) { +#ifdef DEBUG + erl_err_msg("<ERROR> erl_encode: Error while encoding"); +#endif + return 0; + } + return (x - t); + +} + +/* API */ + +int erl_encode(ETERM *ep, unsigned char *t) +{ + return erl_encode3(ep, t, 4); +} + +/* determine the buffer size that will be required for the eterm */ +static int erl_term_len_helper(ETERM *ep, int dist); + +/* FIXME hard coded dist version */ +int erl_term_len(ETERM *ep) +{ + return 1+erl_term_len_helper(ep, 4); +} + +static int erl_term_len_helper(ETERM *ep, int dist) +{ + int len = 0; + int i; + unsigned int u; + long long l; + unsigned long long ul; + + if (ep) { + switch (ERL_TYPE(ep)) { + case ERL_ATOM: + i = ep->uval.aval.len; + len = i + 3; + break; + + case ERL_INTEGER: + i = ep->uval.ival.i; + if ((i > ERL_MAX) || (i < ERL_MIN)) len = 7; + else if ((i < 256) && (i >= 0)) len = 2; + else len = 5; + break; + + case ERL_U_INTEGER: + u = ep->uval.uival.u; + if (u > ERL_MAX) len = 7; + else if (u < 256) len = 2; + else len = 5; + break; + + case ERL_LONGLONG: + l = ep->uval.llval.i; + if ((l > ((long long) ERL_MAX)) || + (l < ((long long) ERL_MIN))) len = 11; + else if ((l < 256) && (l >= 0)) len = 2; + else len = 5; + break; + + case ERL_U_LONGLONG: + ul = ep->uval.ullval.u; + if (ul > ((unsigned long long) ERL_MAX)) len = 11; + else if (ul < 256) len = 2; + else len = 5; + break; + + case ERL_PID: + /* 1 + N + 4 + 4 + 1 where N = 3 + strlen */ + i = strlen((char *)ERL_PID_NODE(ep)); + len = 13 + i; + break; + + case ERL_REF: + i = strlen((char *)ERL_REF_NODE(ep)); + if (dist >= 4 && ERL_REF_LEN(ep) > 1) { + len = 1 + 2 + (i+3) + 1 + ERL_REF_LEN(ep) * 4; + } else { + /* 1 + N + 4 + 1 where N = 3 + strlen */ + len = 9 + i; + } + break; + + case ERL_PORT: + /* 1 + N + 4 + 1 where N = 3 + strlen */ + i = strlen((char *)ERL_PORT_NODE(ep)); + len = 9 + i; + break; + + case ERL_EMPTY_LIST: + len = 1; + break; + + case ERL_LIST: + i = is_string(ep); + if ((i > 0) && (i < 0x10000)) { /* string: 3 + strlen */ + for (len = 3; ERL_TYPE(ep) == ERL_LIST; ep = TAIL(ep)) { + len++; + } + } + else { /* list: 5 + len(elem1) + len(elem2) ... */ + for (len = 5; ERL_TYPE(ep) == ERL_LIST; ep = TAIL(ep)) { + len += erl_term_len_helper(HEAD(ep), dist); + } + len += erl_term_len_helper(ep, dist); /* last element */ + } + break; + + case ERL_TUPLE: + /* (2 or 5) + len(elem1) + len(elem2) ... */ + i = ep->uval.tval.size; + if (i <= 0xff) len = 2; + else len = 5; + + for (i=0; i<ep->uval.tval.size; i++) { + len += erl_term_len_helper(ep->uval.tval.elems[i], dist); + } + break; + + case ERL_FLOAT: + len = 32; + break; + + case ERL_BINARY: + i = ep->uval.bval.size; + len = 5 + i; + break; + + case ERL_FUNCTION: + if (ERL_FUN_ARITY(ep) == -1) { + len = 1 + 4; + len += erl_term_len_helper(ERL_FUN_CREATOR(ep),dist); + len += erl_term_len_helper(ERL_FUN_MODULE(ep),dist); + len += erl_term_len_helper(ERL_FUN_INDEX(ep),dist); + len += erl_term_len_helper(ERL_FUN_UNIQ(ep),dist); + for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) + len += erl_term_len_helper(ERL_CLOSURE_ELEMENT(ep,i), dist); + } else { + len = 1 + 4 + 16 + 4 + 4; + len += erl_term_len_helper(ERL_FUN_MODULE(ep),dist); + len += erl_term_len_helper(ERL_FUN_INDEX(ep),dist); + len += erl_term_len_helper(ERL_FUN_UNIQ(ep),dist); + len += erl_term_len_helper(ERL_FUN_CREATOR(ep),dist); + for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) + len += erl_term_len_helper(ERL_CLOSURE_ELEMENT(ep,i), dist); + } + break; + + default: +#ifdef DEBUG + fprintf(stderr, "Shouldn't happen: erl_term_len, unknown term type: '%c'\n",ERL_TYPE(ep)); +#endif + erl_errno = EINVAL; + exit(1); + } + } + + return len; +} + +/* + * This one makes it easy to ENCODE several CONSECUTIVE + * ETERM's into the same buffer. + */ +int erl_encode_buf(ETERM *ep, unsigned char **ext) +{ + unsigned char *start=*ext; + + *(*ext)++ = ERL_VERSION_MAGIC; + if (erl_encode_it(ep, ext, 0)) { +#ifdef DEBUG + erl_err_msg("<ERROR> erl_encode_buf: Error while encoding\n"); +#endif + return 0; + } + return (*ext - start); + +} /* erl_encode_buf */ + +/* + * A nice macro to make it look cleaner in the + * cases of PID's,PORT's and REF's below. + * It reads the NODE name from a buffer. + */ +#define READ_THE_NODE(ext,cp,len,i) \ +/* eat first atom, repr. the node */ \ +if (**ext != ERL_ATOM_EXT) \ + return (ETERM *) NULL; \ +*ext += 1; \ +i = (**ext << 8) | (*ext)[1]; \ +cp = (char *) *(ext) + 2; \ +*ext += (i + 2); \ +len = i + +#define STATIC_NODE_BUF_SZ 30 + +#define SET_NODE(node,node_buf,cp,len) \ +if (len >= STATIC_NODE_BUF_SZ) node = malloc(len+1); \ +else node = node_buf; \ +memcpy(node, cp, len); \ +node[len] = '\0' + +#define RESET_NODE(node,len) \ +if (len >= STATIC_NODE_BUF_SZ) free(node) + +/* + * The actual DECODE engine. + * Returns NULL in case of failure. + */ +static ETERM *erl_decode_it(unsigned char **ext) +{ + char *cp; + ETERM *ep,*tp,*np; + unsigned int u,sign; + int i,j,len,arity; + double ff; + + /* Assume we are going to decode an integer */ + ep = erl_alloc_eterm(ERL_INTEGER); + ERL_COUNT(ep) = 1; + + switch (*(*ext)++) + { + case ERL_INTEGER_EXT: + i = (int) (**ext << 24) | ((*ext)[1] << 16) | + ((*ext)[2] << 8) | (*ext)[3]; + *ext += 4; + ep->uval.ival.i = i; + return ep; + + case ERL_SMALL_INTEGER_EXT: + i = *(*ext)++; + ep->uval.ival.i = i; + return ep; + + /* NOTE: The arity below for bigs is not really the arity (= number of digits) */ + /* It is the byte count and this might cause problems in other parts... */ + case ERL_SMALL_BIG_EXT: + arity = *(*ext)++; + goto big_cont; + case ERL_LARGE_BIG_EXT: + arity = (**ext << 24) | ((*ext)[1])<< 16 | + ((*ext)[2]) << 8 |((*ext)[3]); + *ext += 4; + big_cont: + sign = *(*ext)++; + if (arity > 8) + goto big_truncate; + + if (arity == 8 && ((*ext)[7] & 0x80) && sign) { + /* MSB already occupied ! */ + goto big_truncate; + } + + if (arity == 4 && ((*ext)[3] & 0x80) && !sign) { + /* It will fit into an unsigned int !! */ + u = (((*ext)[3] << 24)|((*ext)[2])<< 16|((*ext)[1]) << 8 |(**ext)); + ERL_TYPE(ep) = ERL_U_INTEGER; + ep->uval.uival.u = u; + /* *ext += i; */ + *ext += arity; + return ep; + } else if (arity == 4 && !((*ext)[3] & 0x80)) { + /* It will fit into an int !! + * Note: It comes in "one's-complement notation" + */ + if (sign) + i = (int) (~(((*ext)[3] << 24) | ((*ext)[2])<< 16 | + ((*ext)[1]) << 8 | (**ext)) | (unsigned int) sign); + else + i = (int) (((*ext)[3] << 24) | ((*ext)[2])<< 16 | + ((*ext)[1]) << 8 | (**ext)); + ERL_TYPE(ep) = ERL_INTEGER; + ep->uval.ival.i = i; + *ext += arity; + return ep; + } else if (arity == 8 && ((*ext)[7] & 0x80) && !sign) { + /* Fits in an unsigned long long */ + int x; + unsigned long long ul = 0LL; + + for(x = 0 ; x < arity ; x++) { + ul |= ((unsigned long long)(*ext)[x]) << ((unsigned long long)(8*x)); + } + + ERL_TYPE(ep) = ERL_U_LONGLONG; + ep->uval.ullval.u = ul; + *ext += arity; + return ep; + } else { + /* Fits in a long long */ + int x; + long long l = 0LL; + + for(x = 0 ; x < arity ; x++) { + l |= ((long long)(*ext)[x]) << ((long long)(8*x)); + } + + if (sign) l = (long long) (~l | (unsigned long long) sign); + + ERL_TYPE(ep) = ERL_LONGLONG; + ep->uval.llval.i = l; + *ext += arity; + return ep; + } + big_truncate: + /* truncate to: (+/-) 1 */ +#ifdef DEBUG + erl_err_msg("<WARNING> erl_decode_it: Integer truncated..."); +#endif + ERL_TYPE(ep) = ERL_INTEGER; + ep->uval.ival.i = sign?-1:1; + *ext += arity; + return ep; + + case ERL_ATOM_EXT: + ERL_TYPE(ep) = ERL_ATOM; + i = (**ext << 8) | (*ext)[1]; + cp = (char *) *(ext) + 2; + *ext += (i + 2); + ep->uval.aval.len = i; + ep->uval.aval.a = (char *) erl_malloc(i+1); + memcpy(ep->uval.aval.a, cp, i); + ep->uval.aval.a[i]='\0'; + return ep; + + case ERL_PID_EXT: + erl_free_term(ep); + { /* Why not use the constructors? */ + char *node; + char node_buf[STATIC_NODE_BUF_SZ]; + unsigned int number, serial; + unsigned char creation; + ETERM *eterm_p; + + READ_THE_NODE(ext,cp,len,i); + SET_NODE(node,node_buf,cp,len); + + /* get the integers */ +#if 0 + /* FIXME: Remove code or whatever.... + Ints on the wire are big-endian (== network byte order) + so use ntoh[sl]. (But some are little-endian! Arrrgh!) + Also, the libc authors can be expected to optimize them + heavily. However, the marshalling makes no guarantees + about alignments -- so it won't work at all. */ + number = ntohl(*((unsigned int *)*ext)++); + serial = ntohl(*((unsigned int *)*ext)++); +#else + number = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | + ((*ext)[2]) << 8 | ((*ext)[3]); + *ext += 4; + serial = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | + ((*ext)[2]) << 8 | ((*ext)[3]); + *ext += 4; +#endif + creation = *(*ext)++; + eterm_p = erl_mk_pid(node, number, serial, creation); + RESET_NODE(node,len); + return eterm_p; + } + case ERL_REFERENCE_EXT: + erl_free_term(ep); + { + char *node; + char node_buf[STATIC_NODE_BUF_SZ]; + unsigned int number; + unsigned char creation; + ETERM *eterm_p; + + READ_THE_NODE(ext,cp,len,i); + SET_NODE(node,node_buf,cp,len); + + /* get the integers */ +#if 0 + number = ntohl(*((unsigned int *)*ext)++); +#else + number = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | + ((*ext)[2]) << 8 | ((*ext)[3]); + *ext += 4; +#endif + creation = *(*ext)++; + eterm_p = erl_mk_ref(node, number, creation); + RESET_NODE(node,len); + return eterm_p; + } + + case ERL_NEW_REFERENCE_EXT: + erl_free_term(ep); + { + char *node; + char node_buf[STATIC_NODE_BUF_SZ]; + size_t cnt, i; + unsigned int n[3]; + unsigned char creation; + ETERM *eterm_p; + +#if 0 + cnt = ntohs(*((unsigned short *)*ext)++); +#else + cnt = ((*ext)[0] << 8) | (*ext)[1]; + *ext += 2; +#endif + + READ_THE_NODE(ext,cp,len,i); + SET_NODE(node,node_buf,cp,len); + + /* get the integers */ + creation = *(*ext)++; + for(i = 0; i < cnt; i++) + { +#if 0 + n[i] = ntohl(*((unsigned int *)*ext)++); +#else + n[i] = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | + ((*ext)[2]) << 8 | ((*ext)[3]); + *ext += 4; +#endif + } + eterm_p = __erl_mk_reference(node, cnt, n, creation); + RESET_NODE(node,len); + return eterm_p; + } + + case ERL_PORT_EXT: + erl_free_term(ep); + { + char *node; + char node_buf[STATIC_NODE_BUF_SZ]; + unsigned int number; + unsigned char creation; + ETERM *eterm_p; + + READ_THE_NODE(ext,cp,len,i); + SET_NODE(node,node_buf,cp,len); + + /* get the integers */ +#if 0 + number = ntohl(*((unsigned int *)*ext)++); +#else + number = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | + ((*ext)[2]) << 8 | ((*ext)[3]); + *ext += 4; +#endif + creation = *(*ext)++; + eterm_p = erl_mk_port(node, number, creation); + RESET_NODE(node,len); + return eterm_p; + } + + case ERL_NIL_EXT: + ERL_TYPE(ep) = ERL_EMPTY_LIST; + return ep; + + case ERL_LIST_EXT: + ERL_TYPE(ep) = ERL_LIST; + i = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; + *ext += 4; + /* ASSERT(i != 0); */ /* Should be represented by ERL_NIL_EXT. */ + tp = ep; + for (j = 0; j < i; j++) + if ((HEAD(tp) = erl_decode_it(ext)) == NULL) + goto failure; + else if (j + 1 < i) { + /* We have to watch out for how we allocates the + * last tail element since we may encounter non- + * well formed lists. + */ + np = erl_alloc_eterm(ERL_LIST); + ERL_COUNT(np) = 1; + TAIL(np) = NULL; /* in case of failure */ + TAIL(tp) = np; + tp = np; + } + if ((TAIL(tp) = erl_decode_it(ext)) == NULL) + goto failure; + return ep; + + case ERL_STRING_EXT: + { + unsigned char* s; + + ERL_TYPE(ep) = ERL_EMPTY_LIST; + i = (**ext << 8) | ((*ext)[1]); + *ext += 2; + s = *ext+i; + + while (*ext < s) { + ETERM* integer; + ETERM* cons; + + integer = erl_alloc_eterm(ERL_INTEGER); + ERL_COUNT(integer) = 1; + integer->uval.ival.i = *--s; + + cons = erl_alloc_eterm(ERL_LIST); + ERL_COUNT(cons) = 1; + HEAD(cons) = integer; + TAIL(cons) = ep; + ep = cons; + } + *ext += i; + return ep; + } + + case ERL_SMALL_TUPLE_EXT: + ERL_TYPE(ep) = ERL_TUPLE; + i = *(*ext)++; + goto decode_tuple; + + case ERL_LARGE_TUPLE_EXT: + i = (**ext << 24) | ((*ext)[1]) << 16 | + ((*ext)[2]) << 8 | ((*ext)[3]) ; + *ext += 4; + decode_tuple: + ep->uval.tval.size = i; + j = (i + 1) * sizeof(ETERM*); + ep->uval.tval.elems = (ETERM**) erl_malloc(j); + memset(ep->uval.tval.elems, 0, j); /* in case of failure below... */ + for (i=0; i<ep->uval.tval.size; i++) + if ((tp = erl_decode_it(ext)) == NULL) + goto failure; + else + ep->uval.tval.elems[i] = tp; + return ep; + + case ERL_FLOAT_EXT: + ERL_TYPE(ep) = ERL_FLOAT; + if (sscanf((char *) *ext, "%lf", &ff) != 1) + goto failure; + *ext += 31; + ep->uval.fval.f = ff; + return ep; + + case ERL_BINARY_EXT: + ERL_TYPE(ep) = ERL_BINARY; + i = (**ext << 24) | ((*ext)[1] << 16) | + ((*ext)[2] << 8) | (*ext)[3]; + *ext += 4; + ep->uval.bval.size = i; + ep->uval.bval.b = (unsigned char *) erl_malloc(i); + memcpy(ep->uval.bval.b, *ext, i); + *ext += i; + return ep; + + case ERL_FUN_EXT: /* FIXME: error checking */ + ERL_TYPE(ep) = ERL_FUNCTION; + i = get32be(*ext); + /*i = *(**ext << 24) | ((*ext)[1] << 16) | ((*ext)[2] << 8) | (*ext)[3]; + *ext += 4; */ + ERL_FUN_ARITY(ep) = -1; + ERL_CLOSURE_SIZE(ep) = i; + ERL_FUN_CREATOR(ep) = erl_decode_it(ext); + ERL_FUN_MODULE(ep) = erl_decode_it(ext); + ERL_FUN_INDEX(ep) = erl_decode_it(ext); + ERL_FUN_UNIQ(ep) = erl_decode_it(ext); + j = i * sizeof(ETERM*); + ERL_CLOSURE(ep) = (ETERM**) erl_malloc(j); + memset(ERL_CLOSURE(ep), 0, j); + for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) + ERL_CLOSURE_ELEMENT(ep,i) = erl_decode_it(ext); + return ep; + + case ERL_NEW_FUN_EXT: /* FIXME: error checking */ + ERL_TYPE(ep) = ERL_FUNCTION; + i = get32be(*ext); /* size, we don't use it here */ + ERL_FUN_ARITY(ep) = get8(*ext); + memcpy(ERL_FUN_MD5(ep), *ext, 16); + *ext += 16; + ERL_FUN_NEW_INDEX(ep) = get32be(*ext); + i = get32be(*ext); + ERL_CLOSURE_SIZE(ep) = i; + ERL_FUN_MODULE(ep) = erl_decode_it(ext); + ERL_FUN_INDEX(ep) = erl_decode_it(ext); + ERL_FUN_UNIQ(ep) = erl_decode_it(ext); + ERL_FUN_CREATOR(ep) = erl_decode_it(ext); + j = i * sizeof(ETERM*); + ERL_CLOSURE(ep) = (ETERM**) erl_malloc(j); + memset(ERL_CLOSURE(ep), 0, j); + for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) + ERL_CLOSURE_ELEMENT(ep,i) = erl_decode_it(ext); + return ep; + + } /* switch */ + + failure: + erl_free_term(ep); + return (ETERM *) NULL; + +} /* erl_decode_it */ + +/* + * DECODE a buffer of BYTES into an ETERM. + * Returns NULL in case of failure. + */ +ETERM *erl_decode(unsigned char *t) +{ + ETERM *ep; + unsigned char *ext; + + ext = t; + + /* We ignore the version magic since it might be + * possible that the buffer has been manipulated + * with erl_peek_ext. + */ + if (*ext == ERL_VERSION_MAGIC) + ext++; + + ep = NULL; + ep = erl_decode_it(&ext); +#ifdef DEBUG + if (!ep) erl_err_msg("<ERROR> erl_decode: Error while decoding"); +#endif + return ep; + +} /* erl_decode */ + +/* + * This one makes it possible to DECODE two CONSECUTIVE + * ETERM's in the same buffer. + */ +ETERM *erl_decode_buf(unsigned char **ext) +{ + ETERM *ep; + + /* We ignore the version magic since it might be + * possible that the buffer has been manipulated + * with erl_peek_ext. + */ + if (**ext == ERL_VERSION_MAGIC) + (*ext)++; + + ep = NULL; + ep = erl_decode_it(ext); +#ifdef DEBUG + if (!ep) erl_err_msg("<ERROR> erl_decode_buf: Error while decoding"); +#endif + return ep; + +} /* erl_decode_buf */ + + +/*============================================================== + * Ok, here comes routines for inspecting/manipulating + * an encoded buffer of bytes. + *============================================================== + */ + +/* + * Return 1 if the VERSION MAGIC in the BUFFER is the + * same as the this library version. + */ +int erl_verify_magic(unsigned char *ext) +{ + + if (*ext == ERL_VERSION_MAGIC) + return 1; + else + return 0; + +} /* erl_verify_magic */ + +/* + * Return the TYPE of an ENCODED ETERM. + * At failure, return 0. + */ +unsigned char erl_ext_type(unsigned char *ext) +{ + /* FIXME old code could skip multiple magic */ + + /* Move over magic number if any */ + if (*ext == ERL_VERSION_MAGIC) ext++; + + switch (*ext) { + case ERL_SMALL_INTEGER_EXT: + case ERL_INTEGER_EXT: + return ERL_INTEGER; + case ERL_ATOM_EXT: + return ERL_ATOM; + case ERL_PID_EXT: + return ERL_PID; + case ERL_PORT_EXT: + return ERL_PORT; + case ERL_REFERENCE_EXT: + case ERL_NEW_REFERENCE_EXT: + return ERL_REF; + case ERL_NIL_EXT: + return ERL_EMPTY_LIST; + case ERL_LIST_EXT: + return ERL_LIST; + case ERL_SMALL_TUPLE_EXT: + case ERL_LARGE_TUPLE_EXT: + return ERL_TUPLE; + case ERL_FLOAT_EXT: + return ERL_FLOAT; + case ERL_BINARY_EXT: + return ERL_BINARY; + case ERL_FUN_EXT: + case ERL_NEW_FUN_EXT: + return ERL_FUNCTION; + case ERL_SMALL_BIG_EXT: + case ERL_LARGE_BIG_EXT: + return ERL_BIG; + default: + return 0; + + } /* switch */ + +} /* erl_ext_type */ + +/* + * Returns the number of elements in compund + * terms. For other kind of terms zero is returned. + * At failure -1 is returned. + */ +int erl_ext_size(unsigned char *t) +{ + int i; + unsigned char *v; + + if (*t == ERL_VERSION_MAGIC) + return erl_ext_size(t+1); + + v = t+1; + switch(*t) { + case ERL_SMALL_INTEGER_EXT: + case ERL_INTEGER_EXT: + case ERL_ATOM_EXT: + case ERL_PID_EXT: + case ERL_PORT_EXT: + case ERL_REFERENCE_EXT: + case ERL_NEW_REFERENCE_EXT: + case ERL_NIL_EXT: + case ERL_BINARY_EXT: + case ERL_STRING_EXT: + case ERL_FLOAT_EXT: + case ERL_SMALL_BIG_EXT: + case ERL_LARGE_BIG_EXT: + return 0; + break; + case ERL_SMALL_TUPLE_EXT: + i = v[0]; + return i; + break; + case ERL_LIST_EXT: + case ERL_LARGE_TUPLE_EXT: + i = (v[0] << 24) | (v[1] << 16) | (v[2] << 8) | v[3]; + return i; + break; + case ERL_FUN_EXT: + i = (v[0] << 24) | (v[1] << 16) | (v[2] << 8) | v[3]; + return i+4; + break; + case ERL_NEW_FUN_EXT: + v += 4 + 1 + 16 + 4; + i = get32be(v); + return i + 4; + break; + default: + return -1; + break; + } /* switch */ + +} /* ext_size */ + +/* + * A nice macro that eats up the atom pointed to. + */ +#define JUMP_ATOM(ext,i) \ +if (**ext != ERL_ATOM_EXT) \ + return 0; \ +*ext += 1; \ +i = (**ext << 8) | (*ext)[1]; \ +*ext += (i + 2) + +/* + * MOVE the POINTER PAST the ENCODED ETERM we + * are currently pointing at. Returns 1 at + * success, otherwise 0. + */ +static int jump(unsigned char **ext) +{ + int j,k,i=0; + int n; + + switch (*(*ext)++) { + case ERL_VERSION_MAGIC: + return jump(ext); + case ERL_INTEGER_EXT: + *ext += 4; + break; + case ERL_SMALL_INTEGER_EXT: + *ext += 1; + break; + case ERL_ATOM_EXT: + i = (**ext << 8) | (*ext)[1]; + *ext += (i + 2); + break; + case ERL_PID_EXT: + /* eat first atom */ + JUMP_ATOM(ext,i); + *ext += 9; /* Two int's and the creation field */ + break; + case ERL_REFERENCE_EXT: + case ERL_PORT_EXT: + /* first field is an atom */ + JUMP_ATOM(ext,i); + *ext += 5; /* One int and the creation field */ + break; + case ERL_NEW_REFERENCE_EXT: + n = (**ext << 8) | (*ext)[1]; + *ext += 2; + /* first field is an atom */ + JUMP_ATOM(ext,i); + *ext += 4*n+1; + break; + case ERL_NIL_EXT: + /* We just passed it... */ + break; + case ERL_LIST_EXT: + i = j = 0; + j = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; + *ext += 4; + for(k=0; k<j; k++) + if ((i = jump(ext)) == 0) + return(0); + if (**ext == ERL_NIL_EXT) { + *ext += 1; + break; + } + if (jump(ext) == 0) return 0; + break; + case ERL_STRING_EXT: + i = **ext << 8 | (*ext)[1]; + *ext += 2 + i; + break; + case ERL_SMALL_TUPLE_EXT: + i = *(*ext)++; + goto jump_tuple; + case ERL_LARGE_TUPLE_EXT: + i = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; + *ext += 4; + jump_tuple: + for (j = 0; j < i; j++) + if ((k = jump(ext)) == 0) + return(0); + break; + case ERL_FLOAT_EXT: + *ext += 31; + break; + case ERL_BINARY_EXT: + i = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; + *ext += 4+i; + break; + case ERL_FUN_EXT: + i = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; + *ext += 4; + i += 4; + for (j = 0; j < i; j++) + if ((k = jump(ext)) == 0) + return(0); + break; + case ERL_NEW_FUN_EXT: + i = get32be(*ext); + *ext += i + 4; + break; + case ERL_SMALL_BIG_EXT: + i = *(*ext); + *ext += i + 1; + break; + case ERL_LARGE_BIG_EXT: + i = get32be(*ext); + *ext += i + 4; + break; + default: + return 0; + } /* switch */ + + return 1; + +} /* jump */ + +/* + * The actual PEEK engine. + */ +static unsigned char *peek_ext(unsigned char **ext, int jumps) +{ + int i; + + switch (*(*ext)++) + { + case ERL_VERSION_MAGIC: + return peek_ext(ext, jumps); + case ERL_SMALL_TUPLE_EXT: + i = *(*ext)++; + goto do_the_peek_stuff; + case ERL_LARGE_TUPLE_EXT: + case ERL_LIST_EXT: + i = (**ext << 24) | ((*ext)[1]) << 16| ((*ext)[2]) << 8| ((*ext)[3]) ; + *ext += 4; + do_the_peek_stuff: + if (i <= jumps) { +#ifdef DEBUG + erl_err_msg("<ERROR> peek_ext: Out of range"); +#endif + return NULL; + } + for(i=0; i<jumps; i++) + if (!jump(ext)) { +#ifdef DEBUG + erl_err_msg("<ERROR> peek_ext: Bad data"); +#endif + return NULL; + } + return *ext; + default: +#ifdef DEBUG + erl_err_msg("<ERROR> peek_ext: Can't peek in non list/tuple type"); +#endif + return NULL; + } /* switch */ + +} /* peek_ext */ + +/* + * Return a POINTER TO the N:TH ELEMENT in a + * COMPUND ENCODED ETERM. + */ +unsigned char *erl_peek_ext(unsigned char *ext, int jumps) +{ + unsigned char *x=ext; + + return peek_ext(&x, jumps); + +} /* erl_peek_ext */ + +/* + * Lexically compare two strings of bytes, + * (string s1 length l1 and s2 l2). + * Return: -1 if s1 < s2 + * 0 if s1 = s2 + * 1 if s1 > s2 + */ +static int cmpbytes(unsigned char* s1,int l1,unsigned char* s2,int l2) +{ + int i; + i = 0; + while((i < l1) && (i < l2)) { + if (s1[i] < s2[i]) return(-1); + if (s1[i] > s2[i]) return(1); + i++; + } + if (l1 < l2) return(-1); + if (l1 > l2) return(1); + return(0); + +} /* cmpbytes */ + +#define CMP_EXT_ERROR_CODE 4711 + +#define CMP_EXT_INT32_BE(AP, BP) \ +do { \ + if ((AP)[0] != (BP)[0]) return (AP)[0] < (BP)[0] ? -1 : 1; \ + if ((AP)[1] != (BP)[1]) return (AP)[1] < (BP)[1] ? -1 : 1; \ + if ((AP)[2] != (BP)[2]) return (AP)[2] < (BP)[2] ? -1 : 1; \ + if ((AP)[3] != (BP)[3]) return (AP)[3] < (BP)[3] ? -1 : 1; \ +} while (0) + +#define CMP_EXT_SKIP_ATOM(EP) \ +do { \ + if ((EP)[0] != ERL_ATOM_EXT) \ + return CMP_EXT_ERROR_CODE; \ + (EP) += 3 + ((EP)[1] << 8 | (EP)[2]); \ +} while (0) + +/* + * We now know that both byte arrays are of the same type. + */ +static int compare_top_ext(unsigned char**, unsigned char **); /* forward */ +static int cmp_exe2(unsigned char **e1, unsigned char **e2); + +static int cmp_refs(unsigned char **e1, unsigned char **e2) +{ + int tmp, n1, n2; + unsigned char *node1, *node2, *id1, *id2, cre1, cre2; + + if (*((*e1)++) == ERL_REFERENCE_EXT) { + node1 = *e1; + CMP_EXT_SKIP_ATOM(*e1); + n1 = 1; + id1 = *e1; + cre1 = (*e1)[4]; + *e1 += 5; + } else { + n1 = get16be(*e1); + node1 = *e1; + CMP_EXT_SKIP_ATOM(*e1); + cre1 = **e1; + id1 = (*e1) + 1 + (n1 - 1)*4; + *e1 = id1 + 4; + } + + if (*((*e2)++) == ERL_REFERENCE_EXT) { + node2 = *e2; + CMP_EXT_SKIP_ATOM(*e2); + n2 = 1; + id2 = *e2; + cre2 = (*e2)[4]; + *e2 += 5; + } else { + n2 = get16be(*e2); + node2 = *e2; + CMP_EXT_SKIP_ATOM(*e2); + cre2 = **e2; + id2 = (*e2) + 1 + (n2 - 1)*4; + *e2 = id2 + 4; + } + + /* First compare node names... */ + tmp = cmp_exe2(&node1, &node2); + if (tmp != 0) + return tmp; + + /* ... then creations ... */ + if (cre1 != cre2) + return cre1 < cre2 ? -1 : 1; + + /* ... and then finaly ids. */ + if (n1 != n2) { + unsigned char zero[] = {0, 0, 0, 0}; + if (n1 > n2) + do { + CMP_EXT_INT32_BE(id1, zero); + id1 -= 4; + n1--; + } while (n1 > n2); + else + do { + CMP_EXT_INT32_BE(zero, id2); + id2 -= 4; + n2--; + } while (n2 > n1); + } + + for (; n1 > 0; n1--, id1 -= 4, id2 -= 4) + CMP_EXT_INT32_BE(id1, id2); + + return 0; +} + +static int cmp_string_list(unsigned char **e1, unsigned char **e2) { + + /* we need to compare a string in **e1 and a list in **e2 */ + /* convert the string to list representation and convert that with e2 */ + /* we need a temporary buffer of: */ + /* 5 (list tag + length) + 2*string length + 1 (end of list tag) */ + /* for short lists we use a stack allocated buffer, otherwise we malloc */ + + unsigned char *bp; + unsigned char buf[5+2*255+1]; /* used for short lists */ + int i,e1_len; + int res; + + e1_len = ((*e1)[1] << 8) | ((*e1)[2]); + if ( e1_len < 256 ) { + bp = buf; + } else { + bp = malloc(5+(2*e1_len)+1); + } + + bp[0] = ERL_LIST_EXT; + bp[1] = bp[2] = 0; + bp[3] = (*e1)[1]; + bp[4] = (*e1)[2]; + + for(i=0;i<e1_len;i++) { + bp[5+2*i] = ERL_SMALL_INTEGER_EXT; + bp[5+2*i+1] = (*e1)[3+i]; + } + + bp[5+2*e1_len] = ERL_NIL_EXT; + + res = cmp_exe2(&bp, e2); + + if ( e1_len >= 256 ) free(bp); + + return res; +} + +static int cmp_exe2(unsigned char **e1, unsigned char **e2) +{ + int min, ret,i,j,k; + double ff1, ff2; + unsigned char *tmp1, *tmp2; + + if ( ((*e1)[0] == ERL_STRING_EXT) && ((*e2)[0] == ERL_LIST_EXT) ) { + return cmp_string_list(e1, e2); + } else if ( ((*e1)[0] == ERL_LIST_EXT) && ((*e2)[0] == ERL_STRING_EXT) ) { + return -cmp_string_list(e2, e1); + } + + *e2 += 1; + switch (*(*e1)++) + { + case ERL_SMALL_INTEGER_EXT: + if (**e1 < **e2) ret = -1; + else if (**e1 > **e2) ret = 1; + else ret = 0; + *e1 += 1; *e2 += 1; + return ret; + case ERL_INTEGER_EXT: + i = (int) (**e1 << 24) | ((*e1)[1] << 16) |((*e1)[2] << 8) | (*e1)[3]; + j = (int) (**e2 << 24) | ((*e2)[1] << 16) |((*e2)[2] << 8) | (*e2)[3]; + if ( i < j) + ret = -1; + else if ( i > j) + ret = 1; + else + ret = 0; + *e1 += 4; *e2 += 4; + return ret; + case ERL_ATOM_EXT: + i = (**e1 << 8) | (*e1)[1]; + j = (**e2 << 8) | (*e2)[1]; + ret = cmpbytes(*e1 +2, i, *e2 +2, j); + *e1 += (i + 2); + *e2 += (j + 2); + return ret; + case ERL_PID_EXT: { + unsigned char *n1 = *e1; + unsigned char *n2 = *e2; + CMP_EXT_SKIP_ATOM(*e1); CMP_EXT_SKIP_ATOM(*e2); + *e1 += 9; *e2 += 9; + + /* First compare serials ... */ + tmp1 = *e1 - 5; tmp2 = *e2 - 5; + CMP_EXT_INT32_BE(tmp1, tmp2); + + /* ... then ids ... */ + tmp1 -= 4; tmp2 -= 4; + CMP_EXT_INT32_BE(tmp1, tmp2); + + /* ... then node names ... */ + ret = cmp_exe2(&n1, &n2); + if (ret != 0) + return ret; + + /* ... and then finaly creations. */ + tmp1 += 8; tmp2 += 8; + if (*tmp1 != *tmp2) + return *tmp1 < *tmp2 ? -1 : 1; + return 0; + } + case ERL_PORT_EXT: + /* First compare node names ... */ + if (**e1 != ERL_ATOM_EXT || **e2 != ERL_ATOM_EXT) + return CMP_EXT_ERROR_CODE; + ret = cmp_exe2(e1, e2); + *e1 += 5; *e2 += 5; + if (ret != 0) + return ret; + /* ... then creations ... */ + tmp1 = *e1 - 1; tmp2 = *e2 - 1; + if (*tmp1 != *tmp2) + return *tmp1 < *tmp2 ? -1 : 1; + /* ... and then finaly ids. */ + tmp1 -= 4; tmp2 -= 4; + CMP_EXT_INT32_BE(tmp1, tmp2); + return 0; + case ERL_NIL_EXT: return 0; + case ERL_LIST_EXT: + i = (**e1 << 24) | ((*e1)[1] << 16) |((*e1)[2] << 8) | (*e1)[3]; + *e1 += 4; + j = (**e2 << 24) | ((*e2)[1] << 16) |((*e2)[2] << 8) | (*e2)[3]; + *e2 += 4; + if ( i == j && j == 0 ) return 0; + min = (i < j) ? i : j; + k = 0; + while (1) { + if (k++ == min) + return compare_top_ext(e1 , e2); + if ((ret = compare_top_ext(e1 , e2)) == 0) + continue; + return ret; + } + case ERL_STRING_EXT: + i = (**e1 << 8) | ((*e1)[1]); + *e1 += 2; + j = (**e2 << 8) | ((*e2)[1]); + *e2 += 2; + ret = cmpbytes(*e1, i, *e2, j); + *e1 += i; + *e2 += j; + return ret; + case ERL_SMALL_TUPLE_EXT: + i = *(*e1)++; j = *(*e2)++; + if (i < j) return -1; + if (i > j ) return 1; + while (i--) { + if ((j = compare_top_ext(e1, e2))) return j; + } + return 0; + case ERL_LARGE_TUPLE_EXT: + i = (**e1 << 24) | ((*e1)[1]) << 16| ((*e1)[2]) << 8| ((*e1)[3]) ; + *e1 += 4; + j = (**e2 << 24) | ((*e2)[1]) << 16| ((*e2)[2]) << 8| ((*e2)[3]) ; + *e2 += 4; + if (i < j) return -1; + if (i > j ) return 1; + while (i--) { + if ((j = compare_top_ext(e1, e2))) return j; + } + return 0; + case ERL_FLOAT_EXT: + if (sscanf((char *) *e1, "%lf", &ff1) != 1) + return -1; + *e1 += 31; + if (sscanf((char *) *e2, "%lf", &ff2) != 1) + return -1; + *e2 += 31; + return cmp_floats(ff1,ff2); + + case ERL_BINARY_EXT: + i = (**e1 << 24) | ((*e1)[1] << 16) |((*e1)[2] << 8) | (*e1)[3]; + *e1 += 4; + j = (**e2 << 24) | ((*e2)[1] << 16) |((*e2)[2] << 8) | (*e2)[3]; + *e2 += 4; + ret = cmpbytes(*e1, i , *e2 , j); + *e1 += i; *e2 += j; + return ret; + + case ERL_FUN_EXT: /* FIXME: */ + case ERL_NEW_FUN_EXT: /* FIXME: */ + return -1; + + default: + return cmpbytes(*e1, 1, *e2, 1); + + } /* switch */ + +} /* cmp_exe2 */ + +/* Number compare */ + +static int cmp_floats(double f1, double f2) +{ +#if defined(VXWORKS) && CPU == PPC860 + return erl_fp_compare((unsigned *) &f1, (unsigned *) &f2); +#else + if (f1<f2) return -1; + else if (f1>f2) return 1; + else return 0; +#endif +} + +static INLINE double to_float(long l) +{ + double f; +#if defined(VXWORKS) && CPU == PPC860 + erl_long_to_fp(l, (unsigned *) &f); +#else + f = l; +#endif + return f; +} + + +static int cmp_small_big(unsigned char**e1, unsigned char **e2) +{ + int i1,i2; + int t2; + int n2; + long l1; + int res; + + erlang_big *b1,*b2; + + i1 = i2 = 0; + if ( ei_decode_long((char *)*e1,&i1,&l1) < 0 ) return -1; + + ei_get_type((char *)*e2,&i2,&t2,&n2); + + /* any small will fit in two digits */ + if ( (b1 = ei_alloc_big(2)) == NULL ) return -1; + if ( ei_small_to_big(l1,b1) < 0 ) { + ei_free_big(b1); + return -1; + } + + if ( (b2 = ei_alloc_big(n2)) == NULL ) { + ei_free_big(b1); + return 1; + } + + if ( ei_decode_big((char *)*e2,&i2,b2) < 0 ) { + ei_free_big(b1); + ei_free_big(b2); + return 1; + } + + res = ei_big_comp(b1,b2); + + ei_free_big(b1); + ei_free_big(b2); + + *e1 += i1; + *e2 += i2; + + return res; +} + +static int cmp_small_float(unsigned char**e1, unsigned char **e2) +{ + int i1,i2; + long l1; + double f1,f2; + + /* small -> float -> float_comp */ + + i1 = i2 = 0; + if ( ei_decode_long((char *)*e1,&i1,&l1) < 0 ) return -1; + if ( ei_decode_double((char *)*e2,&i2,&f2) < 0 ) return 1; + + f1 = to_float(l1); + + *e1 += i1; + *e2 += i2; + + return cmp_floats(f1,f2); +} + +static int cmp_float_big(unsigned char**e1, unsigned char **e2) +{ + int res; + int i1,i2; + int t2,n2; + double f1,f2; + erlang_big *b2; + + /* big -> float if overflow return big sign else float_comp */ + + i1 = i2 = 0; + if ( ei_decode_double((char *)*e1,&i1,&f1) < 0 ) return -1; + + if (ei_get_type((char *)*e2,&i2,&t2,&n2) < 0) return 1; + if ((b2 = ei_alloc_big(n2)) == NULL) return 1; + if (ei_decode_big((char *)*e2,&i2,b2) < 0) return 1; + + /* convert the big to float */ + if ( ei_big_to_double(b2,&f2) < 0 ) { + /* exception look at the sign */ + res = b2->is_neg ? 1 : -1; + ei_free_big(b2); + return res; + } + + ei_free_big(b2); + + *e1 += i1; + *e2 += i2; + + return cmp_floats(f1,f2); +} + +static int cmp_small_small(unsigned char**e1, unsigned char **e2) +{ + int i1,i2; + long l1,l2; + + i1 = i2 = 0; + if ( ei_decode_long((char *)*e1,&i1,&l1) < 0 ) { + fprintf(stderr,"Failed to decode 1\r\n"); + return -1; + } + if ( ei_decode_long((char *)*e2,&i2,&l2) < 0 ) { + fprintf(stderr,"Failed to decode 2\r\n"); + return 1; + } + + *e1 += i1; + *e2 += i2; + + if ( l1 < l2 ) return -1; + else if ( l1 > l2 ) return 1; + else return 0; +} + +static int cmp_float_float(unsigned char**e1, unsigned char **e2) +{ + int i1,i2; + double f1,f2; + + i1 = i2 = 0; + if ( ei_decode_double((char *)*e1,&i1,&f1) < 0 ) return -1; + if ( ei_decode_double((char *)*e2,&i2,&f2) < 0 ) return 1; + + *e1 += i1; + *e2 += i2; + + return cmp_floats(f1,f2); +} + +static int cmp_big_big(unsigned char**e1, unsigned char **e2) +{ + int res; + int i1,i2; + int t1,t2; + int n1,n2; + erlang_big *b1,*b2; + + i1 = i2 = 0; + ei_get_type((char *)*e1,&i1,&t1,&n1); + ei_get_type((char *)*e2,&i2,&t2,&n2); + + b1 = ei_alloc_big(n1); + b2 = ei_alloc_big(n2); + + ei_decode_big((char *)*e1,&i1,b1); + ei_decode_big((char *)*e2,&i2,b2); + + res = ei_big_comp(b1,b2); + + ei_free_big(b1); + ei_free_big(b2); + + *e1 += i1; + *e2 += i2; + + return res; +} + +static int cmp_number(unsigned char**e1, unsigned char **e2) +{ + switch (CMP_NUM_CODE(**e1,**e2)) { + + case SMALL_BIG: + /* fprintf(stderr,"compare small_big\r\n"); */ + return cmp_small_big(e1,e2); + + case BIG_SMALL: + /* fprintf(stderr,"compare sbig_small\r\n"); */ + return -cmp_small_big(e2,e1); + + case SMALL_FLOAT: + /* fprintf(stderr,"compare small_float\r\n"); */ + return cmp_small_float(e1,e2); + + case FLOAT_SMALL: + /* fprintf(stderr,"compare float_small\r\n"); */ + return -cmp_small_float(e2,e1); + + case FLOAT_BIG: + /* fprintf(stderr,"compare float_big\r\n"); */ + return cmp_float_big(e1,e2); + + case BIG_FLOAT: + /* fprintf(stderr,"compare big_float\r\n"); */ + return -cmp_float_big(e2,e1); + + case SMALL_SMALL: + /* fprintf(stderr,"compare small_small\r\n"); */ + return cmp_small_small(e1,e2); + + case FLOAT_FLOAT: + /* fprintf(stderr,"compare float_float\r\n"); */ + return cmp_float_float(e1,e2); + + case BIG_BIG: + /* fprintf(stderr,"compare big_big\r\n"); */ + return cmp_big_big(e1,e2); + + default: + /* should never get here ... */ + /* fprintf(stderr,"compare standard\r\n"); */ + return cmp_exe2(e1,e2); + } + +} + +/* + * If the arrays are of the same type, then we + * have to do a real compare. + */ +/* + * COMPARE TWO encoded BYTE ARRAYS e1 and e2. + * Return: -1 if e1 < e2 + * 0 if e1 == e2 + * 1 if e2 > e1 + */ +static int compare_top_ext(unsigned char**e1, unsigned char **e2) +{ + if (**e1 == ERL_VERSION_MAGIC) (*e1)++; + if (**e2 == ERL_VERSION_MAGIC) (*e2)++; + + if (cmp_array[**e1] < cmp_array[**e2]) return -1; + if (cmp_array[**e1] > cmp_array[**e2]) return 1; + + if (IS_ERL_NUM(**e1)) + return cmp_number(e1,e2); + + if (cmp_array[**e1] == ERL_REF_CMP) + return cmp_refs(e1, e2); + + return cmp_exe2(e1, e2); +} + +int erl_compare_ext(unsigned char *e1, unsigned char *e2) +{ + return compare_top_ext(&e1, &e2); +} /* erl_compare_ext */ + +#if defined(VXWORKS) && CPU == PPC860 +/* FIXME we have no floating point but don't we have emulation?! */ +int erl_fp_compare(unsigned *a, unsigned *b) +{ + /* Big endian mode of powerPC, IEEE floating point. */ + unsigned a_split[4] = {a[0] >> 31, /* Sign bit */ + (a[0] >> 20) & 0x7FFU, /* Exponent */ + a[0] & 0xFFFFFU, /* Mantissa MS bits */ + a[1]}; /* Mantissa LS bits */ + unsigned b_split[4] = {b[0] >> 31, + (b[0] >> 20) & 0x7FFU, + b[0] & 0xFFFFFU, + b[1]}; + int a_is_infinite, b_is_infinite; + int res; + + + /* Make -0 be +0 */ + if (a_split[1] == 0 && a_split[2] == 0 && a_split[3] == 0) + a_split[0] = 0; + if (b_split[1] == 0 && b_split[2] == 0 && b_split[3] == 0) + b_split[0] = 0; + /* Check for infinity */ + a_is_infinite = (a_split[1] == 0x7FFU && a_split[2] == 0 && + a_split[3] == 0); + b_is_infinite = (b_split[1] == 0x7FFU && b_split[2] == 0 && + b_split[3] == 0); + + if (a_is_infinite && !b_is_infinite) + return (a_split[0]) ? -1 : 1; + if (b_is_infinite && !a_is_infinite) + return (b_split[0]) ? 1 : -1; + if (a_is_infinite && b_is_infinite) + return b[0] - a[0]; + /* Check for indeterminate or nan, infinite is already handled, + so we only check the exponent. */ + if((a_split[1] == 0x7FFU) || (b_split[1] == 0x7FFU)) + return INT_MAX; /* Well, they are not equal anyway, + abort() could be an alternative... */ + + if (a_split[0] && !b_split[0]) + return -1; + if (b_split[0] && !a_split[0]) + return 1; + /* Compare */ + res = memcmp(a_split + 1, b_split + 1, 3 * sizeof(unsigned)); + /* Make -1, 0 or 1 */ + res = (!!res) * ((res < 0) ? -1 : 1); + /* Turn sign if negative values */ + if (a_split[0]) /* Both are negative */ + res = -1 * res; + return res; +} + +static void join(unsigned d_split[4], unsigned *d) +{ + d[0] = (d_split[0] << 31) | /* Sign bit */ + ((d_split[1] & 0x7FFU) << 20) | /* Exponent */ + (d_split[2] & 0xFFFFFU); /* Mantissa MS bits */ + d[1] = d_split[3]; /* Mantissa LS bits */ +} + +static int blength(unsigned long l) +{ + int i; + for(i = 0; l; ++i) + l >>= 1; + return i; +} + +static void erl_long_to_fp(long l, unsigned *d) +{ + unsigned d_split[4]; + unsigned x; + if (l < 0) { + d_split[0] = 1; + x = -l; + } else { + d_split[0] = 0; + x = l; + } + + if (!l) { + memset(d_split,0,sizeof(d_split)); + } else { + int len = blength(x); + x <<= (33 - len); + d_split[2] = (x >> 12); + d_split[3] = (x << 20); + d_split[1] = 1023 + len - 1; + } + join(d_split,d); +} + +#endif + + +/* + * Checks if a term is a "string": a flat list of byte-sized integers. + * + * Returns: 0 if the term is not a string, otherwise the length is returned. + */ + +static int is_string(ETERM* term) +{ + int len = 0; + + while (ERL_TYPE(term) == ERL_LIST) { + ETERM* head = HEAD(term); + + if (!ERL_IS_INTEGER(head) || ((unsigned)head->uval.ival.i) > 255) { + return 0; + } + len++; + term = TAIL(term); + } + + if (ERL_IS_EMPTY_LIST(term)) { + return len; + } + return 0; +} |