diff options
Diffstat (limited to 'lib/erl_interface/src/legacy')
27 files changed, 6513 insertions, 0 deletions
diff --git a/lib/erl_interface/src/legacy/decode_term.c b/lib/erl_interface/src/legacy/decode_term.c new file mode 100644 index 0000000000..ef29d6f57d --- /dev/null +++ b/lib/erl_interface/src/legacy/decode_term.c @@ -0,0 +1,142 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-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% + */ +#include "eidef.h" +#include "eiext.h" +#include "putget.h" +#include "erl_interface.h" + +/* + * This file is actually part of the erl_interface library, + * not the newer 'ei' library. The header file is still in "ei.h" + */ + +/* FIXME: is this to be completed? */ + +#if (0) +int ei_decode_term(const char *buf, int *index, void *t) +{ + const char *s = buf + *index; + const char *s0 = s; + + if (t) { + ETERM *tmp; + + /* this decodes and advances s */ + if (!(tmp = erl_decode_buf((unsigned char **)&s))) return -1; + + *(ETERM **)t = tmp; + *index += s - s0; + + return 0; + } + else { + int tmpindex = *index; + long ttype; + int arity; + int i; + + /* these are all the external types */ + switch ((ttype = get8(s))) { + case ERL_SMALL_INTEGER_EXT: + case ERL_INTEGER_EXT: + case ERL_SMALL_BIG_EXT: + return ei_decode_long(buf,index,NULL); + + case ERL_FLOAT_EXT: + return ei_decode_double(buf,index,NULL); + + case ERL_ATOM_EXT: + return ei_decode_atom(buf,index,NULL); + + case ERL_REFERENCE_EXT: + case ERL_NEW_REFERENCE_EXT: + return ei_decode_ref(buf,index,NULL); + + case ERL_PORT_EXT: + return ei_decode_port(buf,index,NULL); + + case ERL_PID_EXT: + return ei_decode_pid(buf,index,NULL); + + case ERL_SMALL_TUPLE_EXT: + case ERL_LARGE_TUPLE_EXT: + if (ei_decode_tuple_header(buf,index,&arity) < 0) + return -1; + + for (i=0; i<arity; i++) { + if (ei_decode_term(buf,index,NULL)) { + /* restore possibly changed index before returning */ + *index = tmpindex; + return -1; + } + } + return 0; + + case ERL_STRING_EXT: + return ei_decode_string(buf,index,NULL); + + case ERL_LIST_EXT: + case ERL_NIL_EXT: + if (ei_decode_list_header(buf,index,&arity) < 0) + return -1; + + if (arity) { + for (i=0; i<arity; i++) { + if (ei_decode_term(buf,index,NULL) < 0) { + /* restore possibly changed index before returning */ + *index = tmpindex; + return -1; + } + } + if (ei_decode_list_header(buf,index,&arity) < 0) { + *index = tmpindex; + return -1; + } + } + return 0; + + case ERL_BINARY_EXT: + return ei_decode_binary(buf,index,NULL,NULL); + + case ERL_LARGE_BIG_EXT: + default: + break; + } + } + + return -1; +} +#else +int ei_decode_term(const char *buf, int *index, void *t) +{ + const char *s = buf + *index; + const char *s0 = s; + ETERM *tmp; + + /* this decodes and advances s */ + if (!(tmp = erl_decode_buf((unsigned char **)&s))) return -1; + + if (t) *(ETERM **)t = tmp; + else erl_free_term(tmp); + + *index += s - s0; + + return 0; +} +#endif diff --git a/lib/erl_interface/src/legacy/encode_term.c b/lib/erl_interface/src/legacy/encode_term.c new file mode 100644 index 0000000000..c377d7b699 --- /dev/null +++ b/lib/erl_interface/src/legacy/encode_term.c @@ -0,0 +1,53 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-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% + */ +#include "eidef.h" +#include "eiext.h" +#include "putget.h" +#include "ei_x_encode.h" +#include "erl_interface.h" +#include "erl_marshal.h" + +/* FIXME: depends on old erl_interface */ + +int ei_x_encode_term(ei_x_buff* x, void* t) +{ + int i = x->index; + ei_encode_term(NULL, &i, t); + if (!x_fix_buff(x, i)) + return -1; + return ei_encode_term(x->buff, &x->index, t); +} + +int ei_encode_term(char *buf, int *index, void *t) +{ + char *s = buf + *index; + char *s0 = s; + + if (!buf) s += erl_term_len(t) -1; /* -1 for version */ + else { + /* this encodes all but the version at the start */ + /* and it will move s forward the right number of bytes */ + if (erl_encode_it(t,(unsigned char **)&s, 5)) return -1; + } + + *index += s - s0; + + return 0; +} + diff --git a/lib/erl_interface/src/legacy/erl_config.h b/lib/erl_interface/src/legacy/erl_config.h new file mode 100644 index 0000000000..166aa7013c --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_config.h @@ -0,0 +1,22 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-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% + */ +#ifndef _ERL_CONFIG_H +#define _ERL_CONFIG_H + +#endif /* _ERL_CONFIG_H */ diff --git a/lib/erl_interface/src/legacy/erl_connect.c b/lib/erl_interface/src/legacy/erl_connect.c new file mode 100644 index 0000000000..3c8c946506 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_connect.c @@ -0,0 +1,457 @@ +/* + * %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: Connect to any node at any host. + */ + +/*************************************************************************** + * + * 'erl_interface' node connection handling is to use 'ei' for all + * operations without access to the internal structure of saved data, + * e.i. it should use the public interface functions. The connection + * handling can be seen as a restricted node interface where only one + * node can be used in one operating system process. + * + ***************************************************************************/ + +#include "eidef.h" + +#include <stdlib.h> +#include <sys/types.h> +#include <fcntl.h> + +#ifdef __WIN32__ +#include <winsock2.h> +#include <windows.h> +#include <winbase.h> + +#elif VXWORKS +#include <vxWorks.h> +#include <hostLib.h> +#include <selectLib.h> +#include <ifLib.h> +#include <sockLib.h> +#include <taskLib.h> +#include <inetLib.h> + +#include <unistd.h> +#include <sys/types.h> +#include <sys/times.h> +#include <unistd.h> +#include <sys/types.h> +#include <sys/socket.h> +#include <netinet/in.h> +#include <netinet/tcp.h> +#include <timers.h> + +#include "erl_error.h" + +#else /* some other unix */ +#include <unistd.h> +#include <sys/types.h> +#include <sys/times.h> + +#if TIME_WITH_SYS_TIME +# include <sys/time.h> +# include <time.h> +#else +# if HAVE_SYS_TIME_H +# include <sys/time.h> +# else +# include <time.h> +# endif +#endif + +#include <sys/socket.h> +#include <netinet/in.h> +#include <netinet/tcp.h> +#include <arpa/inet.h> +#include <netdb.h> +#include <sys/utsname.h> /* for gen_challenge (NEED FIX?) */ +#endif + +/* common includes */ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <errno.h> + +/* FIXME include less */ +#include "erl_interface.h" +#include "erl_connect.h" +#include "erl_eterm.h" +#include "erl_malloc.h" +#include "putget.h" +#include "ei.h" +#include "ei_connect_int.h" +#include "ei_locking.h" +#include "ei_epmd.h" +#include "ei_internal.h" + +/* rpc_from() uses a buffer this size */ +#ifndef MAX_RECEIVE_BUF +#define MAX_RECEIVE_BUF 32*1024 +#endif + +/* This is the global state of the old erl_* API */ + +static ei_cnode erl_if_ec; + +/*************************************************************************** + * + * API: erl_connect_init() + * API: erl_connect_xinit() + * + * Returns 1 on success and 0 on failure. + * Not documented to set erl_errno. + * + ***************************************************************************/ + +int erl_connect_init(int this_node_number, char *cookie, short creation) +{ + char nn[MAXATOMLEN+1]; + + sprintf(nn, "c%d", this_node_number); + + return ei_connect_init(&erl_if_ec, nn, cookie, creation) == 0; +} + +/* FIXME documented to use struct in_addr as addr */ + +int erl_connect_xinit(char *thishostname, + char *thisalivename, + char *thisnodename, + struct in_addr *thisipaddr, + char *cookie, + short creation) +{ + return ei_connect_xinit(&erl_if_ec, thishostname, thisalivename, + thisnodename, thisipaddr, cookie, creation) >= 0; +} + +/*************************************************************************** + * + * API: erl_connect() + * API: erl_xconnect() + * + * Set up a connection to a given Node, and interchange hand shake + * messages with it. + * + * Returns valid file descriptor on success and < 0 on failure. + * Set erl_errno to EHOSTUNREACH, ENOMEM, EIO or errno from socket(2) + * or connect(2). + * + ***************************************************************************/ + +int erl_connect(char *nodename) +{ + int res = ei_connect(&erl_if_ec, nodename); + if (res < 0) erl_errno = EIO; + return res; +} + +/* FIXME documented to use struct in_addr as addr */ + +int erl_xconnect(Erl_IpAddr addr, char *alivename) +{ + return ei_xconnect(&erl_if_ec, addr, alivename); +} + + +/*************************************************************************** + * + * API: erl_close_connection() + * + * Close a connection. FIXME call ei_close_connection() later. + * + * Returns valid file descriptor on success and < 0 on failure. + * Set erl_errno to EHOSTUNREACH, ENOMEM, EIO or errno from socket(2) + * or connect(2). + * + ***************************************************************************/ + +int erl_close_connection(int fd) +{ + return closesocket(fd); +} + +/* + * Accept and initiate a connection from an other + * Erlang node. Return a file descriptor at success, + * otherwise -1; + */ +int erl_accept(int lfd, ErlConnect *conp) +{ + return ei_accept(&erl_if_ec, lfd, conp); +} + + +/* Receives a message from an Erlang socket. + * If the message was a TICK it is immediately + * answered. Returns: ERL_ERROR, ERL_TICK or + * the number of bytes read. + */ +int erl_receive(int s, unsigned char *bufp, int bufsize) +{ + return ei_receive(s, bufp, bufsize); +} + +/* + * Send an Erlang message to a registered process + * at the Erlang node, connected with a socket. + */ +int erl_reg_send(int fd, char *server_name, ETERM *msg) +{ + ei_x_buff x; + int r; + + ei_x_new_with_version(&x); + if (ei_x_encode_term(&x, msg) < 0) { + erl_errno = EINVAL; + r = 0; + } else { + r = ei_reg_send(&erl_if_ec, fd, server_name, x.buff, x.index); + } + ei_x_free(&x); + return r == 0; +} + +/* + * Sends an Erlang message to a process at an Erlang node + */ +int erl_send(int fd, ETERM *to ,ETERM *msg) +{ + erlang_pid topid; + ei_x_buff x; + int r; + + ei_x_new_with_version(&x); + ei_x_encode_term(&x, msg); + /* make the to-pid */ + if (!ERL_IS_PID(to)) { + ei_x_free(&x); + erl_errno = EINVAL; + return -1; + } + + strcpy(topid.node, (char *)ERL_PID_NODE(to)); + topid.num = ERL_PID_NUMBER(to); + topid.serial = ERL_PID_SERIAL(to); + topid.creation = ERL_PID_CREATION(to); + r = ei_send(fd, &topid, x.buff, x.index); + ei_x_free(&x); + return r == 0; +} + +static int erl_do_receive_msg(int fd, ei_x_buff* x, ErlMessage* emsg) +{ + erlang_msg msg; + + int r; + msg.from.node[0] = msg.to.node[0] = '\0'; + r = ei_do_receive_msg(fd, 0, &msg, x, 0); + + if (r == ERL_MSG) { + int index = 0; + emsg->type = msg.msgtype; + + /* + We can't call ei_decode_term for cases where there are no + data following the type information. If there are other + types added later where there are data this case has to be + extended. + */ + + switch (msg.msgtype) { + case ERL_SEND: + case ERL_REG_SEND: + case ERL_EXIT: + case ERL_EXIT2: + if (ei_decode_term(x->buff, &index, &emsg->msg) < 0) + r = ERL_ERROR; + break; + default: + emsg->msg = NULL; /* Not needed but may avoid problems for unsafe caller */ + break; + } + } else + emsg->msg = NULL; + if (msg.from.node[0] != '\0') + emsg->from = erl_mk_pid(msg.from.node, msg.from.num, msg.from.serial, msg.from.creation); + if (msg.to.node[0] != '\0') + emsg->to = erl_mk_pid(msg.to.node, msg.to.num, msg.to.serial, msg.to.creation); + return r; +} + +int erl_receive_msg(int fd, unsigned char *buf, int bufsize, ErlMessage *emsg) +{ + ei_x_buff x; + int r; + + ei_x_new(&x); + r = erl_do_receive_msg(fd, &x, emsg); + /* FIXME what is this about? */ + if (bufsize > x.index) + bufsize = x.index; + memcpy(buf, x.buff, bufsize); + ei_x_free(&x); + return r; +} + +int erl_xreceive_msg(int fd, unsigned char **buf, int *bufsize, + ErlMessage *emsg) +{ + ei_x_buff x; + int r; + + ei_x_new(&x); + r = erl_do_receive_msg(fd, &x, emsg); + if (*bufsize < x.index) + *buf = erl_realloc(*buf, x.index); + *bufsize = x.index; + memcpy(*buf, x.buff, *bufsize); + ei_x_free(&x); + return r; +} + +/* + * The RPC consists of two parts, send and receive. + * Here is the send part ! + * { PidFrom, { call, Mod, Fun, Args, user }} + */ +/* + * Now returns non-negative number for success, negative for failure. + */ +int erl_rpc_to(int fd, char *mod, char *fun, ETERM *args) +{ + int r; + ei_x_buff x; + + ei_x_new(&x); + ei_x_encode_term(&x, args); + r = ei_rpc_to(&erl_if_ec, fd, mod, fun, x.buff, x.index); + ei_x_free(&x); + return r; +} /* rpc_to */ + + /* + * And here is the rpc receiving part. A negative + * timeout means 'infinity'. Returns either of: ERL_MSG, + * ERL_TICK, ERL_ERROR or ERL_TIMEOUT. +*/ +int erl_rpc_from(int fd, int timeout, ErlMessage *emsg) +{ + fd_set readmask; + struct timeval tv; + struct timeval *t = NULL; + unsigned char rbuf[MAX_RECEIVE_BUF]; + + if (timeout >= 0) { + tv.tv_sec = timeout / 1000; + tv.tv_usec = (timeout % 1000) * 1000; + t = &tv; + } + + FD_ZERO(&readmask); + FD_SET(fd,&readmask); + + switch (select(fd+1, &readmask, NULL, NULL, t)) { + case -1: + erl_errno = EIO; + return ERL_ERROR; + case 0: + erl_errno = ETIMEDOUT; + return ERL_TIMEOUT; + default: + if (FD_ISSET(fd, &readmask)) + return erl_receive_msg(fd, rbuf, MAX_RECEIVE_BUF, emsg); + else { + erl_errno = EIO; + return ERL_ERROR; + } + } +} /* rpc_from */ + +/* + * A true RPC. It return a NULL pointer + * in case of failure, otherwise a valid + * (ETERM *) pointer containing the reply + */ +ETERM *erl_rpc(int fd, char *mod, char *fun, ETERM *args) +{ + int i; + ETERM *ep; + ErlMessage emsg; + + if (erl_rpc_to(fd, mod, fun, args) < 0) { + return NULL; } + while ((i=erl_rpc_from(fd, ERL_NO_TIMEOUT, &emsg)) == ERL_TICK); + + if (i == ERL_ERROR) return NULL; + + ep = erl_element(2,emsg.msg); /* {RPC_Tag, RPC_Reply} */ + erl_free_term(emsg.msg); + erl_free_term(emsg.to); + return ep; +} /* rpc */ + + +/* + ** Handshake + */ + +int erl_publish(int port) +{ + return ei_publish(&erl_if_ec, port); +} + +int erl_unpublish(const char *alive) +{ + return ei_unpublish_tmo(alive,0); +} + +erlang_pid *erl_self(void) +{ + return ei_self(&erl_if_ec); +} + +const char *erl_thisnodename(void) +{ + return ei_thisnodename(&erl_if_ec); +} + +const char *erl_thishostname(void) +{ + return ei_thishostname(&erl_if_ec); +} + +const char *erl_thisalivename(void) +{ + return ei_thisalivename(&erl_if_ec); +} + +const char *erl_thiscookie(void) +{ + return ei_thiscookie(&erl_if_ec); +} + +short erl_thiscreation(void) +{ + return ei_thiscreation(&erl_if_ec); +} diff --git a/lib/erl_interface/src/legacy/erl_connect.h b/lib/erl_interface/src/legacy/erl_connect.h new file mode 100644 index 0000000000..d9d6c4e453 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_connect.h @@ -0,0 +1,24 @@ +/* + * %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% + */ +#ifndef _ERL_CONNECT_H +#define _ERL_CONNECT_H + +erlang_pid *erl_self(void); + +#endif /* _ERL_CONNECT_H */ diff --git a/lib/erl_interface/src/legacy/erl_error.c b/lib/erl_interface/src/legacy/erl_error.c new file mode 100644 index 0000000000..18dc2423bf --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_error.c @@ -0,0 +1,180 @@ +/* + * %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% + */ +/* + * Function: Some nice error routines taken from: + * "Advanced Programming in the UNIX Environment", + * by W.Richard Stevens + * + * void erl_err_sys(const char *fmt, ... ) fatal, sys-error + * void erl_err_ret(const char *fmt, ... ) non-fatal, sys-error + * void erl_err_quit(const char *fmt, ...) fatal, non-sys-error + * void erl_err_msg(const char *fmt, ... ) non-fatal, non-sys-error + */ + +#include <stdio.h> +#include <stdarg.h> +#include <stdlib.h> +#include <string.h> + +#ifdef VRTX /* What's VRIX? [sverkerw] */ +#define __READY_EXTENSIONS__ +#endif +#include <errno.h> + +#if defined(VXWORKS) +#include <taskLib.h> +#include <taskVarLib.h> +#endif + +#include "eidef.h" +#include "erl_interface.h" +#include "erl_error.h" + +/* Forward */ +static void err_doit(int, const char*, va_list); +/* __attribute__ ((format (printf, 2, 0)))*/ + +/* + * Some thoughts on flushing stdout/stderr: + * + * The defaults are reasonable (linebuffered stdout, unbuffered + * stderr). If they are in effect (the user neither knows nor cares), + * there's no need to flush. + * + * If the user changes these defaults (and knows what he's doing, so + * he knows and cares) we shouldn't surprise him by + * second-guessing. So there's a need to not flush. + * + * If the user doesn't know what he's doing, he's hosed anyway. + */ + +/* Fatal error related to a system call. + * Print a message and terminate. + */ +void erl_err_sys(const char *fmt, ... ) +{ + va_list ap; + + va_start(ap, fmt); + err_doit(1, fmt, ap); + va_end(ap); + exit(1); +} /* erl_err_sys */ + +/* Nonfatal error related to a system call. + * Print a message and return + */ +void erl_err_ret(const char *fmt, ... ) +{ + va_list ap; + + va_start(ap, fmt); + err_doit(1, fmt, ap); + va_end(ap); + return; +} /* erl_err_ret */ + +/* Nonfatal error unrelated to a system call. + * Print a message and return + */ +void erl_err_msg(const char *fmt, ... ) +{ + va_list ap; + + va_start(ap, fmt); + err_doit(0, fmt, ap); + va_end(ap); + return; +} /* erl_err_msg */ + +/* Fatal error unrelated to a system call. + * Print a message and terminate + */ +void erl_err_quit(const char *fmt, ... ) +{ + va_list ap; + + va_start(ap, fmt); + err_doit(0, fmt, ap); + va_end(ap); + exit(1); +} /* erl_err_quit */ + + + +/* + * For example on SunOS we don't have the ANSI C strerror. + * + * maybe move to a convenince lib [sverkerw] + */ +#ifndef HAVE_STRERROR + +/* FIXME: move to configure */ +/* CONFIG: probe for sys_nerr/_sys_nerr */ +extern int sys_nerr; + +/* CONFIG: probe for sys_errlist/_sys_errlist and maybe for const-ness */ +#ifdef FREEBSD +extern const char * const sys_errlist[]; +#else +extern char * sys_errlist[]; +#endif + +/* Should be in string.h */ +/* Is supposed to return 'char *' (no const-ness in ANSI's prototype), + but if you rewrite the returned string in place you deserve to + lose. */ +static const char *strerror(int errnum) +{ + if (errnum >= 0 && errnum < sys_nerr) { + return sys_errlist[errnum]; + } else { + /* Enough buffer for 64 bits of error. It should last a while. */ + /* FIXME problem for threaded ? */ + static char b[] = "(error -9223372036854775808)"; + sprintf(b, "(error %d)", errnum); + buf[sizeof(b)-1] = '\0'; + return b; + } +} +#endif /* !HAVE_STRERROR */ + + +/* Print a message and return to caller. + * Caller specifies "errnoflag". + */ +static void err_doit(int errnoflag, const char *fmt, va_list ap) +{ +#ifndef NO_ERR_MSG + int errno_save; + + errno_save = errno; + + vfprintf(stderr, fmt, ap); + if (errnoflag) + { + fputs(": ", stderr); + fputs(strerror(errno_save), stderr); + } + fputs("\n", stderr); +#endif + + return; +} /* err_doit */ + diff --git a/lib/erl_interface/src/legacy/erl_error.h b/lib/erl_interface/src/legacy/erl_error.h new file mode 100644 index 0000000000..931c639c30 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_error.h @@ -0,0 +1,25 @@ +/* + * %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% + */ +#ifndef _ERL_ERROR_H +#define _ERL_ERROR_H + +/* Initialize thread/task-safe erl_errno handling */ +void erl_init_errno(void); + +#endif /* _ERL_ERROR_H */ diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c new file mode 100644 index 0000000000..b685709c02 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -0,0 +1,1308 @@ +/* + * %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: Representation of Erlang terms. + */ + +#include "eidef.h" + +#include <stddef.h> +#include <stdlib.h> +#include <string.h> +#include <ctype.h> + +#include "ei_locking.h" +#include "ei_resolve.h" +#include "erl_interface.h" +#include "erl_eterm.h" +#include "erl_malloc.h" +#include "erl_marshal.h" +#include "erl_error.h" +#include "erl_internal.h" +#include "ei_internal.h" + +#define ERL_IS_BYTE(x) (ERL_IS_INTEGER(x) && (ERL_INT_VALUE(x) & ~0xFF) == 0) + +/* FIXME use unsigned char, or uint8 for buffers, cast (int) really needed? */ + +static void iolist_to_buf(const ETERM* term, char** bufp); +static char* strsave(const char *src); + +/*************************************************************************** + * + * API: erl_init() + * + * Not documented to set erl_errno. + * + ***************************************************************************/ + +/* all initialisation of erl_interface modules should be called from here */ +/* order is important: erl_malloc and erl_resolve depend on ei_locking */ +/* NOTE: don't call this directly - please use erl_init() macro defined + in ei_locking.h! */ +void erl_init(void *hp,long heap_size) +{ + erl_init_malloc(hp, heap_size); + erl_init_marshal(); + ei_init_resolve(); +} + +void erl_set_compat_rel(unsigned rel) +{ + ei_set_compat_rel(rel); +} + +/* + * Create an INTEGER. Depending on its value it + * may end up as a BigNum. + */ +ETERM *erl_mk_int (int i) +{ + ETERM *ep; + + ep = erl_alloc_eterm(ERL_INTEGER); + ERL_COUNT(ep) = 1; + ERL_INT_VALUE(ep) = i; + return ep; +} + +ETERM *erl_mk_longlong (long long i) +{ + ETERM *ep; + + ep = erl_alloc_eterm(ERL_LONGLONG); + ERL_COUNT(ep) = 1; + ERL_LL_VALUE(ep) = i; + return ep; +} + +/* + * Create an UNSIGNED INTEGER. Depending on its + * value it may end up as a BigNum. + */ + +ETERM *erl_mk_uint (unsigned int u) +{ + ETERM *ep; + + ep = erl_alloc_eterm(ERL_U_INTEGER); + ERL_COUNT(ep) = 1; + ERL_INT_UVALUE(ep) = u; + return ep; +} + +ETERM *erl_mk_ulonglong (unsigned long long i) +{ + ETERM *ep; + + ep = erl_alloc_eterm(ERL_U_LONGLONG); + ERL_COUNT(ep) = 1; + ERL_LL_UVALUE(ep) = i; + return ep; +} + +/* + * Create a FLOAT. + */ +ETERM *erl_mk_float (double d) +{ + ETERM *ep; + + ep = erl_alloc_eterm(ERL_FLOAT); + ERL_COUNT(ep) = 1; + ERL_FLOAT_VALUE(ep) = d; + return ep; +} + +/* + * Create an ATOM + */ +ETERM *erl_mk_atom (const char *s) +{ + ETERM *ep; + + /* ASSERT(s != NULL); */ + if (!s) return NULL; + + ep = erl_alloc_eterm(ERL_ATOM); + ERL_COUNT(ep) = 1; + ERL_ATOM_SIZE(ep) = strlen(s); + if ((ERL_ATOM_PTR(ep) = strsave(s)) == NULL) + { + erl_free_term(ep); + erl_errno = ENOMEM; + return NULL; + } + return ep; +} + +/* + * Given a string as input, creates a list. + */ +ETERM *erl_mk_string(const char *s) +{ + /* ASSERT(s != NULL); */ + if (!s) return NULL; + + return erl_mk_estring(s, strlen(s)); +} + +ETERM *erl_mk_estring(const char *s, int len) +{ + ETERM *ep; + int i; + + if ((!s) || (len < 0)) return NULL; + + /* + * ASSERT(s != NULL); + * ASSERT(len >= 0); + */ + + ep = erl_mk_empty_list(); + for (i = len-1; i >= 0; i--) { + ETERM* integer; + ETERM* cons; + + integer = erl_alloc_eterm(ERL_INTEGER); + ERL_COUNT(integer) = 1; + ERL_INT_VALUE(integer) = (unsigned char)s[i]; + + cons = erl_alloc_eterm(ERL_LIST); + ERL_COUNT(cons) = 1; + HEAD(cons) = integer; + TAIL(cons) = ep; + ep = cons; + } + return ep; +} + +/* + * Create a PID. + */ +ETERM *erl_mk_pid(const char *node, + unsigned int number, + unsigned int serial, + unsigned char creation) +{ + ETERM *ep; + + if (!node) return NULL; + /* ASSERT(node != NULL); */ + + ep = erl_alloc_eterm(ERL_PID); + ERL_COUNT(ep) = 1; + if ((ERL_PID_NODE(ep) = strsave(node)) == NULL) + { + erl_free_term(ep); + erl_errno = ENOMEM; + return NULL; + } + ERL_PID_NUMBER(ep) = number & 0x7fff; /* 15 bits */ + if (ei_internal_use_r9_pids_ports()) { + ERL_PID_SERIAL(ep) = serial & 0x07; /* 3 bits */ + } + else { + ERL_PID_SERIAL(ep) = serial & 0x1fff; /* 13 bits */ + } + ERL_PID_CREATION(ep) = creation & 0x03; /* 2 bits */ + return ep; +} + +/* + * Create a PORT. + */ +ETERM *erl_mk_port(const char *node, + unsigned int number, + unsigned char creation) +{ + ETERM *ep; + + if (!node) return NULL; + /* ASSERT(node != NULL); */ + + ep = erl_alloc_eterm(ERL_PORT); + ERL_COUNT(ep) = 1; + if ((ERL_PORT_NODE(ep) = strsave(node)) == NULL) + { + erl_free_term(ep); + erl_errno = ENOMEM; + return NULL; + } + if (ei_internal_use_r9_pids_ports()) { + ERL_PORT_NUMBER(ep) = number & 0x3ffff; /* 18 bits */ + } + else { + ERL_PORT_NUMBER(ep) = number & 0x0fffffff; /* 18 bits */ + } + ERL_PORT_CREATION(ep) = creation & 0x03; /* 2 bits */ + return ep; +} + +/* + * Create any kind of reference. + */ +ETERM *__erl_mk_reference (const char *node, + size_t len, + unsigned int n[], + unsigned char creation) +{ + ETERM * t; + + if (node == NULL) return NULL; + + t = erl_alloc_eterm(ERL_REF); + ERL_COUNT(t) = 1; + + if ((ERL_REF_NODE(t) = strsave(node)) == NULL) + { + erl_free_term(t); + erl_errno = ENOMEM; + return NULL; + } + ERL_REF_LEN(t) = len; + ERL_REF_NUMBERS(t)[0] = n[0] & 0x3ffff; /* 18 bits */ + ERL_REF_NUMBERS(t)[1] = n[1]; + ERL_REF_NUMBERS(t)[2] = n[2]; + ERL_REF_CREATION(t) = creation & 0x03; /* 2 bits */ + + return t; +} + +/* + * Create a REFERENCE. + */ +ETERM *erl_mk_ref (const char *node, + unsigned int number, + unsigned char creation) +{ + unsigned int n[3] = {0, 0, 0}; + n[0] = number; + return __erl_mk_reference(node, 1, n, creation); +} + +/* + * Create a long REFERENCE. + */ +ETERM * +erl_mk_long_ref (const char *node, + unsigned int n1, unsigned int n2, unsigned int n3, + unsigned char creation) +{ + unsigned int n[3] = {0, 0, 0}; + n[0] = n3; n[1] = n2; n[2] = n1; + return __erl_mk_reference(node, 3, n, creation); +} + +/* + * Create a BINARY. + */ +ETERM *erl_mk_binary (const char *b, int size) +{ + ETERM *ep; + + if ((!b) || (size < 0)) return NULL; + /* ASSERT(b != NULL); */ + + ep = erl_alloc_eterm(ERL_BINARY); + ERL_COUNT(ep) = 1; + ERL_BIN_SIZE(ep) = size; + ERL_BIN_PTR(ep) = (unsigned char *) erl_malloc(size); + memcpy(ERL_BIN_PTR(ep), b, size); + return ep; +} + +/* + * Create a TUPLE. For each element in the tuple + * bump its reference counter. + */ +ETERM *erl_mk_tuple (ETERM **arr,int size) +{ + ETERM *ep; + int i; + + if ((!arr) || (size < 0)) return NULL; + for (i=0; i<size; i++) if (!arr[i]) return NULL; + /* ASSERT(arr != NULL); */ + + ep = erl_alloc_eterm(ERL_TUPLE); + ERL_COUNT(ep) = 1; + ERL_TUPLE_SIZE(ep) = size; + ERL_TUPLE_ELEMS(ep) = (ETERM**) erl_malloc((size) * (sizeof(ETERM*))); + for (i = 0; i < size; i++) { + /* ASSERT(arr[i] != NULL); */ + ERL_COUNT(arr[i])++; + ERL_TUPLE_ELEMENT(ep, i) = arr[i]; + } + return ep; +} + +/* + * SET an ELEMENT in a TUPLE. Free the old element + * and bump the reference counter of the new one. + * Return 1 on success, otherwise 0. + */ +#if 0 +int erl_setelement (int ix, ETERM *ep, ETERM *vp) +{ + if ((!ep) || (!vp)) return 0; + /* ASSERT(ep != NULL); + * ASSERT(vp != NULL); + */ + + if ((ERL_TYPE(ep) == ERL_TUPLE) && (ix <= ERL_TUPLE_SIZE(ep))) { + erl_free_term(ERL_TUPLE_ELEMENT(ep, ix-1)); + ERL_TUPLE_ELEMENT(ep, ix-1) = vp; + ERL_COUNT(vp)++; + return 1; + } + erl_err_msg("<ERROR> erl_setelement: Bad type to setelement or out of range \n"); + return 0; +} +#endif + +/* + * Extract an ELEMENT from a TUPLE. Bump the + * reference counter on the extracted object. + */ +ETERM *erl_element (int ix, const ETERM *ep) +{ + if ((!ep) || (ix < 0)) return NULL; + /* + * ASSERT(ep != NULL); + * ASSERT(ix >= 0); + */ + + if ((ERL_TYPE(ep) == ERL_TUPLE) && (ix <= ERL_TUPLE_SIZE(ep))) { + ERL_COUNT(ERL_TUPLE_ELEMENT(ep, ix-1))++; + return ERL_TUPLE_ELEMENT(ep, ix-1); + } + else + return NULL; +} /* erl_element */ + +ETERM *erl_mk_empty_list(void) +{ + ETERM *ep; + + ep = erl_alloc_eterm(ERL_EMPTY_LIST); + ERL_COUNT(ep) = 1; + return ep; +} + +/* + * Construct a new list by CONS'ing a HEAD on + * to the TAIL. Bump the reference counter on + * the head and tail object. Note that we allow + * non-well formed lists to be created. + */ +ETERM *erl_cons(ETERM *hd, ETERM *tl) +{ + ETERM *ep; + + if ((!hd) || (!tl)) return NULL; + + /* + * ASSERT(hd != NULL); + * ASSERT(tl != NULL); + */ + + ep = erl_alloc_eterm(ERL_LIST); + ERL_COUNT(ep) = 1; + HEAD(ep) = hd; + TAIL(ep) = tl; + ERL_COUNT(hd)++; + ERL_COUNT(tl)++; + return ep; +} + +/* + * Extract the HEAD of a LIST. Bump the reference + * counter on the head object. + */ +ETERM *erl_hd (const ETERM *ep) +{ + if (!ep) return NULL; + /* ASSERT(ep != NULL); */ + + if (ERL_TYPE(ep) != ERL_LIST) { + return (ETERM *) NULL; + } + ERL_COUNT(ERL_CONS_HEAD(ep))++; + return ERL_CONS_HEAD(ep); +} + +/* + * Extract the TAIL of a LIST. Bump the reference + * counter on the tail object. + */ +ETERM *erl_tl (const ETERM *ep) +{ + ETERM *tl; + + if (!ep) return NULL; + /* ASSERT(ep != NULL); */ + + if (ERL_TYPE(ep) != ERL_LIST) { + return (ETERM *) NULL; + } + + tl = TAIL(ep); + ERL_COUNT(tl)++; + return tl; +} + +/* + * Create a LIST from an array of elements. Note that + * we create it from the last element in the array to + * the first. Also, note that we decrement the reference + * counter for each member in the list but the first one. + * This is done because of the use of erl_cons. + */ + +ETERM *erl_mk_list (ETERM **arr, int size) +{ + ETERM *ep; + int i; + + if ((!arr) || (size < 0)) return NULL; + for (i=0; i<size; i++) if (!arr[i]) return NULL; + + /* ASSERT(arr != NULL); */ + ep = erl_mk_empty_list(); + if (size > 0) { + ERL_COUNT(ep)--; + } + + for (i = size-1; i >= 0; i--) { + /* ASSERT(arr[i] != NULL); */ + ep = erl_cons(arr[i], ep); + if (i > 0) + ERL_COUNT(ep)--; /* Internal reference */ + } + return ep; +} + +/* + * Create an empty VARIABLE. + */ +ETERM *erl_mk_var(const char *s) +{ + ETERM *ep; + + if (!s) return NULL; + + /* ASSERT(s != NULL); */ + + ep = erl_alloc_eterm(ERL_VARIABLE); + ERL_COUNT(ep) = 1; + ERL_VAR_LEN(ep) = strlen(s); + if ((ERL_VAR_NAME(ep) = strsave(s)) == NULL) + { + erl_free_term(ep); + erl_errno = ENOMEM; + return NULL; + } + ERL_VAR_VALUE(ep) = (ETERM *) NULL; + return ep; +} + +/* + * Return the CONTENT of a VARIABLE with NAME. + * If the content is non-nil then bump its + * reference counter. + */ +ETERM *erl_var_content (const ETERM *ep, const char *name) +{ + int i; + ETERM *vp; + + if ((!ep) || (!name)) return NULL; + + /* ASSERT(ep != NULL); */ + + switch(ERL_TYPE(ep)) + { + case ERL_VARIABLE: + if (strcmp(ERL_VAR_NAME(ep), name) == 0) { + if ((vp = ERL_VAR_VALUE(ep)) != NULL) { + ERL_COUNT(vp)++; + return vp; + } + } + break; + + case ERL_LIST: + while (ep && (ERL_TYPE(ep) != ERL_EMPTY_LIST)) { + if ((vp = erl_var_content(HEAD(ep), name))) return vp; + ep = TAIL(ep); + } + break; + + case ERL_TUPLE: + for (i=0; i < ERL_TUPLE_SIZE(ep); i++) + if ((vp = erl_var_content(ERL_TUPLE_ELEMENT(ep, i), name))) + { + return vp; + } + break; + + default: + /* variables can't occur in other types */ + break; + } + + /* nothing found ! */ + return NULL; +} + +/* + * Return the SIZE of a TUPLE or a BINARY. + * At failure -1 is returned. + */ +int erl_size (const ETERM *ep) +{ + if (!ep) return -1; + + /* ASSERT(ep != NULL); */ + + switch (ERL_TYPE(ep)) { + case ERL_TUPLE: + return ERL_TUPLE_SIZE(ep); + + case ERL_BINARY: + return ERL_BIN_SIZE(ep); + + default: + return -1; + + } +} + +/* + * Return the LENGTH of a LIST. + * At failure -1 is returned (this include non-proper lists like [a|b]). + */ +int erl_length(const ETERM *ep) +{ + int n = 0; + + if (!ep) return -1; + /* ASSERT(ep != NULL); */ + + while (ERL_TYPE(ep) == ERL_LIST) { + n++; + ep = TAIL(ep); + } + + if (!ERL_IS_EMPTY_LIST(ep)) return -1; + + return n; +} + + +/*********************************************************************** + * I o l i s t f u n c t i o n s + * + * The following functions handles I/O lists. + * + * Informally, an I/O list is a deep list of characters and binaries, + * which can be sent to an Erlang port. + * + * Formally, in BNF, an I/O list is defined as: + * + * iolist ::= [] + * | Binary + * | [iohead | iolist] + * ; + * + * iohead ::= Binary + * | Byte (integer in the range [0..255]) + * | iolist + * ; + * + * Note that versions of Erlang/OTP prior to R2 had a slightly more + * restricted definition of I/O lists, in that the tail of a an I/O list + * was not allowed to be a binary. The erl_interface functions + * for I/O lists follows the more liberal rules described by the BNF + * description above. + ***********************************************************************/ + +/* + * This function converts an I/O list to a '\0' terminated C string. + * The I/O list must not contain any occurrences of the integer 0. + * + * The string will be in memory allocated by erl_malloc(). It is the + * responsibility of the caller to eventually call erl_free() to free + * the memory. + * + * Returns: NULL if the list was not an I/O list or contained + * the integer 0, otherwise a pointer to '\0' terminated string. + */ + +char* erl_iolist_to_string(const ETERM* term) +{ + ETERM* bin; + + if ((bin = erl_iolist_to_binary(term)) == NULL) { + return NULL; + } else { + char* result = NULL; + + if (memchr(ERL_BIN_PTR(bin), '\0', ERL_BIN_SIZE(bin)) == NULL) { + result = (char *) erl_malloc(ERL_BIN_SIZE(bin)+1); + memcpy(result, ERL_BIN_PTR(bin), ERL_BIN_SIZE(bin)); + result[ERL_BIN_SIZE(bin)] = '\0'; + } + erl_free_term(bin); + return result; + } +} + +/* + * This function converts an I/O list to a binary term. + * + * Returns: NULL if the list was not an I/O list, otherwise + * an ETERM pointer pointing to a binary term. + */ + +ETERM *erl_iolist_to_binary (const ETERM* term) +{ + ETERM *dest; + int size; + char* ptr; + + if (!term) return NULL; + /* ASSERT(term != NULL); */ + + /* + * Verify that the term is an I/O list and get its length. + */ + + size = erl_iolist_length(term); + if (size == -1) { + return NULL; + } + + /* + * Allocate the binary and copy the contents of the I/O list into it. + */ + + dest = erl_alloc_eterm(ERL_BINARY); + ERL_COUNT(dest) = 1; + ERL_BIN_SIZE(dest) = size; + ptr = (char *)erl_malloc(size); + ERL_BIN_PTR(dest) = (unsigned char *)ptr; + iolist_to_buf(term, &ptr); + + /* + * If ptr doesn't point exactly one byte beyond the end of the + * binary, something must be seriously wrong. + */ + + if (ERL_BIN_PTR(dest) + size != (unsigned char *) ptr) return NULL; + /* ASSERT(ERL_BIN_PTR(dest) + size == (unsigned char *) ptr); */ + + return dest; +} + +/* + * Returns the length of an I/O list. + * + * Returns: -1 if the term if the given term is not a I/O list, + * or the length otherwise. + */ + +int erl_iolist_length (const ETERM* term) +{ + int len = 0; + + while (ERL_IS_CONS(term)) { + ETERM* obj = HEAD(term); + + if (ERL_IS_BYTE(obj)) { + len++; + } else if (ERL_IS_CONS(obj)) { + int i; + if ((i = erl_iolist_length(obj)) < 0) + return i; + len += i; + } else if (ERL_IS_BINARY(obj)) { + len += ERL_BIN_SIZE(obj); + } else if (!ERL_IS_EMPTY_LIST(obj)) { + return(-1); + } + term = TAIL(term); + } + if (ERL_IS_EMPTY_LIST(term)) + return len; + else if (ERL_IS_BINARY(term)) + return len + ERL_BIN_SIZE(term); + else + return -1; +} + +/* + * Return a brand NEW COPY of an ETERM. + */ +/* + * FIXME: Deep (the whole tree) or shallow (just the top term) copy? + * The documentation never says, but the code as written below will + * make a deep copy. This should be documented. + */ +ETERM *erl_copy_term(const ETERM *ep) +{ + int i; + ETERM *cp; + + if (!ep) return NULL; + /* ASSERT(ep != NULL); */ + + cp = erl_alloc_eterm(ERL_TYPE(ep)); + ERL_COUNT(cp) = 1; + + switch(ERL_TYPE(cp)) { + case ERL_INTEGER: + case ERL_SMALL_BIG: + ERL_INT_VALUE(cp) = ERL_INT_VALUE(ep); + break; + case ERL_U_INTEGER: + case ERL_U_SMALL_BIG: + ERL_INT_UVALUE(cp) = ERL_INT_UVALUE(ep); + break; + case ERL_FLOAT: + ERL_FLOAT_VALUE(cp) = ERL_FLOAT_VALUE(ep); + break; + case ERL_ATOM: + ERL_ATOM_SIZE(cp) = ERL_ATOM_SIZE(ep); + ERL_ATOM_PTR(cp) = strsave(ERL_ATOM_PTR(ep)); + if (ERL_ATOM_PTR(cp) == NULL) + { + erl_free_term(cp); + erl_errno = ENOMEM; + return NULL; + } + break; + case ERL_PID: + /* FIXME: First copy the bit pattern, then duplicate the node + name and plug in. Somewhat ugly (also done with port and + ref below). */ + memcpy(&cp->uval.pidval, &ep->uval.pidval, sizeof(Erl_Pid)); + ERL_PID_NODE(cp) = strsave(ERL_PID_NODE(ep)); + ERL_COUNT(cp) = 1; + break; + case ERL_PORT: + memcpy(&cp->uval.portval, &ep->uval.portval, sizeof(Erl_Port)); + ERL_PORT_NODE(cp) = strsave(ERL_PORT_NODE(ep)); + ERL_COUNT(cp) = 1; + break; + case ERL_REF: + memcpy(&cp->uval.refval, &ep->uval.refval, sizeof(Erl_Ref)); + ERL_REF_NODE(cp) = strsave(ERL_REF_NODE(ep)); + ERL_COUNT(cp) = 1; + break; + case ERL_LIST: + HEAD(cp) = erl_copy_term(HEAD(ep)); + TAIL(cp) = erl_copy_term(TAIL(ep)); + break; + case ERL_EMPTY_LIST: + break; + case ERL_TUPLE: + i = ERL_TUPLE_SIZE(cp) = ERL_TUPLE_SIZE(ep); + ERL_TUPLE_ELEMS(cp) = (ETERM**) erl_malloc(i * sizeof(ETERM*)); + for(i=0; i < ERL_TUPLE_SIZE(ep); i++) + ERL_TUPLE_ELEMENT(cp,i) = erl_copy_term(ERL_TUPLE_ELEMENT(ep, i)); + break; + case ERL_BINARY: + ERL_BIN_SIZE(cp) = ERL_BIN_SIZE(ep); + ERL_BIN_PTR(cp) = (unsigned char *) erl_malloc(ERL_BIN_SIZE(ep)); + memcpy(ERL_BIN_PTR(cp), ERL_BIN_PTR(ep), ERL_BIN_SIZE(ep)); + break; + case ERL_FUNCTION: + i = ERL_CLOSURE_SIZE(cp) = ERL_CLOSURE_SIZE(ep); + ERL_FUN_ARITY(cp) = ERL_FUN_ARITY(ep); + ERL_FUN_NEW_INDEX(cp) = ERL_FUN_NEW_INDEX(ep); + ERL_FUN_INDEX(cp) = erl_copy_term(ERL_FUN_INDEX(ep)); + ERL_FUN_UNIQ(cp) = erl_copy_term(ERL_FUN_UNIQ(ep)); + ERL_FUN_CREATOR(cp) = erl_copy_term(ERL_FUN_CREATOR(ep)); + ERL_FUN_MODULE(cp) = erl_copy_term(ERL_FUN_MODULE(ep)); + memcpy(ERL_FUN_MD5(cp), ERL_FUN_MD5(ep), sizeof(ERL_FUN_MD5(ep))); + ERL_CLOSURE(cp) = (ETERM**) erl_malloc(i * sizeof(ETERM*)); + for(i=0; i < ERL_CLOSURE_SIZE(ep); i++) + ERL_CLOSURE_ELEMENT(cp,i) = + erl_copy_term(ERL_CLOSURE_ELEMENT(ep, i)); + break; + default: + erl_err_msg("<ERROR> erl_copy_term: wrong type encountered !"); + erl_free_term(cp); + return (ETERM *) NULL; + } + + return cp; +} + +#ifndef SILENT + +static int print_string(FILE* fp, const ETERM* ep); +static int is_printable_list(const ETERM* term); + +/* + * PRINT out an ETERM. + */ + +int erl_print_term(FILE *fp, const ETERM *ep) +{ + int j,i,doquote; + int ch_written = 0; /* counter of written chars */ + + if ((!fp) || (!ep)) return 0; + /* ASSERT(ep != NULL); */ + + j = i = doquote = 0; + switch(ERL_TYPE(ep)) + { + case ERL_ATOM: + /* FIXME: what if some weird locale is in use? */ + if (!islower((int)ERL_ATOM_PTR(ep)[0])) + doquote = 1; + + for (i = 0; !doquote && i < ERL_ATOM_SIZE(ep); i++) + { + doquote = !(isalnum((int)ERL_ATOM_PTR(ep)[i]) + || (ERL_ATOM_PTR(ep)[i] == '_')); + } + + if (doquote) { + putc('\'', fp); + ch_written++; + } + fputs(ERL_ATOM_PTR(ep), fp); + ch_written += ERL_ATOM_SIZE(ep); + if (doquote) { + putc('\'', fp); + ch_written++; + } + break; + + case ERL_VARIABLE: + if (!isupper((int)ERL_VAR_NAME(ep)[0])) { + doquote = 1; + putc('\'', fp); + ch_written++; + } + + fputs(ERL_VAR_NAME(ep), fp); + ch_written += ERL_VAR_LEN(ep); + + if (doquote) { + putc('\'', fp); + ch_written++; + } + break; + + case ERL_PID: + ch_written += fprintf(fp, "<%s.%d.%d>", + ERL_PID_NODE(ep), + ERL_PID_NUMBER(ep), ERL_PID_SERIAL(ep)); + break; + case ERL_PORT: + ch_written += fprintf(fp, "#Port"); + break; + case ERL_REF: + ch_written += fprintf(fp, "#Ref"); + break; + case ERL_EMPTY_LIST: + ch_written += fprintf(fp, "[]"); + break; + case ERL_LIST: + if (is_printable_list(ep)) { + ch_written += print_string(fp, ep); + } else { + putc('[', fp); + ch_written++; + while (ERL_IS_CONS(ep)) { + ch_written += erl_print_term(fp, HEAD(ep)); + ep = TAIL(ep); + if (ERL_IS_CONS(ep)) { + putc(',', fp); + ch_written++; + } + } + if (!ERL_IS_EMPTY_LIST(ep)) { + putc('|', fp); + ch_written++; + ch_written += erl_print_term(fp, ep); + } + putc(']', fp); + ch_written++; + } + break; + case ERL_TUPLE: + putc('{', fp); + ch_written++; + for (i=0; i < ERL_TUPLE_SIZE(ep); i++) { + ch_written += erl_print_term(fp, ERL_TUPLE_ELEMENT(ep, j++) ); + if (i != ERL_TUPLE_SIZE(ep)-1) { + putc(',', fp); + ch_written++; + } + } + putc('}', fp); + ch_written++; + break; + case ERL_BINARY: { + int sz = (ERL_BIN_SIZE(ep) > 20) ? 20 : ERL_BIN_SIZE(ep); + unsigned char *ptr = ERL_BIN_PTR(ep); + ch_written += fprintf(fp, "#Bin<"); + for (i = 0; i < sz; i++) { + putc(ptr[i], fp); ch_written++; + } + if (sz == 20) ch_written += fprintf(fp, "(%d)....>", ERL_BIN_SIZE(ep)-20); + else ch_written += fprintf(fp, ">"); + break; + } + case ERL_INTEGER: + case ERL_SMALL_BIG: + ch_written += fprintf(fp, "%d", ERL_INT_VALUE(ep)); + break; + case ERL_U_INTEGER: + case ERL_U_SMALL_BIG: + ch_written += fprintf(fp, "%d", ERL_INT_UVALUE(ep)); + break; + case ERL_LONGLONG: + case ERL_U_LONGLONG: + ch_written += fprintf(fp, "%lld", ERL_LL_UVALUE(ep)); + break; + case ERL_FLOAT: + ch_written += fprintf(fp, "%f", ERL_FLOAT_VALUE(ep)); + break; + case ERL_FUNCTION: + ch_written += fprintf(fp, "#Fun<"); + ch_written += erl_print_term(fp, ERL_FUN_MODULE(ep)); + putc('.', fp); + ch_written++; + ch_written += erl_print_term(fp, ERL_FUN_INDEX(ep)); + putc('.', fp); + ch_written++; + ch_written += erl_print_term(fp, ERL_FUN_UNIQ(ep)); + putc('>', fp); + ch_written++; + break; + default: + ch_written = -10000; + erl_err_msg("<ERROR> erl_print_term: Bad type of term !"); + } + return ch_written; +} + +/* + * FIXME not done yet.... + */ + +#if 0 + +int erl_sprint_term(char *buf, const ETERM *ep) +{ + int j,i,doquote; + int ch_written = 0; /* counter of written chars */ + + if ((!buf) || (!ep)) return 0; + /* ASSERT(ep != NULL); */ + + j = i = doquote = 0; + switch(ERL_TYPE(ep)) + { + case ERL_ATOM: + /* FIXME: what if some weird locale is in use? */ + if (!islower((int)ERL_ATOM_PTR(ep)[0])) + doquote = 1; + + for (i = 0; !doquote && i < ERL_ATOM_SIZE(ep); i++) + { + doquote = !(isalnum((int)ERL_ATOM_PTR(ep)[i]) + || (ERL_ATOM_PTR(ep)[i] == '_')); + } + + if (doquote) { + *buf++ = '\''; + ch_written++; + } + { + int len = ERL_ATOM_SIZE(ep); + strncpy(buf, ERL_ATOM_PTR(ep), len); + buf += len; + ch_written += len; + } + if (doquote) { + *buf++ = '\''; + ch_written++; + } + break; + + case ERL_VARIABLE: + if (!isupper((int)ERL_VAR_NAME(ep)[0])) { + doquote = 1; + *buf++ = '\''; + ch_written++; + } + len = ERL_VAR_LEN(ep); + strncpy(buf, ERL_VAR_NAME(ep), len); + buf += len; + ch_written += len; + + if (doquote) { + *buf++ = '\''; + ch_written++; + } + break; + + case ERL_PID: + len = sprintf(buf, "<%s.%d.%d>", + ERL_PID_NODE(ep), + ERL_PID_NUMBER(ep), ERL_PID_SERIAL(ep)); + buf += len; + ch_written += len; + break; + case ERL_PORT: + len = sprintf(buf , "#Port"); + buf += len; + ch_written += len; + break; + case ERL_REF: + len = sprintf(buf , "#Ref"); + buf += len; + ch_written += len; + break; + case ERL_EMPTY_LIST: + len = sprintf(buf , "[]"); + buf += len; + ch_written += len; + break; + case ERL_LIST: + if (is_printable_list(ep)) { + ch_written += print_string(fp, ep); + } else { + putc('[', fp); + ch_written++; + while (ERL_IS_CONS(ep)) { + ch_written += erl_sprint_term(fp, HEAD(ep)); + ep = TAIL(ep); + if (ERL_IS_CONS(ep)) { + putc(',', fp); + ch_written++; + } + } + if (!ERL_IS_EMPTY_LIST(ep)) { + putc('|', fp); + ch_written++; + ch_written += erl_sprint_term(fp, ep); + } + putc(']', fp); + ch_written++; + } + break; + case ERL_TUPLE: + putc('{', fp); + ch_written++; + for (i=0; i < ERL_TUPLE_SIZE(ep); i++) { + ch_written += erl_sprint_term(fp, ERL_TUPLE_ELEMENT(ep, j++) ); + if (i != ERL_TUPLE_SIZE(ep)-1) { + putc(',', fp); + ch_written++; + } + } + putc('}', fp); + ch_written++; + break; + case ERL_BINARY: + len = sprintf(buf , "#Bin"); + buf += len; + ch_written += len; + break; + case ERL_INTEGER: + case ERL_SMALL_BIG: + len = sprintf(buf , "%d", ERL_INT_VALUE(ep)); + buf += len; + ch_written += len; + break; + case ERL_U_INTEGER: + case ERL_U_SMALL_BIG: + len = sprintf(buf , "%d", ERL_INT_UVALUE(ep)); + buf += len; + ch_written += len; + break; + case ERL_FLOAT: + len = sprintf(buf , "%f", ERL_FLOAT_VALUE(ep)); + buf += len; + ch_written += len; + break; + case ERL_FUNCTION: + len = sprintf(buf , "#Fun<"); + buf += len; + ch_written += len; + ch_written += erl_sprint_term(fp, ERL_FUN_MODULE(ep)); + putc('.', fp); + ch_written++; + ch_written += erl_sprint_term(fp, ERL_FUN_INDEX(ep)); + putc('.', fp); + ch_written++; + ch_written += erl_sprint_term(fp, ERL_FUN_UNIQ(ep)); + putc('>', fp); + ch_written++; + break; + default: + ch_written = -10000; + erl_err_msg("<ERROR> erl_sprint_term: Bad type of term !"); + } + return ch_written; +} +#endif + +static int print_string(FILE* fp, const ETERM* ep) +{ + int ch_written = 0; /* counter of written chars */ + + putc('"', fp); + ch_written++; + while (ERL_IS_CONS(ep)) { + int c = ERL_INT_VALUE(HEAD(ep)); + + if (c >= ' ') { + putc(c, fp); + ch_written++; + } + else { + switch (c) { + case '\n': fputs("\\n", fp); ch_written += 2; break; + case '\r': fputs("\\r", fp); ch_written += 2; break; + case '\t': fputs("\\t", fp); ch_written += 2; break; + case '\v': fputs("\\v", fp); ch_written += 2; break; + case '\b': fputs("\\b", fp); ch_written += 2; break; + case '\f': fputs("\\f", fp); ch_written += 2; break; + break; + default: + ch_written += fprintf(fp, "\\%o", c); + break; + } + } + ep = TAIL(ep); + } + putc('"', fp); + ch_written++; + return ch_written; +} + +/* + * Returns 1 if term is a list of printable character, otherwise 0. + */ + +static int is_printable_list(const ETERM* term) +{ + while (ERL_TYPE(term) == ERL_LIST) { + ETERM* head = HEAD(term); + + if (!ERL_IS_BYTE(head)) { + return 0; + } + if (ERL_INT_VALUE(head) < ' ') { + switch (ERL_INT_VALUE(head)) { + case '\n': + case '\r': + case '\t': + case '\v': + case '\b': + case '\f': + break; + default: + return 0; + } + } + term = TAIL(term); + } + + return ERL_IS_EMPTY_LIST(term); +} + +#endif + +/* + * Retrieves the bytes from an I/O list and copy into a buffer. + * + * NOTE! It is the responsibility of the caller to ensure that + * that the buffer is big enough (typically by calling + * erl_iolist_length()), and that the term is an I/O list. + * + * ETERM* term; Term to convert to bytes. + * char** bufp; Pointer to pointer to buffer + * where the bytes should be stored. + * On return, the pointer will point beyond + * the last byte stored. + */ + +static void iolist_to_buf(const ETERM* term, char** bufp) +{ + char* dest = *bufp; + + while (ERL_IS_CONS(term)) { + ETERM* obj = HEAD(term); + + if (ERL_IS_BYTE(obj)) { + *dest++ = ERL_INT_VALUE(obj); + } else if (ERL_IS_CONS(obj)) { + iolist_to_buf(obj, &dest); + } else if (ERL_IS_BINARY(obj)) { + memcpy(dest, ERL_BIN_PTR(obj), ERL_BIN_SIZE(obj)); + dest += ERL_BIN_SIZE(obj); + } else { + /* + * Types have been checked by caller. + */ + if (!ERL_IS_EMPTY_LIST(obj)) return; + /* ASSERT(ERL_IS_EMPTY_LIST(obj)); */ + } + term = TAIL(term); + } + if (ERL_IS_BINARY(term)) { + memcpy(dest, ERL_BIN_PTR(term), ERL_BIN_SIZE(term)); + dest += ERL_BIN_SIZE(term); + } else { + /* + * Types have been checked by caller. + */ + if (!ERL_IS_EMPTY_LIST(term)) return; + /* ASSERT(ERL_IS_EMPTY_LIST(term));*/ + } + *bufp = dest; +} + +static char* strsave(const char *src) +{ + char * dest = malloc(strlen(src)+1); + + if (dest != NULL) + strcpy(dest, src); + return dest; +} + + +/* + * Local Variables: + * compile-command: "cd ..; ERL_TOP=/clearcase/otp/erts make -k" + * End: + */ diff --git a/lib/erl_interface/src/legacy/erl_eterm.h b/lib/erl_interface/src/legacy/erl_eterm.h new file mode 100644 index 0000000000..41b008f04f --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_eterm.h @@ -0,0 +1,61 @@ +/* + * %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% + */ +#ifndef _ERL_ETERM_H +#define _ERL_ETERM_H + +#ifndef SILENT +#include <stdio.h> +#endif + +#include "portability.h" + +#define ERL_MAX_COUNT 0xffffff +#define ERL_MAX ((1 << 27)-1) +#define ERL_MIN -(1 << 27) + +/* FIXME should this be documented and in erl_interface.h ??? */ +#define ERL_BIG_ARITY(x) ((x)->uval.bigval.arity) +#define ERL_BIG_IS_NEG(x) ((x)->uval.bigval.is_neg) +#define ERL_BIG_DIGITS(x) ((x)->uval.bigval.digits) +#define ERL_BIG_DIGIT(x,i) (ERL_BIG_DIGITS(x)[(i)]) + +/* + * Typing checking macros. + */ + +/* FIXME should this be documented and in erl_interface.h ??? */ +#define ERL_IS_DEFINED(x) (ERL_TYPE(x) != 0) +#define ERL_IS_COMPOUND(x) (ERL_TYPE(x) & ERL_COMPOUND) +#define ERL_IS_FUNCTION(x) (ERL_TYPE(x) == ERL_FUNCTION) +#define ERL_IS_BIG(x) (ERL_TYPE(x) == ERL_BIG) + + +typedef struct _heapmark { + unsigned long mark; /* id */ + int size; /* size of buffer */ + Erl_Heap *base; /* points to start of buffer */ + Erl_Heap *cur; /* points into buffer */ + struct _heapmark *prev; /* previous heapmark */ +} Erl_HeapMark; + + +ETERM * __erl_mk_reference(const char *, size_t, unsigned int n[], unsigned char); +int erl_current_fix_desc(void); + +#endif /* _ERL_ETERM_H */ diff --git a/lib/erl_interface/src/legacy/erl_fix_alloc.c b/lib/erl_interface/src/legacy/erl_fix_alloc.c new file mode 100644 index 0000000000..20f3024e41 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_fix_alloc.c @@ -0,0 +1,193 @@ +/* + * %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% + */ +/* + * Function: General purpose Memory allocator for fixed block + * size objects. This allocater is at least an order of + * magnitude faster than malloc(). + */ +#include "eidef.h" + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "ei_locking.h" +#include "erl_interface.h" +#include "erl_error.h" +#include "erl_malloc.h" +#include "erl_fix_alloc.h" +#include "erl_eterm.h" + +#define WIPE_CHAR ((char)0xaa) /* 10101010 */ + +/* the freelist is a singly linked list of these */ +/* i.e. the user structure and a link pointer */ +struct fix_block { + ETERM term; + struct fix_block *next; + int free; +}; + +/* this is a struct just to keep namespace pollution low on VxWorks */ +struct eterm_stateinfo { + struct fix_block *freelist; + unsigned long freed; + unsigned long allocated; +#ifdef _REENTRANT + ei_mutex_t *lock; +#endif /* _REENTRANT */ +}; +/* FIXME problem for threaded ? */ +static struct eterm_stateinfo *erl_eterm_state=NULL; + + +int erl_init_eterm_alloc (void) +{ +#if defined(PURIFY) && defined (DEBUG) + fprintf(stderr,"erl_fix_alloc() compiled for Purify - using \"real\" malloc()"); +#endif + + erl_eterm_state = malloc(sizeof(*erl_eterm_state)); + if (erl_eterm_state == NULL) goto err1; + + erl_eterm_state->freelist = NULL; + erl_eterm_state->freed = 0; + erl_eterm_state->allocated = 0; +#ifdef _REENTRANT + erl_eterm_state->lock = ei_mutex_create(); + if (erl_eterm_state->lock == NULL) goto err2; +#endif /* _REENTRANT */ + + return 1; + + /* Error cleanup */ +#ifdef _REENTRANT + err2: + /* FIXME ENOMEM is not what went wrong... */ + free(erl_eterm_state); +#endif /* _REENTRANT */ + err1: + erl_errno = ENOMEM; + return 0; +} + +/* get an eterm, from the freelist if possible or from malloc() */ +void *erl_eterm_alloc (void) +{ +#ifdef PURIFY + ETERM *p; + + if ((p = malloc(sizeof(*p)))) { + memset(p, WIPE_CHAR, sizeof(*p)); + } + return p; +#else + struct fix_block *b; + +#ifdef _REENTRANT + ei_mutex_lock(erl_eterm_state->lock, 0); +#endif /* _REENTRANT */ + + /* try to pop block from head of freelist */ + if ((b = erl_eterm_state->freelist) != NULL) { + erl_eterm_state->freelist = b->next; + erl_eterm_state->freed--; + } else if ((b = malloc(sizeof(*b))) == NULL) { + erl_errno = ENOMEM; + } + erl_eterm_state->allocated++; + b->free = 0; + b->next = NULL; +#ifdef _REENTRANT + ei_mutex_unlock(erl_eterm_state->lock); +#endif /* _REENTRANT */ + return (void *) &b->term; +#endif /* !PURIFY */ +} + +/* free an eterm back to the freelist */ +void erl_eterm_free(void *p) +{ +#ifdef PURIFY + if (p) { + memset(p, WIPE_CHAR, sizeof(ETERM)); + } + free(p); +#else + struct fix_block *b = p; + + if (b) { + if (b->free) { +#ifdef DEBUG + fprintf(stderr,"erl_eterm_free: attempt to free already freed block %p\n",b); +#endif + return; + } + +#ifdef _REENTRANT + ei_mutex_lock(erl_eterm_state->lock,0); +#endif /* _REENTRANT */ + b->free = 1; + b->next = erl_eterm_state->freelist; + erl_eterm_state->freelist = b; + erl_eterm_state->freed++; + erl_eterm_state->allocated--; +#ifdef _REENTRANT + ei_mutex_unlock(erl_eterm_state->lock); +#endif /* _REENTRANT */ + } +#endif /* !PURIFY */ +} + +/* really free the freelist */ +void erl_eterm_release (void) +{ +#if !defined(PURIFY) + struct fix_block *b; + +#ifdef _REENTRANT + ei_mutex_lock(erl_eterm_state->lock,0); +#endif /* _REENTRANT */ + { + while (erl_eterm_state->freelist != NULL) { + b = erl_eterm_state->freelist; + erl_eterm_state->freelist = b->next; + free(b); + erl_eterm_state->freed--; + } + } +#ifdef _REENTRANT + ei_mutex_unlock(erl_eterm_state->lock); +#endif /* _REENTRANT */ +#endif /* !PURIFY */ +} + +void erl_eterm_statistics (unsigned long *allocd, unsigned long *freed) +{ + if (allocd) *allocd = erl_eterm_state->allocated; + if (freed) *freed = erl_eterm_state->freed; + + return; +} + + +/* + * Local Variables: + * compile-command: "cd ..; ERL_TOP=/clearcase/otp/erts make -k" + * End: + */ diff --git a/lib/erl_interface/src/legacy/erl_fix_alloc.h b/lib/erl_interface/src/legacy/erl_fix_alloc.h new file mode 100644 index 0000000000..16d2f4217a --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_fix_alloc.h @@ -0,0 +1,26 @@ +/* + * %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% + */ +#ifndef _ERL_FIX_ALLOC_H +#define _ERL_FIX_ALLOC_H + +int erl_init_eterm_alloc(void); +void erl_eterm_free(void*); +void *erl_eterm_alloc(void); + +#endif /* _ERL_FIX_ALLOC_H */ diff --git a/lib/erl_interface/src/legacy/erl_format.c b/lib/erl_interface/src/legacy/erl_format.c new file mode 100644 index 0000000000..9848e9296a --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_format.c @@ -0,0 +1,729 @@ +/* + * %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% + */ +/* + * Function: Provides two primitives: erl_format to build + * Erlang terms in an easy way, and erl_match to perform + * pattern match similar to what is done in Erlang. + * + */ + +#include "eidef.h" + +#include <stdio.h> +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <ctype.h> + +#ifdef VRTX +#define __READY_EXTENSIONS__ +#include <errno.h> +#endif +#include "erl_interface.h" +#include "erl_eterm.h" +#include "erl_malloc.h" +#include "erl_error.h" +#include "erl_internal.h" + +#define ERL_TRUE 1 +#define ERL_FALSE 0 +#define ERL_OK 0 +#define ERL_FORMAT_ERROR -1 + +#define ERL_MAX_ENTRIES 255 /* Max entries in a tuple/list term */ +#define ERL_MAX_NAME_LENGTH 255 /* Max length of variable names */ + +#define PRINT(t) \ +{ \ + print_term(stderr,t); \ + fprintf(stderr,"\n"); \ + } + + +typedef struct lvar { + ETERM *var; + struct lvar *next; +} lvar; + + +/* Forward */ +static ETERM *eformat(char**, va_list*); +static int ematch(ETERM*, ETERM*); + +/* FIXME not thread safe */ +struct _ef { + lvar *chain; /* Chain of local variables */ + lvar *idle; /* Idle list of lvar's */ +} ef; + +/* Find local variable in term. + */ +static ETERM *find_lvar(char *name) +{ + lvar *tmp=ef.chain; + + while (tmp != NULL) { + if (strcmp(tmp->var->uval.vval.name,name) == 0) + return tmp->var->uval.vval.v; + tmp = tmp->next; + } + return (ETERM *) NULL; + +} /* find_lvar */ + +static void lvar_free(lvar *lv) +{ + lvar *tmp=ef.chain; + + /* Link in the chain into the idle list */ + if (ef.idle == NULL) + ef.idle = lv; + else { + tmp = ef.idle; + while (tmp->next != NULL) + tmp = tmp->next; + tmp->next = lv; + } + + + /* Clear out the variable information */ + tmp = lv; + while (tmp != NULL) { + tmp->var = (ETERM *) NULL; + tmp = tmp->next; + } + +} /* lvar_free */ + +static lvar *lvar_alloc(void) +{ + lvar *tmp; + + if ((tmp = ef.idle) == NULL) { + tmp = (lvar *) malloc(sizeof(lvar)); /* FIXME check result */ + } + else { + tmp = ef.idle; + ef.idle = tmp->next; + } + return tmp; + +} /* lvar_alloc */ + +static void undo_bindings(void) +{ + lvar *tmp=ef.chain; + + while (tmp != NULL) { + erl_free_term(tmp->var->uval.vval.v); + tmp->var->uval.vval.v = (ETERM *) NULL; + tmp = tmp->next; + } + +} /* undo_bindings */ + +static void release_chain(void) +{ + + lvar_free(ef.chain); + ef.chain = (lvar *) NULL; + +} /* release_chain */ + +static void add_lvar(ETERM *t) +{ + lvar *lv; + + lv = lvar_alloc(); + lv->var = t; + lv->next = ef.chain; + ef.chain = lv; + +} /* add_lvar */ + +static char *pvariable(char **fmt, char *buf) +{ + char *start=*fmt; + char c; + int len; + + while (1) { + c = *(*fmt)++; + if (isalnum((int) c) || (c == '_')) + continue; + else + break; + } + (*fmt)--; + len = *fmt - start; + memcpy(buf, start, len); + buf[len] = 0; + + return buf; + +} /* pvariable */ + +static char *patom(char **fmt, char *buf) +{ + char *start=*fmt; + char c; + int len; + + while (1) { + c = *(*fmt)++; + if (isalnum((int) c) || (c == '_') || (c == '@')) + continue; + else + break; + } + (*fmt)--; + len = *fmt - start; + memcpy(buf, start, len); + buf[len] = 0; + + return buf; + +} /* patom */ + +/* Check if integer or float + */ +static char *pdigit(char **fmt, char *buf) +{ + char *start=*fmt; + char c; + int len,dotp=0; + + while (1) { + c = *(*fmt)++; + if (isdigit((int) c)) + continue; + else if (!dotp && (c == '.')) { + dotp = 1; + continue; + } + else + break; + } + (*fmt)--; + len = *fmt - start; + memcpy(buf, start, len); + buf[len] = 0; + + return buf; + +} /* pdigit */ + +static char *pstring(char **fmt, char *buf) +{ + char *start=++(*fmt); /* skip first quote */ + char c; + int len; + + while (1) { + c = *(*fmt)++; + if (c == '"') { + if (*((*fmt)-1) == '\\') + continue; + else + break; + } else + continue; + } + len = *fmt - 1 - start; /* skip last quote */ + memcpy(buf, start, len); + buf[len] = 0; + + return buf; + +} /* pstring */ + +static char *pquotedatom(char **fmt, char *buf) +{ + char *start=++(*fmt); /* skip first quote */ + char c; + int len; + + while (1) { + c = *(*fmt)++; + if (c == '\'') { + if (*((*fmt)-1) == '\\') + continue; + else + break; + } else + continue; + } + len = *fmt - 1 - start; /* skip last quote */ + memcpy(buf, start, len); + buf[len] = 0; + + return buf; + +} /* pquotedatom */ + + +/* + * The format letters are: + * w - Any Erlang term + * a - An Atom + * b - A Binary + * s - A String + * i - An Integer + * f - A Float (double) + */ +static int pformat(char **fmt, va_list *pap, ETERM *v[], int size) +{ + int rc=ERL_OK; + + /* this next section hacked to remove the va_arg calls */ + switch (*(*fmt)++) { + + case 'w': + v[size] = va_arg(*pap, ETERM*); + ERL_COUNT(v[size])++; + break; + + case 'a': + v[size] = erl_mk_atom(va_arg(*pap, char *)); + break; + + case 's': + v[size] = erl_mk_string(va_arg(*pap, char *)); + break; + + case 'i': + v[size] = erl_mk_int(va_arg(*pap, int)); + break; + + case 'f': + v[size] = erl_mk_float(va_arg(*pap, double)); + break; + + case 'b': { + char *sarg = va_arg(*pap, char *); + v[size] = erl_mk_binary(sarg, strlen(sarg)); + break; + } + + default: + rc = ERL_FORMAT_ERROR; + break; + } + + return rc; + +} /* pformat */ + +static int ptuple(char **fmt, va_list *pap, ETERM *v[], int size) +{ + int res=ERL_FORMAT_ERROR; + + switch (*(*fmt)++) { + + case '}': + res = size; + break; + + case ',': + res = ptuple(fmt, pap, v, size); + break; + + case '~': + + if (pformat(fmt, pap, v, size) == ERL_OK) + res = ptuple(fmt, pap, v, ++size); + else + erl_err_msg("ptuple(1): Wrong format sequence !"); + break; + + case ' ': + return ptuple(fmt, pap, v, size); + break; + + default: { + (*fmt)--; + if ((v[size++] = eformat(fmt, pap)) != (ETERM *) NULL) + res = ptuple(fmt, pap, v, size); + break; + + /* + if (isupper(**fmt)) { + v[size++] = erl_mk_var(pvariable(fmt, wbuf)); + res = ptuple(fmt, pap, v, size); + } + else if ((v[size++] = eformat(fmt, pap)) != (ETERM *) NULL) + res = ptuple(fmt, pap, v, size); + break; + */ + } + + } /* switch */ + + return res; + +} /* ptuple */ + + +static int plist(char **fmt, va_list *pap, ETERM *v[], int size) +{ + int res=ERL_FORMAT_ERROR; + + switch (*(*fmt)++) { + + case ']': + res = size; + break; + + case ',': + res = plist(fmt, pap, v, size); + break; + + case '~': + + if (pformat(fmt, pap, v, size) == ERL_OK) + res = plist(fmt, pap, v, ++size); + else + erl_err_msg("plist(1): Wrong format sequence !"); + break; + + case ' ': + return plist(fmt, pap, v, size); + break; + + default: { + (*fmt)--; + if ((v[size++] = eformat(fmt, pap)) != (ETERM *) NULL) + res = plist(fmt, pap, v, size); + break; + + /* + if (isupper(**fmt)) { + v[size++] = erl_mk_var(pvariable(fmt, wbuf)); + res = plist(fmt, pap, v, size); + } + else if ((v[size++] = eformat(fmt, pap)) != (ETERM *) NULL) + res = plist(fmt, pap, v, size); + break; + */ + } + + } /* switch */ + + return res; + +} /* plist */ + + +static ETERM *eformat(char **fmt, va_list *pap) +{ + int size; + ETERM *v[ERL_MAX_ENTRIES],*ep; + + switch (*(*fmt)++) { + case '{': + if ((size = ptuple(fmt, pap , v, 0)) != ERL_FORMAT_ERROR) { + ep = erl_mk_tuple(v, size); + erl_free_array(v, size); + return ep; + } + else + return (ETERM *) NULL; + break; + + case '[': + if (**fmt == ']') { + (*fmt)++; + return erl_mk_empty_list(); + } else if ((size = plist(fmt, pap , v, 0)) != ERL_FORMAT_ERROR) { + ep = erl_mk_list(v, size); + erl_free_array(v, size); + return ep; + } else + return (ETERM *) NULL; + break; + + case '$': /* char-value? */ + return erl_mk_int((int)(*(*fmt)++)); + break; + + case '~': + if (pformat(fmt, pap, v, 0) == ERL_OK) { + ep = erl_copy_term(v[0]); + erl_free_term(v[0]); + return ep; + } + break; + + case ' ': + return eformat(fmt, pap); + break; + + /* handle negative numbers too... + * case '-': + * { + * ETERM *tmp; + * + * tmp = eformat(fmt,pap); + * if (ERL_IS_INTEGER(tmp)) ERL_INT_VALUE(tmp) = -(ERL_INT_VALUE(tmp)); + * return tmp; + * } + * + * + * break; + */ + + default: + { + char wbuf[BUFSIZ]; /* now local to this function for reentrancy */ + + (*fmt)--; + if (islower((int)**fmt)) { /* atom ? */ + char *atom=patom(fmt, wbuf); + return erl_mk_atom(atom); + } + else if (isupper((int)**fmt) || (**fmt == '_')) { + char *var=pvariable(fmt, wbuf); + return erl_mk_var(var); + } + else if (isdigit((int)**fmt)) { /* integer/float ? */ + char *digit=pdigit(fmt, wbuf); + if (strchr(digit,(int) '.') == NULL) + return erl_mk_int(atoi((const char *) digit)); + else + return erl_mk_float(atof((const char *) digit)); + } + else if (**fmt == '"') { /* string ? */ + char *string=pstring(fmt, wbuf); + return erl_mk_string(string); + } + else if (**fmt == '\'') { /* quoted atom ? */ + char *qatom=pquotedatom(fmt, wbuf); + return erl_mk_atom(qatom); + } + } + break; + + } + + erl_err_msg("<ERROR> Syntax error in eformat, char was: %c !", **fmt); + return (ETERM *) NULL; + +} /* eformat */ + + +ETERM *erl_format(char *fmt, ... ) +{ + ETERM *res=NULL; + va_list ap; + + va_start(ap, fmt); + res = eformat(&fmt, &ap); + va_end(ap); + + return res; +} /* erl_format */ + + +/* + * Perform a pattern match between a pattern p and a term t. + * As a side effect bind any unbound variables in p. + * Return true or false. + */ +static int ematch(ETERM *p, ETERM *t) +{ + unsigned int type_p; + unsigned int type_t; + ETERM *tmp; + + /* two NULLs are equal, one is not... */ + if (!p && !t) return ERL_TRUE; + if (!p || !t) return ERL_FALSE; + /* + * ASSERT(p != NULL); + * ASSERT(t != NULL); + */ + + type_p = ERL_TYPE(p); + type_t = ERL_TYPE(t); + + if (type_t == ERL_VARIABLE) { + if (t->uval.vval.v == NULL) + return ERL_FALSE; /* Can't have an unbound variable here ! */ + else + t = t->uval.vval.v; + } + + if (type_p != ERL_VARIABLE && type_p != type_t) + return ERL_FALSE; + + switch (type_p) { + + case ERL_ATOM: + return p->uval.aval.len == t->uval.aval.len && + memcmp(p->uval.aval.a, t->uval.aval.a, p->uval.aval.len) == 0; + + case ERL_VARIABLE: + if (strcmp(p->uval.vval.name, "_") == 0) /* anon. variable */ + return ERL_TRUE; + else if ((tmp = find_lvar(p->uval.vval.name)) != (ETERM *) NULL) { + /* v points to NULL in cases like erl_format("{X,X}") for the + second variable */ + if (p->uval.vval.v == NULL) + p->uval.vval.v = erl_copy_term(tmp); + return ematch(p->uval.vval.v, t); + } + else { + /* check if the variable is bound already */ + if (p->uval.vval.v != NULL) { + if (ematch(p->uval.vval.v, t) == ERL_TRUE ){ + add_lvar(p); + return ERL_TRUE; + } + else + return ERL_FALSE; + } + else { + p->uval.vval.v = erl_copy_term(t); + add_lvar(p); + return ERL_TRUE; + } + } + break; + + case ERL_PID: + if ((strcmp(ERL_PID_NODE(p), ERL_PID_NODE(t)) == 0) && + (ERL_PID_NUMBER(p) == ERL_PID_NUMBER(t)) && + (ERL_PID_SERIAL(p) == ERL_PID_SERIAL(t)) && + (ERL_PID_CREATION(p) == ERL_PID_CREATION(t))) + return ERL_TRUE; + else + return ERL_FALSE; + break; + + case ERL_PORT: + if ((strcmp(ERL_PORT_NODE(p), ERL_PORT_NODE(t)) == 0) && + (ERL_PORT_NUMBER(p) == ERL_PORT_NUMBER(t)) && + (ERL_PORT_CREATION(p) == ERL_PORT_CREATION(t))) + return ERL_TRUE; + else + return ERL_FALSE; + break; + + case ERL_REF: { + int i, len; + + if (strcmp(ERL_REF_NODE(p), ERL_REF_NODE(t)) != 0 || + ERL_REF_CREATION(p) != ERL_REF_CREATION(t)) + return ERL_FALSE; + + /* FIXME: {len=1, n={42}} and {len=3, n={42, 17, 13}} tests equal. */ + len = ERL_REF_LEN(p); + if (len > ERL_REF_LEN(t)) + len = ERL_REF_LEN(t); + + for (i = 0; i < len; i++) + if (ERL_REF_NUMBERS(p)[i] != ERL_REF_NUMBERS(t)[i]) + return ERL_FALSE; + + return ERL_TRUE; + break; + } + + case ERL_EMPTY_LIST: + return ERL_TRUE; + + case ERL_LIST: + while (ERL_IS_CONS(p) && ERL_IS_CONS(t)) { + if (ematch(p->uval.lval.head, t->uval.lval.head) == ERL_FALSE) + return ERL_FALSE; + p = p->uval.lval.tail; + t = t ->uval.lval.tail; + } + return ematch(p, t); + + case ERL_TUPLE: + { + int i; + if (erl_size(p) != erl_size(t)) + return ERL_FALSE; + else { + for(i=0; i<erl_size(p); i++) + if (ematch(p->uval.tval.elems[i],t->uval.tval.elems[i]) == ERL_FALSE) + return ERL_FALSE; + return ERL_TRUE; + } + } + break; + + case ERL_BINARY: + { + int i; + if ((i = p->uval.bval.size) != t->uval.bval.size) + return ERL_FALSE; + else + return (memcmp(p->uval.bval.b,t->uval.bval.b,i)==0) ? ERL_TRUE : ERL_FALSE; + } + break; + + case ERL_INTEGER: + return (p->uval.ival.i == t->uval.ival.i) ? ERL_TRUE : ERL_FALSE; + break; + + case ERL_SMALL_BIG: + case ERL_U_SMALL_BIG: + /* This case can't happend since it is impossible + * to create a bignum from the C code. + */ + return ERL_FALSE; + break; + + case ERL_FLOAT: +#if defined(VXWORKS) && CPU == PPC860 + { + return (erl_fp_compare((unsigned *)&(p->uval.fval.f), + (unsigned *)&(t->uval.fval.f)) == 0) + ? ERL_TRUE : ERL_FALSE; + } +#else + return (p->uval.fval.f == t->uval.fval.f) ? ERL_TRUE : ERL_FALSE; +#endif + break; + default: + return ERL_FALSE; + break; + } + + /* erl_err_msg("ematch: Unknown type == %c\n", type_p); */ + return ERL_FALSE; + +} /* ematch */ + + +int erl_match(ETERM *p, ETERM *t) +{ + int i; + + if ((i = ematch(p, t)) == ERL_FALSE) + undo_bindings(); + release_chain(); + return i; + +} /* erl_match */ + + diff --git a/lib/erl_interface/src/legacy/erl_format.h b/lib/erl_interface/src/legacy/erl_format.h new file mode 100644 index 0000000000..90801e4892 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_format.h @@ -0,0 +1,22 @@ +/* + * %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% + */ +#ifndef _ERL_FORMAT_H +#define _ERL_FORMAT_H + +#endif /* _ERL_FORMAT_H */ diff --git a/lib/erl_interface/src/legacy/erl_global.h b/lib/erl_interface/src/legacy/erl_global.h new file mode 100644 index 0000000000..ef09eab0b0 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_global.h @@ -0,0 +1,27 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-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% + */ +#ifndef _ERL_GLOBAL_H +#define _ERL_GLOBAL_H + +char **erl_global_names(int fd, int *count); +ETERM *erl_global_whereis(int fd, const char *name, char *node); +int erl_global_register(int fd, const char *name, ETERM *pid); +int erl_global_unregister(int fd, const char *name); + +#endif /* _ERL_GLOBAL_H */ diff --git a/lib/erl_interface/src/legacy/erl_internal.h b/lib/erl_interface/src/legacy/erl_internal.h new file mode 100644 index 0000000000..e79c815946 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_internal.h @@ -0,0 +1,47 @@ +/* + * %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% + */ +#ifndef _ERL_INTERNAL_H +#define _ERL_INTERNAL_H + +/* + * Function: Some useful stuff not to be exported to users. + */ + +#define HEAD(ep) ep->uval.lval.head +#define TAIL(ep) ep->uval.lval.tail +#define ERL_NO_REF(x) (ERL_COUNT(x) == 0) + +#ifdef DEBUG +#define ASSERT(e) \ + if (e) { \ + ; \ + } else { \ + erl_assert_error(#e, __FILE__, __LINE__); \ + } + +extern void erl_assert_error(char* expr, char* file, int line) + __attribute__ ((__noreturn__)); + +#else + +#define ASSERT(e) + +#endif + +#endif /* _ERL_INTERNAL_H */ diff --git a/lib/erl_interface/src/legacy/erl_malloc.c b/lib/erl_interface/src/legacy/erl_malloc.c new file mode 100644 index 0000000000..f51a6c69b3 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_malloc.c @@ -0,0 +1,239 @@ +/* + * %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% + */ + +#include "eidef.h" + +#include <stddef.h> +#include <stdlib.h> + +#include "erl_interface.h" +#include "erl_fix_alloc.h" +#include "erl_malloc.h" +#include "erl_internal.h" +#include "erl_eterm.h" +#include "ei_malloc.h" + +void erl_init_malloc(Erl_Heap *hp, long heap_size) +{ + erl_init_eterm_alloc(); +} /* erl_init_malloc */ + +ETERM *erl_alloc_eterm(unsigned char type) +{ + ETERM *e; + + /* Use fix size allocator */ + if (!(e = (ETERM *) erl_eterm_alloc())) + erl_err_sys("<ERROR> erl_alloc_eterm: Failed to allocate more memory\n"); + + ERL_HEADER(e)->count = 0; + ERL_HEADER(e)->type = type; + return e; + +} /* erl_alloc_eterm */ + +#define EXTERNAL 1 +#define INTERNAL 0 +#define COMPOUND 1 +#define NOT_COMPOUND 0 + +static void _erl_free_term (ETERM *ep, int external, int compound); + +/* + * Free a term, but don't deallocate it until + * the reference counter triggers. + */ +void erl_free_term(ETERM *ep) +{ + _erl_free_term(ep, EXTERNAL, NOT_COMPOUND); +} /* erl_free_term */ + +/* + * Free a term regardless of its reference + * counter value. Use this when you have + * built compound terms such as lists or tuples. + */ + +/* + * FIXME is this true?! + * Tearing down term structures no-matter-what is a horrible idea if + * any term happens to be shared (with some other structure or even + * with yourself). + */ + +void erl_free_compound (ETERM *ep) +{ + _erl_free_term(ep, EXTERNAL, COMPOUND); +} /* erl_free_compound */ + + +/* +** The actual free'ing is done here in _erl_free_term. +** It is by nature recursive, but does not recurse +** on the CDR of a list, which makes it usable for large lists. +*/ + +/* +** Convenience macro, called for variables and lists, +** avoids deep recursions. +*/ +#define RESTART(Eterm, External, Compound) \ +do { \ + ETERM *sep; \ + sep = (Eterm); \ + external = (External); \ + compound = (Compound); \ + /* Clear header info */ \ + ERL_TYPE(ep) = ERL_UNDEF; \ + erl_eterm_free((unsigned int *) ep); \ + ep = sep; \ + goto restart; \ +} while(0) + +#define FREE_AND_CLEAR(ptr) \ +do { \ + erl_free(ptr); \ + (ptr) = NULL; \ +} while (0) + +static void _erl_free_term (ETERM *ep, int external, int compound) +{ +restart: + if (ep == NULL) + return; + if (compound || ERL_NO_REF(ep)) { + /* Yes, it's time to *really* free this one ! */ + switch(ERL_TYPE(ep)) + { + case ERL_ATOM: + FREE_AND_CLEAR(ERL_ATOM_PTR(ep)); + break; + case ERL_VARIABLE: + FREE_AND_CLEAR(ERL_VAR_NAME(ep)); + /* Note: It may be unbound ! */ + if (ERL_VAR_VALUE(ep) != NULL) { + ERL_COUNT(ERL_VAR_VALUE(ep))--; + /* Cleanup and Restart with the actual value */ + RESTART(ERL_VAR_VALUE(ep), INTERNAL, compound); + } + break; + case ERL_LIST: + if (HEAD(ep)) { + ERL_COUNT(HEAD(ep))--; + /* FIXME added cast, is this correct? */ + _erl_free_term((ETERM *)HEAD(ep), INTERNAL, compound); + } + if (TAIL(ep)) { + ERL_COUNT(TAIL(ep))--; + /* Clean up and walk on to CDR in list */ + RESTART(TAIL(ep), INTERNAL, compound); + } + break; + case ERL_TUPLE: + { + int i; + for (i=0; i < ERL_TUPLE_SIZE(ep); i++) + if (ERL_TUPLE_ELEMENT(ep, i)) { + ERL_COUNT(ERL_TUPLE_ELEMENT(ep, i))--; + _erl_free_term(ERL_TUPLE_ELEMENT(ep, i), + INTERNAL, compound); + } + FREE_AND_CLEAR(ERL_TUPLE_ELEMS(ep)); + } + break; + case ERL_BINARY: + FREE_AND_CLEAR(ERL_BIN_PTR(ep)); + break; + case ERL_PID: + FREE_AND_CLEAR(ERL_PID_NODE(ep)); + break; + case ERL_PORT: + FREE_AND_CLEAR(ERL_PORT_NODE(ep)); + break; + case ERL_REF: + FREE_AND_CLEAR(ERL_REF_NODE(ep)); + break; + case ERL_EMPTY_LIST: + case ERL_INTEGER: + case ERL_SMALL_BIG: + case ERL_U_SMALL_BIG: + case ERL_FLOAT: + break; + case ERL_FUNCTION: + { + int i; + + _erl_free_term(ERL_FUN_INDEX(ep), INTERNAL, compound); + _erl_free_term(ERL_FUN_UNIQ(ep), INTERNAL, compound); + _erl_free_term(ERL_FUN_CREATOR(ep), INTERNAL, compound); + _erl_free_term(ERL_FUN_MODULE(ep), INTERNAL, compound); + if (ERL_CLOSURE(ep) != NULL) { + for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) + _erl_free_term(ERL_CLOSURE_ELEMENT(ep,i), + INTERNAL, compound); + } + } + break; + } /* switch */ + + /* Clear header info for those cases where we are done */ + ERL_TYPE(ep) = ERL_UNDEF; + erl_eterm_free(ep); + } else if (external) { + ERL_COUNT(ep)--; + external = INTERNAL; + goto restart; + } +} /* _erl_free_term */ +#undef RESTART +#undef FREE_AND_CLEAR + +void erl_free_array(ETERM **arr, int size) +{ + int i; + + for (i=0; i<size; i++) + erl_free_term(arr[i]); + +} /* erl_free_array */ + + +void* erl_malloc (long size) +{ + void *res; + + if ((res = ei_malloc(size)) == NULL) + erl_err_sys("<ERROR> erl_malloc: Failed to allocate more memory"); + + return res; +} + +void* erl_realloc(void* orig, long size) +{ + void *res; + + if ((res = ei_realloc(orig, size)) == NULL) + erl_err_sys("<ERROR> erl_realloc: Failed to allocate more memory"); + return res; +} + +void erl_free (void *ptr) +{ + ei_free(ptr); +} diff --git a/lib/erl_interface/src/legacy/erl_malloc.h b/lib/erl_interface/src/legacy/erl_malloc.h new file mode 100644 index 0000000000..787d3bb98f --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_malloc.h @@ -0,0 +1,26 @@ +/* + * %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% + */ +#ifndef _ERL_MALLOC_H +#define _ERL_MALLOC_H + +/* FIXME: not documented */ +void *erl_realloc(void*, long); +int erl_current_fix_desc(void); + +#endif /* _ERL_MALLOC_H */ 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; +} diff --git a/lib/erl_interface/src/legacy/erl_marshal.h b/lib/erl_interface/src/legacy/erl_marshal.h new file mode 100644 index 0000000000..8b3c3b6fa1 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_marshal.h @@ -0,0 +1,29 @@ +/* + * %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% + */ +#ifndef _ERL_MARSHALL_H +#define _ERL_MARSHALL_H + +#include "erl_eterm.h" /* FIXME don't want to include this here */ + +/* FIXME: not documented, may be internal */ +int erl_verify_magic(unsigned char*); +void erl_init_marshal(void); +int erl_encode_it(ETERM *ep, unsigned char **ext, int dist); + +#endif /* _ERL_MARSHALL_H */ diff --git a/lib/erl_interface/src/legacy/erl_resolve.c b/lib/erl_interface/src/legacy/erl_resolve.c new file mode 100644 index 0000000000..7dfebb78ed --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_resolve.c @@ -0,0 +1,106 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-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% + */ + +/*************************************************************************** + * + * Compatibility with the old erl_interface library that had some + * undocumented functions. + * + ***************************************************************************/ + +#include "eidef.h" + +#include "erl_interface.h" +#include "ei_resolve.h" +#include "ei_connect_int.h" +#include "ei_epmd.h" + +struct hostent *erl_gethostbyname(const char *name) +{ + return ei_gethostbyname(name); +} + + +void erl_init_resolve(void) +{ + ei_init_resolve(); +} + + +struct hostent *erl_gethostbyaddr(const char *addr, int len, int type) +{ + return ei_gethostbyaddr(addr, len, type); +} + + +struct hostent *erl_gethostbyname_r(const char *name, + struct hostent *hostp, + char *buffer, + int buflen, + int *h_errnop) +{ + return ei_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); +} + + +struct hostent *erl_gethostbyaddr_r(const char *addr, + int length, + int type, + struct hostent *hostp, + char *buffer, + int buflen, + int *h_errnop) +{ + return ei_gethostbyaddr_r(addr,length,type,hostp,buffer,buflen,h_errnop); +} + + +int erl_distversion(int fd) +{ + return ei_distversion(fd); +} + +int erl_epmd_connect(struct in_addr *inaddr) +{ + return ei_epmd_connect_tmo(inaddr,0); +} + +int erl_epmd_port(struct in_addr *inaddr, const char *alive, int *dist) +{ + return ei_epmd_port(inaddr, alive, dist); +} + + + +/* FIXME !!!!! +erl_epmd_port ei_epmd_port +erl_mutex_lock ei_mutex_lock +erl_malloc erl_free ???? +erl_publish erl_unpublish +< extern int erl_epmd_connect(struct in_addr *inaddr); +< extern int erl_epmd_publish(int port, const char *alive); +< extern int erl_epmd_port(struct in_addr *inaddr, const char *alive, int *dist); + +< int erl_unpublish(const char *alive) +--- +> int ei_unpublish_alive(const char *alive) + +erl_self +erl_getfdcookie +*/ diff --git a/lib/erl_interface/src/legacy/erl_timeout.c b/lib/erl_interface/src/legacy/erl_timeout.c new file mode 100644 index 0000000000..af1a4a1f3a --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_timeout.c @@ -0,0 +1,161 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-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% + */ +/* timeout.c + * + * todo: use posix timers (timer_create etc) instead of setitimer. + * + */ +#if !defined(__WIN32__) && !defined(VXWORKS) + +/* FIXME: well, at least I can compile now... */ + +#include "eidef.h" + +#include <stdio.h> +#include <stdlib.h> +#include <setjmp.h> +#include <signal.h> + +#if TIME_WITH_SYS_TIME +# include <sys/time.h> +# include <time.h> +#else +# if HAVE_SYS_TIME_H +# include <sys/time.h> +# else +# include <time.h> +# endif +#endif + +#include "erl_timeout.h" + +typedef struct jmp_s { + jmp_buf jmpbuf; + struct itimerval timerinfo; + void *siginfo; + struct jmp_s *next; +} *jmp_t; + +static jmp_t push(jmp_t j); +static jmp_t pop(void); +static void timeout_handler(int dummy); + +jmp_buf *timeout_setup(int ms) +{ + struct itimerval t; + jmp_t j; + void *s; + +#ifdef DEBUG + fprintf(stderr,"timeout setup\n"); +#endif + s=signal(SIGALRM,timeout_handler); + + /* set the timer */ + t.it_interval.tv_sec = 0; + t.it_interval.tv_usec = 0; + t.it_value.tv_sec = ms / 1000; + t.it_value.tv_usec = (ms % 1000) * 1000; + + /* get a jump buffer and save it */ + j = malloc(sizeof(*j)); /* FIXME check result */ + j->siginfo = s; + push(j); + + setitimer(ITIMER_REAL,&t,&(j->timerinfo)); + + return &(j->jmpbuf); +} + + +int timeout_cancel(void) +{ + jmp_t j; + +#ifdef DEBUG + fprintf(stderr,"timeout cancel\n"); +#endif + /* retrieve the jump buffer */ + j=pop(); + /* restore the timer and signal disposition */ + setitimer(ITIMER_REAL,&(j->timerinfo),NULL); + signal(SIGALRM,j->siginfo); + + free(j); + + return 0; +} + +void timeout_handler(int dummy) +{ + jmp_t j; + +#ifdef DEBUG + fprintf(stderr,"timeout handler\n"); +#endif + + /* retrieve the jump buffer */ + j=pop(); + + /* restore the timer and signal disposition */ + setitimer(ITIMER_REAL,&(j->timerinfo),NULL); + signal(SIGALRM,j->siginfo); + + free(j); + longjmp(j->jmpbuf,JMPVAL); + return; /* not reached */ +} + + +/* a simple stack for saving the jump buffer allows us to pass a + * variable between functions that don't call each other, in a way + * that will survive the longjmp(). + */ + +/* FIXME problem for threaded ? */ +static jmp_t jmp_head=NULL; +#ifdef DEBUG +static int depth = 0; +static int maxdepth = 0; +#endif + +static jmp_t push(jmp_t j) +{ + j->next = jmp_head; + jmp_head = j; + +#ifdef DEBUG + depth++; + if (depth > maxdepth) maxdepth = depth; +#endif + + return j; +} + +static jmp_t pop(void) +{ + jmp_t j = jmp_head; + if (j) jmp_head = j->next; +#ifdef DEBUG + depth--; +#endif + return j; +} + +#endif /* platform */ diff --git a/lib/erl_interface/src/legacy/erl_timeout.h b/lib/erl_interface/src/legacy/erl_timeout.h new file mode 100644 index 0000000000..4ef6d21a72 --- /dev/null +++ b/lib/erl_interface/src/legacy/erl_timeout.h @@ -0,0 +1,74 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-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% + */ +#ifndef _ERL_TIMEOUT_H +#define _ERL_TIMEOUT_H + +#if !defined (__WIN32__) && !defined (VXWORKS) + +#include <setjmp.h> + +/* + use timeout like this (delay in ms): + + if (timeout(delay,fun(a,b,c))) { + printf("timeout occurred\n"); + } + else { + ... + } + +If the call to fun() has not returned before 'delay' ms, it will be +interrupted and and timeout() will return a non-zero value. + +If fun() finishes before 'delay' ms, then timeout will return 0. + +If you need the return value from fun then assign it like this: + + if (timeout(delay,(x = fun(...)))) { + } + +These functions work by setting and catching SIGALRM, and although it +saves and restores the signal handler, it may not work in situations +where you are already using SIGALRM (this includes calls to sleep(3)). + +Note that although recursive calls to timeout will not fail, they may +not give the expected results. All invocations of timeout use the same +timer, which is set on entrance to timeout and restored on exit from +timeout. So although an inner call to timeout will restart the timer +for any pending outer call when it exits, any time that has already +elapsed against the outer timeout is forgotten. In addition, the alarm +signal will always go to the innermost (last called) timeout, which +may or may not be the intention in recursive cases. + +*/ + +#define JMPVAL 997 /* magic */ + +#define timeout(ms,funcall) \ + (setjmp(*timeout_setup(ms)) == JMPVAL ? -1: \ + ((void)(funcall), timeout_cancel())) + + +/* don't call any of these directly - use the macro! see above! */ +jmp_buf *timeout_setup(int ms); +int timeout_cancel(void); + +#endif /* WIN32 && VXWORKS */ + +#endif /* _ERL_TIMEOUT_H */ diff --git a/lib/erl_interface/src/legacy/global_names.c b/lib/erl_interface/src/legacy/global_names.c new file mode 100644 index 0000000000..7333d94931 --- /dev/null +++ b/lib/erl_interface/src/legacy/global_names.c @@ -0,0 +1,109 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-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% + */ +#include <stdlib.h> +#include <string.h> +#include "eidef.h" +#include "eiext.h" +#include "eisend.h" +#include "eirecv.h" +#include "ei_connect_int.h" +#include "erl_interface.h" +#include "erl_connect.h" + +#define GLOBALNAMEBUF (16*1024) /* not very small actually */ + +/* return a list of all registered names. Function allocates and + * returns a NULL-terminated array of pointers to strings. The caller + * is responsible for freeing the array. Space for the array and + * all strings is allocated with a single call to malloc, so the + * caller can make one call to free(). + */ +/* global:registered_names() -> [name1,name2,...] */ +char **erl_global_names(int fd, int *count) +{ + char buf[GLOBALNAMEBUF]; + char *bufp=buf; + char tmpbuf[64]; + int size = 0; + int index = 0; + erlang_pid *self = erl_self(); + erlang_msg msg; + int i; + int version; + int arity; + int msglen; + char **names; + char *s; + + self->num = fd; + ei_encode_version(buf,&index); + ei_encode_tuple_header(buf,&index,2); + ei_encode_pid(buf,&index,self); /* PidFrom */ + ei_encode_tuple_header(buf,&index,5); + ei_encode_atom(buf,&index,"call"); /* call */ + ei_encode_atom(buf,&index,"global"); /* Mod */ + ei_encode_atom(buf,&index,"registered_names"); /* Fun */ + ei_encode_list_header(buf,&index,0); /* Args: [ ] */ + ei_encode_atom(buf,&index,"user"); /* user */ + + /* make the rpc call */ + if (ei_send_reg_encoded(fd,self,"rex",buf,index)) return NULL; + + while (1) { + index = GLOBALNAMEBUF; + if (!(i = ei_recv_internal(fd,&bufp,&index,&msg,&msglen,1,0))) continue; + else break; + } + + if (i != ERL_SEND) return NULL; + + /* expecting { rex, [name1, name2, ...] } */ + size = msglen; + index = 0; + + if (ei_decode_version(buf,&index,&version) + || ei_decode_tuple_header(buf,&index,&arity) + || (arity != 2) + || ei_decode_atom(buf,&index,tmpbuf) + || strcmp(tmpbuf,"rex") + || ei_decode_list_header(buf,&index,&arity)) return NULL; + + + /* we use the size of the rest of the received message to estimate + * the buffer space required for all the strings. we know how many + * they are (arity) so we need space for that many pointers, plus + * a little less than the atoms themselves needed in the reply. + */ + arity++; /* we will need a terminating NULL as well */ + if (!(names = malloc((arity * sizeof(char**)) + (size-index)))) return NULL; + + /* arity pointers first, followed by s */ + s = (char *)(names+arity+1); + + if (count) *count = 0; + for (i=0; i<arity; i++) { + names[i] = s; /* insert the pointer */ + if (ei_decode_atom(buf,&index,s)) break; /* copy the data */ + if (count) (*count)++; + s += strlen(names[i]) + 1; /* advance pointer */ + } + names[i]=NULL; + + return names; +} diff --git a/lib/erl_interface/src/legacy/global_register.c b/lib/erl_interface/src/legacy/global_register.c new file mode 100644 index 0000000000..3a4de8b08e --- /dev/null +++ b/lib/erl_interface/src/legacy/global_register.c @@ -0,0 +1,110 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-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% + */ +#include <string.h> +#include "eidef.h" +#include "eiext.h" +#include "eisend.h" +#include "eirecv.h" +#include "erl_interface.h" + +int erl_global_register(int fd, const char *name, ETERM *pid) +{ + char buf[EISMALLBUF]; + char *bufp=buf; + char tmpbuf[64]; + int index = 0; + erlang_pid self; + erlang_msg msg; + int needlink, needatom; + int arity; + int version; + int msglen; + int i; + + /* get that pid into a better format */ + if (!erl_encode(pid,(unsigned char*)buf)) return -1; + if (ei_decode_version(buf,&index,&version) + || ei_decode_pid(buf,&index,&self)) return -1; + + /* set up rpc arguments */ + /* { PidFrom, { call, Mod, Fun, Args, user }} */ + index = 0; + ei_encode_version(buf,&index); + ei_encode_tuple_header(buf,&index,2); + ei_encode_pid(buf,&index,&self); /* PidFrom */ + ei_encode_tuple_header(buf,&index,5); + ei_encode_atom(buf,&index,"call"); /* call */ + ei_encode_atom(buf,&index,"global"); /* Mod */ + ei_encode_atom(buf,&index,"register_name_external"); /* Fun */ + ei_encode_list_header(buf,&index,3); /* Args: [ name, self(), cnode ] */ + ei_encode_atom(buf,&index,name); + ei_encode_pid(buf,&index,&self); + ei_encode_tuple_header(buf,&index,2); + ei_encode_atom(buf,&index,"global"); /* special "resolve" treatment */ + ei_encode_atom(buf,&index,"cnode"); /* i.e. we get a SEND when conflict */ + ei_encode_empty_list(buf,&index); + ei_encode_atom(buf,&index,"user"); /* user */ + + /* make the rpc call */ + if (ei_send_reg_encoded(fd,&self,"rex",buf,index)) return -1; + + /* get the reply: expect link and an atom, or just an atom */ + needlink = needatom = 1; + while (1) { + /* get message */ + while (1) { + index = EISMALLBUF; + if (!(i = ei_recv_internal(fd,&bufp,&index,&msg,&msglen,1,0))) continue; + else break; + } + + switch (i) { + case ERL_LINK: + /* got link */ + if (!needlink) return -1; + needlink = 0; + break; + + case ERL_SEND: + /* got message - does it contain our atom? */ + if (!needatom) return -1; + else { + /* expecting { rex, yes } */ + index = 0; + if (ei_decode_version(buf,&index,&version) + || ei_decode_tuple_header(buf,&index,&arity) + || (arity != 2) + || ei_decode_atom(buf,&index,tmpbuf) + || strcmp(tmpbuf,"rex") + || ei_decode_atom(buf,&index,tmpbuf) + || strcmp(tmpbuf,"yes")) + return -1; /* bad response from other side */ + + /* we're done */ + return 0; + } + break; + + default: + return -1; /* something else */ + } + } + return 0; +} + diff --git a/lib/erl_interface/src/legacy/global_unregister.c b/lib/erl_interface/src/legacy/global_unregister.c new file mode 100644 index 0000000000..514dbc3c68 --- /dev/null +++ b/lib/erl_interface/src/legacy/global_unregister.c @@ -0,0 +1,102 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-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% + */ +#include <string.h> +#include "eidef.h" /* Has to be first */ +#include "eiext.h" +#include "eisend.h" +#include "eirecv.h" +#include "ei_connect_int.h" +#include "erl_interface.h" +#include "erl_connect.h" + +/* remove the association between name and its pid */ +/* global:unregister_name(name) -> ok */ +int erl_global_unregister(int fd, const char *name) +{ + char buf[EISMALLBUF]; + char *bufp=buf; + char tmpbuf[64]; + int index = 0; + erlang_pid *self = erl_self(); + erlang_msg msg; + int i; + int version,arity,msglen; + int needunlink, needatom; + + /* make a self pid */ + self->num = fd; + ei_encode_version(buf,&index); + ei_encode_tuple_header(buf,&index,2); + ei_encode_pid(buf,&index,self); /* PidFrom */ + ei_encode_tuple_header(buf,&index,5); + ei_encode_atom(buf,&index,"call"); /* call */ + ei_encode_atom(buf,&index,"global"); /* Mod */ + ei_encode_atom(buf,&index,"unregister_name_external"); /* Fun */ + ei_encode_list_header(buf,&index,1); /* Args: [ name ] */ + ei_encode_atom(buf,&index,name); + ei_encode_empty_list(buf,&index); + ei_encode_atom(buf,&index,"user"); /* user */ + + /* make the rpc call */ + if (ei_send_reg_encoded(fd,self,"rex",buf,index)) return -1; + + /* get the reply: expect unlink and an atom, or just an atom */ + needunlink = needatom = 1; + while (1) { + /* get message */ + while (1) { + index = EISMALLBUF; + if (!(i = ei_recv_internal(fd,&bufp,&index,&msg,&msglen,1,0))) continue; + else break; + } + + switch (i) { + case ERL_UNLINK: + /* got link */ + if (!needunlink) return -1; + needunlink = 0; + break; + + case ERL_SEND: + /* got message - does it contain our atom? */ + if (!needatom) return -1; + else { + /* expecting { rex, ok } */ + index = 0; + if (ei_decode_version(buf,&index,&version) + || ei_decode_tuple_header(buf,&index,&arity) + || (arity != 2) + || ei_decode_atom(buf,&index,tmpbuf) + || strcmp(tmpbuf,"rex") + || ei_decode_atom(buf,&index,tmpbuf) + || strcmp(tmpbuf,"ok")) + return -1; /* bad response from other side */ + + /* we're done here */ + return 0; + } + break; + + default: + return -1; + } + } + + return 0; +} diff --git a/lib/erl_interface/src/legacy/global_whereis.c b/lib/erl_interface/src/legacy/global_whereis.c new file mode 100644 index 0000000000..2afb193504 --- /dev/null +++ b/lib/erl_interface/src/legacy/global_whereis.c @@ -0,0 +1,91 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-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% + */ +#include <stdlib.h> +#include <string.h> +#include "eidef.h" +#include "eiext.h" +#include "eisend.h" +#include "eirecv.h" +#include "ei_connect_int.h" +#include "erl_interface.h" +#include "erl_connect.h" + +/* return the ETERM pid corresponding to name. If caller + * provides non-NULL node, nodename will be returned there + */ +/* global:whereis_name(name) -> pid */ + +ETERM *erl_global_whereis(int fd, const char *name, char *node) +{ + char buf[EISMALLBUF]; + char *bufp=buf; + char tmpbuf[64]; + int index = 0; + erlang_pid *self = erl_self(); + erlang_pid epid; + ETERM *opid; + erlang_msg msg; + int i; + int version,arity,msglen; + + self->num = fd; /* FIXME looks strange to change something?! */ + + ei_encode_version(buf,&index); + ei_encode_tuple_header(buf,&index,2); + ei_encode_pid(buf,&index,self); /* PidFrom */ + ei_encode_tuple_header(buf,&index,5); + ei_encode_atom(buf,&index,"call"); /* call */ + ei_encode_atom(buf,&index,"global"); /* Mod */ + ei_encode_atom(buf,&index,"whereis_name"); /* Fun */ + ei_encode_list_header(buf,&index,1); /* Args: [ name ] */ + ei_encode_atom(buf,&index,name); + ei_encode_empty_list(buf,&index); + ei_encode_atom(buf,&index,"user"); /* user */ + + /* make the rpc call */ + if (ei_send_reg_encoded(fd,self,"rex",buf,index)) return NULL; + + while (1) { + index = EISMALLBUF; + if (!(i = ei_recv_internal(fd,&bufp,&index,&msg,&msglen,1,0))) continue; + else break; + } + + if (i != ERL_SEND) return NULL; + + /* expecting { rex, pid } */ + index = 0; + if (ei_decode_version(buf,&index,&version) + || ei_decode_tuple_header(buf,&index,&arity) + || (arity != 2) + || ei_decode_atom(buf,&index,tmpbuf) + || strcmp(tmpbuf,"rex") + || ei_decode_pid(buf,&index,&epid)) + return NULL; /* bad response from other side */ + + /* put the pid into a format for the caller */ + index = 0; + ei_encode_pid(buf,&index,&epid); + opid = erl_decode((unsigned char*)buf); + + /* extract the nodename for the caller */ + if (node) strcpy(node,epid.node); + + return opid; +} diff --git a/lib/erl_interface/src/legacy/portability.h b/lib/erl_interface/src/legacy/portability.h new file mode 100644 index 0000000000..5f984b08e1 --- /dev/null +++ b/lib/erl_interface/src/legacy/portability.h @@ -0,0 +1,33 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-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% + */ + +#ifndef _PORTABILITY_H +#define _PORTABILITY_H + +#if !defined(__GNUC__) || __GNUC__ < 2 + +/* + * GCC's attributes are too useful to not use. Other compilers + * just lose opportunities to optimize and warn. + */ +# define __attribute__(foo) /* nothing */ + +#endif + +#endif /* _PORTABILITY_H */ |