diff options
Diffstat (limited to 'erts')
234 files changed, 9238 insertions, 5066 deletions
diff --git a/erts/autoconf/configure.vxworks b/erts/autoconf/configure.vxworks index 14fbf766dc..23a93faa31 100755 --- a/erts/autoconf/configure.vxworks +++ b/erts/autoconf/configure.vxworks @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# Copyright Ericsson AB 1997-2011. 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 diff --git a/erts/autoconf/vxworks/sed.general b/erts/autoconf/vxworks/sed.general index 551458daf5..88697b788d 100644 --- a/erts/autoconf/vxworks/sed.general +++ b/erts/autoconf/vxworks/sed.general @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# Copyright Ericsson AB 1997-2011. 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 diff --git a/erts/configure.in b/erts/configure.in index 6e983a07b0..c93fa95ab1 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. -*-m4-*- dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2010. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2011. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -580,6 +580,11 @@ AC_SUBST(WFLAGS) AC_SUBST(CFLAG_RUNTIME_LIBRARY_PATH) AC_CHECK_SIZEOF(void *) # Needed for ARCH and smp checks below +if test "x$ac_cv_sizeof_void_p" = x8; then + AC_SUBST(EXTERNAL_WORD_SIZE, 64) +else + AC_SUBST(EXTERNAL_WORD_SIZE, 32) +fi dnl dnl Figure out operating system and cpu architecture @@ -2394,6 +2399,12 @@ if test "$cross_compiling" != "yes" && test X${enable_hipe} != Xno; then if test -z "$M4"; then enable_hipe=no AC_MSG_NOTICE([HiPE disabled as no valid m4 is found in PATH]) + elif test "$enable_halfword_emulator" = "yes"; then + if test X${enable_hipe} = Xyes; then + AC_MSG_ERROR([HiPE can not be combined with halfword emulator (yet)]) + else + AC_MSG_NOTICE([HiPE auto-disabled on halfword emulator]) + fi else case "$ARCH-$OPSYS" in x86-linux|amd64-linux|x86-darwin*|amd64-darwin*|ppc-linux|ppc-darwin|arm-linux|amd64-freebsd|x86-freebsd|x86-sol2|amd64-sol2|ultrasparc-linux) @@ -3655,6 +3666,12 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in urp="uninstall/openssl_is1/inno setup: app path" rp="$wrp$urp" if regtool -q get "$rp" > /dev/null; then + true + else + urp="uninstall/openssl (32-bit)_is1/inno setup: app path" + rp="$wrp$urp" + fi + if regtool -q get "$rp" > /dev/null; then ssl_install_dir=`regtool -q get "$rp"` # Try hard to get rid of spaces... if cygpath -d "$ssl_install_dir" > /dev/null 2>&1; then diff --git a/erts/doc/src/driver.xml b/erts/doc/src/driver.xml index db455312ec..2b1ed398ee 100644 --- a/erts/doc/src/driver.xml +++ b/erts/doc/src/driver.xml @@ -63,7 +63,8 @@ <p>This is a simple driver for accessing a postgres database using the libpq C client library. Postgres is used because it's free and open source. For information - on postgres, refer to the website www.postgres.org.</p> + on postgres, refer to the website + <url href="http://www.postgres.org">www.postgres.org</url>.</p> <p>The driver is synchronous, it uses the synchronous calls of the client library. This is only for simplicity, and is generally not good, since it will @@ -210,7 +211,7 @@ static void stop(ErlDrvData drv_data) input data is a string paramater for <c><![CDATA[connect]]></c> and <c><![CDATA[select]]></c>. The returned data consists of Erlang terms.</p> <p>The functions <c><![CDATA[get_s]]></c> and <c><![CDATA[ei_x_to_new_binary]]></c> are - utilities that is used to make the code shorter. <c><![CDATA[get_s]]></c> + utilities that are used to make the code shorter. <c><![CDATA[get_s]]></c> duplicates the string and zero-terminates it, since the postgres client library wants that. <c><![CDATA[ei_x_to_new_binary]]></c> takes an <c><![CDATA[ei_x_buff]]></c> buffer and allocates a binary and @@ -244,7 +245,7 @@ static int control(ErlDrvData drv_data, unsigned int command, char *buf, return r; } ]]></code> - <p>In <c><![CDATA[do_connect]]></c> is where we log in to the database. If the connection + <p><c><![CDATA[do_connect]]></c> is where we log in to the database. If the connection was successful we store the connection handle in our driver data, and return ok. Otherwise, we return the error message from postgres, and store <c><![CDATA[NULL]]></c> in the driver data.</p> @@ -264,7 +265,7 @@ static int do_connect(const char *s, our_data_t* data, ei_x_buff* x) } ]]></code> <p>If we are connected (if the connection handle is not <c><![CDATA[NULL]]></c>), - we log out from the database. We need to check if a we should + we log out from the database. We need to check if we should encode an ok, since we might get here from the <c><![CDATA[stop]]></c> function, which doesn't return data to the emulator.</p> <code type="none"><![CDATA[ @@ -279,7 +280,7 @@ static int do_disconnect(our_data_t* data, ei_x_buff* x) return 0; } ]]></code> - <p>We execute a query and encodes the result. Encoding is done + <p>We execute a query and encode the result. Encoding is done in another C module, <c><![CDATA[pg_encode.c]]></c> which is also provided as sample code.</p> <code type="none"><![CDATA[ @@ -291,7 +292,7 @@ static int do_select(const char* s, our_data_t* data, ei_x_buff* x) return 0; } ]]></code> - <p>Here we simply checks the result from postgres, and + <p>Here we simply check the result from postgres, and if it's data we encode it as lists of lists with column data. Everything from postgres is C strings, so we just use <c><![CDATA[ei_x_encode_string]]></c> to send @@ -392,7 +393,7 @@ disconnect(Port) -> select(Port, Query) -> binary_to_term(port_control(Port, ?DRV_SELECT, Query)). ]]></code> - <p>The api is simple: <c><![CDATA[connect/1]]></c> loads the driver, opens it + <p>The API is simple: <c><![CDATA[connect/1]]></c> loads the driver, opens it and logs on to the database, returning the Erlang port if successful, <c><![CDATA[select/2]]></c> sends a query to the driver, and returns the result, <c><![CDATA[disconnect/1]]></c> closes the @@ -417,7 +418,7 @@ select(Port, Query) -> <p>Sometimes database queries can take long time to complete, in our <c><![CDATA[pg_sync]]></c> driver, the emulator halts while the driver is doing its job. This is - often not acceptable, since no other Erlang processes + often not acceptable, since no other Erlang process gets a chance to do anything. To improve on our postgres driver, we reimplement it using the asynchronous calls in LibPQ.</p> @@ -472,7 +473,7 @@ typedef struct our_data_t { whether the driver is waiting for a connection or waiting for the result of a query. (This is needed since the entry <c><![CDATA[ready_io]]></c> will be called both when connecting and - when there is query result.)</p> + when there is a query result.)</p> <code type="none"><![CDATA[ static int do_connect(const char *s, our_data_t* data) { @@ -571,7 +572,7 @@ static void ready_io(ErlDrvData drv_data, ErlDrvEvent event) connection is successful, or error if it's not. If the connection is not yet established, we simply return; <c><![CDATA[ready_io]]></c> will be called again.</p> - <p>If we have result from a connect, indicated that we have data in + <p>If we have a result from a connect, indicated by having data in the <c><![CDATA[x]]></c> buffer, we no longer need to select on output (<c><![CDATA[ready_output]]></c>), so we remove this by calling <c><![CDATA[driver_select]]></c>.</p> @@ -630,9 +631,9 @@ return_port_data(Port) -> message queue. The function <c><![CDATA[return_port_data]]></c> above receives data from the port. Since the data is in binary format, we use <c><![CDATA[binary_to_term/1]]></c> to convert - it to Erlang term. Note that the driver is opened in - binary mode, <c><![CDATA[open_port/2]]></c> is called with the option - <c><![CDATA[[binary]]]></c>. This means that data sent from the driver + it to an Erlang term. Note that the driver is opened in + binary mode (<c><![CDATA[open_port/2]]></c> is called with the option + <c><![CDATA[[binary]]]></c>). This means that data sent from the driver to the emulator is sent as binaries. Without the <c><![CDATA[binary]]></c> option, they would have been lists of integers.</p> </section> @@ -646,15 +647,15 @@ return_port_data(Port) -> of a list of integers. For large lists (more than 100000 elements), this will take some time, so we will perform this as an asynchronous task.</p> - <p>The asynchronous api for drivers are quite complicated. First + <p>The asynchronous API for drivers is quite complicated. First of all, the work must be prepared. In our example we do this in <c><![CDATA[output]]></c>. We could have used <c><![CDATA[control]]></c> just as well, but we want some variation in our examples. In our driver, we allocate - a structure that contains all needed for the asynchronous task + a structure that contains anything that's needed for the asynchronous task to do the work. This is done in the main emulator thread. Then the asynchronous function is called from a driver thread, - separate from the main emulator thread. Note that the driver- - functions are not reentrant, so they shouldn't be used. + separate from the main emulator thread. Note that the driver-functions + are not reentrant, so they shouldn't be used. Finally, after the function is completed, the driver callback <c><![CDATA[ready_async]]></c> is called from the main emulator thread, this is where we return the result to Erlang. (We can't @@ -692,7 +693,7 @@ static ErlDrvEntry next_perm_driver_entry = { be sent later from the <c><![CDATA[ready_async]]></c> call-back.</p> <p>The <c><![CDATA[async_data]]></c> will be passed to the <c><![CDATA[do_perm]]></c> function. We do not use a <c><![CDATA[async_free]]></c> function (the last argument to - <c><![CDATA[driver_async]]></c>, it's only used if the task is cancelled + <c><![CDATA[driver_async]]></c>), it's only used if the task is cancelled programmatically.</p> <code type="none"><![CDATA[ struct our_async_data { @@ -743,7 +744,7 @@ static void ready_async(ErlDrvData drv_data, ErlDrvThreadData async_data) ErlDrvPort port = reinterpret_cast<ErlDrvPort>(drv_data); our_async_data* d = reinterpret_cast<our_async_data*>(async_data); int n = d->data.size(), result_n = n*2 + 3; - ErlDrvTermData* result = new ErlDrvTermData[result_n], * rp = result; + ErlDrvTermData *result = new ErlDrvTermData[result_n], *rp = result; for (vector<int>::iterator i = d->data.begin(); i != d->data.end(); ++i) { *rp++ = ERL_DRV_INT; diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml index dd949d4048..dfddbb18ea 100644 --- a/erts/doc/src/driver_entry.xml +++ b/erts/doc/src/driver_entry.xml @@ -4,7 +4,7 @@ <cref> <header> <copyright> - <year>2001</year><year>2010</year> + <year>2001</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -36,7 +36,7 @@ <description> <p>As of erts version 5.5.3 the driver interface has been extended (see <seealso marker="driver_entry#extended_marker">extended marker</seealso>). - The extended interface introduce + The extended interface introduces <seealso marker="erl_driver#version_management">version management</seealso>, the possibility to pass capability flags (see <seealso marker="driver_entry#driver_flags">driver flags</seealso>) @@ -45,21 +45,21 @@ <note> <p>Old drivers (compiled with an <c>erl_driver.h</c> from an earlier erts version than 5.5.3) have to be recompiled - (but does not have to use the extended interface).</p> + (but do not have to use the extended interface).</p> </note> <p>The <c>driver_entry</c> structure is a C struct that all erlang - drivers defines. It contains entry points for the erlang driver + drivers define. It contains entry points for the erlang driver that are called by the erlang emulator when erlang code accesses the driver.</p> <p> <marker id="emulator"></marker> The <seealso marker="driver_entry">erl_driver</seealso> driver - API functions needs a port handle + API functions need a port handle that identifies the driver instance (and the port in the emulator). This is only passed to the <c>start</c> function, but not to the other functions. The <c>start</c> function returns a driver-defined handle that is passed to the other functions. A - common practice is to have the <c>start</c> function allocating + common practice is to have the <c>start</c> function allocate some application-defined structure and stash the <c>port</c> handle in it, to use it later with the driver API functions.</p> <p>The driver call-back functions are called synchronously from the @@ -219,6 +219,10 @@ typedef struct erl_drv_entry { completes, write to the pipe (use <c>SetEvent</c> on Windows), this will make the emulator call <c>ready_input</c> or <c>ready_output</c>.</p> + <p>Spurious events may happen. That is, calls to <c>ready_input</c> + or <c>ready_output</c> even though no real events are signaled. In + reality it should be rare (and OS dependant), but a robust driver + must nevertheless be able to handle such cases.</p> </item> <tag><marker id="driver_name"/>char *driver_name</tag> <item> @@ -235,7 +239,7 @@ typedef struct erl_drv_entry { </item> <tag>void *handle</tag> <item> - <p>This field is reserved for the emulators internal use. The + <p>This field is reserved for the emulator's internal use. The emulator will modify this field; therefore, it is important that the <c>driver_entry</c> isn't declared <c>const</c>.</p> </item> @@ -399,7 +403,7 @@ typedef struct erl_drv_entry { <tag>void *handle2</tag> <item> <p> - This field is reserved for the emulators internal use. The + This field is reserved for the emulator's internal use. The emulator will modify this field; therefore, it is important that the <c>driver_entry</c> isn't declared <c>const</c>. </p> diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 9aebcf6111..f4c81d9c47 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1996</year><year>2010</year> + <year>1996</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -231,7 +231,8 @@ <tag><c><![CDATA[-detached]]></c></tag> <item> <p>Starts the Erlang runtime system detached from the system - console. Useful for running daemons and backgrounds processes.</p> + console. Useful for running daemons and backgrounds processes. Implies + <c><![CDATA[-noinput]]></c>.</p> </item> <tag><c><![CDATA[-emu_args]]></c></tag> <item> diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml index 1fe7ac7ecd..6c725fc82d 100644 --- a/erts/doc/src/erl_dist_protocol.xml +++ b/erts/doc/src/erl_dist_protocol.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2007</year> - <year>2007</year> + <year>2011</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index 497a2fa01d..066a2a4b92 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -56,16 +56,16 @@ instance is connected to an Erlang port. Every port has a port owner process. Communication with the port is normally done through the port owner process.</p> - <p>Most of the functions takes the <c>port</c> handle as an + <p>Most of the functions take the <c>port</c> handle as an argument. This identifies the driver instance. Note that this port handle must be stored by the driver, it is not given when the driver is called from the emulator (see <seealso marker="driver_entry#emulator">driver_entry</seealso>).</p> - <p>Some of the functions takes a parameter of type + <p>Some of the functions take a parameter of type <c>ErlDrvBinary</c>, a driver binary. It should be both - allocated and freed by the caller. Using a binary directly avoid + allocated and freed by the caller. Using a binary directly avoids one extra copying of data.</p> - <p>Many of the output functions has a "header buffer", with + <p>Many of the output functions have a "header buffer", with <c>hbuf</c> and <c>hlen</c> parameters. This buffer is sent as a list before the binary (or list, depending on port mode) that is sent. This is convenient when matching on messages received from @@ -92,7 +92,7 @@ with SMP support without being rewritten if driver level locking is used.</p> <note> - <p>It is assumed that drivers does not access other drivers. If + <p>It is assumed that drivers do not access other drivers. If drivers should access each other they have to provide their own mechanism for thread safe synchronization. Such "inter driver communication" is strongly discouraged.</p> @@ -113,12 +113,12 @@ call-backs may be made from different threads.</p> </note> <p>Most functions in this API are <em>not</em> thread-safe, i.e., - they may <em>not</em> be called from an arbitrary thread. Function + they may <em>not</em> be called from an arbitrary thread. Functions that are not documented as thread-safe may only be called from driver call-backs or function calls descending from a driver call-back call. Note that driver call-backs may be called from different threads. This, however, is not a problem for any - functions in this API, since the emulator have control over + function in this API, since the emulator has control over these threads.</p> <note> <p>Functions not explicitly documented as thread-safe are @@ -155,10 +155,10 @@ more information.</p> </item> <tag>Output functions</tag> - <item>With the output functions, the driver sends data back + <item>With the output functions, the driver sends data back to the emulator. They will be received as messages by the port owner process, see <c>open_port/2</c>. The vector function and the - function taking a driver binary is faster, because that avoid + function taking a driver binary are faster, because they avoid copying the data buffer. There is also a fast way of sending terms from the driver, without going through the binary term format.</item> @@ -193,14 +193,14 @@ use functionality from the POSIX thread API or the Windows native thread API. </p> - <p>The Erlang driver thread API only return error codes when it is + <p>The Erlang driver thread API only returns error codes when it is reasonable to recover from an error condition. If it isn't reasonable to recover from an error condition, the whole runtime system is terminated. For example, if a create mutex operation fails, an error code is returned, but if a lock operation on a mutex fails, the whole runtime system is terminated. </p> - <p>Note that there exist no "condition variable wait with timeout" in + <p>Note that there exists no "condition variable wait with timeout" in the Erlang driver thread API. This is due to issues with <c>pthread_cond_timedwait()</c>. When the system clock suddenly is changed, it isn't always guaranteed that you will wake up from @@ -241,7 +241,7 @@ to give you better error reports. </p> </item> - <tag>Adding / remove drivers</tag> + <tag>Adding / removing drivers</tag> <item>A driver can add and later remove drivers.</item> <tag>Monitoring processes</tag> <item>A driver can monitor a process that does not own a port.</item> @@ -262,7 +262,7 @@ could, under rare circumstances, mean that drivers have to be slightly modified. If so, this will of course be documented. <c>ERL_DRV_EXTENDED_MINOR_VERSION</c> will be incremented when - new features are added. The runtime system use the minor version + new features are added. The runtime system uses the minor version of the driver to determine what features to use. The runtime system will refuse to load a driver if the major versions differ, or if the major versions are equal and the @@ -273,7 +273,7 @@ It can, however, not make sure that it isn't incompatible. Therefore, when loading a driver that doesn't use the extended driver interface, there is a risk that it will be loaded also when - the driver is incompatible. When the driver use the extended driver + the driver is incompatible. When the driver uses the extended driver interface, the emulator can verify that it isn't of an incompatible driver version. You are therefore advised to use the extended driver interface.</p> @@ -309,7 +309,7 @@ typedef struct ErlDrvSysInfo { <seealso marker="#driver_system_info">driver_system_info()</seealso> will write the system information when passed a reference to a <c>ErlDrvSysInfo</c> structure. A description of the - fields in the structure follow: + fields in the structure follows: </p> <taglist> <tag><c>driver_major_version</c></tag> @@ -347,14 +347,6 @@ typedef struct ErlDrvSysInfo { <item>A value <c>!= 0</c> if the runtime system has SMP support; otherwise, <c>0</c>. </item> - <tag><c>thread_support</c></tag> - <item>A value <c>!= 0</c> if the runtime system has thread support; - otherwise, <c>0</c>. - </item> - <tag><c>smp_support</c></tag> - <item>A value <c>!= 0</c> if the runtime system has SMP support; - otherwise, <c>0</c>. - </item> <tag><c>async_threads</c></tag> <item>The number of async threads in the async thread pool used by <seealso marker="#driver_async">driver_async()</seealso> @@ -401,8 +393,8 @@ typedef struct ErlDrvBinary { <seealso marker="#driver_binary_dec_refc">driver_binary_dec_refc()</seealso>.</p> </note> <p>Some driver calls, such as <c>driver_enq_binary</c>, - increments the driver reference count, and others, such as - <c>driver_deq</c> decrements it.</p> + increment the driver reference count, and others, such as + <c>driver_deq</c> decrement it.</p> <p>Using a driver binary instead of a normal buffer, is often faster, since the emulator doesn't need to copy the data, only the pointer is used.</p> @@ -415,7 +407,7 @@ typedef struct ErlDrvBinary { <c>driver_outputv</c> calls, and in the queue. Also the driver call-back <seealso marker="driver_entry#outputv">outputv</seealso> uses driver binaries.</p> - <p>If the driver of some reason or another, wants to keep a + <p>If the driver for some reason or another, wants to keep a driver binary around, in a static variable for instance, the reference count should be incremented, and the binary can later be freed in the <seealso marker="driver_entry#stop">stop</seealso> call-back, with @@ -423,7 +415,7 @@ typedef struct ErlDrvBinary { <p>Note that since a driver binary is shared by the driver and the emulator, a binary received from the emulator or sent to the emulator, must not be changed by the driver.</p> - <p>From erts version 5.5 (OTP release R11B), orig_bytes is + <p>Since erts version 5.5 (OTP release R11B), orig_bytes is guaranteed to be properly aligned for storage of an array of doubles (usually 8-byte aligned).</p> </item> @@ -447,7 +439,7 @@ typedef struct ErlIOVec { int vsize; int size; SysIOVec* iov; - >ErlDrvBinary** binv; + ErlDrvBinary** binv; } ErlIOVec; </code> <p>The I/O vector used by the emulator and drivers, is a list @@ -495,17 +487,17 @@ typedef struct ErlIOVec { Currently, the only port specific data that the emulator associates with the port data lock is the driver queue.</p> <p>Normally a driver instance does not have a port data lock. If - the driver instance want to use a port data lock, it has to + the driver instance wants to use a port data lock, it has to create the port data lock by calling <seealso marker="#driver_pdl_create">driver_pdl_create()</seealso>. <em>NOTE</em>: Once the port data lock has been created, every - access to data associated with the port data lock have to be done + access to data associated with the port data lock has to be done while having the port data lock locked. The port data lock is locked, and unlocked, respectively, by use of <seealso marker="#driver_pdl_lock">driver_pdl_lock()</seealso>, and <seealso marker="#driver_pdl_unlock">driver_pdl_unlock()</seealso>.</p> <p>A port data lock is reference counted, and when the reference - count reach zero, it will be destroyed. The emulator will at + count reaches zero, it will be destroyed. The emulator will at least increment the reference count once when the lock is created and decrement it once when the port associated with the lock terminates. The emulator will also increment the @@ -545,7 +537,7 @@ typedef struct ErlIOVec { </p> <taglist> <tag>suggested_stack_size</tag> - <item>A suggestion, in kilo-words, on how large stack to use. A value less + <item>A suggestion, in kilo-words, on how large a stack to use. A value less than zero means default size. </item> </taglist> @@ -648,7 +640,7 @@ typedef struct ErlIOVec { opened.</p> <p>The data is queued in the port owner process' message queue. Note that this does not yield to the emulator. (Since - the driver and the emulator runs in the same thread.)</p> + the driver and the emulator run in the same thread.)</p> <p>The parameter <c>buf</c> points to the data to send, and <c>len</c> is the number of bytes.</p> <p>The return value for all output functions is 0. (Unless the @@ -749,7 +741,7 @@ typedef struct ErlIOVec { function <seealso marker="driver_entry#emulator">timeout</seealso> is called.</p> <p>Note that there is only one timer on each driver instance; setting a new timer will replace an older one.</p> - <p>Return value i 0 (-1 only when the <c>timeout</c> driver + <p>Return value is 0 (-1 only when the <c>timeout</c> driver function is <c>NULL</c>).</p> </desc> </func> @@ -799,20 +791,20 @@ typedef struct ErlIOVec { event object must be a socket or pipe (or other object that <c>select</c>/<c>poll</c> can use). On windows, the Win32 API function <c>WaitForMultipleObjects</c> - is used. This places other restriction on the event object. + is used. This places other restrictions on the event object. Refer to the Win32 SDK documentation.</p> <p>The <c>on</c> parameter should be <c>1</c> for setting events and <c>0</c> for clearing them.</p> - <p>The <c>mode</c> argument is bitwise-or combination of + <p>The <c>mode</c> argument is a bitwise-or combination of <c>ERL_DRV_READ</c>, <c>ERL_DRV_WRITE</c> and <c>ERL_DRV_USE</c>. - The first two specifies whether to wait for read events and/or write + The first two specify whether to wait for read events and/or write events. A fired read event will call <seealso marker="driver_entry#ready_input">ready_input</seealso> while a fired write event will call <seealso marker="driver_entry#ready_output">ready_output</seealso>. </p> <note> - <p>Some OS (Windows) does not differ between read and write events. + <p>Some OS (Windows) do not differentiate between read and write events. The call-back for a fired event then only depends on the value of <c>mode</c>.</p> </note> <p><c>ERL_DRV_USE</c> specifies if we are using the event object or if we want to close it. @@ -834,9 +826,9 @@ typedef struct ErlIOVec { as before. But it is recommended to update them to use <c>ERL_DRV_USE</c> and <c>stop_select</c> to make sure that event objects are closed in a safe way.</p> </note> - <p>The return value is 0 (Failure, -1, only if the + <p>The return value is 0 (failure, -1, only if the <c>ready_input</c>/<c>ready_output</c> is - <c>NULL</c>.</p> + <c>NULL</c>).</p> </desc> </func> <func> @@ -1076,7 +1068,7 @@ typedef struct ErlIOVec { array of <c>SysIOVec</c>s. It also returns the number of elements in <c>vlen</c>. This is the only way to get data out of the queue.</p> - <p>Nothing is remove from the queue by this function, that must be done + <p>Nothing is removed from the queue by this function, that must be done with <c>driver_deq</c>.</p> <p>The returned array is suitable to use with the Unix system call <c>writev</c>.</p> @@ -1209,7 +1201,7 @@ typedef struct ErlIOVec { <fsummary>Stop monitoring a process from a driver</fsummary> <desc> <marker id="driver_demonitor_process"></marker> - <p>This function cancels an monitor created earlier. </p> + <p>This function cancels a monitor created earlier. </p> <p>The function returns 0 if a monitor was removed and > 0 if the monitor did no longer exist.</p> </desc> @@ -1326,7 +1318,7 @@ typedef struct ErlIOVec { <p>This function signals to erlang that the driver has encountered an EOF and should be closed, unless the port was opened with the <c>eof</c> option, in that case eof is sent - to the port. Otherwise, the port is close and an + to the port. Otherwise, the port is closed and an <c>'EXIT'</c> message is sent to the port owner process.</p> <p>The return value is 0.</p> </desc> @@ -1349,8 +1341,8 @@ typedef struct ErlIOVec { (<c>driver_failure</c>).</p> <p>The driver should fail only when in severe error situations, when the driver cannot possibly keep open, for instance - buffer allocation gets out of memory. Normal errors is more - appropriate to handle with sending error codes with + buffer allocation gets out of memory. For normal errors + it is more appropriate to send error codes with <c>driver_output</c>.</p> <p>The return value is 0.</p> </desc> @@ -1371,7 +1363,7 @@ typedef struct ErlIOVec { <p>This function returns the process id of the process that made the current call to the driver. The process id can be used with <c>driver_send_term</c> to send back data to the - caller. <c>driver_caller()</c> only return valid data + caller. <c>driver_caller()</c> only returns valid data when currently executing in one of the following driver callbacks:</p> <taglist> @@ -1409,7 +1401,7 @@ typedef struct ErlIOVec { tuple, the elements are given first, and then the tuple term, with a count. Likewise for lists.</p> <p>A tuple must be specified with the number of elements. (The - elements precedes the <c>ERL_DRV_TUPLE</c> term.)</p> + elements precede the <c>ERL_DRV_TUPLE</c> term.)</p> <p>A list must be specified with the number of elements, including the tail, which is the last term preceding <c>ERL_DRV_LIST</c>.</p> @@ -1518,7 +1510,7 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len }; driver_output_term(port, spec, sizeof(spec) / sizeof(spec[0])); ]]></code> - <p>If you want to pass a binary and doesn't already have the content + <p>If you want to pass a binary and don't already have the content of the binary in an <c>ErlDrvBinary</c>, you can benefit from using <c>ERL_DRV_BUF2BINARY</c> instead of creating an <c>ErlDrvBinary</c> via <c>driver_alloc_binary()</c> and then pass the binary via @@ -1565,7 +1557,7 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len <em>other</em> processes than the port owner process. The <c>receiver</c> parameter specifies the process to receive the data.</p> - <p>The parameters <c>term</c> and <c>n</c> does the same thing + <p>The parameters <c>term</c> and <c>n</c> do the same thing as in <seealso marker="#driver_output_term">driver_output_term</seealso>.</p> <p>This function is only thread-safe when the emulator with SMP support is used.</p> @@ -1660,7 +1652,7 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len <desc> <marker id="driver_lock_driver"></marker> <p>This function locks the driver used by the port <c>port</c> - in memory for the rest of the emulator process + in memory for the rest of the emulator process' lifetime. After this call, the driver behaves as one of Erlang's statically linked in drivers.</p> </desc> @@ -1904,7 +1896,7 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len corresponding to one of the involved thread identifiers has terminated since the thread identifier was saved, the result of <c>erl_drv_equal_tids()</c> might not give - expected result. + the expected result. </p></note> <p>This function is thread-safe.</p> </desc> diff --git a/erts/doc/src/erl_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml index c2d58d1ef1..fd2da2cfe3 100644 --- a/erts/doc/src/erl_ext_dist.xml +++ b/erts/doc/src/erl_ext_dist.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2007</year> - <year>2007</year> + <year>2011</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 27887cbdf6..4bbd4e2a54 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -4,7 +4,7 @@ <cref> <header> <copyright> - <year>2001</year><year>2010</year> + <year>2001</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -193,9 +193,9 @@ ok A handle ("safe pointer") to this memory block can then be returned to Erlang by the use of <seealso marker="#enif_make_resource">enif_make_resource</seealso>. The term returned by <c>enif_make_resource</c> - is totally opaque in nature. It can be stored and passed between processses - on the same node, but the only real end usage is to pass it back as argument to a NIF. - The NIF can then do <seealso marker="#enif_get_resource">enif_get_resource</seealso> + is totally opaque in nature. It can be stored and passed between processes + on the same node, but the only real end usage is to pass it back as an argument to a NIF. + The NIF can then call <seealso marker="#enif_get_resource">enif_get_resource</seealso> and get back a pointer to the memory block that is guaranteed to still be valid. A resource object will not be deallocated until the last handle term has been garbage collected by the VM and the resource has been @@ -212,17 +212,7 @@ ok the garbage collector or <c>enif_release_resource</c>). Resource types are uniquely identified by a supplied name string and the name of the implementing module.</p> - <p>Resource types support upgrade in runtime by allowing a loaded NIF - library to takeover an already existing resource type and thereby - "inherit" all existing objects of that type. The destructor of the new - library will thereafter be called for the inherited objects and the - library with the old destructor function can be safely unloaded. Existing - resource objects, of a module that is upgraded, must either be deleted - or taken over by the new NIF library. The unloading of a library will be - postponed as long as there exist resource objects with a destructor - function in the library. - </p> - <p>Here is a template example of how to create and return a resource object.</p> + <marker id="enif_resource_example"/><p>Here is a template example of how to create and return a resource object.</p> <p/> <code type="none"> ERL_NIF_TERM term; @@ -240,8 +230,13 @@ ok /* resource now only owned by "Erlang" */ } return term; -} -</code> + </code> + <p>Note that once <c>enif_make_resource</c> creates the term to + return to Erlang, the code can choose to either keep its own + native pointer to the allocated struct and release it later, or + release it immediately and rely solely on the garbage collector + to eventually deallocate the resource object when it collects + the term.</p> <p>Another usage of resource objects is to create binary terms with user defined memory management. <seealso marker="#enif_make_resource_binary">enif_make_resource_binary</seealso> @@ -251,6 +246,16 @@ ok this can be a binary term consisting of data from a <c>mmap</c>'ed file. The destructor can then do <c>munmap</c> to release the memory region.</p> + <p>Resource types support upgrade in runtime by allowing a loaded NIF + library to takeover an already existing resource type and thereby + "inherit" all existing objects of that type. The destructor of the new + library will thereafter be called for the inherited objects and the + library with the old destructor function can be safely unloaded. Existing + resource objects, of a module that is upgraded, must either be deleted + or taken over by the new NIF library. The unloading of a library will be + postponed as long as there exist resource objects with a destructor + function in the library. + </p> </item> <tag>Threads and concurrency</tag> <item><p>A NIF is thread-safe without any explicit synchronization as @@ -368,7 +373,7 @@ ok environments between NIF calls. </p> <p>A <em>process independent environment</em> is created by calling <seealso marker="#enif_alloc_env">enif_alloc_env</seealso>. It can be - used to store terms beteen NIF calls and to send terms with + used to store terms between NIF calls and to send terms with <seealso marker="#enif_send">enif_send</seealso>. A process independent environment with all its terms is valid until you explicitly invalidates it with <seealso marker="#enif_free_env">enif_free_env</seealso> @@ -464,7 +469,7 @@ typedef enum { </section> <funcs> - <func><name><ret>void*</ret><nametext>enif_alloc(ErlNifEnv* env, size_t size)</nametext></name> + <func><name><ret>void*</ret><nametext>enif_alloc(size_t size)</nametext></name> <fsummary>Allocate dynamic memory.</fsummary> <desc><p>Allocate memory of <c>size</c> bytes. Return NULL if allocation failed.</p></desc> </func> @@ -539,7 +544,7 @@ typedef enum { <desc><p>Same as <seealso marker="erl_driver#erl_drv_equal_tids">erl_drv_equal_tids</seealso>. </p></desc> </func> - <func><name><ret>void</ret><nametext>enif_free(ErlNifEnv* env, void* ptr)</nametext></name> + <func><name><ret>void</ret><nametext>enif_free(void* ptr)</nametext></name> <fsummary>Free dynamic memory</fsummary> <desc><p>Free memory allocated by <c>enif_alloc</c>.</p></desc> </func> @@ -832,8 +837,14 @@ typedef enum { <fsummary>Create an opaque handle to a resource object</fsummary> <desc><p>Create an opaque handle to a memory managed resource object obtained by <seealso marker="#enif_alloc_resource">enif_alloc_resource</seealso>. - No ownership transfer is done, the resource object still needs to be released by - <seealso marker="#enif_release_resource">enif_release_resource</seealso>.</p> + No ownership transfer is done, as the resource object still needs to be released by + <seealso marker="#enif_release_resource">enif_release_resource</seealso>, + but note that the call to <c>enif_release_resource</c> can occur + immediately after obtaining the term from <c>enif_make_resource</c>, + in which case the resource object will be deallocated when the + term is garbage collected. See the + <seealso marker="#enif_resource_example">example of creating and + returning a resource object</seealso> for more details.</p> <p>Note that the only defined behaviour of using a resource term in an Erlang program is to store it and send it between processes on the same node. Other operations such as matching or <c>term_to_binary</c> @@ -857,11 +868,6 @@ typedef enum { <seealso marker="#enif_release_resource">enif_release_resource</seealso>.</p> </desc> </func> - <func><name><ret>ErlNifPid*</ret><nametext>enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)</nametext></name> - <fsummary>Get the pid of the calling process.</fsummary> - <desc><p>Initialize the pid variable <c>*pid</c> to represent the - calling process. Return <c>pid</c>.</p></desc> - </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_string(ErlNifEnv* env, const char* string, ErlNifCharEncoding encoding)</nametext></name> <fsummary>Create a string.</fsummary> <desc><p>Create a list containing the characters of the @@ -980,11 +986,12 @@ typedef enum { <c>reload</c> or <c>upgrade</c>.</p> <p>Was previously named <c>enif_get_data</c>.</p></desc> </func> - <func><name><ret>void</ret><nametext>enif_realloc_binary(ErlNifBinary* bin, size_t size)</nametext></name> + <func><name><ret>int</ret><nametext>enif_realloc_binary(ErlNifBinary* bin, size_t size)</nametext></name> <fsummary>Change the size of a binary.</fsummary> <desc><p>Change the size of a binary <c>bin</c>. The source binary may be read-only, in which case it will be left untouched and - a mutable copy is allocated and assigned to <c>*bin</c>.</p></desc> + a mutable copy is allocated and assigned to <c>*bin</c>. Return true on success, + false if memory allocation failed.</p></desc> </func> <func><name><ret>void</ret><nametext>enif_release_binary(ErlNifBinary* bin)</nametext></name> <fsummary>Release a binary.</fsummary> @@ -1041,7 +1048,12 @@ typedef enum { <desc><p>Same as <seealso marker="erl_driver#erl_drv_rwlock_tryrwlock">erl_drv_rwlock_tryrwlock</seealso>. </p></desc> </func> - <func><name><ret>unsigned</ret><nametext>enif_send(ErlNifEnv* env, ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg)</nametext></name> + <func><name><ret>ErlNifPid*</ret><nametext>enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)</nametext></name> + <fsummary>Get the pid of the calling process.</fsummary> + <desc><p>Initialize the pid variable <c>*pid</c> to represent the + calling process. Return <c>pid</c>.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_send(ErlNifEnv* env, ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg)</nametext></name> <fsummary>Send a message to a process.</fsummary> <desc><p>Send a message to a process.</p> <taglist> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 78d58a1e56..19f501391f 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2010</year> + <year>1996</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -3980,7 +3980,8 @@ os_prompt%</pre> <tag><c>{status, Status}</c></tag> <item> <p><c>Status</c> is the status of the process. <c>Status</c> - is <c>waiting</c> (waiting for a message), <c>running</c>, + is <c>exiting</c>, <c>garbage_collecting</c>, + <c>waiting</c> (for a message), <c>running</c>, <c>runnable</c> (ready to run, but another process is running), or <c>suspended</c> (suspended on a "busy" port or by the <c>erlang:suspend_process/[1,2]</c> BIF).</p> diff --git a/erts/doc/src/erlc.xml b/erts/doc/src/erlc.xml index 1e8960c22c..ebf76a2afe 100644 --- a/erts/doc/src/erlc.xml +++ b/erts/doc/src/erlc.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>1997</year><year>2010</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -141,6 +141,50 @@ for compiling native code, which needs to be compiled with the same run-time system that it should be run on.</p> </item> + <tag>-M</tag> + <item> + <p>Produces a Makefile rule to track headers dependencies. The + rule is sent to stdout. No object file is produced. + </p> + </item> + <tag>-MF <em>Makefile</em></tag> + <item> + <p>Like the <c><![CDATA[-M]]></c> option above, except that the + Makefile is written to <em>Makefile</em>. No object + file is produced. + </p> + </item> + <tag>-MD</tag> + <item> + <p>Same as <c><![CDATA[-M -MF <File>.Pbeam]]></c>. + </p> + </item> + <tag>-MT <em>Target</em></tag> + <item> + <p>In conjunction with <c><![CDATA[-M]]></c> or + <c><![CDATA[-MF]]></c>, change the name of the rule emitted + to <em>Target</em>. + </p> + </item> + <tag>-MQ <em>Target</em></tag> + <item> + <p>Like the <c><![CDATA[-MT]]></c> option above, except that + characters special to make(1) are quoted. + </p> + </item> + <tag>-MP</tag> + <item> + <p>In conjunction with <c><![CDATA[-M]]></c> or + <c><![CDATA[-MF]]></c>, add a phony target for each dependency. + </p> + </item> + <tag>-MG</tag> + <item> + <p>In conjunction with <c><![CDATA[-M]]></c> or + <c><![CDATA[-MF]]></c>, consider missing headers as generated + files and add them to the dependencies. + </p> + </item> <tag>--</tag> <item> <p>Signals that no more options will follow. diff --git a/erts/doc/src/escript.xml b/erts/doc/src/escript.xml index 44c9a5ac68..66e904f64f 100644 --- a/erts/doc/src/escript.xml +++ b/erts/doc/src/escript.xml @@ -4,7 +4,7 @@ <comref> <header> <copyright> - <year>2007</year><year>2010</year> + <year>2007</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -153,7 +153,10 @@ halt(1).</pre> <p>Execution of interpreted code is slower than compiled code. If much of the execution takes place in interpreted code it may be worthwhile to compile it, even though the compilation - itself will take a little while.</p> + itself will take a little while. It is also possible to supply + <c>native</c> instead of compile, this will compile the script + using the native flag, again depending on the characteristics + of the escript this could or could not be worth while.</p> <p>As mentioned earlier, it is possible to have a script which contains precompiled <c>beam</c> code. In a precompiled @@ -397,6 +400,9 @@ ok Warnings and errors (if any) are written to the standard output, but the script will not be run. The exit status will be 0 if there were no errors, and 127 otherwise.</item> + + <tag>-n</tag> + <item>Compile the escript using the +native flag.</item> </taglist> </section> </comref> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 77181d3407..102fa43c1f 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -30,6 +30,246 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 5.8.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The scroll wheel now scrolls the werl window on Windows.</p> + <p> + Own Id: OTP-8985</p> + </item> + <item> + <p> + Some malformed distribution messages could cause VM to + crash, this is now corrected.</p> + <p> + Own Id: OTP-8993</p> + </item> + <item> + <p> + The OS function getifaddrs() can return NULL in some + address fields for e.g PPP and tunnel devices which + caused the emulator to segfault. This bug has now been + corrected.</p> + <p> + Own Id: OTP-8996</p> + </item> + <item> + <p> + The expression <<A:0>> would always produce + an empty binary, even if <c>A</c> was not an integer. + Corrected to cause a <c>badarg</c> exception if the type + of <c>A</c> is invalid. (Thanks to Zvi.)</p> + <p> + Own Id: OTP-8997</p> + </item> + <item> + <p> + A bug that potentially could cause an emulator crash when + deleting an ETS-table has been fixed. A resource leak + when hitting the maximum amount of ETS-tables allowed has + also been fixed.</p> + <p> + Own Id: OTP-8999</p> + </item> + <item> + <p> + A bug in the <c>exit/2</c> BIF could potentially cause an + emulator crash.</p> + <p> + Own Id: OTP-9005</p> + </item> + <item> + <p> + Due to a bug in glibc the runtime system could abort + while trying to destroy a mutex. The runtime system will + now issue a warning instead of aborting.</p> + <p> + Own Id: OTP-9009</p> + </item> + <item> + <p> + A bug in epmd could create strange behaviour when + listen() calls failed. This is now corrected thanks to + Steve Vinoski.</p> + <p> + Own Id: OTP-9024</p> + </item> + <item> + <p>When setting file_info the win32_driver will now + correctly set access and modified time. Previously these + entities were swapped.</p> + <p> + Own Id: OTP-9046</p> + </item> + <item> + <p> + Setting scheduler bind type to <c>unbound</c> failed if + binding of schedulers wasn't supported, or if CPU + topology wasn't present. This even though the + documentation stated that it is possible to set the bind + type to <c>unbound</c>.</p> + <p> + Own Id: OTP-9056 Aux Id: Seq11779 </p> + </item> + <item> + <p>Two problems were fixed in crash dump: The time left + for timers are now shown as unsigned integers and the + contents of ordered_set ETS tables is no longer + included.</p> + <p> + Own Id: OTP-9057</p> + </item> + <item> + <p> + The VM could fail to set IP_TOS and SO_PRIORITY in + certain situations, either because sockets were supplied + as open file descriptors, or because SO_PRIORITY by + default was set higher than the user can explicitly set + it to. Those situations are now handled.</p> + <p> + Own Id: OTP-9069</p> + </item> + <item> + <p> + Wx on MacOS X generated complains on stderr about certain + cocoa functions not beeing called from the "Main thread". + This is now corrected.</p> + <p> + Own Id: OTP-9081</p> + </item> + <item> + <p> + Fix a couple typos in driver_entry(3) (thanks to Tuncer + Ayaz).</p> + <p> + Own Id: OTP-9085</p> + </item> + <item> + <p> + Mention that "-detached" implies "-noinput"</p> + <p> + Clarify that specifying "-noinput" is unnecessary if the + "-detached" flag is given. (thanks to Holger Wei�)</p> + <p> + Own Id: OTP-9086</p> + </item> + <item> + <p> + A potential problem (found by code inspection) when + calling a fun whose code was not loaded has been fixed.</p> + <p> + Own Id: OTP-9095</p> + </item> + <item> + <p> + The emulator could get into a state where it didn't check + for I/O.</p> + <p> + Own Id: OTP-9105 Aux Id: Seq11798 </p> + </item> + <item> + <p> + Attempting to create binaries exceeding 2Gb (using for + example <c>term_to_binary/1</c>) would crash the emulator + with an attempt to allocate huge amounts of memory. + (Thanks to Jon Meredith.)</p> + <p> + Own Id: OTP-9117</p> + </item> + <item> + <p> + Fix erlang:hibernate/3 on HiPE enabled emulator (Thanks + to Paul Guyot)</p> + <p> + Own Id: OTP-9125</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>From this release, the previously experimental + halfword emulator is now official. It can be enabled by + giving the <c>--enable-halfword-emulator</c> option to + the <c>configure</c> script.</p> + <p>The halfword emulator is a 64-bit application, but + uses halfwords (32-bit words) for all data in Erlang + processes, therefore using less memory and being faster + than the standard 64-bit emulator. The total size of all + BEAM code and all process data for all processes is + limited to 4Gb, but ETS tables and off-heap binaries are + only limited by the amount of available memory.</p> + <p> + Own Id: OTP-8941</p> + </item> + <item> + <p> + 32-bit atomic memory operations have been introduced + internally in the run time system, and are now used where + appropriate. There were previously only atomic memory + operations of word size available. The 32-bit atomic + memory operations slightly reduce memory consumption, and + slightly improve performance on 64-bit runtime systems.</p> + <p> + Own Id: OTP-8974</p> + </item> + <item> + <p> + Performance enhancements for looking up timer-entries and + removing timers from the wheel.</p> + <p> + Own Id: OTP-8990</p> + </item> + <item> + <p> + Write accesses to ETS tables have been optimized by + reducing the amount of atomic memory operations needed + during a write access.</p> + <p> + Own Id: OTP-9000</p> + </item> + <item> + <p> + Strange C coding in the VM made the -D_FORTIFY_SOURCE + option to gcc-4.5 react badly. The code is now cleaned up + so that it's accepted by gcc-4.5.</p> + <p> + Own Id: OTP-9025</p> + </item> + <item> + <p> + The memory footprint for loaded code has been somewhat + reduced (especially in the 64-bit BEAM machine).</p> + <p> + Own Id: OTP-9030</p> + </item> + <item> + <p> + The maximum number of allowed arguments for an Erlang + function has been lowered from 256 to 255, so that the + number of arguments can now fit in a byte.</p> + <p> + Own Id: OTP-9049</p> + </item> + <item> + <p> + Dependency generation for Makefiles has been added to the + compiler and erlc. See the manual pages for + <c>compile</c> and <c>erlc</c>. (Thanks to Jean-Sebastien + Pedron.)</p> + <p> + Own Id: OTP-9065</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 5.8.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 6c33e2ca16..f04df354a8 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -505,8 +505,10 @@ ifdef HIPE_ENABLED OPCODE_TABLES += hipe/hipe_ops.tab endif -$(TTF_DIR)/beam_opcodes.h $(TTF_DIR)/beam_opcodes.c: $(OPCODE_TABLES) - LANG=C $(PERL) utils/beam_makeops -outdir $(TTF_DIR) \ +$(TTF_DIR)/beam_opcodes.h $(TTF_DIR)/beam_opcodes.c: $(OPCODE_TABLES) utils/beam_makeops + LANG=C $(PERL) utils/beam_makeops \ + -wordsize @EXTERNAL_WORD_SIZE@ \ + -outdir $(TTF_DIR) \ -emulator $(OPCODE_TABLES) # bif and atom table diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index b0bf14b94f..8a48049921 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. 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 @@ -48,7 +48,6 @@ void dbg_bt(Process* p, Eterm* sp); void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg); -static void print_big(int to, void *to_arg, Eterm* addr); static int print_op(int to, void *to_arg, int op, int size, BeamInstr* addr); Eterm erts_debug_same_2(Process* p, Eterm term1, Eterm term2) @@ -157,6 +156,25 @@ void debug_dump_code(BeamInstr *I, int num) } #endif +BIF_RETTYPE +erts_debug_instructions_0(BIF_ALIST_0) +{ + int i = 0; + Uint needed = num_instructions * 2; + Eterm* hp; + Eterm res = NIL; + + for (i = 0; i < num_instructions; i++) { + needed += 2*strlen(opc[i].name); + } + hp = HAlloc(BIF_P, needed); + for (i = num_instructions-1; i >= 0; i--) { + Eterm s = erts_bld_string_n(&hp, 0, opc[i].name, strlen(opc[i].name)); + res = erts_bld_cons(&hp, 0, s, res); + } + return res; +} + Eterm erts_debug_disassemble_1(Process* p, Eterm addr) { @@ -249,7 +267,7 @@ erts_debug_disassemble_1(Process* p, Eterm addr) "unknown " HEXF "\n", instr); code_ptr++; } - bin = new_binary(p, (byte *) dsbufp->str, (int) dsbufp->str_len); + bin = new_binary(p, (byte *) dsbufp->str, dsbufp->str_len); erts_destroy_tmp_dsbuf(dsbufp); hsz = 4+4; (void) erts_bld_uword(NULL, &hsz, (BeamInstr) code_ptr); @@ -312,6 +330,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) BeamInstr packed = 0; /* Accumulator for packed operations. */ BeamInstr args[8]; /* Arguments for this instruction. */ BeamInstr* ap; /* Pointer to arguments. */ + BeamInstr* unpacked; /* Unpacked arguments */ start_prog = opc[op].pack; @@ -360,6 +379,12 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) *ap++ = packed & BEAM_LOOSE_MASK; packed >>= BEAM_LOOSE_SHIFT; break; +#ifdef ARCH_64 + case 'w': /* Shift 32 steps */ + *ap++ = packed & BEAM_WIDE_MASK; + packed >>= BEAM_WIDE_SHIFT; + break; +#endif case 'p': *sp++ = *--ap; break; @@ -386,7 +411,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) break; case 'x': /* x(N) */ if (reg_index(ap[0]) == 0) { - erts_print(to, to_arg, "X[0]"); + erts_print(to, to_arg, "x[0]"); } else { erts_print(to, to_arg, "x(%d)", reg_index(ap[0])); } @@ -506,6 +531,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) ap++; break; case 'P': /* Byte offset into tuple (see beam_load.c) */ + case 'Q': /* Like 'P', but packable */ erts_print(to, to_arg, "%d", (*ap / sizeof(Eterm)) - 1); ap++; break; @@ -526,9 +552,12 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) * Print more information about certain instructions. */ + unpacked = ap; ap = addr + size; switch (op) { - case op_i_select_val_sfI: + case op_i_select_val_rfI: + case op_i_select_val_xfI: + case op_i_select_val_yfI: { int n = ap[-1]; @@ -540,7 +569,24 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_jump_on_val_sfII: + case op_i_select_tuple_arity_rfI: + case op_i_select_tuple_arity_xfI: + case op_i_select_tuple_arity_yfI: + { + int n = ap[-1]; + + while (n > 0) { + Uint arity = arityval(ap[0]); + erts_print(to, to_arg, " {%d} f(" HEXF ")", arity, ap[1]); + ap += 2; + size += 2; + n--; + } + } + break; + case op_i_jump_on_val_rfII: + case op_i_jump_on_val_xfII: + case op_i_jump_on_val_yfII: { int n; for (n = ap[-2]; n > 0; n--) { @@ -550,39 +596,46 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) } } break; - case op_i_select_big_sf: - while (ap[0]) { - Eterm *bigp = (Eterm *) ap; - int arity = thing_arityval(*bigp); - print_big(to, to_arg, bigp); - size += TermWords(arity+1); - ap += TermWords(arity+1); - erts_print(to, to_arg, " f(" HEXF ") ", ap[0]); - ap++; - size++; + case op_i_jump_on_val_zero_rfI: + case op_i_jump_on_val_zero_xfI: + case op_i_jump_on_val_zero_yfI: + { + int n; + for (n = ap[-1]; n > 0; n--) { + erts_print(to, to_arg, "f(" HEXF ") ", ap[0]); + ap++; + size++; + } + } + break; + case op_i_put_tuple_rI: + case op_i_put_tuple_xI: + case op_i_put_tuple_yI: + { + int n = unpacked[-1]; + + while (n > 0) { + if (!is_header(ap[0])) { + erts_print(to, to_arg, " %T", (Eterm) ap[0]); + } else { + switch ((ap[0] >> 2) & 0x03) { + case R_REG_DEF: + erts_print(to, to_arg, " x(0)"); + break; + case X_REG_DEF: + erts_print(to, to_arg, " x(%d)", ap[0] >> 4); + break; + case Y_REG_DEF: + erts_print(to, to_arg, " y(%d)", ap[0] >> 4); + break; + } + } + ap++, size++, n--; + } } - ap++; - size++; break; } erts_print(to, to_arg, "\n"); return size; } - -static void -print_big(int to, void *to_arg, Eterm* addr) -{ - int i; - int k; - - i = BIG_SIZE(addr); - if (BIG_SIGN(addr)) - erts_print(to, to_arg, "-#integer(%d) = {", i); - else - erts_print(to, to_arg, "#integer(%d) = {", i); - erts_print(to, to_arg, "0x%x", BIG_DIGIT(addr, 0)); - for (k = 1; k < i; k++) - erts_print(to, to_arg, ",0x%x", BIG_DIGIT(addr, k)); - erts_print(to, to_arg, "}"); -} diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 8a0e12dd4f..8991f7b198 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -321,6 +321,7 @@ extern int count_instructions; # define POST_BIF_GC_SWAPIN_0(_p, _res) \ ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ PROCESS_MAIN_CHK_LOCKS((_p)); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \ if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \ E = (_p)->stop; \ @@ -328,6 +329,7 @@ extern int count_instructions; HTOP = HEAP_TOP((_p)) # define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \ ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ PROCESS_MAIN_CHK_LOCKS((_p)); \ if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ @@ -344,6 +346,8 @@ extern int count_instructions; #define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N))) #define yb(N) (*(Eterm *) (((unsigned char *)E) + (N))) #define fb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N))) +#define Qb(N) (N) +#define Ib(N) (N) #define x(N) reg[N] #define y(N) E[N] #define r(N) x##N @@ -365,6 +369,7 @@ extern int count_instructions; reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, needed + (HeapNeed), reg, (M)); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ r(0) = reg[0]; \ SWAPIN; \ @@ -418,6 +423,7 @@ extern int count_instructions; reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ r(0) = reg[0]; \ SWAPIN; \ @@ -440,6 +446,7 @@ extern int count_instructions; reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ r(0) = reg[0]; \ SWAPIN; \ @@ -462,6 +469,7 @@ extern int count_instructions; reg[Live] = Extra; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)+1); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ if (Live > 0) { \ r(0) = reg[0]; \ @@ -472,6 +480,13 @@ extern int count_instructions; HEAP_SPACE_VERIFIED(need); \ } while (0) +#define TestHeapPutList(Need, Reg) \ + do { \ + TestHeap((Need), 1); \ + PutList(Reg, r(0), r(0), StoreSimpleDest); \ + CHECK_TERM(r(0)); \ + } while (0) + #ifdef HYBRID #ifdef INCREMENTAL #define TestGlobalHeap(Nh, Live, hp) \ @@ -516,6 +531,11 @@ extern int count_instructions; SWAPIN; \ } while (0) +#define PutTuple(Dst, Arity) \ + do { \ + Dst = make_tuple(HTOP); \ + pt_arity = (Arity); \ + } while (0) /* * Check that we haven't used the reductions and jump to function pointed to by @@ -674,6 +694,11 @@ extern int count_instructions; SET_I((BeamInstr *) CallDest); \ Dispatch(); +#define MoveJump(Src) \ + r(0) = (Src); \ + SET_I((BeamInstr *) Arg(0)); \ + Goto(*I); + #define GetList(Src, H, T) do { \ Eterm* tmp_ptr = list_val(Src); \ H = CAR(tmp_ptr); \ @@ -723,16 +748,8 @@ extern int count_instructions; (Dest) = (* (Eterm *) EXPAND_POINTER(tmp_arg1)); \ } while (0) -#define PutTuple(Arity, Src, Dest) \ - ASSERT(is_arity_value(Arity)); \ - Dest = make_tuple(HTOP); \ - HTOP[0] = (Arity); \ - HTOP[1] = (Src); \ - HTOP += 2 - -#define Put(Word) *HTOP++ = (Word) - #define EqualImmed(X, Y, Action) if (X != Y) { Action; } +#define NotEqualImmed(X, Y, Action) if (X == Y) { Action; } #define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; } @@ -984,8 +1001,39 @@ extern int count_instructions; #define IsPid(Src, Fail) if (is_not_pid(Src)) { Fail; } #define IsRef(Src, Fail) if (is_not_ref(Src)) { Fail; } -static BifFunction translate_gc_bif(void* gcf); -static BeamInstr* handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf); +/* + * process_main() is already huge, so we want to avoid inlining + * into it. Especially functions that are seldom used. + */ +#ifdef __GNUC__ +# define NOINLINE __attribute__((__noinline__)) +#else +# define NOINLINE +#endif + +/* + * The following functions are called directly by process_main(). + * Don't inline them. + */ +static BifFunction translate_gc_bif(void* gcf) NOINLINE; +static BeamInstr* handle_error(Process* c_p, BeamInstr* pc, + Eterm* reg, BifFunction bf) NOINLINE; +static BeamInstr* call_error_handler(Process* p, BeamInstr* ip, + Eterm* reg, Eterm func) NOINLINE; +static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity) NOINLINE; +static BeamInstr* apply(Process* p, Eterm module, Eterm function, + Eterm args, Eterm* reg) NOINLINE; +static BeamInstr* call_fun(Process* p, int arity, + Eterm* reg, Eterm args) NOINLINE; +static BeamInstr* apply_fun(Process* p, Eterm fun, + Eterm args, Eterm* reg) NOINLINE; +static Eterm new_fun(Process* p, Eterm* reg, + ErlFunEntry* fe, int num_free) NOINLINE; + + +/* + * Functions not directly called by process_main(). OK to inline. + */ static BeamInstr* next_catch(Process* c_p, Eterm *reg); static void terminate_proc(Process* c_p, Eterm Value); static Eterm add_stacktrace(Process* c_p, Eterm Value, Eterm exc); @@ -993,16 +1041,6 @@ static void save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf, Eterm args); static struct StackTrace * get_trace_from_exc(Eterm exc); static Eterm make_arglist(Process* c_p, Eterm* reg, int a); -static Eterm call_error_handler(Process* p, BeamInstr* ip, Eterm* reg); -static Eterm call_breakpoint_handler(Process* p, BeamInstr* fi, Eterm* reg); -static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity); -static BeamInstr* apply(Process* p, Eterm module, Eterm function, - Eterm args, Eterm* reg); -static int hibernate(Process* c_p, Eterm module, Eterm function, - Eterm args, Eterm* reg); -static BeamInstr* call_fun(Process* p, int arity, Eterm* reg, Eterm args); -static BeamInstr* apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg); -static Eterm new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free); #if defined(VXWORKS) static int init_done; @@ -1146,6 +1184,8 @@ void process_main(void) Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */ + Eterm pt_arity; /* Used by do_put_tuple */ + ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */ @@ -1178,7 +1218,12 @@ void process_main(void) do_schedule1: PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); +#if HALFWORD_HEAP + ASSERT(erts_get_scheduler_data()->num_tmp_heap_used == 0); +#endif + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); c_p = schedule(c_p, reds_used); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); #ifdef DEBUG pid = c_p->id; #endif @@ -1246,6 +1291,52 @@ void process_main(void) #define STORE_ARITH_RESULT(res) StoreBifResult(2, (res)); #define ARITH_FUNC(name) erts_gc_##name + { + Eterm increment_reg_val; + Eterm increment_val; + Uint live; + Eterm result; + + OpCase(i_increment_yIId): + increment_reg_val = yb(Arg(0)); + goto do_increment; + + OpCase(i_increment_xIId): + increment_reg_val = xb(Arg(0)); + goto do_increment; + + OpCase(i_increment_rIId): + increment_reg_val = r(0); + I--; + + do_increment: + increment_val = Arg(1); + if (is_small(increment_reg_val)) { + Sint i = signed_val(increment_reg_val) + increment_val; + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (MY_IS_SSMALL(i)) { + result = make_small(i); + store_result: + StoreBifResult(3, result); + } + } + + live = Arg(2); + SWAPOUT; + reg[0] = r(0); + reg[live] = increment_reg_val; + reg[live+1] = make_small(increment_val); + result = erts_gc_mixed_plus(c_p, reg, live); + r(0) = reg[0]; + SWAPIN; + ERTS_HOLE_CHECK(c_p); + if (is_value(result)) { + goto store_result; + } + ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); + goto find_func_info; + } + OpCase(i_plus_jId): { Eterm result; @@ -1309,6 +1400,52 @@ void process_main(void) } Next(1); + { + Eterm is_eq_exact_lit_val; + + OpCase(i_is_eq_exact_literal_xfc): + is_eq_exact_lit_val = xb(Arg(0)); + I++; + goto do_is_eq_exact_literal; + + OpCase(i_is_eq_exact_literal_yfc): + is_eq_exact_lit_val = yb(Arg(0)); + I++; + goto do_is_eq_exact_literal; + + OpCase(i_is_eq_exact_literal_rfc): + is_eq_exact_lit_val = r(0); + + do_is_eq_exact_literal: + if (!eq(Arg(1), is_eq_exact_lit_val)) { + ClauseFail(); + } + Next(2); + } + + { + Eterm is_ne_exact_lit_val; + + OpCase(i_is_ne_exact_literal_xfc): + is_ne_exact_lit_val = xb(Arg(0)); + I++; + goto do_is_ne_exact_literal; + + OpCase(i_is_ne_exact_literal_yfc): + is_ne_exact_lit_val = yb(Arg(0)); + I++; + goto do_is_ne_exact_literal; + + OpCase(i_is_ne_exact_literal_rfc): + is_ne_exact_lit_val = r(0); + + do_is_ne_exact_literal: + if (eq(Arg(1), is_ne_exact_lit_val)) { + ClauseFail(); + } + Next(2); + } + OpCase(i_move_call_only_fcr): { r(0) = Arg(1); } @@ -1392,6 +1529,17 @@ void process_main(void) NextPF(1, next); } + OpCase(move_x1_c): { + x(1) = Arg(0); + Next(1); + } + + OpCase(move_x2_c): { + x(2) = Arg(0); + Next(1); + } + + OpCase(return): { SET_I(c_p->cp); /* @@ -1405,16 +1553,6 @@ void process_main(void) Goto(*I); } - OpCase(test_heap_1_put_list_Iy): { - BeamInstr *next; - - PreFetch(2, next); - TestHeap(Arg(0), 1); - PutList(yb(Arg(1)), r(0), r(0), StoreSimpleDest); - CHECK_TERM(r(0)); - NextPF(2, next); - } - /* * Send is almost a standard call-BIF with two arguments, except for: * 1) It cannot be traced. @@ -1447,24 +1585,36 @@ void process_main(void) goto find_func_info; } - OpCase(i_element_jssd): { - Eterm index; - Eterm tuple; - - /* - * Inlined version of element/2 for speed. - */ - GetArg2(1, index, tuple); - if (is_small(index) && is_tuple(tuple)) { - Eterm* tp = tuple_val(tuple); - - if ((signed_val(index) >= 1) && - (signed_val(index) <= arityval(*tp))) { - Eterm result = tp[signed_val(index)]; - StoreBifResult(3, result); - } - } - } + { + Eterm element_index; + Eterm element_tuple; + + OpCase(i_element_xjsd): + element_tuple = xb(Arg(0)); + I++; + goto do_element; + + OpCase(i_element_yjsd): + element_tuple = yb(Arg(0)); + I++; + goto do_element; + + OpCase(i_element_rjsd): + element_tuple = r(0); + /* Fall through */ + + do_element: + GetArg1(1, element_index); + if (is_small(element_index) && is_tuple(element_tuple)) { + Eterm* tp = tuple_val(element_tuple); + + if ((signed_val(element_index) >= 1) && + (signed_val(element_index) <= arityval(*tp))) { + Eterm result = tp[signed_val(element_index)]; + StoreBifResult(2, result); + } + } + } /* Fall through */ OpCase(badarg_j): @@ -1472,24 +1622,32 @@ void process_main(void) c_p->freason = BADARG; goto lb_Cl_error; - OpCase(i_fast_element_jIsd): { - Eterm tuple; - - /* - * Inlined version of element/2 for even more speed. - * The first argument is an untagged integer >= 1. - * The second argument is guaranteed to be a register operand. - */ - GetArg1(2, tuple); - if (is_tuple(tuple)) { - Eterm* tp = tuple_val(tuple); - tmp_arg2 = Arg(1); - if (tmp_arg2 <= arityval(*tp)) { - Eterm result = tp[tmp_arg2]; - StoreBifResult(3, result); - } - } + { + Eterm fast_element_tuple; + + OpCase(i_fast_element_rjId): + fast_element_tuple = r(0); + + do_fast_element: + if (is_tuple(fast_element_tuple)) { + Eterm* tp = tuple_val(fast_element_tuple); + Eterm pos = Arg(1); /* Untagged integer >= 1 */ + if (pos <= arityval(*tp)) { + Eterm result = tp[pos]; + StoreBifResult(2, result); + } + } goto badarg; + + OpCase(i_fast_element_xjId): + fast_element_tuple = xb(Arg(0)); + I++; + goto do_fast_element; + + OpCase(i_fast_element_yjId): + fast_element_tuple = yb(Arg(0)); + I++; + goto do_fast_element; } OpCase(catch_yf): @@ -1515,6 +1673,7 @@ void process_main(void) SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; } @@ -1633,6 +1792,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); }, { + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); r(0) = reg[0]; SWAPIN; @@ -1691,6 +1851,7 @@ void process_main(void) CANCEL_TIMER(c_p); free_message(msgp); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); NextPF(0, next); @@ -1842,8 +2003,87 @@ void process_main(void) NextPF(0, next); } - OpCase(i_select_val_sfI): - GetArg1(0, tmp_arg1); + + { + Eterm select_val2; + + OpCase(i_select_tuple_arity2_yfAfAf): + select_val2 = yb(Arg(0)); + goto do_select_tuple_arity2; + + OpCase(i_select_tuple_arity2_xfAfAf): + select_val2 = xb(Arg(0)); + goto do_select_tuple_arity2; + + OpCase(i_select_tuple_arity2_rfAfAf): + select_val2 = r(0); + I--; + + do_select_tuple_arity2: + if (is_not_tuple(select_val2)) { + goto select_val2_fail; + } + select_val2 = *tuple_val(select_val2); + goto do_select_val2; + + OpCase(i_select_val2_yfcfcf): + select_val2 = yb(Arg(0)); + goto do_select_val2; + + OpCase(i_select_val2_xfcfcf): + select_val2 = xb(Arg(0)); + goto do_select_val2; + + OpCase(i_select_val2_rfcfcf): + select_val2 = r(0); + I--; + + do_select_val2: + if (select_val2 == Arg(2)) { + I += 2; + } else if (select_val2 == Arg(4)) { + I += 4; + } + + select_val2_fail: + SET_I((BeamInstr *) Arg(1)); + Goto(*I); + } + + { + Eterm select_val; + + OpCase(i_select_tuple_arity_xfI): + select_val = xb(Arg(0)); + goto do_select_tuple_arity; + + OpCase(i_select_tuple_arity_yfI): + select_val = yb(Arg(0)); + goto do_select_tuple_arity; + + OpCase(i_select_tuple_arity_rfI): + select_val = r(0); + I--; + + do_select_tuple_arity: + if (is_tuple(select_val)) { + select_val = *tuple_val(select_val); + goto do_binary_search; + } + SET_I((BeamInstr *) Arg(1)); + Goto(*I); + + OpCase(i_select_val_xfI): + select_val = xb(Arg(0)); + goto do_binary_search; + + OpCase(i_select_val_yfI): + select_val = yb(Arg(0)); + goto do_binary_search; + + OpCase(i_select_val_rfI): + select_val = r(0); + I--; do_binary_search: { @@ -1880,9 +2120,9 @@ void process_main(void) unsigned int boffset = ((unsigned int)bdiff >> 1) & ~(sizeof(struct Pairs)-1); mid = (struct Pairs*)((char*)low + boffset); - if (tmp_arg1 < mid->val) { + if (select_val < mid->val) { high = mid; - } else if (tmp_arg1 > mid->val) { + } else if (select_val > mid->val) { low = mid + 1; } else { SET_I(mid->addr); @@ -1892,16 +2132,28 @@ void process_main(void) SET_I((BeamInstr *) Arg(1)); Goto(*I); } + } - OpCase(i_jump_on_val_zero_sfI): { - Eterm index; - - GetArg1(0, index); - if (is_small(index)) { - index = signed_val(index); - if (index < Arg(2)) { - SET_I((BeamInstr *) (&Arg(3))[index]); + Eterm jump_on_val_zero_index; + + OpCase(i_jump_on_val_zero_yfI): + jump_on_val_zero_index = yb(Arg(0)); + goto do_jump_on_val_zero_index; + + OpCase(i_jump_on_val_zero_xfI): + jump_on_val_zero_index = xb(Arg(0)); + goto do_jump_on_val_zero_index; + + OpCase(i_jump_on_val_zero_rfI): + jump_on_val_zero_index = r(0); + I--; + + do_jump_on_val_zero_index: + if (is_small(jump_on_val_zero_index)) { + jump_on_val_zero_index = signed_val(jump_on_val_zero_index); + if (jump_on_val_zero_index < Arg(2)) { + SET_I((BeamInstr *) (&Arg(3))[jump_on_val_zero_index]); Goto(*I); } } @@ -1909,15 +2161,27 @@ void process_main(void) Goto(*I); } - OpCase(i_jump_on_val_sfII): { - Eterm index; + Eterm jump_on_val_index; - GetArg1(0, index); - if (is_small(index)) { - index = (Uint) (signed_val(index) - Arg(3)); - if (index < Arg(2)) { - SET_I((BeamInstr *) (&Arg(4))[index]); + + OpCase(i_jump_on_val_yfII): + jump_on_val_index = yb(Arg(0)); + goto do_jump_on_val_index; + + OpCase(i_jump_on_val_xfII): + jump_on_val_index = xb(Arg(0)); + goto do_jump_on_val_index; + + OpCase(i_jump_on_val_rfII): + jump_on_val_index = r(0); + I--; + + do_jump_on_val_index: + if (is_small(jump_on_val_index)) { + jump_on_val_index = (Uint) (signed_val(jump_on_val_index) - Arg(3)); + if (jump_on_val_index < Arg(2)) { + SET_I((BeamInstr *) (&Arg(4))[jump_on_val_index]); Goto(*I); } } @@ -1925,6 +2189,32 @@ void process_main(void) Goto(*I); } + do_put_tuple: { + Eterm* hp = HTOP; + + *hp++ = make_arityval(pt_arity); + + do { + Eterm term = *I++; + switch (term & _TAG_IMMED1_MASK) { + case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: + *hp++ = r(0); + break; + case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: + *hp++ = x(term >> _TAG_IMMED1_SIZE); + break; + case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: + *hp++ = y(term >> _TAG_IMMED1_SIZE); + break; + default: + *hp++ = term; + break; + } + } while (--pt_arity != 0); + HTOP = hp; + Goto(*I); + } + /* * All guards with zero arguments have special instructions: * self/0 @@ -1952,6 +2242,7 @@ void process_main(void) ASSERT(!ERTS_PROC_IS_EXITING(c_p)); result = (*bf)(c_p, arg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; @@ -1980,6 +2271,7 @@ void process_main(void) ASSERT(!ERTS_PROC_IS_EXITING(c_p)); result = (*bf)(c_p, arg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; @@ -2009,6 +2301,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); result = (*bf)(c_p, reg, live); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -2044,6 +2337,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); result = (*bf)(c_p, reg, live); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -2082,6 +2376,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); result = (*bf)(c_p, reg, live); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -2116,6 +2411,7 @@ void process_main(void) ASSERT(!ERTS_PROC_IS_EXITING(c_p)); result = (*bf)(c_p, tmp_arg1, tmp_arg2); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; @@ -2139,6 +2435,7 @@ void process_main(void) ASSERT(!ERTS_PROC_IS_EXITING(c_p)); result = (*bf)(c_p, tmp_arg1, tmp_arg2); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); if (is_value(result)) { @@ -2562,23 +2859,25 @@ void process_main(void) OpCase(i_int_bnot_jsId): { - GetArg1(1, tmp_arg1); - if (is_small(tmp_arg1)) { - tmp_arg1 = make_small(~signed_val(tmp_arg1)); + Eterm bnot_val; + + GetArg1(1, bnot_val); + if (is_small(bnot_val)) { + bnot_val = make_small(~signed_val(bnot_val)); } else { Uint live = Arg(2); SWAPOUT; reg[0] = r(0); - reg[live] = tmp_arg1; - tmp_arg1 = erts_gc_bnot(c_p, reg, live); + reg[live] = bnot_val; + bnot_val = erts_gc_bnot(c_p, reg, live); r(0) = reg[0]; SWAPIN; ERTS_HOLE_CHECK(c_p); - if (is_nil(tmp_arg1)) { + if (is_nil(bnot_val)) { goto lb_Cl_error; } } - StoreBifResult(3, tmp_arg1); + StoreBifResult(3, bnot_val); } badarith: @@ -2833,121 +3132,6 @@ void process_main(void) goto do_schedule1; } - OpCase(i_select_tuple_arity_sfI): - { - GetArg1(0, tmp_arg1); - - if (is_tuple(tmp_arg1)) { - tmp_arg1 = *tuple_val(tmp_arg1); - goto do_binary_search; - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - - OpCase(i_select_big_sf): - { - Eterm* bigp; - Uint arity; - Eterm* given; - Uint given_arity; - Uint given_size; - - GetArg1(0, tmp_arg1); - if (is_big(tmp_arg1)) { - - /* - * The loader has sorted the bignumbers in descending order - * on the arity word. Therefore, we know that the search - * has failed as soon as we encounter an arity word less than - * the arity word of the given number. There is a zero word - * (less than any valid arity word) stored after the last bignumber. - */ - - given = big_val(tmp_arg1); - given_arity = given[0]; - given_size = thing_arityval(given_arity); - bigp = (Eterm *) &Arg(2); - while ((arity = bigp[0]) > given_arity) { - bigp += (TermWords(thing_arityval(arity) + 1) + 1) * (sizeof(BeamInstr)/sizeof(Eterm)); - } - while (bigp[0] == given_arity) { - if (memcmp(bigp+1, given+1, sizeof(Eterm)*given_size) == 0) { - BeamInstr *tmp = - ((BeamInstr *) (UWord) bigp) + TermWords(given_size + 1); - SET_I((BeamInstr *) *tmp); - Goto(*I); - } - bigp += (TermWords(thing_arityval(arity) + 1) + 1) * (sizeof(BeamInstr)/sizeof(Eterm)); - } - } - - /* - * Failed. - */ - - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - -#if defined(ARCH_64) && !HALFWORD_HEAP - OpCase(i_select_float_sfI): - { - Uint f; - int n; - struct ValLabel { - Uint f; - BeamInstr* addr; - }; - struct ValLabel* ptr; - - GetArg1(0, tmp_arg1); - ASSERT(is_float(tmp_arg1)); - f = float_val(tmp_arg1)[1]; - n = Arg(2); - ptr = (struct ValLabel *) &Arg(3); - while (n-- > 0) { - if (ptr->f == f) { - SET_I(ptr->addr); - Goto(*I); - } - ptr++; - } - SET_I((Eterm *) Arg(1)); - Goto(*I); - } -#else - OpCase(i_select_float_sfI): - { - Uint fpart1; - Uint fpart2; - int n; - struct ValLabel { - Uint fpart1; - Uint fpart2; - BeamInstr* addr; - }; - struct ValLabel* ptr; - - GetArg1(0, tmp_arg1); - ASSERT(is_float(tmp_arg1)); - fpart1 = float_val(tmp_arg1)[1]; - fpart2 = float_val(tmp_arg1)[2]; - - n = Arg(2); - ptr = (struct ValLabel *) &Arg(3); - while (n-- > 0) { - if (ptr->fpart1 == fpart1 && ptr->fpart2 == fpart2) { - SET_I(ptr->addr); - Goto(*I); - } - ptr++; - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } -#endif - OpCase(set_tuple_element_sdP): { Eterm element; Eterm tuple; @@ -2993,15 +3177,17 @@ void process_main(void) the first argument. We also handle atom tags in the first argument for backwards compatibility. */ - GetArg2(0, tmp_arg1, tmp_arg2); - c_p->fvalue = tmp_arg2; + Eterm raise_val1; + Eterm raise_val2; + GetArg2(0, raise_val1, raise_val2); + c_p->fvalue = raise_val2; if (c_p->freason == EXC_NULL) { /* a safety check for the R10-0 case; should not happen */ c_p->ftrace = NIL; c_p->freason = EXC_ERROR; } /* for R10-0 code, keep existing c_p->ftrace and hope it's correct */ - switch (tmp_arg1) { + switch (raise_val1) { case am_throw: c_p->freason = EXC_THROWN & ~EXF_SAVETRACE; break; @@ -3017,8 +3203,8 @@ void process_main(void) passed from a user! Currently only expecting generated calls. */ struct StackTrace *s; - c_p->ftrace = tmp_arg1; - s = get_trace_from_exc(tmp_arg1); + c_p->ftrace = raise_val1; + s = get_trace_from_exc(raise_val1); if (s == NULL) { c_p->freason = EXC_ERROR; } else { @@ -3029,11 +3215,24 @@ void process_main(void) goto find_func_info; } - OpCase(badmatch_s): { - GetArg1(0, tmp_arg1); - c_p->fvalue = tmp_arg1; - c_p->freason = BADMATCH; - } + { + Eterm badmatch_val; + + OpCase(badmatch_y): + badmatch_val = yb(Arg(0)); + goto do_badmatch; + + OpCase(badmatch_x): + badmatch_val = xb(Arg(0)); + goto do_badmatch; + + OpCase(badmatch_r): + badmatch_val = r(0); + + do_badmatch: + c_p->fvalue = badmatch_val; + c_p->freason = BADMATCH; + } /* Fall through here */ find_func_info: { @@ -3056,12 +3255,11 @@ void process_main(void) */ SWAPOUT; reg[0] = r(0); - tmp_arg1 = call_error_handler(c_p, I-3, reg); + I = call_error_handler(c_p, I-3, reg, am_undefined_function); r(0) = reg[0]; SWAPIN; - if (tmp_arg1) { - SET_I(c_p->i); - Dispatch(); + if (I) { + Goto(*I); } /* Fall through */ @@ -3084,128 +3282,153 @@ void process_main(void) } } - OpCase(call_nif): - { - /* - * call_nif is always first instruction in function: - * - * I[-3]: Module - * I[-2]: Function - * I[-1]: Arity - * I[0]: &&call_nif - * I[1]: Function pointer to NIF function - * I[2]: Pointer to erl_module_nif - */ - BifFunction vbf; - - c_p->current = I-3; /* current and vbf set to please handle_error */ - SWAPOUT; - c_p->fcalls = FCALLS - 1; - PROCESS_MAIN_CHK_LOCKS(c_p); - tmp_arg2 = I[-1]; - ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + { + Eterm nif_bif_result; + Eterm bif_nif_arity; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - { - typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); - NifF* fp = vbf = (NifF*) I[1]; - struct enif_environment_t env; - erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]); - reg[0] = r(0); - tmp_arg1 = (*fp)(&env, tmp_arg2, reg); - erts_post_nif(&env); - } - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1)); - PROCESS_MAIN_CHK_LOCKS(c_p); - goto apply_bif_or_nif_epilogue; - - OpCase(apply_bif): - /* - * At this point, I points to the code[3] in the export entry for - * the BIF: - * - * code[0]: Module - * code[1]: Function - * code[2]: Arity - * code[3]: &&apply_bif - * code[4]: Function pointer to BIF function - */ + OpCase(call_nif): + { + /* + * call_nif is always first instruction in function: + * + * I[-3]: Module + * I[-2]: Function + * I[-1]: Arity + * I[0]: &&call_nif + * I[1]: Function pointer to NIF function + * I[2]: Pointer to erl_module_nif + */ + BifFunction vbf; - c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */ - c_p->i = I; /* In case we apply check_process_code/2. */ - c_p->arity = 0; /* To allow garbage collection on ourselves - * (check_process_code/2). - */ - SWAPOUT; - c_p->fcalls = FCALLS - 1; - vbf = (BifFunction) Arg(0); - PROCESS_MAIN_CHK_LOCKS(c_p); - tmp_arg2 = I[-1]; - ASSERT(tmp_arg2 <= 3); - ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); - switch (tmp_arg2) { - case 3: + c_p->current = I-3; /* current and vbf set to please handle_error */ + SWAPOUT; + c_p->fcalls = FCALLS - 1; + PROCESS_MAIN_CHK_LOCKS(c_p); + bif_nif_arity = I[-1]; + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); { - Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - tmp_arg1 = (*bf)(c_p, r(0), x(1), x(2), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1)); - PROCESS_MAIN_CHK_LOCKS(c_p); + typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); + NifF* fp = vbf = (NifF*) I[1]; + struct enif_environment_t env; + erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]); + reg[0] = r(0); + nif_bif_result = (*fp)(&env, bif_nif_arity, reg); + erts_post_nif(&env); } - break; - case 2: - { - Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - tmp_arg1 = (*bf)(c_p, r(0), x(1), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1)); - PROCESS_MAIN_CHK_LOCKS(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + goto apply_bif_or_nif_epilogue; + + OpCase(apply_bif): + /* + * At this point, I points to the code[3] in the export entry for + * the BIF: + * + * code[0]: Module + * code[1]: Function + * code[2]: Arity + * code[3]: &&apply_bif + * code[4]: Function pointer to BIF function + */ + + c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */ + c_p->i = I; /* In case we apply check_process_code/2. */ + c_p->arity = 0; /* To allow garbage collection on ourselves + * (check_process_code/2). + */ + SWAPOUT; + c_p->fcalls = FCALLS - 1; + vbf = (BifFunction) Arg(0); + PROCESS_MAIN_CHK_LOCKS(c_p); + bif_nif_arity = I[-1]; + ASSERT(bif_nif_arity <= 3); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + switch (bif_nif_arity) { + case 3: + { + Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + nif_bif_result = (*bf)(c_p, r(0), x(1), x(2), I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || + is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + } + break; + case 2: + { + Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + nif_bif_result = (*bf)(c_p, r(0), x(1), I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || + is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + } + break; + case 1: + { + Eterm (*bf)(Process*, Eterm, BeamInstr*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + nif_bif_result = (*bf)(c_p, r(0), I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || + is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + } + break; + case 0: + { + Eterm (*bf)(Process*, BeamInstr*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + nif_bif_result = (*bf)(c_p, I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || + is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + break; + } + default: + erl_exit(1, "apply_bif: invalid arity: %u\n", + bif_nif_arity); } - break; - case 1: - { - Eterm (*bf)(Process*, Eterm, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - tmp_arg1 = (*bf)(c_p, r(0), I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1)); - PROCESS_MAIN_CHK_LOCKS(c_p); + + apply_bif_or_nif_epilogue: + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + ERTS_HOLE_CHECK(c_p); + if (c_p->mbuf) { + reg[0] = r(0); + nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result, + reg, bif_nif_arity); + r(0) = reg[0]; } - break; - case 0: - { - Eterm (*bf)(Process*, BeamInstr*) = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - tmp_arg1 = (*bf)(c_p, I); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1)); - PROCESS_MAIN_CHK_LOCKS(c_p); - break; + SWAPIN; /* There might have been a garbage collection. */ + FCALLS = c_p->fcalls; + if (is_value(nif_bif_result)) { + r(0) = nif_bif_result; + CHECK_TERM(r(0)); + SET_I(c_p->cp); + c_p->cp = 0; + Goto(*I); + } else if (c_p->freason == TRAP) { + SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3))); + r(0) = c_p->def_arg_reg[0]; + x(1) = c_p->def_arg_reg[1]; + x(2) = c_p->def_arg_reg[2]; + if (c_p->status == P_WAITING) { + goto do_schedule; + } + Dispatch(); } - } -apply_bif_or_nif_epilogue: - ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); - ERTS_HOLE_CHECK(c_p); - if (c_p->mbuf) { reg[0] = r(0); - tmp_arg1 = erts_gc_after_bif_call(c_p, tmp_arg1, reg, tmp_arg2); - r(0) = reg[0]; + I = handle_error(c_p, c_p->cp, reg, vbf); + goto post_error_handling; } - SWAPIN; /* There might have been a garbage collection. */ - FCALLS = c_p->fcalls; - if (is_value(tmp_arg1)) { - r(0) = tmp_arg1; - CHECK_TERM(r(0)); - SET_I(c_p->cp); - Goto(*I); - } else if (c_p->freason == TRAP) { - SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3))); - r(0) = c_p->def_arg_reg[0]; - x(1) = c_p->def_arg_reg[1]; - x(2) = c_p->def_arg_reg[2]; - Dispatch(); - } - reg[0] = r(0); - I = handle_error(c_p, c_p->cp, reg, vbf); - goto post_error_handling; } OpCase(i_get_sd): @@ -3218,11 +3441,25 @@ apply_bif_or_nif_epilogue: StoreBifResult(1, result); } - OpCase(case_end_s): - GetArg1(0, tmp_arg1); - c_p->fvalue = tmp_arg1; - c_p->freason = EXC_CASE_CLAUSE; - goto find_func_info; + { + Eterm case_end_val; + + OpCase(case_end_x): + case_end_val = xb(Arg(0)); + goto do_case_end; + + OpCase(case_end_y): + case_end_val = yb(Arg(0)); + goto do_case_end; + + OpCase(case_end_r): + case_end_val = r(0); + + do_case_end: + c_p->fvalue = case_end_val; + c_p->freason = EXC_CASE_CLAUSE; + goto find_func_info; + } OpCase(if_end): c_p->freason = EXC_IF_CLAUSE; @@ -3235,10 +3472,13 @@ apply_bif_or_nif_epilogue: } OpCase(try_case_end_s): - GetArg1(0, tmp_arg1); - c_p->fvalue = tmp_arg1; - c_p->freason = EXC_TRY_CLAUSE; - goto find_func_info; + { + Eterm try_case_end_val; + GetArg1(0, try_case_end_val); + c_p->fvalue = try_case_end_val; + c_p->freason = EXC_TRY_CLAUSE; + goto find_func_info; + } /* * Construction of binaries using new instructions. @@ -3786,19 +4026,20 @@ apply_bif_or_nif_epilogue: Eterm header; BeamInstr *next; Uint slots; + Eterm context; OpCase(i_bs_start_match2_rfIId): { - tmp_arg1 = r(0); + context = r(0); do_start_match: slots = Arg(2); - if (!is_boxed(tmp_arg1)) { + if (!is_boxed(context)) { ClauseFail(); } PreFetch(4, next); - header = *boxed_val(tmp_arg1); + header = *boxed_val(context); if (header_is_bin_matchstate(header)) { - ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(tmp_arg1); + ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(context); Uint actual_slots = HEADER_NUM_SLOTS(header); ms->save_offset[0] = ms->mb.offset; if (actual_slots < slots) { @@ -3806,8 +4047,8 @@ apply_bif_or_nif_epilogue: Uint live = Arg(1); Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); - TestHeapPreserve(wordsneeded, live, tmp_arg1); - ms = (ErlBinMatchState *) boxed_val(tmp_arg1); + TestHeapPreserve(wordsneeded, live, context); + ms = (ErlBinMatchState *) boxed_val(context); dst = (ErlBinMatchState *) HTOP; *dst = *ms; *HTOP = HEADER_BIN_MATCHSTATE(slots); @@ -3819,12 +4060,12 @@ apply_bif_or_nif_epilogue: Eterm result; Uint live = Arg(1); Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); - TestHeapPreserve(wordsneeded, live, tmp_arg1); + TestHeapPreserve(wordsneeded, live, context); HEAP_TOP(c_p) = HTOP; #ifdef DEBUG c_p->stop = E; /* Needed for checking in HeapOnlyAlloc(). */ #endif - result = erts_bs_start_match_2(c_p, tmp_arg1, slots); + result = erts_bs_start_match_2(c_p, context, slots); HTOP = HEAP_TOP(c_p); HEAP_SPACE_VERIFIED(0); if (is_non_value(result)) { @@ -3838,12 +4079,12 @@ apply_bif_or_nif_epilogue: NextPF(4, next); } OpCase(i_bs_start_match2_xfIId): { - tmp_arg1 = xb(Arg(0)); + context = xb(Arg(0)); I++; goto do_start_match; } OpCase(i_bs_start_match2_yfIId): { - tmp_arg1 = yb(Arg(0)); + context = yb(Arg(0)); I++; goto do_start_match; } @@ -3936,93 +4177,105 @@ apply_bif_or_nif_epilogue: NextPF(2, next); } + { + Eterm bs_get_integer8_context; + OpCase(i_bs_get_integer_8_rfd): { - tmp_arg1 = r(0); - goto do_bs_get_integer_8; - } + bs_get_integer8_context = r(0); + goto do_bs_get_integer_8; + } OpCase(i_bs_get_integer_8_xfd): { - tmp_arg1 = xb(Arg(0)); - I++; - } + bs_get_integer8_context = xb(Arg(0)); + I++; + } do_bs_get_integer_8: { - ErlBinMatchBuffer *_mb; - Eterm _result; - _mb = ms_matchbuffer(tmp_arg1); - if (_mb->size - _mb->offset < 8) { - ClauseFail(); - } - if (BIT_OFFSET(_mb->offset) != 0) { - _result = erts_bs_get_integer_2(c_p, 8, 0, _mb); - } else { - _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]); - _mb->offset += 8; + ErlBinMatchBuffer *_mb; + Eterm _result; + _mb = ms_matchbuffer(bs_get_integer8_context); + if (_mb->size - _mb->offset < 8) { + ClauseFail(); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _result = erts_bs_get_integer_2(c_p, 8, 0, _mb); + } else { + _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]); + _mb->offset += 8; + } + StoreBifResult(1, _result); } - StoreBifResult(1, _result); } - OpCase(i_bs_get_integer_16_rfd): { - tmp_arg1 = r(0); + { + Eterm bs_get_integer_16_context; + + OpCase(i_bs_get_integer_16_rfd): + bs_get_integer_16_context = r(0); goto do_bs_get_integer_16; - } - OpCase(i_bs_get_integer_16_xfd): { - tmp_arg1 = xb(Arg(0)); + OpCase(i_bs_get_integer_16_xfd): + bs_get_integer_16_context = xb(Arg(0)); I++; - } - do_bs_get_integer_16: { - ErlBinMatchBuffer *_mb; - Eterm _result; - _mb = ms_matchbuffer(tmp_arg1); - if (_mb->size - _mb->offset < 16) { - ClauseFail(); - } - if (BIT_OFFSET(_mb->offset) != 0) { - _result = erts_bs_get_integer_2(c_p, 16, 0, _mb); - } else { - _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset))); - _mb->offset += 16; + do_bs_get_integer_16: + { + ErlBinMatchBuffer *_mb; + Eterm _result; + _mb = ms_matchbuffer(bs_get_integer_16_context); + if (_mb->size - _mb->offset < 16) { + ClauseFail(); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _result = erts_bs_get_integer_2(c_p, 16, 0, _mb); + } else { + _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset))); + _mb->offset += 16; + } + StoreBifResult(1, _result); } - StoreBifResult(1, _result); } - OpCase(i_bs_get_integer_32_rfId): { - tmp_arg1 = r(0); + { + Eterm bs_get_integer_32_context; + + OpCase(i_bs_get_integer_32_rfId): + bs_get_integer_32_context = r(0); goto do_bs_get_integer_32; - } + - OpCase(i_bs_get_integer_32_xfId): { - tmp_arg1 = xb(Arg(0)); + OpCase(i_bs_get_integer_32_xfId): + bs_get_integer_32_context = xb(Arg(0)); I++; - } - do_bs_get_integer_32: { - ErlBinMatchBuffer *_mb; - Uint32 _integer; - Eterm _result; - _mb = ms_matchbuffer(tmp_arg1); - if (_mb->size - _mb->offset < 32) { ClauseFail(); } - if (BIT_OFFSET(_mb->offset) != 0) { - _integer = erts_bs_get_unaligned_uint32(_mb); - } else { - _integer = get_int32(_mb->base + _mb->offset/8); - } - _mb->offset += 32; + + do_bs_get_integer_32: + { + ErlBinMatchBuffer *_mb; + Uint32 _integer; + Eterm _result; + _mb = ms_matchbuffer(bs_get_integer_32_context); + if (_mb->size - _mb->offset < 32) { ClauseFail(); } + if (BIT_OFFSET(_mb->offset) != 0) { + _integer = erts_bs_get_unaligned_uint32(_mb); + } else { + _integer = get_int32(_mb->base + _mb->offset/8); + } + _mb->offset += 32; #if !defined(ARCH_64) || HALFWORD_HEAP - if (IS_USMALL(0, _integer)) { + if (IS_USMALL(0, _integer)) { #endif - _result = make_small(_integer); + _result = make_small(_integer); #if !defined(ARCH_64) || HALFWORD_HEAP - } else { - TestHeap(BIG_UINT_HEAP_SIZE, Arg(1)); - _result = uint_to_big((Uint) _integer, HTOP); - HTOP += BIG_UINT_HEAP_SIZE; - HEAP_SPACE_VERIFIED(0); - } + } else { + TestHeap(BIG_UINT_HEAP_SIZE, Arg(1)); + _result = uint_to_big((Uint) _integer, HTOP); + HTOP += BIG_UINT_HEAP_SIZE; + HEAP_SPACE_VERIFIED(0); + } #endif - StoreBifResult(2, _result); + StoreBifResult(2, _result); + } } /* Operands: Size Live Fail Flags Dst */ @@ -4120,54 +4373,64 @@ apply_bif_or_nif_epilogue: StoreBifResult(3, result); } - /* Operands: MatchContext Fail Dst */ + { + Eterm get_utf8_context; + + /* Operands: MatchContext Fail Dst */ OpCase(i_bs_get_utf8_rfd): { - tmp_arg1 = r(0); - goto do_bs_get_utf8; - } + get_utf8_context = r(0); + goto do_bs_get_utf8; + } OpCase(i_bs_get_utf8_xfd): { - tmp_arg1 = xb(Arg(0)); - I++; - } + get_utf8_context = xb(Arg(0)); + I++; + } - /* - * tmp_arg1 = match_context - * Operands: Fail Dst - */ + /* + * get_utf8_context = match_context + * Operands: Fail Dst + */ - do_bs_get_utf8: { - Eterm result = erts_bs_get_utf8(ms_matchbuffer(tmp_arg1)); - if (is_non_value(result)) { - ClauseFail(); + do_bs_get_utf8: { + Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context)); + if (is_non_value(result)) { + ClauseFail(); + } + StoreBifResult(1, result); } - StoreBifResult(1, result); } - /* Operands: MatchContext Fail Flags Dst */ + { + Eterm get_utf16_context; + + /* Operands: MatchContext Fail Flags Dst */ OpCase(i_bs_get_utf16_rfId): { - tmp_arg1 = r(0); - goto do_bs_get_utf16; - } + get_utf16_context = r(0); + goto do_bs_get_utf16; + } OpCase(i_bs_get_utf16_xfId): { - tmp_arg1 = xb(Arg(0)); - I++; - } + get_utf16_context = xb(Arg(0)); + I++; + } - /* - * tmp_arg1 = match_context - * Operands: Fail Flags Dst - */ - do_bs_get_utf16: { - Eterm result = erts_bs_get_utf16(ms_matchbuffer(tmp_arg1), Arg(1)); - if (is_non_value(result)) { - ClauseFail(); + /* + * get_utf16_context = match_context + * Operands: Fail Flags Dst + */ + do_bs_get_utf16: { + Eterm result = erts_bs_get_utf16(ms_matchbuffer(get_utf16_context), + Arg(1)); + if (is_non_value(result)) { + ClauseFail(); + } + StoreBifResult(2, result); } - StoreBifResult(2, result); } { + Eterm context_to_binary_context; ErlBinMatchBuffer* mb; ErlSubBin* sb; Uint size; @@ -4176,27 +4439,29 @@ apply_bif_or_nif_epilogue: Uint hole_size; OpCase(bs_context_to_binary_r): { - tmp_arg1 = x0; + context_to_binary_context = x0; I -= 2; goto do_context_to_binary; } /* Unfortunately, inlining can generate this instruction. */ OpCase(bs_context_to_binary_y): { - tmp_arg1 = yb(Arg(0)); + context_to_binary_context = yb(Arg(0)); goto do_context_to_binary0; } OpCase(bs_context_to_binary_x): { - tmp_arg1 = xb(Arg(0)); + context_to_binary_context = xb(Arg(0)); do_context_to_binary0: I--; } do_context_to_binary: - if (is_boxed(tmp_arg1) && header_is_bin_matchstate(*boxed_val(tmp_arg1))) { - ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(tmp_arg1); + if (is_boxed(context_to_binary_context) && + header_is_bin_matchstate(*boxed_val(context_to_binary_context))) { + ErlBinMatchState* ms; + ms = (ErlBinMatchState *) boxed_val(context_to_binary_context); mb = &ms->mb; offs = ms->save_offset[0]; size = mb->size - offs; @@ -4205,17 +4470,17 @@ apply_bif_or_nif_epilogue: Next(2); OpCase(i_bs_get_binary_all_reuse_rfI): { - tmp_arg1 = x0; + context_to_binary_context = x0; goto do_bs_get_binary_all_reuse; } OpCase(i_bs_get_binary_all_reuse_xfI): { - tmp_arg1 = xb(Arg(0)); + context_to_binary_context = xb(Arg(0)); I++; } do_bs_get_binary_all_reuse: - mb = ms_matchbuffer(tmp_arg1); + mb = ms_matchbuffer(context_to_binary_context); size = mb->size - mb->offset; if (size % Arg(1) != 0) { ClauseFail(); @@ -4224,7 +4489,7 @@ apply_bif_or_nif_epilogue: do_bs_get_binary_all_reuse_common: orig = mb->orig; - sb = (ErlSubBin *) boxed_val(tmp_arg1); + sb = (ErlSubBin *) boxed_val(context_to_binary_context); hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE; sb->thing_word = HEADER_SUB_BIN; sb->size = BYTE_OFFSET(size); @@ -4240,12 +4505,14 @@ apply_bif_or_nif_epilogue: } { + Eterm match_string_context; + OpCase(i_bs_match_string_rfII): { - tmp_arg1 = r(0); + match_string_context = r(0); goto do_bs_match_string; } OpCase(i_bs_match_string_xfII): { - tmp_arg1 = xb(Arg(0)); + match_string_context = xb(Arg(0)); I++; } @@ -4260,7 +4527,7 @@ apply_bif_or_nif_epilogue: PreFetch(3, next); bits = Arg(1); bytes = (byte *) Arg(2); - mb = ms_matchbuffer(tmp_arg1); + mb = ms_matchbuffer(match_string_context); if (mb->size - mb->offset < bits) { ClauseFail(); } @@ -4353,6 +4620,7 @@ apply_bif_or_nif_epilogue: ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); flags = erts_call_trace(c_p, ep->code, ep->match_prog_set, reg, 0, &c_p->tracer_proc); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -4364,6 +4632,7 @@ apply_bif_or_nif_epilogue: /* SWAPOUT, SWAPIN was done and r(0) was saved above */ PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect(c_p, 3, reg, ep->code[2]); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); r(0) = reg[0]; SWAPIN; @@ -4453,6 +4722,7 @@ apply_bif_or_nif_epilogue: reg[0] = r(0); PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect(c_p, 2, reg, I[-1]); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); r(0) = reg[0]; } @@ -4556,6 +4826,7 @@ apply_bif_or_nif_epilogue: /* SWAPOUT was done and r(0) was saved above */ PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect(c_p, need, reg, I[-1]); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); r(0) = reg[0]; SWAPIN; @@ -4723,7 +4994,7 @@ apply_bif_or_nif_epilogue: NextPF(2, next); } - OpCase(fmove_new_ld): { + OpCase(fmove_ld): { Eterm fr = Arg(0); Eterm dest = make_float(HTOP); @@ -4753,11 +5024,6 @@ apply_bif_or_nif_epilogue: NextPF(2, next); } - /* - * Old allocating fmove. - */ - - #ifdef NO_FPE_SIGNALS OpCase(fclearerror): OpCase(i_fcheckerror): @@ -4958,7 +5224,7 @@ apply_bif_or_nif_epilogue: OpCase(i_hibernate): { SWAPOUT; - if (hibernate(c_p, r(0), x(1), x(2), reg)) { + if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) { goto do_schedule; } else { I = handle_error(c_p, I, reg, hibernate_3); @@ -4969,12 +5235,11 @@ apply_bif_or_nif_epilogue: OpCase(i_debug_breakpoint): { SWAPOUT; reg[0] = r(0); - tmp_arg1 = call_breakpoint_handler(c_p, I-3, reg); + I = call_error_handler(c_p, I-3, reg, am_breakpoint); r(0) = reg[0]; SWAPIN; - if (tmp_arg1) { - SET_I(c_p->i); - Dispatch(); + if (I) { + Goto(*I); } goto no_error_handler; } @@ -5633,9 +5898,6 @@ build_stacktrace(Process* c_p, Eterm exc) { Eterm args; int depth; BeamInstr* current; -#if HALFWORD_HEAP - BeamInstr current_buff[3]; -#endif Eterm Where = NIL; Eterm *next_p = &Where; @@ -5665,14 +5927,7 @@ build_stacktrace(Process* c_p, Eterm exc) { * (e.g. spawn_link(erlang, abs, [1])). */ if (current == NULL) { -#if HALFWORD_HEAP - current = current_buff; - current[0] = (BeamInstr) c_p->initial[0]; - current[1] = (BeamInstr) c_p->initial[1]; - current[2] = (BeamInstr) c_p->initial[2]; -#else current = c_p->initial; -#endif args = am_true; /* Just in case */ } else { args = get_args_from_exc(exc); @@ -5724,8 +5979,8 @@ build_stacktrace(Process* c_p, Eterm exc) { } -static Eterm -call_error_handler(Process* p, BeamInstr* fi, Eterm* reg) +static BeamInstr* +call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func) { Eterm* hp; Export* ep; @@ -5737,62 +5992,12 @@ call_error_handler(Process* p, BeamInstr* fi, Eterm* reg) /* * Search for the error_handler module. */ - ep = erts_find_function(erts_proc_get_error_handler(p), - am_undefined_function, 3); - if (ep == NULL) { /* No error handler */ - p->current = fi; - p->freason = EXC_UNDEF; - return 0; - } - p->i = ep->address; - - /* - * Create a list with all arguments in the x registers. - */ - - arity = fi[2]; - sz = 2 * arity; - if (HeapWordsLeft(p) < sz) { - erts_garbage_collect(p, sz, reg, arity); - } - hp = HEAP_TOP(p); - HEAP_TOP(p) += sz; - args = NIL; - for (i = arity-1; i >= 0; i--) { - args = CONS(hp, reg[i], args); - hp += 2; - } - - /* - * Set up registers for call to error_handler:undefined_function/3. - */ - reg[0] = fi[0]; - reg[1] = fi[1]; - reg[2] = args; - return 1; -} - -static Eterm -call_breakpoint_handler(Process* p, BeamInstr* fi, Eterm* reg) -{ - Eterm* hp; - Export* ep; - int arity; - Eterm args; - Uint sz; - int i; - - /* - * Search for error handler module. - */ - ep = erts_find_function(erts_proc_get_error_handler(p), - am_breakpoint, 3); + ep = erts_find_function(erts_proc_get_error_handler(p), func, 3); if (ep == NULL) { /* No error handler */ p->current = fi; p->freason = EXC_UNDEF; return 0; } - p->i = ep->address; /* * Create a list with all arguments in the x registers. @@ -5812,15 +6017,14 @@ call_breakpoint_handler(Process* p, BeamInstr* fi, Eterm* reg) } /* - * Set up registers for call to error_handler:breakpoint/3. + * Set up registers for call to error_handler:<func>/3. */ reg[0] = fi[0]; reg[1] = fi[1]; reg[2] = args; - return 1; + return ep->address; } - static Export* apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity, Eterm* reg) @@ -5997,8 +6201,8 @@ fixed_apply(Process* p, Eterm* reg, Uint arity) return ep->address; } -static int -hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg) +int +erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg) { int arity; Eterm tmp; @@ -6069,6 +6273,7 @@ hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg) c_p->fvalue = NIL; PROCESS_MAIN_CHK_LOCKS(c_p); erts_garbage_collect_hibernate(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -6195,6 +6400,7 @@ call_fun(Process* p, /* Current process. */ reg[0] = module; reg[1] = fun; reg[2] = args; + reg[3] = NIL; return ep->address; } } @@ -6314,6 +6520,7 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) if (HEAP_LIMIT(p) - HEAP_TOP(p) <= needed) { PROCESS_MAIN_CHK_LOCKS(p); erts_garbage_collect(p, needed, reg, num_free); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(p); PROCESS_MAIN_CHK_LOCKS(p); } hp = p->htop; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index df5602b040..c697b1ef31 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -89,13 +89,12 @@ typedef struct { } Label; /* - * Type for a operand for a generic instruction. + * Type for an operand for a generic instruction. */ typedef struct { unsigned type; /* Type of operand. */ - BeamInstr val; /* Value of operand. */ - Uint bigarity; /* Arity for bignumbers (only). */ + BeamInstr val; /* Value of operand. */ } GenOpArg; /* @@ -326,11 +325,6 @@ typedef struct { Literal* literals; /* Array of literals. */ LiteralPatch* literal_patches; /* Operands that need to be patched. */ Uint total_literal_size; /* Total heap size for all literals. */ - - /* - * Floating point. - */ - int new_float_instructions; /* New allocation scheme for floating point. */ } LoaderState; typedef struct { @@ -476,16 +470,16 @@ static int read_code_header(LoaderState* stp); static int load_code(LoaderState* stp); static GenOp* gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, GenOpArg Tuple, GenOpArg Dst); -static GenOp* gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail, +static GenOp* gen_split_values(LoaderState* stp, GenOpArg S, + GenOpArg TypeFail, GenOpArg Fail, GenOpArg Size, GenOpArg* Rest); static GenOp* gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpArg* Rest); -static GenOp* gen_select_big(LoaderState* stp, GenOpArg S, GenOpArg Fail, - GenOpArg Size, GenOpArg* Rest); +static GenOp* gen_select_literals(LoaderState* stp, GenOpArg S, + GenOpArg Fail, GenOpArg Size, + GenOpArg* Rest); static GenOp* const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpArg* Rest); -static GenOp* gen_func_info(LoaderState* stp, GenOpArg mod, GenOpArg Func, - GenOpArg arity, GenOpArg label); static int freeze_code(LoaderState* stp); @@ -818,7 +812,6 @@ init_state(LoaderState* stp) stp->total_literal_size = 0; stp->literal_patches = 0; stp->string_patches = 0; - stp->new_float_instructions = 0; stp->may_load_nif = 0; stp->on_load = 0; } @@ -1618,7 +1611,6 @@ load_code(LoaderState* stp) BeamInstr val; BeamInstr words = 0; - stp->new_float_instructions = 1; GetTagAndValue(stp, tag, n); VerifyTag(stp, tag, TAG_u); while (n-- > 0) { @@ -1772,7 +1764,7 @@ load_code(LoaderState* stp) } stp->specific_op = specific; - CodeNeed(opc[stp->specific_op].sz+2); /* Extra margin for packing */ + CodeNeed(opc[stp->specific_op].sz+16); /* Extra margin for packing */ code[ci++] = BeamOpCode(stp->specific_op); } @@ -1936,7 +1928,8 @@ load_code(LoaderState* stp) } code[ci++] = (BeamInstr) stp->import[i].bf; break; - case 'P': /* Byte offset into tuple */ + case 'P': /* Byte offset into tuple or stack */ + case 'Q': /* Like 'P', but packable */ VerifyTag(stp, tag, TAG_u); tmp = tmp_op->a[arg].val; code[ci++] = (BeamInstr) ((tmp_op->a[arg].val+1) * sizeof(Eterm)); @@ -1957,84 +1950,6 @@ load_code(LoaderState* stp) } /* - * Load any list arguments using the primitive tags. - */ - - for ( ; arg < tmp_op->arity; arg++) { - switch (tmp_op->a[arg].type) { - case TAG_i: - CodeNeed(1); - code[ci++] = make_small(tmp_op->a[arg].val); - break; - case TAG_u: - case TAG_a: - case TAG_v: - CodeNeed(1); - code[ci++] = tmp_op->a[arg].val; - break; - case TAG_f: - CodeNeed(1); - code[ci] = stp->labels[tmp_op->a[arg].val].patches; - stp->labels[tmp_op->a[arg].val].patches = ci; - ci++; - break; - case TAG_q: - { - Eterm lit; - - lit = stp->literals[tmp_op->a[arg].val].term; - if (is_big(lit)) { - Eterm* bigp; - Eterm *tmp; - Uint size; - Uint term_size; - - bigp = big_val(lit); - term_size = bignum_header_arity(*bigp); - size = TermWords(term_size + 1); - CodeNeed(size); - tmp = (Eterm *) (code + ci); - *tmp++ = *bigp++; - while (term_size-- > 0) { - *tmp++ = *bigp++; - } - ci +=size; - } else if (is_float(lit)) { -#if defined(ARCH_64) && !HALFWORD_HEAP - CodeNeed(1); - code[ci++] = float_val(stp->literals[tmp_op->a[arg].val].term)[1]; -#elif HALFWORD_HEAP - Eterm* fptr; - Uint size; - Eterm *tmp; - - fptr = float_val(stp->literals[tmp_op->a[arg].val].term)+1; - size = TermWords(2); - CodeNeed(size); - tmp = (Eterm *) (code + ci); - *tmp++ = *fptr++; - *tmp = *fptr; - ci += size; -#else - Eterm* fptr; - - fptr = float_val(stp->literals[tmp_op->a[arg].val].term)+1; - CodeNeed(2); - code[ci++] = *fptr++; - code[ci++] = *fptr; -#endif - } else { - LoadError0(stp, "literal is neither float nor big"); - } - } - break; - default: - LoadError1(stp, "unsupported primitive type '%c'", - tag_to_letter[tmp_op->a[arg].type]); - } - } - - /* * The packing engine. */ if (opc[stp->specific_op].pack[0]) { @@ -2057,6 +1972,11 @@ load_code(LoaderState* stp) case '6': /* Shift 16 steps */ packed = (packed << BEAM_LOOSE_SHIFT) | code[--ci]; break; +#ifdef ARCH_64 + case 'w': /* Shift 32 steps */ + packed = (packed << BEAM_WIDE_SHIFT) | code[--ci]; + break; +#endif case 'p': /* Put instruction (from stack). */ code[ci++] = *--sp; break; @@ -2072,6 +1992,58 @@ load_code(LoaderState* stp) } /* + * Load any list arguments using the primitive tags. + */ + + for ( ; arg < tmp_op->arity; arg++) { + switch (tmp_op->a[arg].type) { + case TAG_i: + CodeNeed(1); + code[ci++] = make_small(tmp_op->a[arg].val); + break; + case TAG_u: + case TAG_a: + case TAG_v: + CodeNeed(1); + code[ci++] = tmp_op->a[arg].val; + break; + case TAG_f: + CodeNeed(1); + code[ci] = stp->labels[tmp_op->a[arg].val].patches; + stp->labels[tmp_op->a[arg].val].patches = ci; + ci++; + break; + case TAG_r: + CodeNeed(1); + code[ci++] = (R_REG_DEF << _TAG_PRIMARY_SIZE) | + TAG_PRIMARY_HEADER; + break; + case TAG_x: + CodeNeed(1); + code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) | + (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER; + break; + case TAG_y: + CodeNeed(1); + code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) | + (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER; + break; + case TAG_n: + CodeNeed(1); + code[ci++] = NIL; + break; + case TAG_q: + CodeNeed(1); + new_literal_patch(stp, ci); + code[ci++] = tmp_op->a[arg].val; + break; + default: + LoadError1(stp, "unsupported primitive type '%c'", + tag_to_letter[tmp_op->a[arg].type]); + } + } + + /* * Handle a few special cases. */ switch (stp->specific_op) { @@ -2239,11 +2211,12 @@ use_jump_tab(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) } /* - * Predicate to test whether all values in a table are big numbers. + * Predicate to test whether all values in a table are either + * floats or bignums. */ static int -all_values_are_big(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) +floats_or_bignums(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) { int i; @@ -2255,9 +2228,6 @@ all_values_are_big(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) if (Rest[i].type != TAG_q) { return 0; } - if (is_not_big(stp->literals[Rest[i].val].term)) { - return 0; - } if (Rest[i+1].type != TAG_f) { return 0; } @@ -2317,6 +2287,14 @@ mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) return 0; } +static int +same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label) +{ + return Target.type = TAG_f && Label.type == TAG_u && + Target.val == Label.val; +} + + /* * Generate an instruction for element/2. */ @@ -2328,23 +2306,23 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, GenOp* op; NEW_GENOP(stp, op); - op->op = genop_i_element_4; op->arity = 4; - op->a[0] = Fail; - op->a[1] = Index; - op->a[2] = Tuple; - op->a[3] = Dst; op->next = NULL; - /* - * If safe, generate a faster instruction. - */ - if (Index.type == TAG_i && Index.val > 0 && (Tuple.type == TAG_r || Tuple.type == TAG_x || Tuple.type == TAG_y)) { op->op = genop_i_fast_element_4; - op->a[1].type = TAG_u; - op->a[1].val = Index.val; + op->a[0] = Tuple; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = Index.val; + op->a[3] = Dst; + } else { + op->op = genop_i_element_4; + op->a[0] = Tuple; + op->a[1] = Fail; + op->a[2] = Index; + op->a[3] = Dst; } return op; @@ -2595,8 +2573,6 @@ binary_too_big_bits(LoaderState* stp, GenOpArg Size) return Size.type == TAG_u && (((Size.val+7)/8) >> (8*sizeof(Uint)-3) != 0); } -#define new_float_allocation(Stp) ((Stp)->new_float_instructions) - static GenOp* gen_put_binary(LoaderState* stp, GenOpArg Fail,GenOpArg Size, GenOpArg Unit, GenOpArg Flags, GenOpArg Src) @@ -2809,6 +2785,52 @@ gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, return op; } +static GenOp* +gen_increment(LoaderState* stp, GenOpArg Reg, GenOpArg Integer, + GenOpArg Live, GenOpArg Dst) +{ + GenOp* op; + + NEW_GENOP(stp, op); + op->op = genop_i_increment_4; + op->arity = 4; + op->next = NULL; + op->a[0] = Reg; + op->a[1].type = TAG_u; + op->a[1].val = Integer.val; + op->a[2] = Live; + op->a[3] = Dst; + return op; +} + +static GenOp* +gen_increment_from_minus(LoaderState* stp, GenOpArg Reg, GenOpArg Integer, + GenOpArg Live, GenOpArg Dst) +{ + GenOp* op; + + NEW_GENOP(stp, op); + op->op = genop_i_increment_4; + op->arity = 4; + op->next = NULL; + op->a[0] = Reg; + op->a[1].type = TAG_u; + op->a[1].val = -Integer.val; + op->a[2] = Live; + op->a[3] = Dst; + return op; +} + +/* + * Test whether the negation of the given number is small. + */ +static int +negation_is_small(LoaderState* stp, GenOpArg Int) +{ + return Int.type == TAG_i && IS_SSMALL(-Int.val); +} + + static int smp(LoaderState* stp) { @@ -3000,6 +3022,21 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail, ASSERT(op->a[i].val < op->a[i+2].val); } #endif + + /* + * Use a special-cased instruction if there are only two values. + */ + if (size == 2) { + op->op = genop_i_select_tuple_arity2_6; + op->arity--; + op->a[2].type = TAG_u; + op->a[2].val = arityval(op->a[3].val); + op->a[3] = op->a[4]; + op->a[4].type = TAG_u; + op->a[4].val = arityval(op->a[5].val); + op->a[5] = op->a[6]; + } + return op; } @@ -3009,18 +3046,24 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail, */ static GenOp* -gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail, - GenOpArg Size, GenOpArg* Rest) +gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg TypeFail, + GenOpArg Fail, GenOpArg Size, GenOpArg* Rest) { GenOp* op1; GenOp* op2; GenOp* label; - Uint type; + GenOp* is_integer; int i; ASSERT(Size.val >= 2 && Size.val % 2 == 0); + NEW_GENOP(stp, is_integer); + is_integer->op = genop_is_integer_2; + is_integer->arity = 2; + is_integer->a[0] = TypeFail; + is_integer->a[1] = S; + NEW_GENOP(stp, label); label->op = genop_label_1; label->arity = 1; @@ -3046,15 +3089,13 @@ gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail, op2->a[2].type = TAG_u; op2->a[2].val = 0; - op1->next = label; - label->next = op2; - op2->next = NULL; - - type = Rest[0].type; + /* + * Split the list. + */ ASSERT(Size.type == TAG_u); for (i = 0; i < Size.val; i += 2) { - GenOp* op = (Rest[i].type == type) ? op1 : op2; + GenOp* op = (Rest[i].type == TAG_q) ? op2 : op1; int dst = 3 + op->a[2].val; ASSERT(Rest[i+1].type == TAG_f); @@ -3063,13 +3104,36 @@ gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail, op->arity += 2; op->a[2].val += 2; } + ASSERT(op1->a[2].val > 0); + ASSERT(op2->a[2].val > 0); /* - * None of the instructions should have zero elements in the list. + * Order the instruction sequence appropriately. */ - ASSERT(op1->a[2].val > 0); - ASSERT(op2->a[2].val > 0); + if (TypeFail.val == Fail.val) { + /* + * select_val L1 S ... (small numbers) + * label L1 + * is_integer Fail S + * select_val Fail S ... (bignums) + */ + op1->next = label; + label->next = is_integer; + is_integer->next = op2; + } else { + /* + * is_integer TypeFail S + * select_val L1 S ... (small numbers) + * label L1 + * select_val Fail S ... (bignums) + */ + is_integer->next = op1; + op1->next = label; + label->next = op2; + op1 = is_integer; + } + op2->next = NULL; return op1; } @@ -3091,6 +3155,29 @@ gen_jump_tab(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpAr ASSERT(Size.val >= 2 && Size.val % 2 == 0); /* + * If there is only one choice, don't generate a jump table. + */ + if (Size.val == 2) { + GenOp* jump; + + NEW_GENOP(stp, op); + op->arity = 3; + op->op = genop_is_ne_exact_3; + op->a[0] = Rest[1]; + op->a[1] = S; + op->a[2] = Rest[0]; + + NEW_GENOP(stp, jump); + jump->next = NULL; + jump->arity = 1; + jump->op = genop_jump_1; + jump->a[0] = Fail; + + op->next = jump; + return op; + } + + /* * Calculate the minimum and maximum values and size of jump table. */ @@ -3162,8 +3249,9 @@ genopargcompare(GenOpArg* a, GenOpArg* b) } /* - * Generate a select_val instruction. We know that a jump table is not suitable, - * and that all values are of the same type (integer, atoms, floats; never bignums). + * Generate a select_val instruction. We know that a jump table + * is not suitable, and that all values are of the same type + * (integer or atoms). */ static GenOp* @@ -3177,12 +3265,7 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, NEW_GENOP(stp, op); op->next = NULL; - if (Rest[0].type != TAG_q) { - op->op = genop_i_select_val_3; - } else { - ASSERT(is_float(stp->literals[Rest[0].val].term)); - op->op = genop_i_select_float_3; - } + op->op = genop_i_select_val_3; GENOP_ARITY(op, arity); op->a[0] = S; op->a[1] = Fail; @@ -3204,19 +3287,19 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, } #endif - return op; -} - -/* - * Compare function for qsort(). - */ + /* + * Use a special-cased instruction if there are only two values. + */ + if (size == 2) { + op->op = genop_i_select_val2_6; + op->arity--; + op->a[2] = op->a[3]; + op->a[3] = op->a[4]; + op->a[4] = op->a[5]; + op->a[5] = op->a[6]; + } -static int -genbigcompare(GenOpArg* a, GenOpArg* b) -{ - int val = (int)(b->bigarity - a->bigarity); - - return val != 0 ? val : ((int) (a->val - b->val)); + return op; } /* @@ -3224,37 +3307,35 @@ genbigcompare(GenOpArg* a, GenOpArg* b) */ static GenOp* -gen_select_big(LoaderState* stp, GenOpArg S, GenOpArg Fail, +gen_select_literals(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpArg* Rest) { GenOp* op; - int arity = Size.val + 2 + 1; - int size = Size.val / 2; + GenOp* jump; + GenOp** prev_next = &op; + int i; - NEW_GENOP(stp, op); - op->next = NULL; - op->op = genop_i_select_big_2; - GENOP_ARITY(op, arity); - op->a[0] = S; - op->a[1] = Fail; for (i = 0; i < Size.val; i += 2) { + GenOp* op; ASSERT(Rest[i].type == TAG_q); - op->a[i+2] = Rest[i]; - op->a[i+2].bigarity = *big_val(stp->literals[op->a[i+2].val].term); - op->a[i+3] = Rest[i+1]; - } - ASSERT(i+2 == arity-1); - op->a[arity-1].type = TAG_u; - op->a[arity-1].val = 0; - - /* - * Sort the values in descending arity order. - */ - - qsort(op->a+2, size, 2*sizeof(GenOpArg), - (int (*)(const void *, const void *)) genbigcompare); + NEW_GENOP(stp, op); + op->op = genop_is_ne_exact_3; + op->arity = 3; + op->a[0] = Rest[i+1]; + op->a[1] = S; + op->a[2] = Rest[i]; + *prev_next = op; + prev_next = &op->next; + } + + NEW_GENOP(stp, jump); + jump->next = NULL; + jump->op = genop_jump_1; + jump->arity = 1; + jump->a[0] = Fail; + *prev_next = jump; return op; } @@ -3272,7 +3353,6 @@ const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, int i; ASSERT(Size.type == TAG_u); - ASSERT(S.type == TAG_q); NEW_GENOP(stp, op); op->next = NULL; @@ -3283,18 +3363,32 @@ const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, * Search for a literal matching the controlling expression. */ - if (S.type == TAG_q) { - Eterm expr = stp->literals[S.val].term; - for (i = 0; i < Size.val; i += 2) { - if (Rest[i].type == TAG_q) { - Eterm term = stp->literals[Rest[i].val].term; - if (eq(term, expr)) { - ASSERT(Rest[i+1].type == TAG_f); - op->a[0] = Rest[i+1]; - return op; + switch (S.type) { + case TAG_q: + { + Eterm expr = stp->literals[S.val].term; + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type == TAG_q) { + Eterm term = stp->literals[Rest[i].val].term; + if (eq(term, expr)) { + ASSERT(Rest[i+1].type == TAG_f); + op->a[0] = Rest[i+1]; + return op; + } } } } + break; + case TAG_i: + case TAG_a: + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].val == S.val && Rest[i].type == S.type) { + ASSERT(Rest[i+1].type == TAG_f); + op->a[0] = Rest[i+1]; + return op; + } + } + break; } /* @@ -3305,36 +3399,6 @@ const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, return op; } - -static GenOp* -gen_func_info(LoaderState* stp, GenOpArg mod, GenOpArg func, - GenOpArg arity, GenOpArg label) -{ - GenOp* fi; - GenOp* op; - - NEW_GENOP(stp, fi); - fi->op = genop_i_func_info_4; - fi->arity = 4; - fi->a[0].type = TAG_u; /* untagged Zero */ - fi->a[0].val = 0; - fi->a[1] = mod; - fi->a[2] = func; - fi->a[3] = arity; - - NEW_GENOP(stp, op); - op->op = genop_label_1; - op->arity = 1; - op->a[0] = label; - - fi->next = op; - op->next = NULL; - - return fi; -} - - - static GenOp* gen_make_fun2(LoaderState* stp, GenOpArg idx) { @@ -3477,6 +3541,56 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, return op; } +static GenOp* +tuple_append_put5(LoaderState* stp, GenOpArg Arity, GenOpArg Dst, + GenOpArg* Puts, GenOpArg S1, GenOpArg S2, GenOpArg S3, + GenOpArg S4, GenOpArg S5) +{ + GenOp* op; + int arity = Arity.val; /* Arity of tuple, not the instruction */ + int i; + + NEW_GENOP(stp, op); + op->next = NULL; + GENOP_ARITY(op, arity+2+5); + op->op = genop_i_put_tuple_2; + op->a[0] = Dst; + op->a[1].type = TAG_u; + op->a[1].val = arity + 5; + for (i = 0; i < arity; i++) { + op->a[i+2] = Puts[i]; + } + op->a[arity+2] = S1; + op->a[arity+3] = S2; + op->a[arity+4] = S3; + op->a[arity+5] = S4; + op->a[arity+6] = S5; + return op; +} + +static GenOp* +tuple_append_put(LoaderState* stp, GenOpArg Arity, GenOpArg Dst, + GenOpArg* Puts, GenOpArg S) +{ + GenOp* op; + int arity = Arity.val; /* Arity of tuple, not the instruction */ + int i; + + NEW_GENOP(stp, op); + op->next = NULL; + GENOP_ARITY(op, arity+2+1); + op->op = genop_i_put_tuple_2; + op->a[0] = Dst; + op->a[1].type = TAG_u; + op->a[1].val = arity + 1; + for (i = 0; i < arity; i++) { + op->a[i+2] = Puts[i]; + } + op->a[arity+2] = S; + return op; +} + + /* * Freeze the code in memory, move the string table into place, @@ -3624,25 +3738,32 @@ freeze_code(LoaderState* stp) CHKBLK(ERTS_ALC_T_CODE,code); if (compile_size) { byte* compile_info = str_table + strtab_size + attr_size; - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); sys_memcpy(compile_info, stp->chunks[COMPILE_CHUNK].start, stp->chunks[COMPILE_CHUNK].size); - CHKBLK(ERTS_ALC_T_CODE,code); + + CHKBLK(ERTS_ALC_T_CODE,code); code[MI_COMPILE_PTR] = (BeamInstr) compile_info; - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); code[MI_COMPILE_SIZE] = (BeamInstr) stp->chunks[COMPILE_CHUNK].size; - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); decoded_size = erts_decode_ext_size(compile_info, compile_size, 0); - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); if (decoded_size < 0) { LoadError0(stp, "bad external term representation of compilation information"); } - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size; } CHKBLK(ERTS_ALC_T_CODE,code); /* + * Make sure that we have not overflowed the allocated code space. + */ + ASSERT(str_table + strtab_size + attr_size + compile_size == + ((byte *) code) + size); + + /* * Go through all i_new_bs_put_strings instructions, restore the pointer to * the instruction and convert string offsets to pointers (to the * FIRST character). @@ -3876,11 +3997,23 @@ transform_engine(LoaderState* st) if (i == 0) goto restart; break; +#if defined(TOP_is_eq) case TOP_is_eq: ASSERT(ap < instr->arity); if (*pc++ != instr->a[ap].val) goto restart; break; +#endif + case TOP_is_type_eq: + mask = *pc++; + + ASSERT(ap < instr->arity); + ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); + if (((1 << instr->a[ap].type) & mask) == 0) + goto restart; + if (*pc++ != instr->a[ap].val) + goto restart; + break; case TOP_is_same_var: ASSERT(ap < instr->arity); i = *pc++; @@ -4001,14 +4134,17 @@ transform_engine(LoaderState* st) case TOP_rest_args: { int n = *pc++; + int formal_arity = gen_opc[instr->op].arity; + int num_vars = n + (instr->arity - formal_arity); + int j = formal_arity; + var = erts_alloc(ERTS_ALC_T_LOADER_TMP, - instr->arity * sizeof(GenOpArg)); + num_vars * sizeof(GenOpArg)); for (i = 0; i < n; i++) { var[i] = def_vars[i]; } - while (i < instr->arity) { - var[i] = instr->a[i]; - i++; + while (i < num_vars) { + var[i++] = instr->a[j++]; } } break; @@ -5315,6 +5451,9 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) if (state.lambdas != state.def_lambdas) { erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas); } + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels); + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom); + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export); if (bin != NULL) { driver_free_binary(bin); } @@ -5326,9 +5465,18 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) if (code != NULL) { erts_free(ERTS_ALC_T_CODE, code); } + if (state.labels != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels); + } if (state.lambdas != state.def_lambdas) { erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas); } + if (state.atom != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom); + } + if (state.export != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export); + } if (bin != NULL) { driver_free_binary(bin); } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index d4a43f6e5f..f01580eb2b 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -1091,10 +1091,20 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) BIF_RETTYPE hibernate_3(BIF_ALIST_3) { /* - * hibernate/3 is implemented as an instruction; therefore - * this function will never be called. + * hibernate/3 is usually translated to an instruction; therefore + * this function is only called from HiPE or when the call could not + * be translated. */ - BIF_ERROR(BIF_P, BADARG); + Eterm reg[3]; + + if (erts_hibernate(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, reg)) { + /* + * If hibernate succeeded, TRAP. The process will be suspended + * if status is P_WAITING or continue (if any message was in the queue). + */ + BIF_TRAP_CODE_PTR_(BIF_P, BIF_P->i); + } + return THE_NON_VALUE; } /**********************************************************************/ @@ -1351,9 +1361,10 @@ BIF_RETTYPE exit_2(BIF_ALIST_2) #ifdef ERTS_SMP if (rp == BIF_P) rp_locks &= ~ERTS_PROC_LOCK_MAIN; - else + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + if (rp != BIF_P) erts_smp_proc_dec_refc(rp); - erts_smp_proc_unlock(rp, rp_locks); #endif /* * We may have exited ourselves and may have to take action. diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index a84ee7bb23..8faa09feb8 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -201,6 +201,12 @@ do { \ return THE_NON_VALUE; \ } while(0) +#define BIF_TRAP_CODE_PTR_(p, Code_) do { \ + *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ + } while(0) + extern Export bif_return_trap_export; #ifdef DEBUG #define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, DEBUG_VAL) \ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 60b4b1946b..d9dd80fa8b 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -660,6 +660,7 @@ bif erts_debug:display/1 bif 'erl.system.debug':display/1 ebif_erts_debug_display_1 bif erts_debug:dist_ext_to_term/2 bif 'erl.system.debug':dist_ext_to_term/2 ebif_erts_debug_dist_ext_to_term_2 +bif erts_debug:instructions/0 # # Monitor testing bif's... diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index ff15d834ab..f47f5a9c0c 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -1558,7 +1558,7 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) ** Convert a bignum to a double float */ int -big_to_double(Eterm x, double* resp) +big_to_double(Wterm x, double* resp) { double d = 0.0; Eterm* xp = big_val(x); @@ -1725,7 +1725,7 @@ static Eterm big_norm(Eterm *x, dsize_t xl, short sign) /* ** Compare bignums */ -int big_comp(Eterm x, Eterm y) +int big_comp(Wterm x, Wterm y) { Eterm* xp = big_val(x); Eterm* yp = big_val(y); @@ -2060,7 +2060,7 @@ static Eterm B_plus_minus(ErtsDigit *x, dsize_t xl, short xsgn, /* ** Add bignums */ -Eterm big_plus(Eterm x, Eterm y, Eterm *r) +Eterm big_plus(Wterm x, Wterm y, Eterm *r) { Eterm* xp = big_val(x); Eterm* yp = big_val(y); diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 25466cd3c2..f28a390aea 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -120,7 +120,7 @@ char *erts_big_to_string(Eterm x, char *buf, Uint buf_sz); Eterm small_times(Sint, Sint, Eterm*); -Eterm big_plus(Eterm, Eterm, Eterm*); +Eterm big_plus(Wterm, Wterm, Eterm*); Eterm big_minus(Eterm, Eterm, Eterm*); Eterm big_times(Eterm, Eterm, Eterm*); Eterm big_div(Eterm, Eterm, Eterm*); @@ -137,9 +137,9 @@ Eterm big_bxor(Eterm, Eterm, Eterm*); Eterm big_bnot(Eterm, Eterm*); Eterm big_lshift(Eterm, Sint, Eterm*); -int big_comp (Eterm, Eterm); +int big_comp (Wterm, Wterm); int big_ucomp (Eterm, Eterm); -int big_to_double(Eterm x, double* resp); +int big_to_double(Wterm x, double* resp); Eterm small_to_big(Sint, Eterm*); Eterm uint_to_big(Uint, Eterm*); Eterm uword_to_big(UWord, Eterm*); diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 4be869f269..9486602633 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -56,7 +56,7 @@ erts_init_binary(void) */ Eterm -new_binary(Process *p, byte *buf, int len) +new_binary(Process *p, byte *buf, Uint len) { ProcBin* pb; Binary* bptr; diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index fd2ec91e65..d255cf3558 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -558,7 +558,7 @@ do_break(void) #endif #ifdef DEBUG case 't': - p_slpq(); + erts_p_slpq(); return; case 'b': bin_check(); diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 8bee47232e..243e8973cf 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -72,8 +72,11 @@ copy_object(Eterm obj, Process* to) * Return the "flat" size of the object. */ -Uint -size_object(Eterm obj) +#if HALFWORD_HEAP +Uint size_object_rel(Eterm obj, Eterm* base) +#else +Uint size_object(Eterm obj) +#endif { Uint sum = 0; Eterm* ptr; @@ -84,7 +87,7 @@ size_object(Eterm obj) switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: sum += 2; - ptr = list_val(obj); + ptr = list_val_rel(obj,base); obj = *ptr++; if (!IS_CONST(obj)) { ESTACK_PUSH(s, obj); @@ -93,11 +96,11 @@ size_object(Eterm obj) break; case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val(obj); + Eterm hdr = *boxed_val_rel(obj,base); ASSERT(is_header(hdr)); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: - ptr = tuple_val(obj); + ptr = tuple_val_rel(obj,base); arity = header_arity(hdr); sum += arity + 1; if (arity == 0) { /* Empty tuple -- unusual. */ @@ -113,7 +116,7 @@ size_object(Eterm obj) break; case FUN_SUBTAG: { - Eterm* bptr = fun_val(obj); + Eterm* bptr = fun_val_rel(obj,base); ErlFunThing* funp = (ErlFunThing *) bptr; unsigned eterms = 1 /* creator */ + funp->num_free; unsigned sz = thing_arityval(hdr); @@ -136,7 +139,7 @@ size_object(Eterm obj) Uint bitoffs; Uint extra_bytes; Eterm hdr; - ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); + ERTS_GET_REAL_BIN_REL(obj, real_bin, offset, bitoffs, bitsize, base); if ((bitsize + bitoffs) > 8) { sum += ERL_SUB_BIN_SIZE; extra_bytes = 2; @@ -146,11 +149,11 @@ size_object(Eterm obj) } else { extra_bytes = 0; } - hdr = *binary_val(real_bin); + hdr = *binary_val_rel(real_bin,base); if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { sum += PROC_BIN_SIZE; } else { - sum += heap_bin_size(binary_size(obj)+extra_bytes); + sum += heap_bin_size(binary_size_rel(obj,base)+extra_bytes); } goto pop_next; } @@ -181,8 +184,12 @@ size_object(Eterm obj) /* * Copy a structure to a heap. */ -Eterm -copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +#if HALFWORD_HEAP +Eterm copy_struct_rel(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, + Eterm* src_base, Eterm* dst_base) +#else +Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +#endif { char* hstart; Uint hsize; @@ -214,7 +221,10 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) /* Copy the object onto the heap */ switch (primary_tag(obj)) { - case TAG_PRIMARY_LIST: argp = &res; goto L_copy_list; + case TAG_PRIMARY_LIST: + argp = &res; + objp = list_val_rel(obj,src_base); + goto L_copy_list; case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed; default: erl_exit(ERTS_ABORT_EXIT, @@ -231,32 +241,46 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) hp++; break; case TAG_PRIMARY_LIST: - objp = list_val(obj); + objp = list_val_rel(obj,src_base); + #if !HALFWORD_HEAP || defined(DEBUG) if (in_area(objp,hstart,hsize)) { + ASSERT(!HALFWORD_HEAP); hp++; break; } + #endif argp = hp++; /* Fall through */ L_copy_list: tailp = argp; - while (is_list(obj)) { - objp = list_val(obj); + for (;;) { tp = tailp; - elem = *objp; + elem = CAR(objp); if (IS_CONST(elem)) { - *(hbot-2) = elem; - tailp = hbot-1; hbot -= 2; + CAR(hbot) = elem; + tailp = &CDR(hbot); } else { - *htop = elem; - tailp = htop+1; + CAR(htop) = elem; + #if HALFWORD_HEAP + CDR(htop) = CDR(objp); + *tailp = make_list_rel(htop,dst_base); + htop += 2; + goto L_copy; + #else + tailp = &CDR(htop); htop += 2; + #endif + } + ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot); + *tp = make_list_rel(tailp - 1, dst_base); + obj = CDR(objp); + if (!is_list(obj)) { + break; } - *tp = make_list(tailp - 1); - obj = *(objp+1); + objp = list_val_rel(obj,src_base); } switch (primary_tag(obj)) { case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy; @@ -268,21 +292,24 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } case TAG_PRIMARY_BOXED: - if (in_area(boxed_val(obj),hstart,hsize)) { + #if !HALFWORD_HEAP || defined(DEBUG) + if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) { + ASSERT(!HALFWORD_HEAP); hp++; break; } + #endif argp = hp++; L_copy_boxed: - objp = boxed_val(obj); + objp = boxed_val_rel(obj, src_base); hdr = *objp; switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { int const_flag = 1; /* assume constant tuple */ i = arityval(hdr); - *argp = make_tuple(htop); + *argp = make_tuple_rel(htop, dst_base); tp = htop; /* tp is pointer to new arity value */ *htop++ = *objp++; /* copy arity value */ while (i--) { @@ -311,7 +338,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) while (i--) { *tp++ = *objp++; } - *argp = make_binary(hbot); + *argp = make_binary_rel(hbot, dst_base); pb = (ProcBin*) hbot; erts_refc_inc(&pb->val->refc, 2); pb->next = off_heap->first; @@ -338,7 +365,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) extra_bytes = 0; } real_size = size+extra_bytes; - objp = binary_val(real_bin); + objp = binary_val_rel(real_bin,src_base); if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) { ErlHeapBin* from = (ErlHeapBin *) objp; ErlHeapBin* to; @@ -368,7 +395,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*) to; OH_OVERHEAD(off_heap, to->size / sizeof(Eterm)); } - *argp = make_binary(hbot); + *argp = make_binary_rel(hbot, dst_base); if (extra_bytes != 0) { ErlSubBin* res; hbot -= ERL_SUB_BIN_SIZE; @@ -380,7 +407,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) res->offs = 0; res->is_writable = 0; res->orig = *argp; - *argp = make_binary(hbot); + *argp = make_binary_rel(hbot, dst_base); } break; } @@ -400,7 +427,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*) funp; erts_refc_inc(&funp->fe->refc, 2); #endif - *argp = make_fun(tp); + *argp = make_fun_rel(tp, dst_base); } break; case EXTERNAL_PID_SUBTAG: @@ -420,7 +447,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) off_heap->first = (struct erl_off_heap_header*)etp; erts_refc_inc(&etp->node->refc, 2); - *argp = make_external(tp); + *argp = make_external_rel(tp, dst_base); } break; case BIN_MATCHSTATE_SUBTAG: @@ -430,7 +457,7 @@ copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) i = thing_arityval(hdr)+1; hbot -= i; tp = hbot; - *argp = make_boxed(hbot); + *argp = make_boxed_rel(hbot, dst_base); while (i--) { *tp++ = *objp++; } @@ -885,12 +912,21 @@ Eterm copy_struct_lazy(Process *from, Eterm orig, Uint offs) * * NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr). */ -Eterm -copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +#if HALFWORD_HEAP +Eterm copy_shallow_rel(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, + Eterm* src_base) +#else +Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +#endif { Eterm* tp = ptr; Eterm* hp = *hpp; - Sint offs = hp - tp; + const Eterm res = make_tuple(hp); +#if HALFWORD_HEAP + const Sint offs = COMPRESS_POINTER(hp - (tp - src_base)); +#else + const Sint offs = (hp - tp) * sizeof(Eterm); +#endif while (sz--) { Eterm val = *tp++; @@ -901,7 +937,7 @@ copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) break; case TAG_PRIMARY_LIST: case TAG_PRIMARY_BOXED: - *hp++ = offset_ptr(val, offs); + *hp++ = byte_offset_ptr(val, offs); break; case TAG_PRIMARY_HEADER: *hp++ = val; @@ -958,7 +994,8 @@ copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } } *hpp = hp; - return make_tuple(ptr + offs); + + return res; } /* Move all terms in heap fragments into heap. The terms must be guaranteed to diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 694460d702..044fd045a6 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -864,11 +864,15 @@ erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote) #include <valgrind/valgrind.h> #include <valgrind/memcheck.h> +#ifndef HAVE_VALGRIND_PRINTF_XML +#define VALGRIND_PRINTF_XML VALGRIND_PRINTF +#endif + # define PURIFY_MSG(msg) \ do { \ char buf__[1]; size_t bufsz__ = sizeof(buf__); \ if (erts_sys_getenv("VALGRIND_LOG_XML", buf__, &bufsz__) >= 0) { \ - VALGRIND_PRINTF("<erlang_error_log>" \ + VALGRIND_PRINTF_XML("<erlang_error_log>" \ "%s, line %d: %s</erlang_error_log>\n", \ __FILE__, __LINE__, msg); \ } else { \ @@ -917,6 +921,7 @@ int erts_net_message(Port *prt, Eterm token_size; ErtsMonitor *mon; ErtsLink *lnk; + Uint tuple_arity; int res; #ifdef ERTS_DIST_MSG_DBG int orig_len = len; @@ -1003,29 +1008,23 @@ int erts_net_message(Port *prt, #endif if (is_not_tuple(arg) || - (tuple = tuple_val(arg), arityval(*tuple) < 1) || + (tuple = tuple_val(arg), (tuple_arity = arityval(*tuple)) < 1) || is_not_small(tuple[1])) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, "Invalid distribution message: %.200T", arg); - erts_send_error_to_logger_nogl(dsbufp); - goto data_error; + goto invalid_message; } token_size = 0; switch (type = unsigned_val(tuple[1])) { case DOP_LINK: + if (tuple_arity != 3) { + goto invalid_message; + } from = tuple[2]; to = tuple[3]; /* local proc to link to */ if (is_not_pid(from) || is_not_pid(to)) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - PURIFY_MSG("data error"); - erts_dsprintf(dsbufp, - "Invalid DOP_LINK distribution message: %.200T", - arg); - erts_send_error_to_logger_nogl(dsbufp); - goto data_error; + goto invalid_message; } rp = erts_pid2proc_opt(NULL, 0, @@ -1064,8 +1063,14 @@ int erts_net_message(Port *prt, case DOP_UNLINK: { ErtsDistLinkData dld; + if (tuple_arity != 3) { + goto invalid_message; + } from = tuple[2]; to = tuple[3]; + if (is_not_pid(from) || is_not_pid(to)) { + goto invalid_message; + } rp = erts_pid2proc_opt(NULL, 0, to, ERTS_PROC_LOCK_LINK, @@ -1092,11 +1097,19 @@ int erts_net_message(Port *prt, /* A remote process wants to monitor us, we get: {DOP_MONITOR_P, Remote pid, local pid or name, ref} */ Eterm name; + + if (tuple_arity != 4) { + goto invalid_message; + } watcher = tuple[2]; watched = tuple[3]; /* local proc to monitor */ ref = tuple[4]; + if (is_not_ref(ref)) { + goto invalid_message; + } + if (is_atom(watched)) { name = watched; rp = erts_whereis_process(NULL, 0, @@ -1138,10 +1151,17 @@ int erts_net_message(Port *prt, We get {DOP_DEMONITOR_P, Remote pid, Local pid or name, ref}, We need only the ref of course */ + if (tuple_arity != 4) { + goto invalid_message; + } /* watcher = tuple[2]; */ /* watched = tuple[3]; May be an atom in case of monitor name */ ref = tuple[4]; + if(is_not_ref(ref)) { + goto invalid_message; + } + erts_smp_de_links_lock(dep); mon = erts_remove_monitor(&(dep->monitors),ref); erts_smp_de_links_unlock(dep); @@ -1166,10 +1186,11 @@ int erts_net_message(Port *prt, erts_destroy_monitor(mon); break; - case DOP_NODE_LINK: /* XXX never sent ?? */ - break; - case DOP_REG_SEND_TT: + if (tuple_arity != 5) { + goto invalid_message; + } + token_size = size_object(tuple[5]); /* Fall through ... */ case DOP_REG_SEND: @@ -1180,12 +1201,19 @@ int erts_net_message(Port *prt, * There is intentionally no testing of the cookie (it is always '') * from R9B and onwards. */ + if (type != DOP_REG_SEND_TT && tuple_arity != 4) { + goto invalid_message; + } + #ifdef ERTS_DIST_MSG_DBG dist_msg_dbg(&ede, "MSG", buf, orig_len); #endif from = tuple[2]; to = tuple[4]; + if (is_not_pid(from) || is_not_atom(to)){ + goto invalid_message; + } rp = erts_whereis_process(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC); if (rp) { Uint xsize = (type == DOP_REG_SEND @@ -1217,6 +1245,10 @@ int erts_net_message(Port *prt, break; case DOP_SEND_TT: + if (tuple_arity != 4) { + goto invalid_message; + } + token_size = size_object(tuple[4]); /* Fall through ... */ case DOP_SEND: @@ -1227,8 +1259,13 @@ int erts_net_message(Port *prt, #ifdef ERTS_DIST_MSG_DBG dist_msg_dbg(&ede, "MSG", buf, orig_len); #endif - + if (type != DOP_SEND_TT && tuple_arity != 3) { + goto invalid_message; + } to = tuple[3]; + if (is_not_pid(to)) { + goto invalid_message; + } rp = erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC); if (rp) { Uint xsize = type == DOP_SEND ? 0 : ERTS_HEAP_FRAG_SIZE(token_size); @@ -1266,11 +1303,19 @@ int erts_net_message(Port *prt, Eterm sysname; ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_MSG_SEND|ERTS_PROC_LOCK_LINK; + if (tuple_arity != 5) { + goto invalid_message; + } + /* watched = tuple[2]; */ /* remote proc which died */ /* watcher = tuple[3]; */ ref = tuple[4]; reason = tuple[5]; + if(is_not_ref(ref)) { + goto invalid_message; + } + erts_smp_de_links_lock(dep); sysname = dep->sysname; mon = erts_remove_monitor(&(dep->monitors), ref); @@ -1317,24 +1362,25 @@ int erts_net_message(Port *prt, ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCKS_XSIG_SEND; /* 'from', which 'to' is linked to, died */ if (type == DOP_EXIT) { - from = tuple[2]; - to = tuple[3]; - reason = tuple[4]; - token = NIL; + if (tuple_arity != 4) { + goto invalid_message; + } + + from = tuple[2]; + to = tuple[3]; + reason = tuple[4]; + token = NIL; } else { - from = tuple[2]; - to = tuple[3]; - token = tuple[4]; - reason = tuple[5]; + if (tuple_arity != 5) { + goto invalid_message; + } + from = tuple[2]; + to = tuple[3]; + token = tuple[4]; + reason = tuple[5]; } - if (is_not_internal_pid(to)) { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - PURIFY_MSG("data error"); - erts_dsprintf(dsbufp, - "Invalid DOP_EXIT distribution message: %.200T", - arg); - erts_send_error_to_logger_nogl(dsbufp); - goto data_error; + if (is_not_pid(from) || is_not_internal_pid(to)) { + goto invalid_message; } rp = erts_pid2proc(NULL, 0, to, rp_locks); @@ -1381,15 +1427,24 @@ int erts_net_message(Port *prt, ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; /* 'from' is send an exit signal to 'to' */ if (type == DOP_EXIT2) { - from = tuple[2]; - to = tuple[3]; - reason = tuple[4]; - token = NIL; + if (tuple_arity != 4) { + goto invalid_message; + } + from = tuple[2]; + to = tuple[3]; + reason = tuple[4]; + token = NIL; } else { - from = tuple[2]; - to = tuple[3]; - token = tuple[4]; - reason = tuple[5]; + if (tuple_arity != 5) { + goto invalid_message; + } + from = tuple[2]; + to = tuple[3]; + token = tuple[4]; + reason = tuple[5]; + } + if (is_not_pid(from) || is_not_internal_pid(to)) { + goto invalid_message; } rp = erts_pid2proc_opt(NULL, 0, to, rp_locks, ERTS_P2P_FLG_SMP_INC_REFC); @@ -1408,10 +1463,14 @@ int erts_net_message(Port *prt, break; } case DOP_GROUP_LEADER: + if (tuple_arity != 3) { + goto invalid_message; + } from = tuple[2]; /* Group leader */ to = tuple[3]; /* new member */ - if (is_not_pid(from)) - break; + if (is_not_pid(from) || is_not_pid(to)) { + goto invalid_message; + } rp = erts_pid2proc(NULL, 0, to, ERTS_PROC_LOCK_MAIN); if (!rp) @@ -1420,16 +1479,8 @@ int erts_net_message(Port *prt, erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); break; - default: { - erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); - erts_dsprintf(dsbufp, - "Illegal value in distribution dispatch switch: " - "%.200T", - arg); - erts_send_error_to_logger_nogl(dsbufp); - PURIFY_MSG("data error"); - goto data_error; - } + default: + goto invalid_message; } erts_cleanup_offheap(&off_heap); @@ -1441,8 +1492,14 @@ int erts_net_message(Port *prt, UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE); ERTS_SMP_CHK_NO_PROC_LOCKS; return 0; - + invalid_message: + { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Invalid distribution message: %.200T", arg); + erts_send_error_to_logger_nogl(dsbufp); + } data_error: + PURIFY_MSG("data error"); erts_cleanup_offheap(&off_heap); #ifndef HYBRID /* FIND ME! */ if (ctl != ctl_default) { diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index 9ccc3e5ba9..695a4fc3fe 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -52,7 +52,7 @@ #define DOP_SEND 2 #define DOP_EXIT 3 #define DOP_UNLINK 4 -#define DOP_NODE_LINK 5 +/* Ancient DOP_NODE_LINK (5) was here, can be reused */ #define DOP_REG_SEND 6 #define DOP_GROUP_LEADER 7 #define DOP_EXIT2 8 @@ -69,7 +69,6 @@ /* distribution trap functions */ extern Export* dsend2_trap; extern Export* dsend3_trap; -/*extern Export* dsend_nosuspend_trap;*/ extern Export* dlink_trap; extern Export* dunlink_trap; extern Export* dmonitor_node_trap; diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 7793f60f4f..775f4435a9 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2010. All Rights Reserved. + * Copyright Ericsson AB 2002-2011. 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 @@ -1411,6 +1411,33 @@ void erts_alloc_reg_scheduler_id(Uint id) erts_tsd_set(thr_ix_key, (void *)(long) ix); } +static void +no_verify(Allctr_t *allctr) +{ + +} + +erts_alloc_verify_func_t +erts_alloc_get_verify_unused_temp_alloc(Allctr_t **allctr) +{ + if (erts_allctrs_info[ERTS_ALC_A_TEMPORARY].alloc_util + && erts_allctrs_info[ERTS_ALC_A_TEMPORARY].thr_spec) { + ErtsAllocatorThrSpec_t *tspec; + tspec = &erts_allctr_thr_spec[ERTS_ALC_A_TEMPORARY]; + if (!tspec->all_thr_safe) { + int ix = erts_alc_get_thr_ix(); + + if (ix < tspec->size) { + *allctr = tspec->allctr[ix]; + return erts_alcu_verify_unused; + } + } + } + + *allctr = NULL; + return no_verify; +} + __decl_noreturn void erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) { @@ -1568,7 +1595,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) Eterm atoms[sizeof(size)/sizeof(Uint)]; Uint *uintps[sizeof(size)/sizeof(Uint)]; Eterm euints[sizeof(size)/sizeof(Uint)]; - int need_atom; int want_tot_or_sys; int length; Eterm res = THE_NON_VALUE; @@ -1756,7 +1782,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) /* Calculate values needed... */ want_tot_or_sys = want.total || want.system; - need_atom = ERTS_MEM_NEED_ALL_ALCU || want.atom; if (ERTS_MEM_NEED_ALL_ALCU) { size.total = 0; diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 3e96c76dbf..ce792d4d17 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2010. All Rights Reserved. + * Copyright Ericsson AB 2002-2011. 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 @@ -172,9 +172,17 @@ void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size); void erts_free(ErtsAlcType_t type, void *ptr); void *erts_alloc_fnf(ErtsAlcType_t type, Uint size); void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size); +void *erts_alloc_permanent_cache_aligned(ErtsAlcType_t type, Uint size); + #endif /* #if !ERTS_ALC_DO_INLINE */ +#ifndef ERTS_CACHE_LINE_SIZE +/* Assume a cache line size of 64 bytes */ +# define ERTS_CACHE_LINE_SIZE ((UWord) 64) +# define ERTS_CACHE_LINE_MASK (ERTS_CACHE_LINE_SIZE - 1) +#endif + #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) ERTS_ALC_INLINE @@ -234,13 +242,25 @@ void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size) size); } +ERTS_ALC_INLINE +void *erts_alloc_permanent_cache_aligned(ErtsAlcType_t type, Uint size) +{ + UWord v = (UWord) erts_alloc(type, size + (ERTS_CACHE_LINE_SIZE-1)); + + if (v & ERTS_CACHE_LINE_MASK) { + v = (v & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE; + } + ASSERT((v & ERTS_CACHE_LINE_MASK) == 0); + return (void*)v; +} + #endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */ -#ifndef ERTS_CACHE_LINE_SIZE -/* Assume a cache line size of 64 bytes */ -# define ERTS_CACHE_LINE_SIZE ((UWord) 64) -# define ERTS_CACHE_LINE_MASK (ERTS_CACHE_LINE_SIZE - 1) -#endif +typedef void (*erts_alloc_verify_func_t)(Allctr_t *); + +erts_alloc_verify_func_t +erts_alloc_get_verify_unused_temp_alloc(Allctr_t **allctr); + #define ERTS_ALC_CACHE_LINE_ALIGN_SIZE(SZ) \ (((((SZ) - 1) / ERTS_CACHE_LINE_SIZE) + 1) * ERTS_CACHE_LINE_SIZE) diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 408ffd12f7..ca71798917 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2010. All Rights Reserved. +# Copyright Ericsson AB 2003-2011. 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 @@ -193,6 +193,7 @@ type DB_FIXATION SHORT_LIVED ETS db_fixation type DB_FIX_DEL SHORT_LIVED ETS fixed_del type DB_TABLES LONG_LIVED ETS db_tabs type DB_NTAB_ENT STANDARD ETS db_named_table_entry +type DB_HEIR_DATA STANDARD ETS db_heir_data type DB_TMP TEMPORARY ETS db_tmp type DB_MC_STK TEMPORARY ETS db_mc_stack type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc @@ -263,6 +264,8 @@ type XPORTS_LIST SHORT_LIVED SYSTEM extra_port_list type PROC_LCK_WTR LONG_LIVED SYSTEM proc_lock_waiter type PROC_LCK_QS LONG_LIVED SYSTEM proc_lock_queues type RUNQ_BLNS LONG_LIVED SYSTEM run_queue_balancing +type MISC_AUX_WORK_Q LONG_LIVED SYSTEM misc_aux_work_q +type MISC_AUX_WORK SHORT_LIVED SYSTEM misc_aux_work +endif # diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 8b184899c9..1394b7e829 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2010. All Rights Reserved. + * Copyright Ericsson AB 2002-2011. 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 @@ -3368,6 +3368,38 @@ erts_alcu_test(unsigned long op, unsigned long a1, unsigned long a2) * Debug functions * \* */ +void +erts_alcu_verify_unused(Allctr_t *allctr) +{ + UWord no; + + no = allctr->sbcs.curr_mseg.no; + no += allctr->sbcs.curr_sys_alloc.no; + no += allctr->mbcs.blocks.curr.no; + + if (no) { + UWord sz = allctr->sbcs.blocks.curr.size; + sz += allctr->mbcs.blocks.curr.size; + erl_exit(ERTS_ABORT_EXIT, + "%salloc() used when expected to be unused!\n" + "Total amount of blocks allocated: %bpu\n" + "Total amount of bytes allocated: %bpu\n", + allctr->name_prefix, no, sz); + } +} + +void +erts_alcu_verify_unused_ts(Allctr_t *allctr) +{ +#ifdef USE_THREADS + erts_mtx_lock(&allctr->mutex); +#endif + erts_alcu_verify_unused(allctr); +#ifdef USE_THREADS + erts_mtx_unlock(&allctr->mutex); +#endif +} + #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG static void diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index f2b951bca6..d296081714 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2010. All Rights Reserved. + * Copyright Ericsson AB 2002-2011. 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 @@ -333,6 +333,9 @@ struct Allctr_t_ { int erts_alcu_start(Allctr_t *, AllctrInit_t *); void erts_alcu_stop(Allctr_t *); +void erts_alcu_verify_unused(Allctr_t *); +void erts_alcu_verify_unused_ts(Allctr_t *allctr); + unsigned long erts_alcu_test(unsigned long, unsigned long, unsigned long); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 4a717d7271..71206c48b2 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2010. All Rights Reserved. + * Copyright Ericsson AB 1999-2011. 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 @@ -1545,7 +1545,7 @@ process_info_aux(Process *BIF_P, case am_backtrace: { erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); erts_stack_dump(ERTS_PRINT_DSBUF, (void *) dsbufp, rp); - res = new_binary(BIF_P, (byte *) dsbufp->str, (int) dsbufp->str_len); + res = new_binary(BIF_P, (byte *) dsbufp->str, dsbufp->str_len); erts_destroy_tmp_dsbuf(dsbufp); hp = HAlloc(BIF_P, 3); break; @@ -1723,8 +1723,14 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ } else if (is_list(*tp)) { #if defined(PURIFY) #define ERTS_ERROR_CHECKER_PRINTF purify_printf +#define ERTS_ERROR_CHECKER_PRINTF_XML purify_printf #elif defined(VALGRIND) #define ERTS_ERROR_CHECKER_PRINTF VALGRIND_PRINTF +# ifndef HAVE_VALGRIND_PRINTF_XML +# define ERTS_ERROR_CHECKER_PRINTF_XML VALGRIND_PRINTF +# else +# define ERTS_ERROR_CHECKER_PRINTF_XML VALGRIND_PRINTF_XML +# endif #endif int buf_size = 8*1024; /* Try with 8KB first */ char *buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); @@ -1741,8 +1747,8 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ } buf[buf_size - 1 - r] = '\0'; if (check_if_xml()) { - ERTS_ERROR_CHECKER_PRINTF("<erlang_info_log>" - "%s</erlang_info_log>\n", buf); + ERTS_ERROR_CHECKER_PRINTF_XML("<erlang_info_log>" + "%s</erlang_info_log>\n", buf); } else { ERTS_ERROR_CHECKER_PRINTF("%s\n", buf); } @@ -2074,7 +2080,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); ASSERT(dsbufp && dsbufp->str); - res = new_binary(BIF_P, (byte *) dsbufp->str, (int) dsbufp->str_len); + res = new_binary(BIF_P, (byte *) dsbufp->str, dsbufp->str_len); erts_destroy_info_dsbuf(dsbufp); BIF_RET(res); } else if (ERTS_IS_ATOM_STR("dist_ctrl", BIF_ARG_1)) { diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c index ce13469801..47c48e74d6 100644 --- a/erts/emulator/beam/erl_bif_lists.c +++ b/erts/emulator/beam/erl_bif_lists.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2010. All Rights Reserved. + * Copyright Ericsson AB 1999-2011. 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 @@ -378,7 +378,7 @@ keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List) Eterm *tuple_ptr = tuple_val(term); if (pos <= arityval(*tuple_ptr)) { Eterm element = tuple_ptr[pos]; - if (cmp(Key, element) == 0) { + if (CMP(Key, element) == 0) { return term; } } diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c index 4ae2f6ebf4..db771bd216 100644 --- a/erts/emulator/beam/erl_bif_timer.c +++ b/erts/emulator/beam/erl_bif_timer.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2010. All Rights Reserved. + * Copyright Ericsson AB 2005-2011. 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 @@ -478,7 +478,7 @@ setup_bif_timer(Uint32 xflags, tab_insert(btm); ASSERT(btm == tab_find(ref)); btm->tm.active = 0; /* MUST be initalized */ - erl_set_timer(&btm->tm, + erts_set_timer(&btm->tm, (ErlTimeoutProc) bif_timer_timeout, (ErlCancelProc) bif_timer_cleanup, (void *) btm, @@ -550,7 +550,7 @@ BIF_RETTYPE cancel_timer_1(BIF_ALIST_1) res = am_false; } else { - Uint left = time_left(&btm->tm); + Uint left = erts_time_left(&btm->tm); if (!(btm->flags & BTM_FLG_BYNAME)) { erts_smp_proc_lock(btm->receiver.proc.ess, ERTS_PROC_LOCK_MSGQ); unlink_proc(btm); @@ -558,7 +558,7 @@ BIF_RETTYPE cancel_timer_1(BIF_ALIST_1) } tab_remove(btm); ASSERT(!tab_find(BIF_ARG_1)); - erl_cancel_timer(&btm->tm); + erts_cancel_timer(&btm->tm); erts_smp_btm_rwunlock(); res = erts_make_integer(left, BIF_P); } @@ -587,7 +587,7 @@ BIF_RETTYPE read_timer_1(BIF_ALIST_1) res = am_false; } else { - Uint left = time_left(&btm->tm); + Uint left = erts_time_left(&btm->tm); res = erts_make_integer(left, BIF_P); } @@ -613,7 +613,8 @@ erts_print_bif_timer_info(int to, void *to_arg) : btm->receiver.proc.ess->id); erts_print(to, to_arg, "=timer:%T\n", receiver); erts_print(to, to_arg, "Message: %T\n", btm->message); - erts_print(to, to_arg, "Time left: %d ms\n", time_left(&btm->tm)); + erts_print(to, to_arg, "Time left: %u ms\n", + erts_time_left(&btm->tm)); } } @@ -640,7 +641,7 @@ erts_cancel_bif_timers(Process *p, ErtsProcLocks plocks) tab_remove(btm); tmp_btm = btm; btm = btm->receiver.proc.next; - erl_cancel_timer(&tmp_btm->tm); + erts_cancel_timer(&tmp_btm->tm); } p->bif_timers = NULL; diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index bdf0fe23fc..506c4813fa 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2010. All Rights Reserved. + * Copyright Ericsson AB 2000-2011. 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 @@ -71,6 +71,7 @@ typedef struct erl_heap_bin { */ #define binary_size(Bin) (binary_val(Bin)[1]) +#define binary_size_rel(Bin,BasePtr) (binary_val_rel(Bin,BasePtr)[1]) #define binary_bitsize(Bin) \ ((*binary_val(Bin) == HEADER_SUB_BIN) ? \ @@ -93,9 +94,12 @@ typedef struct erl_heap_bin { * Bitsize: output variable (Uint) */ -#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \ +#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \ + ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,NULL) + +#define ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,BasePtr) \ do { \ - Eterm* _real_bin = binary_val(Bin); \ + Eterm* _real_bin = binary_val_rel(Bin,BasePtr); \ Uint _offs = 0; \ Bitoffs = Bitsize = 0; \ if (*_real_bin == HEADER_SUB_BIN) { \ @@ -103,7 +107,7 @@ do { \ _offs = _sb->offs; \ Bitoffs = _sb->bitoffs; \ Bitsize = _sb->bitsize; \ - _real_bin = binary_val(_sb->orig); \ + _real_bin = binary_val_rel(_sb->orig,BasePtr); \ } \ if (*_real_bin == HEADER_PROC_BIN) { \ Bytep = ((ProcBin *) _real_bin)->bytes + _offs; \ @@ -125,9 +129,12 @@ do { \ * BitSize: Extra bit size (Uint) */ -#define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \ +#define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \ + ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, NULL) + +#define ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, BasePtr) \ do { \ - ErlSubBin* _sb = (ErlSubBin *) binary_val(Bin); \ + ErlSubBin* _sb = (ErlSubBin *) binary_val_rel(Bin,BasePtr); \ if (_sb->thing_word == HEADER_SUB_BIN) { \ RealBin = _sb->orig; \ ByteOffset = _sb->offs; \ diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 88d2c06246..6f8a7436d5 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -555,10 +555,11 @@ fmt_int(byte *buf, Uint sz, Eterm val, Uint size, Uint flags) { unsigned long offs; - ASSERT(size != 0); offs = BIT_OFFSET(size); if (is_small(val)) { Sint v = signed_val(val); + + ASSERT(size != 0); /* Tested by caller */ if (flags & BSF_LITTLE) { /* Little endian */ sz--; COPY_VAL(buf,1,v,sz); @@ -578,6 +579,9 @@ fmt_int(byte *buf, Uint sz, Eterm val, Uint size, Uint flags) ErtsDigit* dp = big_v(val); int n = MIN(sz,ds); + if (size == 0) { + return 0; + } if (flags & BSF_LITTLE) { sz -= n; /* pad with this amount */ if (sign) { @@ -729,15 +733,13 @@ erts_new_bs_put_integer(ERL_BITS_PROTO_3(Eterm arg, Uint num_bits, unsigned flag Uint b; byte *iptr; - if (num_bits == 0) { - return 1; - } - bit_offset = BIT_OFFSET(bin_offset); if (is_small(arg)) { Uint rbits = 8 - bit_offset; - if (bit_offset + num_bits <= 8) { + if (num_bits == 0) { + return 1; + } else if (bit_offset + num_bits <= 8) { /* * All bits are in the same byte. */ diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c index 8a6b4d8d6c..bcf8bcf270 100644 --- a/erts/emulator/beam/erl_cpu_topology.c +++ b/erts/emulator/beam/erl_cpu_topology.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010. All Rights Reserved. + * Copyright Ericsson AB 2010-2011. 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 @@ -630,13 +630,13 @@ write_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size) int erts_init_scheduler_bind_type_string(char *how) { - if (erts_bind_to_cpu(cpuinfo, -1) == -ENOTSUP) + if (sys_strcmp(how, "u") == 0) + cpu_bind_order = ERTS_CPU_BIND_NONE; + else if (erts_bind_to_cpu(cpuinfo, -1) == -ENOTSUP) return ERTS_INIT_SCHED_BIND_TYPE_NOT_SUPPORTED; - - if (!system_cpudata && !user_cpudata) + else if (!system_cpudata && !user_cpudata) return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY; - - if (sys_strcmp(how, "db") == 0) + else if (sys_strcmp(how, "db") == 0) cpu_bind_order = ERTS_CPU_BIND_DEFAULT_BIND; else if (sys_strcmp(how, "s") == 0) cpu_bind_order = ERTS_CPU_BIND_SPREAD; @@ -652,11 +652,8 @@ erts_init_scheduler_bind_type_string(char *how) cpu_bind_order = ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD; else if (sys_strcmp(how, "ns") == 0) cpu_bind_order = ERTS_CPU_BIND_NO_SPREAD; - else if (sys_strcmp(how, "u") == 0) - cpu_bind_order = ERTS_CPU_BIND_NONE; else return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_BAD_TYPE; - return ERTS_INIT_SCHED_BIND_TYPE_SUCCESS; } @@ -724,6 +721,11 @@ erts_bind_schedulers(Process *c_p, Eterm how) erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx); if (erts_bind_to_cpu(cpuinfo, -1) == -ENOTSUP) { + if (cpu_bind_order == ERTS_CPU_BIND_NONE + && ERTS_IS_ATOM_STR("unbound", how)) { + res = bound_schedulers_term(ERTS_CPU_BIND_NONE); + goto done; + } ERTS_BIF_PREP_ERROR(res, c_p, EXC_NOTSUP); } else { diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 65565cf3c7..61e8a595be 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -219,47 +219,68 @@ Export ets_select_continue_exp; * Static traps */ static Export ets_delete_continue_exp; - -static ERTS_INLINE DbTable* db_ref(DbTable* tb, db_lock_kind_t kind) -{ - if (tb != NULL && kind != LCK_READ) { - erts_refc_inc(&tb->common.ref, 2); - } - return tb; -} - -static ERTS_INLINE DbTable* db_unref(DbTable* tb, db_lock_kind_t kind) + +static void +free_dbtable(DbTable* tb) { - if (kind != LCK_READ && !erts_refc_dectest(&tb->common.ref, 0)) { #ifdef HARDDEBUG if (erts_smp_atomic_read(&tb->common.memory_size) != sizeof(DbTable)) { - erts_fprintf(stderr, "ets: db_unref memory remain=%ld fix=%x\n", - erts_smp_atomic_read(&tb->common.memory_size)-sizeof(DbTable), + erts_fprintf(stderr, "ets: free_dbtable memory remain=%ld fix=%x\n", + erts_smp_atomic_read(&tb->common.memory_size)-sizeof(DbTable), tb->common.fixations); } - erts_fprintf(stderr, "ets: db_unref(%T) deleted!!!\r\n", + erts_fprintf(stderr, "ets: free_dbtable(%T) deleted!!!\r\n", tb->common.id); - erts_fprintf(stderr, "ets: db_unref: meta_pid_to_tab common.memory_size = %ld\n", + erts_fprintf(stderr, "ets: free_dbtable: meta_pid_to_tab common.memory_size = %ld\n", erts_smp_atomic_read(&meta_pid_to_tab->common.memory_size)); print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_tab); - erts_fprintf(stderr, "ets: db_unref: meta_pid_to_fixed_tab common.memory_size = %ld\n", + erts_fprintf(stderr, "ets: free_dbtable: meta_pid_to_fixed_tab common.memory_size = %ld\n", erts_smp_atomic_read(&meta_pid_to_fixed_tab->common.memory_size)); print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_fixed_tab); - #endif #ifdef ERTS_SMP erts_smp_rwmtx_destroy(&tb->common.rwlock); erts_smp_mtx_destroy(&tb->common.fixlock); #endif ASSERT(is_immed(tb->common.heir_data)); - erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); + erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); ERTS_ETS_MISC_MEM_ADD(-sizeof(DbTable)); - return NULL; - } - return tb; +} + +#ifdef ERTS_SMP +static void +chk_free_dbtable(void *vtb) +{ + DbTable * tb = (DbTable *) vtb; + ERTS_THR_MEMORY_BARRIER; + if (erts_refc_dectest(&tb->common.ref, 0) == 0) + free_dbtable(tb); +} +#endif + +static void schedule_free_dbtable(DbTable* tb) +{ + /* + * NON-SMP case: Caller is *not* allowed to access the *tb + * structure after this function has returned! + * SMP case: Caller is allowed to access the *tb structure + * until the bif has returned (we typically + * need to unlock the table lock after this + * function has returned). + */ +#ifdef ERTS_SMP + int scheds = erts_get_max_no_executing_schedulers(); + ASSERT(scheds >= 1); + ASSERT(erts_refc_read(&tb->common.ref, 0) == 0); + erts_refc_init(&tb->common.ref, scheds); + ERTS_THR_MEMORY_BARRIER; + erts_smp_schedule_misc_aux_work(0, scheds, chk_free_dbtable, tb); +#else + free_dbtable(tb); +#endif } static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock, @@ -270,8 +291,6 @@ static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock, if (use_frequent_read_lock) rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ; #endif - erts_refc_init(&tb->common.ref, 1); - erts_refc_init(&tb->common.fixref, 0); #ifdef ERTS_SMP erts_smp_rwmtx_init_opt_x(&tb->common.rwlock, &rwmtx_opt, rwname, tb->common.the_name); @@ -280,7 +299,7 @@ static ERTS_INLINE void db_init_lock(DbTable* tb, int use_frequent_read_lock, #endif } -static ERTS_INLINE void db_lock_take_over_ref(DbTable* tb, db_lock_kind_t kind) +static ERTS_INLINE void db_lock(DbTable* tb, db_lock_kind_t kind) { #ifdef ERTS_SMP ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab); @@ -308,16 +327,13 @@ static ERTS_INLINE void db_lock_take_over_ref(DbTable* tb, db_lock_kind_t kind) #endif } -static ERTS_INLINE void db_lock(DbTable* tb, db_lock_kind_t kind) -{ - (void) db_ref(tb, kind); -#ifdef ERTS_SMP - db_lock_take_over_ref(tb, kind); -#endif -} - static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind) { + /* + * In NON-SMP case tb may refer to an already deallocated + * DbTable structure. That is, ONLY the SMP case is allowed + * to follow the tb pointer! + */ #ifdef ERTS_SMP ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab); @@ -344,7 +360,6 @@ static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind) } } #endif - (void) db_unref(tb, kind); /* May delete table... */ } @@ -371,6 +386,13 @@ DbTable* db_get_table_aux(Process *p, DbTable *tb = NULL; erts_smp_rwmtx_t *mtl = NULL; + /* + * IMPORTANT: Only scheduler threads are allowed + * to access tables. Memory management + * depend on it. + */ + ASSERT(erts_get_scheduler_data()); + if (is_small(id)) { Uint slot = unsigned_val(id) & meta_main_tab_slot_mask; if (!meta_already_locked) { @@ -384,12 +406,8 @@ DbTable* db_get_table_aux(Process *p, || erts_lc_rwmtx_is_rwlocked(test_mtl)); } #endif - if (slot < db_max_tabs && IS_SLOT_ALIVE(slot)) { - /* SMP: inc to prevent race, between unlock of meta_main_tab_lock - * and the table locking outside the meta_main_tab_lock - */ - tb = db_ref(meta_main_tab[slot].u.tb, kind); - } + if (slot < db_max_tabs && IS_SLOT_ALIVE(slot)) + tb = meta_main_tab[slot].u.tb; } else if (is_atom(id)) { struct meta_name_tab_entry* bucket = meta_name_tab_bucket(id,&mtl); @@ -403,16 +421,15 @@ DbTable* db_get_table_aux(Process *p, if (bucket->pu.tb != NULL) { if (is_atom(bucket->u.name_atom)) { /* single */ - if (bucket->u.name_atom == id) { - tb = db_ref(bucket->pu.tb, kind); - } + if (bucket->u.name_atom == id) + tb = bucket->pu.tb; } else { /* multi */ Uint cnt = unsigned_val(bucket->u.mcnt); Uint i; for (i=0; i<cnt; i++) { if (bucket->pu.mvec[i].u.name_atom == id) { - tb = db_ref(bucket->pu.mvec[i].pu.tb, kind); + tb = bucket->pu.mvec[i].pu.tb; break; } } @@ -420,7 +437,7 @@ DbTable* db_get_table_aux(Process *p, } } if (tb) { - db_lock_take_over_ref(tb, kind); + db_lock(tb, kind); if (tb->common.id != id || ((tb->common.status & what) == 0 && p->id != tb->common.owner)) { db_unlock(tb, kind); @@ -594,11 +611,11 @@ done: */ static ERTS_INLINE void local_fix_table(DbTable* tb) { - erts_refc_inc(&tb->common.fixref, 1); + erts_refc_inc(&tb->common.ref, 1); } static ERTS_INLINE void local_unfix_table(DbTable* tb) { - if (erts_refc_dectest(&tb->common.fixref, 0) == 0) { + if (erts_refc_dectest(&tb->common.ref, 0) == 0) { ASSERT(IS_HASH_TABLE(tb->common.status)); db_unfix_table_hash(&(tb->hash)); } @@ -893,7 +910,8 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) Eterm upop; Eterm* tpl; Sint position; - Eterm incr, warp, oldcnt; + Eterm incr, warp; + Wterm oldcnt; if (is_not_list(iter)) { goto finalize; @@ -968,7 +986,7 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) Eterm* tpl = tuple_val(CAR(list_val(iter))); Sint position = signed_val(tpl[1]); Eterm incr = tpl[2]; - Eterm oldcnt = handle.dbterm->tpl[position]; + Wterm oldcnt = db_do_read_element(&handle,position); Eterm newcnt = db_add_counter(&htop, oldcnt, incr); if (newcnt == NIL) { @@ -981,9 +999,9 @@ BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) if (arityval(*tpl) == 4) { /* Maybe warp it */ Eterm threshold = tpl[3]; - if ((cmp(incr,make_small(0)) < 0) ? /* negative increment? */ - (cmp(newcnt,threshold) < 0) : /* if negative, check if below */ - (cmp(newcnt,threshold) > 0)) { /* else check if above threshold */ + if ((CMP(incr,make_small(0)) < 0) ? /* negative increment? */ + (CMP(newcnt,threshold) < 0) : /* if negative, check if below */ + (CMP(newcnt,threshold) > 0)) { /* else check if above threshold */ newcnt = tpl[4]; } @@ -1414,6 +1432,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.type = status & ERTS_ETS_TABLE_TYPES; /* Note, 'type' is *read only* from now on... */ #endif + erts_refc_init(&tb->common.ref, 0); db_init_lock(tb, status & (DB_FINE_LOCKED|DB_FREQ_READ), "db_tab", "db_tab_fix"); tb->common.keypos = keypos; @@ -1436,8 +1455,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) "** Too many db tables **\n"); free_heir_data(tb); tb->common.meth->db_free_table(tb); - erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); - ERTS_ETS_MISC_MEM_ADD(-sizeof(DbTable)); + free_dbtable(tb); BIF_ERROR(BIF_P, SYSTEM_LIMIT); } @@ -1471,9 +1489,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) free_slot(slot); erts_smp_rwmtx_rwunlock(mmtl); - db_lock_take_over_ref(tb,LCK_WRITE); + db_lock(tb,LCK_WRITE); free_heir_data(tb); tb->common.meth->db_free_table(tb); + schedule_free_dbtable(tb); db_unlock(tb,LCK_WRITE); BIF_ERROR(BIF_P, BADARG); } @@ -2694,7 +2713,6 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) Binary *mp; Eterm res; Uint32 dummy; - Uint sz; if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) || !is_binary(BIF_ARG_2)) { error: @@ -2719,11 +2737,10 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) BIF_TRAP3(bif_export[BIF_ets_match_spec_run_r_3], BIF_P,lst,BIF_ARG_2,ret); } - res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, 0, &dummy); + res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, NULL, 0, + ERTS_PAM_COPY_RESULT, &dummy); if (is_value(res)) { - sz = size_object(res); - hp = HAlloc(BIF_P, sz + 2); - res = copy_struct(res, sz, &hp, &MSO(BIF_P)); + hp = HAlloc(BIF_P, 2); ret = CONS(hp,res,ret); /*hp += 2;*/ } @@ -2756,17 +2773,10 @@ void init_db(void) rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ; rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED; - meta_main_tab_locks = erts_alloc(ERTS_ALC_T_DB_TABLES, - (sizeof(erts_meta_main_tab_lock_t) - * (ERTS_META_MAIN_TAB_LOCK_TAB_SIZE+1))); - - if ((((UWord) meta_main_tab_locks) & ERTS_CACHE_LINE_MASK) != 0) - meta_main_tab_locks = ((erts_meta_main_tab_lock_t *) - ((((UWord) meta_main_tab_locks) - & ~ERTS_CACHE_LINE_MASK) - + ERTS_CACHE_LINE_SIZE)); - - ASSERT((((UWord) meta_main_tab_locks) & ERTS_CACHE_LINE_MASK) == 0); + meta_main_tab_locks = + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_DB_TABLES, + sizeof(erts_meta_main_tab_lock_t) + * ERTS_META_MAIN_TAB_LOCK_TAB_SIZE); for (i = 0; i < ERTS_META_MAIN_TAB_LOCK_TAB_SIZE; i++) { erts_smp_rwmtx_init_opt_x(&meta_main_tab_locks[i].rwmtx, &rwmtx_opt, @@ -2845,8 +2855,7 @@ void init_db(void) meta_pid_to_tab->common.meth = &db_hash; meta_pid_to_tab->common.compress = 0; - erts_refc_init(&meta_pid_to_tab->common.ref, 1); - erts_refc_init(&meta_pid_to_tab->common.fixref, 0); + erts_refc_init(&meta_pid_to_tab->common.ref, 0); /* Neither rwlock or fixlock used db_init_lock(meta_pid_to_tab, "meta_pid_to_tab", "meta_pid_to_tab_FIX");*/ @@ -2878,8 +2887,7 @@ void init_db(void) meta_pid_to_fixed_tab->common.meth = &db_hash; meta_pid_to_fixed_tab->common.compress = 0; - erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 1); - erts_refc_init(&meta_pid_to_fixed_tab->common.fixref, 0); + erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 0); /* Neither rwlock or fixlock used db_init_lock(meta_pid_to_fixed_tab, "meta_pid_to_fixed_tab", "meta_pid_to_fixed_tab_FIX");*/ @@ -3037,12 +3045,10 @@ retry: to_pid, to_locks, ERTS_P2P_FLG_TRY_LOCK); if (to_proc == ERTS_PROC_LOCK_BUSY) { - db_ref(tb, LCK_NONE); /* while unlocked */ db_unlock(tb,LCK_WRITE); to_proc = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, to_pid, to_locks); db_lock(tb,LCK_WRITE); - tb = db_unref(tb, LCK_NONE); ASSERT(tb != NULL); if (tb->common.owner != p->id) { @@ -3153,13 +3159,13 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(ix); erts_smp_rwmtx_rlock(mmtl); if (!IS_SLOT_FREE(ix)) { - tb = db_ref(GET_ANY_SLOT_TAB(ix), LCK_WRITE); + tb = GET_ANY_SLOT_TAB(ix); ASSERT(tb); } erts_smp_rwmtx_runlock(mmtl); if (tb) { int do_yield; - db_lock_take_over_ref(tb, LCK_WRITE); + db_lock(tb, LCK_WRITE); /* Ownership may have changed since we looked up the table. */ if (tb->common.owner != pid) { @@ -3241,7 +3247,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(ix); erts_smp_rwmtx_rlock(mmtl); if (IS_SLOT_ALIVE(ix)) { - tb = db_ref(meta_main_tab[ix].u.tb, LCK_WRITE_REC); + tb = meta_main_tab[ix].u.tb; ASSERT(tb); } erts_smp_rwmtx_runlock(mmtl); @@ -3249,7 +3255,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) int reds; DbFixation** pp; - db_lock_take_over_ref(tb, LCK_WRITE_REC); + db_lock(tb, LCK_WRITE_REC); #ifdef ERTS_SMP erts_smp_mtx_lock(&tb->common.fixlock); #endif @@ -3260,7 +3266,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) if ((*pp)->pid == pid) { DbFixation* fix = *pp; erts_aint_t diff = -((erts_aint_t) fix->counter); - erts_refc_add(&tb->common.fixref,diff,0); + erts_refc_add(&tb->common.ref,diff,0); *pp = fix->next; erts_db_free(ERTS_ALC_T_DB_FIXATION, tb, fix, sizeof(DbFixation)); @@ -3335,7 +3341,7 @@ static void fix_table_locked(Process* p, DbTable* tb) #ifdef ERTS_SMP erts_smp_mtx_lock(&tb->common.fixlock); #endif - erts_refc_inc(&tb->common.fixref,1); + erts_refc_inc(&tb->common.ref,1); fix = tb->common.fixations; if (fix == NULL) { get_now(&(tb->common.megasec), @@ -3389,7 +3395,7 @@ static void unfix_table_locked(Process* p, DbTable* tb, for (pp = &tb->common.fixations; *pp != NULL; pp = &(*pp)->next) { if ((*pp)->pid == p->id) { DbFixation* fix = *pp; - erts_refc_dec(&tb->common.fixref,0); + erts_refc_dec(&tb->common.ref,0); --(fix->counter); ASSERT(fix->counter >= 0); if (fix->counter > 0) { @@ -3419,7 +3425,6 @@ unlocked: #ifdef ERTS_SMP if (*kind_p == LCK_READ && tb->common.is_thread_safe) { /* Must have write lock while purging pseudo-deleted (OTP-8166) */ - db_ref(tb, LCK_WRITE); /* LCK_WRITE need it, but not LCK_READ */ erts_smp_rwmtx_runlock(&tb->common.rwlock); erts_smp_rwmtx_rwlock(&tb->common.rwlock); *kind_p = LCK_WRITE; @@ -3438,6 +3443,8 @@ static void free_fixations_locked(DbTable *tb) fix = tb->common.fixations; while (fix != NULL) { + erts_aint_t diff = -((erts_aint_t) fix->counter); + erts_refc_add(&tb->common.ref,diff,0); next_fix = fix->next; db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC); db_erase_bag_exact2(meta_pid_to_fixed_tab, @@ -3475,11 +3482,24 @@ static void set_heir(Process* me, DbTable* tb, Eterm heir, UWord heir_data) if (!is_immed(heir_data)) { DeclareTmpHeap(tmp,2,me); + Eterm wrap_tpl; + int size; + DbTerm* dbterm; + Eterm* top; + ErlOffHeap tmp_offheap; UseTmpHeap(2,me); - /* Make a dummy 1-tuple around data to use db_get_term() */ - heir_data = (UWord) db_store_term(&tb->common, NULL, 0, - TUPLE1(tmp,heir_data)); + /* Make a dummy 1-tuple around data to use DbTerm */ + wrap_tpl = TUPLE1(tmp,heir_data); + size = size_object(wrap_tpl); + dbterm = erts_db_alloc(ERTS_ALC_T_DB_HEIR_DATA, (DbTable *)tb, + (sizeof(DbTerm) + sizeof(Eterm)*(size-1))); + dbterm->size = size; + top = dbterm->tpl; + tmp_offheap.first = NULL; + copy_struct(wrap_tpl, size, &top, &tmp_offheap); + dbterm->first_oh = tmp_offheap.first; + heir_data = (UWord)dbterm; UnUseTmpHeap(2,me); ASSERT(!is_immed(heir_data)); } @@ -3491,7 +3511,7 @@ static void free_heir_data(DbTable* tb) if (tb->common.heir != am_none && !is_immed(tb->common.heir_data)) { DbTerm* p = (DbTerm*) tb->common.heir_data; db_cleanup_offheap_comp(p); - erts_db_free(ERTS_ALC_T_DB_TERM, tb, (void *)p, + erts_db_free(ERTS_ALC_T_DB_HEIR_DATA, tb, (void *)p, sizeof(DbTerm) + (p->size-1)*sizeof(Eterm)); } #ifdef DEBUG @@ -3561,10 +3581,6 @@ static int free_table_cont(Process *p, mmtl = get_meta_main_tab_lock(tb->common.slot); #ifdef ERTS_SMP if (erts_smp_rwmtx_tryrwlock(mmtl) == EBUSY) { - /* - * We keep our increased refc over this op in order to - * prevent the table from disapearing. - */ erts_smp_rwmtx_rwunlock(&tb->common.rwlock); erts_smp_rwmtx_rwlock(mmtl); erts_smp_rwmtx_rwlock(&tb->common.rwlock); @@ -3579,7 +3595,7 @@ static int free_table_cont(Process *p, make_small(tb->common.slot)); db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC); } - db_unref(tb, LCK_NONE); + schedule_free_dbtable(tb); BUMP_REDS(p, 100); return 0; } diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 1e50fee554..9ef990cc4f 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. 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 @@ -258,12 +258,6 @@ static ERTS_INLINE Sint next_slot_w(DbTableHash* tb, Uint ix, } -/* - * tplp is an untagged pointer to a tuple we know is large enough - * and dth is a pointer to a DbTableHash. - */ -#define GETKEY(dth, tplp) (*((tplp) + (dth)->common.keypos)) - /* * Some special binary flags */ @@ -434,6 +428,9 @@ static ERTS_INLINE void try_shrink(DbTableHash* tb) } } +#define EQ_REL(x,y,y_base) \ + (is_same(x,NULL,y,y_base) || (is_not_both_immed((x),(y)) && eq_rel((x),NULL,(y),y_base))) + /* Is this a live object (not pseodo-deleted) with the specified key? */ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, @@ -443,7 +440,7 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); - return EQ(key,itemKey); + return EQ_REL(key, itemKey, b->dbterm.tpl); } } @@ -456,7 +453,7 @@ static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b, else { Eterm itemKey = GETKEY(tb, b->dbterm.tpl); ASSERT(!is_header(itemKey)); - return EQ(key,itemKey); + return EQ_REL(key, itemKey, b->dbterm.tpl); } } @@ -696,9 +693,7 @@ static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret) } } if (list != NULL) { - Eterm key = GETKEY(tb, list->dbterm.tpl); - - COPY_OBJECT(key, p, ret); + *ret = db_copy_key(p, tbl, &list->dbterm); RUNLOCK_HASH(lck); } else { @@ -746,7 +741,7 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) *ret = am_EOT; } else { - COPY_OBJECT(GETKEY(tb, b->dbterm.tpl), p, ret); + *ret = db_copy_key(p, tbl, &b->dbterm); RUNLOCK_HASH(lck); } return DB_ERROR_NONE; @@ -1308,8 +1303,8 @@ static int db_select_continue_hash(Process *p, } for(;;) { if (current->hvalue != INVALID_HASH && - (match_res = db_prog_match_and_copy(&tb->common, p, mp, all_objects, - ¤t->dbterm, &hp, 2), + (match_res = db_match_dbterm(&tb->common, p, mp, all_objects, + ¤t->dbterm, &hp, 2), is_value(match_res))) { match_list = CONS(hp, match_res, match_list); @@ -1473,8 +1468,8 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, for(;;) { if (current != NULL) { if (current->hvalue != INVALID_HASH) { - match_res = db_prog_match_and_copy(&tb->common, p, mpi.mp, 0, - ¤t->dbterm, &hp, 2); + match_res = db_match_dbterm(&tb->common, p, mpi.mp, 0, + ¤t->dbterm, &hp, 2); if (is_value(match_res)) { match_list = CONS(hp, match_res, match_list); ++got; @@ -1639,8 +1634,8 @@ static int db_select_count_hash(Process *p, for(;;) { if (current != NULL) { if (current->hvalue != INVALID_HASH) { - if (db_prog_match_and_copy(&tb->common, p, mpi.mp, 0, - ¤t->dbterm, NULL,0) == am_true) { + if (db_match_dbterm(&tb->common, p, mpi.mp, 0, + ¤t->dbterm, NULL,0) == am_true) { ++got; } --num_left; @@ -1788,8 +1783,8 @@ static int db_select_delete_hash(Process *p, } else { int did_erase = 0; - if (db_prog_match_and_copy(&tb->common, p, mpi.mp, 0, - &(*current)->dbterm, NULL, 0) == am_true) { + if (db_match_dbterm(&tb->common, p, mpi.mp, 0, + &(*current)->dbterm, NULL, 0) == am_true) { if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ if (slot_ix != last_pseudo_delete) { add_fixed_deletion(tb, slot_ix); @@ -1899,8 +1894,8 @@ static int db_select_delete_continue_hash(Process *p, } else { int did_erase = 0; - if (db_prog_match_and_copy(&tb->common, p, mp, 0, - &(*current)->dbterm, NULL, 0) == am_true) { + if (db_match_dbterm(&tb->common, p, mp, 0, + &(*current)->dbterm, NULL, 0) == am_true) { if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ if (slot_ix != last_pseudo_delete) { add_fixed_deletion(tb, slot_ix); @@ -1999,8 +1994,8 @@ static int db_select_count_continue_hash(Process *p, current = current->next; continue; } - if (db_prog_match_and_copy(&tb->common, p, mp, 0, ¤t->dbterm, - NULL, 0) == am_true) { + if (db_match_dbterm(&tb->common, p, mp, 0, ¤t->dbterm, + NULL, 0) == am_true) { ++got; } --num_left; @@ -2179,7 +2174,7 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern, HashValue hval = NIL; int num_heads = 0; int i; - + mpi->lists = mpi->dlists; mpi->num_lists = 0; mpi->key_given = 1; @@ -2695,6 +2690,9 @@ static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle handle->dbterm = &b->dbterm; handle->mustResize = 0; handle->new_size = b->dbterm.size; + #if HALFWORD_HEAP + handle->abs_vec = NULL; + #endif handle->lck = lck; /* KEEP hval WLOCKED, db_finalize_dbterm_hash will WUNLOCK */ return 1; diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 8108494fc5..6cdbec3213 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. 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 @@ -48,9 +48,6 @@ #include "erl_db_tree.h" - - -#define GETKEY(dtt, tplp) (*((tplp) + (dtt)->common.keypos)) #define GETKEY_WITH_POS(Keypos, Tplp) (*((Tplp) + Keypos)) #define NITEMS(tb) ((int)erts_smp_atomic_read(&(tb)->common.nitems)) @@ -282,7 +279,7 @@ struct select_delete_context { /* ** Forward declarations */ -static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key); +static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key, Eterm* key_base); static TreeDbTerm *linkout_object_tree(DbTableTree *tb, Eterm object); static int do_free_tree_cont(DbTableTree *tb, int num_left); @@ -293,15 +290,15 @@ static int delsub(TreeDbTerm **this); static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot); static TreeDbTerm *find_node(DbTableTree *tb, Eterm key); static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key); -static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key); -static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key); +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase); +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase); static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack*, Eterm key); static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack*, Eterm key); static void traverse_backwards(DbTableTree *tb, DbTreeStack*, - Eterm lastkey, + Eterm lastkey, Eterm* lk_base, int (*doit)(DbTableTree *tb, TreeDbTerm *, void *, @@ -309,7 +306,7 @@ static void traverse_backwards(DbTableTree *tb, void *context); static void traverse_forward(DbTableTree *tb, DbTreeStack*, - Eterm lastkey, + Eterm lastkey, Eterm* lk_base, int (*doit)(DbTableTree *tb, TreeDbTerm *, void *, @@ -317,8 +314,8 @@ static void traverse_forward(DbTableTree *tb, void *context); static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, Eterm *partly_bound_key); -static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key); -static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done); +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base); +static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done); static int analyze_pattern(DbTableTree *tb, Eterm pattern, struct mp_info *mpi); @@ -338,7 +335,6 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, int forward); -static void do_dump_tree(int to, void *to_arg, TreeDbTerm *t); static int partly_bound_can_match_lesser(Eterm partly_bound_1, Eterm partly_bound_2); @@ -492,9 +488,6 @@ static int db_first_tree(Process *p, DbTable *tbl, Eterm *ret) DbTableTree *tb = &tbl->tree; DbTreeStack* stack; TreeDbTerm *this; - Eterm e; - Eterm *hp; - Uint sz; if (( this = tb->root ) == NULL) { *ret = am_EOT; @@ -513,13 +506,7 @@ static int db_first_tree(Process *p, DbTable *tbl, Eterm *ret) stack->slot = 1; release_stack(tb,stack); } - e = GETKEY(tb, this->dbterm.tpl); - sz = size_object(e); - - hp = HAlloc(p, sz); - - *ret = copy_struct(e,sz,&hp,&MSO(p)); - + *ret = db_copy_key(p, tbl, &this->dbterm); return DB_ERROR_NONE; } @@ -528,26 +515,17 @@ static int db_next_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) DbTableTree *tb = &tbl->tree; DbTreeStack* stack; TreeDbTerm *this; - Eterm e; - Eterm *hp; - Uint sz; if (is_atom(key) && key == am_EOT) return DB_ERROR_BADKEY; stack = get_any_stack(tb); - this = find_next(tb, stack, key); + this = find_next(tb, stack, key, NULL); release_stack(tb,stack); if (this == NULL) { *ret = am_EOT; return DB_ERROR_NONE; } - e = GETKEY(tb, this->dbterm.tpl); - sz = size_object(e); - - hp = HAlloc(p, sz); - - *ret = copy_struct(e,sz,&hp,&MSO(p)); - + *ret = db_copy_key(p, tbl, &this->dbterm); return DB_ERROR_NONE; } @@ -556,9 +534,6 @@ static int db_last_tree(Process *p, DbTable *tbl, Eterm *ret) DbTableTree *tb = &tbl->tree; TreeDbTerm *this; DbTreeStack* stack; - Eterm e; - Eterm *hp; - Uint sz; if (( this = tb->root ) == NULL) { *ret = am_EOT; @@ -577,13 +552,7 @@ static int db_last_tree(Process *p, DbTable *tbl, Eterm *ret) stack->slot = NITEMS(tb); release_stack(tb,stack); } - e = GETKEY(tb, this->dbterm.tpl); - sz = size_object(e); - - hp = HAlloc(p, sz); - - *ret = copy_struct(e,sz,&hp,&MSO(p)); - + *ret = db_copy_key(p, tbl, &this->dbterm); return DB_ERROR_NONE; } @@ -592,27 +561,33 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) DbTableTree *tb = &tbl->tree; TreeDbTerm *this; DbTreeStack* stack; - Eterm e; - Eterm *hp; - Uint sz; if (is_atom(key) && key == am_EOT) return DB_ERROR_BADKEY; stack = get_any_stack(tb); - this = find_prev(tb, stack, key); + this = find_prev(tb, stack, key, NULL); release_stack(tb,stack); if (this == NULL) { *ret = am_EOT; return DB_ERROR_NONE; } - e = GETKEY(tb, this->dbterm.tpl); - sz = size_object(e); + *ret = db_copy_key(p, tbl, &this->dbterm); + return DB_ERROR_NONE; +} - hp = HAlloc(p, sz); +static ERTS_INLINE int cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base, + TreeDbTerm* obj) +{ + return cmp_rel(key, key_base, + GETKEY(tb,obj->dbterm.tpl), obj->dbterm.tpl); +} - *ret = copy_struct(e,sz,&hp,&MSO(p)); - - return DB_ERROR_NONE; +static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base, + TreeDbTerm* obj) +{ + Eterm obj_key = GETKEY(tb,obj->dbterm.tpl); + return is_same(key, key_base, obj_key, obj->dbterm.tpl) + || cmp_rel(key, key_base, obj_key, obj->dbterm.tpl) == 0; } static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) @@ -646,8 +621,8 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) (*this)->balance = 0; (*this)->left = (*this)->right = NULL; break; - } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) { - /* go left */ + } else if ((c = cmp_key(tb, key, NULL, *this)) < 0) { + /* go lefts */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -801,7 +776,7 @@ static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret) *ret = am_true; - if ((res = linkout_tree(tb, key)) != NULL) { + if ((res = linkout_tree(tb, key, NULL)) != NULL) { free_term(tb, res); } return DB_ERROR_NONE; @@ -993,15 +968,15 @@ static int db_select_continue_tree(Process *p, stack = get_any_stack(tb); if (chunk_size) { if (reverse) { - traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); + traverse_backwards(tb, stack, lastkey, NULL, &doit_select_chunk, &sc); } else { - traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); + traverse_forward(tb, stack, lastkey, NULL, &doit_select_chunk, &sc); } } else { if (reverse) { - traverse_forward(tb, stack, lastkey, &doit_select, &sc); + traverse_forward(tb, stack, lastkey, NULL, &doit_select, &sc); } else { - traverse_backwards(tb, stack, lastkey, &doit_select, &sc); + traverse_backwards(tb, stack, lastkey, NULL, &doit_select, &sc); } } release_stack(tb,stack); @@ -1026,10 +1001,9 @@ static int db_select_continue_tree(Process *p, } key = GETKEY(tb, sc.lastobj); - - sz = size_object(key); + sz = size_object_rel(key,sc.lastobj); hp = HAlloc(p, 9 + sz); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); continuation = TUPLE8 (hp, tptr[1], @@ -1050,8 +1024,8 @@ static int db_select_continue_tree(Process *p, key = GETKEY(tb, sc.lastobj); if (chunk_size) { if (end_condition != NIL && - ((!reverse && cmp_partly_bound(end_condition,key) < 0) || - (reverse && cmp_partly_bound(end_condition,key) > 0))) { + ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0) || + (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0))) { /* done anyway */ if (!sc.got) { RET_TO_BIF(am_EOT, DB_ERROR_NONE); @@ -1063,16 +1037,16 @@ static int db_select_continue_tree(Process *p, } } else { if (end_condition != NIL && - ((!reverse && cmp_partly_bound(end_condition,key) > 0) || - (reverse && cmp_partly_bound(end_condition,key) < 0))) { + ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0) || + (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0))) { /* done anyway */ RET_TO_BIF(sc.accum,DB_ERROR_NONE); } } /* Not done yet, let's trap. */ - sz = size_object(key); + sz = size_object_rel(key,sc.lastobj); hp = HAlloc(p, 9 + sz); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); continuation = TUPLE8 (hp, tptr[1], @@ -1099,6 +1073,7 @@ static int db_select_tree(Process *p, DbTable *tbl, struct select_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; + Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1140,7 +1115,7 @@ static int db_select_tree(Process *p, DbTable *tbl, sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && - cmp(mpi.least,mpi.most) == 0) { + CMP(mpi.least,mpi.most) == 0) { doit_select(tb,mpi.save_term,&sc,0 /* direction doesn't matter */); RET_TO_BIF(sc.accum,DB_ERROR_NONE); } @@ -1150,20 +1125,20 @@ static int db_select_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.most; } - - traverse_forward(tb, stack, lastkey, &doit_select, &sc); + traverse_forward(tb, stack, lastkey, lk_base, &doit_select, &sc); } else { if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - - traverse_backwards(tb, stack, lastkey, &doit_select, &sc); + traverse_backwards(tb, stack, lastkey, lk_base, &doit_select, &sc); } release_stack(tb,stack); #ifdef HARDDEBUG @@ -1176,9 +1151,9 @@ static int db_select_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb=db_make_mp_binary(p,mpi.mp,&hp); @@ -1259,7 +1234,7 @@ static int db_select_count_continue_tree(Process *p, } stack = get_any_stack(tb); - traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); + traverse_backwards(tb, stack, lastkey, NULL, &doit_select_count, &sc); release_stack(tb,stack); BUMP_REDS(p, 1000 - sc.max); @@ -1269,12 +1244,12 @@ static int db_select_count_continue_tree(Process *p, } key = GETKEY(tb, sc.lastobj); if (end_condition != NIL && - (cmp_partly_bound(end_condition,key) > 0)) { + (cmp_partly_bound(end_condition,key,sc.lastobj) > 0)) { /* done anyway */ RET_TO_BIF(make_small(sc.got),DB_ERROR_NONE); } /* Not done yet, let's trap. */ - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); if (IS_USMALL(0, sc.got)) { hp = HAlloc(p, sz + 6); egot = make_small(sc.got); @@ -1284,7 +1259,7 @@ static int db_select_count_continue_tree(Process *p, egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); continuation = TUPLE5 (hp, tptr[1], @@ -1307,6 +1282,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, struct select_count_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; + Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1347,7 +1323,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && - cmp(mpi.least,mpi.most) == 0) { + CMP(mpi.least,mpi.most) == 0) { doit_select_count(tb,mpi.save_term,&sc,0 /* dummy */); RET_TO_BIF(erts_make_integer(sc.got,p),DB_ERROR_NONE); } @@ -1356,11 +1332,12 @@ static int db_select_count_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); + traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_count, &sc); release_stack(tb,stack); BUMP_REDS(p, 1000 - sc.max); if (sc.max > 0) { @@ -1368,7 +1345,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); if (IS_USMALL(0, sc.got)) { hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); egot = make_small(sc.got); @@ -1378,7 +1355,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl, egot = uint_to_big(sc.got, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb = db_make_mp_binary(p,mpi.mp,&hp); @@ -1409,6 +1386,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, struct select_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; + Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1450,7 +1428,7 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, sc.all_objects = mpi.all_objects; if (!mpi.got_partial && mpi.some_limitation && - cmp(mpi.least,mpi.most) == 0) { + CMP(mpi.least,mpi.most) == 0) { doit_select(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */); if (sc.accum != NIL) { hp=HAlloc(p, 3); @@ -1465,20 +1443,20 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - - traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); + traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc); } else { if (mpi.some_limitation) { if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.most; } - - traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); + traverse_forward(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc); } release_stack(tb,stack); @@ -1503,9 +1481,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; mpb = db_make_mp_binary(p,mpi.mp,&hp); @@ -1528,9 +1506,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, sc.lastobj); - sz = size_object(key); + sz = size_object_rel(key, sc.lastobj); hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL); if (mpi.all_objects) (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; @@ -1606,7 +1584,7 @@ static int db_select_delete_continue_tree(Process *p, sc.keypos = tb->common.keypos; ASSERT(!erts_smp_atomic_read(&tb->is_stack_busy)); - traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); + traverse_backwards(tb, &tb->static_stack, lastkey, NULL, &doit_select_delete, &sc); BUMP_REDS(p, 1000 - sc.max); @@ -1615,11 +1593,11 @@ static int db_select_delete_continue_tree(Process *p, } key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); if (end_condition != NIL && - cmp_partly_bound(end_condition,key) > 0) { /* done anyway */ + cmp_partly_bound(end_condition,key,sc.lastterm->dbterm.tpl) > 0) { /* done anyway */ RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); } /* Not done yet, let's trap. */ - sz = size_object(key); + sz = size_object_rel(key, sc.lastterm->dbterm.tpl); if (IS_USMALL(0, sc.accum)) { hp = HAlloc(p, sz + 6); eaccsum = make_small(sc.accum); @@ -1629,7 +1607,7 @@ static int db_select_delete_continue_tree(Process *p, eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL); continuation = TUPLE5 (hp, tptr[1], @@ -1650,6 +1628,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, struct select_delete_context sc; struct mp_info mpi; Eterm lastkey = THE_NON_VALUE; + Eterm* lk_base = NULL; Eterm key; Eterm continuation; unsigned sz; @@ -1693,7 +1672,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, sc.mp = mpi.mp; if (!mpi.got_partial && mpi.some_limitation && - cmp(mpi.least,mpi.most) == 0) { + CMP(mpi.least,mpi.most) == 0) { doit_select_delete(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */); RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); @@ -1702,11 +1681,12 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, if (mpi.some_limitation) { if ((this = find_next_from_pb_key(tb, &tb->static_stack, mpi.most)) != NULL) { lastkey = GETKEY(tb, this->dbterm.tpl); + lk_base = this->dbterm.tpl; } sc.end_condition = mpi.least; } - traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); + traverse_backwards(tb, &tb->static_stack, lastkey, lk_base, &doit_select_delete, &sc); BUMP_REDS(p, 1000 - sc.max); if (sc.max > 0) { @@ -1714,7 +1694,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, } key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); - sz = size_object(key); + sz = size_object_rel(key, sc.lastterm->dbterm.tpl); if (IS_USMALL(0, sc.accum)) { hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); eaccsum = make_small(sc.accum); @@ -1724,7 +1704,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl, eaccsum = uint_to_big(sc.accum, hp); hp += BIG_UINT_HEAP_SIZE; } - key = copy_struct(key, sz, &hp, &MSO(p)); + key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL); mpb = db_make_mp_binary(p,mpi.mp,&hp); continuation = TUPLE5 @@ -1766,7 +1746,6 @@ static void db_print_tree(int to, void *to_arg, "------------------------------------------------\n"); #else erts_print(to, to_arg, "Ordered set (AVL tree), Elements: %d\n", NITEMS(tb)); - do_dump_tree(to, to_arg, tb->root); #endif } @@ -1842,7 +1821,7 @@ do_db_tree_foreach_offheap(TreeDbTerm *tdbt, } static TreeDbTerm *linkout_tree(DbTableTree *tb, - Eterm key) + Eterm key, Eterm* key_base) { TreeDbTerm **tstack[STACK_NEED]; int tpos = 0; @@ -1865,7 +1844,7 @@ static TreeDbTerm *linkout_tree(DbTableTree *tb, for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) { + } else if ((c = cmp_key(tb, key, key_base, *this)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -1929,7 +1908,7 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb, for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) { + } else if ((c = cmp_key(tb,key,NULL,*this)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -2082,15 +2061,6 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern, return DB_ERROR_NONE; } -static void do_dump_tree(int to, void *to_arg, TreeDbTerm *t) -{ - if (t != NULL) { - do_dump_tree(to, to_arg, t->left); - erts_print(to, to_arg, "%T\n", make_tuple(t->dbterm.tpl)); - do_dump_tree(to, to_arg, t->right); - } -} - static int do_free_tree_cont(DbTableTree *tb, int num_left) { TreeDbTerm *root; @@ -2324,14 +2294,15 @@ done: * Find next and previous in sort order */ -static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, + Eterm key, Eterm* key_base) { TreeDbTerm *this; TreeDbTerm *tmp; Sint c; if(( this = TOP_NODE(stack)) != NULL) { - if (!CMP_EQ(GETKEY(tb, this->dbterm.tpl),key)) { + if (!cmp_key_eq(tb,key,key_base,this)) { /* Start from the beginning */ stack->pos = stack->slot = 0; } @@ -2341,14 +2312,14 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp(GETKEY(tb, this->dbterm.tpl),key) ) < 0) { + if (( c = cmp_key(tb,key,key_base,this) ) > 0) { if (this->right == NULL) /* We are at the previos and the element does not exist */ break; else this = this->right; - } else if (c > 0) { + } else if (c < 0) { if (this->left == NULL) /* Done */ return this; else @@ -2381,14 +2352,15 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) return this; } -static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key) +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, + Eterm key, Eterm* key_base) { TreeDbTerm *this; TreeDbTerm *tmp; Sint c; if(( this = TOP_NODE(stack)) != NULL) { - if (!CMP_EQ(GETKEY(tb, this->dbterm.tpl),key)) { + if (!cmp_key_eq(tb,key,key_base,this)) { /* Start from the beginning */ stack->pos = stack->slot = 0; } @@ -2398,14 +2370,14 @@ static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key) return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp(GETKEY(tb, this->dbterm.tpl),key) ) > 0) { + if (( c = cmp_key(tb,key,key_base,this) ) < 0) { if (this->left == NULL) /* We are at the next and the element does not exist */ break; else this = this->left; - } else if (c < 0) { + } else if (c > 0) { if (this->right == NULL) /* Done */ return this; else @@ -2451,7 +2423,8 @@ static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl)) ) >= 0) { + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl), + this->dbterm.tpl) ) >= 0) { if (this->right == NULL) { do { tmp = POP_NODE(stack); @@ -2484,7 +2457,8 @@ static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack* stack, return NULL; for (;;) { PUSH_NODE(stack, this); - if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl)) ) <= 0) { + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl), + this->dbterm.tpl) ) <= 0) { if (this->left == NULL) { do { tmp = POP_NODE(stack); @@ -2514,12 +2488,11 @@ static TreeDbTerm *find_node(DbTableTree *tb, Eterm key) Sint res; DbTreeStack* stack = get_static_stack(tb); - if(!stack || EMPTY_NODE(stack) - || !CMP_EQ(GETKEY(tb, ( this = TOP_NODE(stack) )->dbterm.tpl), key)) { + if(!stack || EMPTY_NODE(stack) + || !cmp_key_eq(tb, key, NULL, (this=TOP_NODE(stack)))) { this = tb->root; - while (this != NULL && - ( res = cmp(key, GETKEY(tb, this->dbterm.tpl)) ) != 0) { + while (this != NULL && (res = cmp_key(tb,key,NULL,this)) != 0) { if (res < 0) this = this->left; else @@ -2541,8 +2514,7 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key) Sint res; this = &tb->root; - while ((*this) != NULL && - ( res = cmp(key, GETKEY(tb, (*this)->dbterm.tpl)) ) != 0) { + while ((*this) != NULL && (res = cmp_key(tb, key, NULL, *this)) != 0) { if (res < 0) this = &((*this)->left); else @@ -2565,6 +2537,9 @@ static int db_lookup_dbterm_tree(DbTable *tbl, Eterm key, DbUpdateHandle* handle handle->mustResize = 0; handle->bp = (void**) pp; handle->new_size = (*pp)->dbterm.size; +#if HALFWORD_HEAP + handle->abs_vec = NULL; +#endif return 1; } @@ -2589,7 +2564,7 @@ static void db_finalize_dbterm_tree(DbUpdateHandle* handle) */ static void traverse_backwards(DbTableTree *tb, DbTreeStack* stack, - Eterm lastkey, + Eterm lastkey, Eterm* lk_base, int (*doit)(DbTableTree *, TreeDbTerm *, void *, @@ -2608,15 +2583,16 @@ static void traverse_backwards(DbTableTree *tb, this = this->right; } this = TOP_NODE(stack); - next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), + this->dbterm.tpl); if (!((*doit)(tb, this, context, 0))) return; } else { - next = find_prev(tb, stack, lastkey); + next = find_prev(tb, stack, lastkey, lk_base); } while ((this = next) != NULL) { - next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); if (!((*doit)(tb, this, context, 0))) return; } @@ -2627,7 +2603,7 @@ static void traverse_backwards(DbTableTree *tb, */ static void traverse_forward(DbTableTree *tb, DbTreeStack* stack, - Eterm lastkey, + Eterm lastkey, Eterm* lk_base, int (*doit)(DbTableTree *, TreeDbTerm *, void *, @@ -2646,15 +2622,15 @@ static void traverse_forward(DbTableTree *tb, this = this->left; } this = TOP_NODE(stack); - next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); if (!((*doit)(tb, this, context, 1))) return; } else { - next = find_next(tb, stack, lastkey); + next = find_next(tb, stack, lastkey, lk_base); } while ((this = next) != NULL) { - next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl); if (!((*doit)(tb, this, context, 1))) return; } @@ -2680,7 +2656,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, if (( this = find_node(tb, key) ) == NULL) { return -1; } - *ret = this; + *ret = this; return 1; } else if (partly_bound != NULL && key != am_Underscore && db_is_variable(key) < 0) @@ -2691,7 +2667,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, -static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done) +static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done) { Eterm* aa; Eterm* bb; @@ -2705,44 +2681,44 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done) *done = 1; return 0; } - if (a == b) + if (is_same(a,NULL,b,b_base)) return 0; switch (a & _TAG_PRIMARY_MASK) { case TAG_PRIMARY_LIST: if (!is_list(b)) { - return cmp(a,b); + return cmp_rel(a,NULL,b,b_base); } aa = list_val(a); - bb = list_val(b); + bb = list_val_rel(b,b_base); while (1) { - if ((j = do_cmp_partly_bound(*aa++, *bb++, done)) != 0 || *done) + if ((j = do_cmp_partly_bound(*aa++, *bb++, b_base, done)) != 0 || *done) return j; if (*aa==*bb) return 0; if (is_not_list(*aa) || is_not_list(*bb)) - return do_cmp_partly_bound(*aa, *bb, done); + return do_cmp_partly_bound(*aa, *bb, b_base, done); aa = list_val(*aa); - bb = list_val(*bb); + bb = list_val_rel(*bb,b_base); } case TAG_PRIMARY_BOXED: if ((b & _TAG_PRIMARY_MASK) != TAG_PRIMARY_BOXED) { - return cmp(a,b); + return cmp_rel(a,NULL,b,b_base); } a_hdr = ((*boxed_val(a)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; - b_hdr = ((*boxed_val(b)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; + b_hdr = ((*boxed_val_rel(b,b_base)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; if (a_hdr != b_hdr) { - return cmp(a, b); + return cmp_rel(a, NULL, b, b_base); } if (a_hdr == (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) { aa = tuple_val(a); - bb = tuple_val(b); + bb = tuple_val_rel(b, b_base); /* compare the arities */ i = arityval(*aa); /* get the arity*/ if (i < arityval(*bb)) return(-1); if (i > arityval(*bb)) return(1); while (i--) { - if ((j = do_cmp_partly_bound(*++aa, *++bb, done)) != 0 + if ((j = do_cmp_partly_bound(*++aa, *++bb, b_base, done)) != 0 || *done) return j; } @@ -2750,14 +2726,14 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done) } /* Drop through */ default: - return cmp(a, b); + return cmp_rel(a, NULL, b, b_base); } } -static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key) +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base) { int done = 0; - Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, &done); + Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, bk_base, &done); #ifdef HARDDEBUG erts_fprintf(stderr,"\ncmp_partly_bound: %T", partly_bound_key); if (ret < 0) @@ -2766,7 +2742,7 @@ static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key) erts_fprintf(stderr," > "); else erts_fprintf(stderr," == "); - erts_fprintf(stderr,"%T\n",bound_key); + erts_fprintf(stderr,"%T\n",bound_key); // HALFWORD BUG: printing rterm #endif return ret; } @@ -2853,7 +2829,7 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b, if (not_eq_tags(a,b)) { *done = 1; - return (cmp(a, b) < 0) ? 1 : 0; + return (CMP(a, b) < 0) ? 1 : 0; } /* we now know that tags are the same */ @@ -2889,7 +2865,7 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b, bb = list_val(*bb); } default: - if((i = cmp(a, b)) != 0) { + if((i = CMP(a, b)) != 0) { *done = 1; } return (i < 0) ? 1 : 0; @@ -2924,7 +2900,7 @@ static int do_partly_bound_can_match_greater(Eterm a, Eterm b, if (not_eq_tags(a,b)) { *done = 1; - return (cmp(a, b) > 0) ? 1 : 0; + return (CMP(a, b) > 0) ? 1 : 0; } /* we now know that tags are the same */ @@ -2960,7 +2936,7 @@ static int do_partly_bound_can_match_greater(Eterm a, Eterm b, bb = list_val(*bb); } default: - if((i = cmp(a, b)) != 0) { + if((i = CMP(a, b)) != 0) { *done = 1; } return (i > 0) ? 1 : 0; @@ -2983,16 +2959,16 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && ((forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) < 0) || + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) < 0) || (!forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) > 0))) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) > 0))) { return 0; } - ret = db_prog_match_and_copy(&tb->common,sc->p,sc->mp,sc->all_objects, - &this->dbterm, &hp, 2); + ret = db_match_dbterm(&tb->common,sc->p,sc->mp,sc->all_objects, + &this->dbterm, &hp, 2); if (is_value(ret)) { sc->accum = CONS(hp, ret, sc->accum); } @@ -3020,12 +2996,12 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr, /* Always backwards traversing */ if (sc->end_condition != NIL && (cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) > 0)) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) > 0)) { return 0; } - ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, 0, - &this->dbterm, NULL, 0); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0, + &this->dbterm, NULL, 0); if (ret == am_true) { ++(sc->got); } @@ -3047,17 +3023,17 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && ((forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) < 0) || + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) < 0) || (!forward && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) > 0))) { + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) > 0))) { return 0; } - ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, sc->all_objects, - &this->dbterm, &hp, 2); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, sc->all_objects, + &this->dbterm, &hp, 2); if (is_value(ret)) { ++(sc->got); sc->accum = CONS(hp, ret, sc->accum); @@ -3090,14 +3066,14 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, if (sc->end_condition != NIL && cmp_partly_bound(sc->end_condition, - GETKEY_WITH_POS(sc->keypos, - this->dbterm.tpl)) > 0) + GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl), + this->dbterm.tpl) > 0) return 0; - ret = db_prog_match_and_copy(&tb->common, sc->p, sc->mp, 0, - &this->dbterm, NULL, 0); + ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0, + &this->dbterm, NULL, 0); if (ret == am_true) { key = GETKEY(sc->tb, this->dbterm.tpl); - linkout_tree(sc->tb, key); + linkout_tree(sc->tb, key, this->dbterm.tpl); sc->erase_lastterm = 1; ++sc->accum; } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 2852fb93fe..0b63ab9ba0 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. 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 @@ -57,6 +57,7 @@ DBIF_TABLE_GUARD | DBIF_TABLE_BODY | DBIF_TRACE_GUARD | DBIF_TRACE_BODY +#define HEAP_XTRA 100 /* ** Some convenience macros for stacks (DMC == db_match_compile) @@ -229,6 +230,11 @@ typedef enum { matchCall2, matchCall3, matchPushV, +#if HALFWORD_HEAP + matchPushVGuard, /* First guard-only variable reference */ +#endif + matchPushVResult, /* First variable reference in result, or (if HALFWORD) + in guard if also referenced in result */ matchPushExpr, /* Push the whole expression we're matching ('$_') */ matchPushArrayAsList, /* Only when parameter is an Array and not an erlang term (DCOMP_TRACE) */ @@ -292,11 +298,19 @@ DMC_DECLARE_STACK_TYPE(unsigned); ** Data about the heap during compilation */ +typedef struct DMCVariable { + int is_bound; + int is_in_body; +#if HALFWORD_HEAP + int first_guard_label; /* to maybe change from PushVGuard to PushVResult */ +#endif +} DMCVariable; + typedef struct DMCHeap { int size; - unsigned def[DMC_DEFAULT_SIZE]; - unsigned *data; - int used; + DMCVariable vars_def[DMC_DEFAULT_SIZE]; + DMCVariable* vars; + int vars_used; } DMCHeap; /* @@ -323,7 +337,6 @@ typedef struct dmc_context { Eterm *bodyexpr; int num_match; int current_match; - int eheap_need; Uint cflags; int is_guard; /* 1 if in guard, 0 if in body */ int special; /* 1 if the head in the match was a single expression */ @@ -346,9 +359,22 @@ typedef struct dmc_context { #define ERTS_DEFAULT_MS_HEAP_SIZE 128 +/* Runtime info about a $-variable +*/ +typedef struct MatchVariable { + Eterm term; +#ifdef DEBUG + Process* proc; + Eterm* base; +#endif +} MatchVariable; + typedef struct { Process process; - Eterm *heap; + union { + Eterm* heap; + MatchVariable* variables; /* first on "heap" */ + }u; Eterm default_heap[ERTS_DEFAULT_MS_HEAP_SIZE]; } ErtsMatchPseudoProcess; @@ -371,10 +397,10 @@ cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap) } #endif if (!keep_heap) { - if (mpsp->heap != &mpsp->default_heap[0]) { + if (mpsp->u.heap != mpsp->default_heap) { /* Have to be done *after* call to erts_cleanup_empty_process() */ - erts_free(ERTS_ALC_T_DB_MS_RUN_HEAP, (void *) mpsp->heap); - mpsp->heap = &mpsp->default_heap[0]; + erts_free(ERTS_ALC_T_DB_MS_RUN_HEAP, (void *) mpsp->u.heap); + mpsp->u.heap = mpsp->default_heap; } #ifdef DEBUG else { @@ -398,7 +424,7 @@ create_match_pseudo_process(void) mpsp = (ErtsMatchPseudoProcess *)erts_alloc(ERTS_ALC_T_DB_MS_PSDO_PROC, sizeof(ErtsMatchPseudoProcess)); erts_init_empty_process(&mpsp->process); - mpsp->heap = &mpsp->default_heap[0]; + mpsp->u.heap = mpsp->default_heap; return mpsp; } @@ -422,11 +448,11 @@ get_match_pseudo_process(Process *c_p, Uint heap_size) mpsp = match_pseudo_process; cleanup_match_pseudo_process(mpsp, 0); #endif - if (heap_size > ERTS_DEFAULT_MS_HEAP_SIZE) - mpsp->heap = (Eterm *) erts_alloc(ERTS_ALC_T_DB_MS_RUN_HEAP, - heap_size*sizeof(Uint)); + if (heap_size > ERTS_DEFAULT_MS_HEAP_SIZE*sizeof(Eterm)) { + mpsp->u.heap = (Eterm*) erts_alloc(ERTS_ALC_T_DB_MS_RUN_HEAP, heap_size); + } else { - ASSERT(mpsp->heap == &mpsp->default_heap[0]); + ASSERT(mpsp->u.heap == mpsp->default_heap); } return mpsp; } @@ -467,23 +493,6 @@ erts_match_set_release_result(Process* c_p) static erts_smp_atomic_t trace_control_word; - -Eterm -erts_ets_copy_object(Eterm obj, Process* to) -{ - Uint size = size_object(obj); - Eterm* hp = HAlloc(to, size); - Eterm res; - - res = copy_struct(obj, size, &hp, &MSO(to)); -#ifdef DEBUG - if (eq(obj, res) == 0) { - erl_exit(1, "copy not equal to source\n"); - } -#endif - return res; -} - /* This needs to be here, before the bif table... */ static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm val); @@ -869,9 +878,9 @@ static DMCRet dmc_one_term(DMCContext *context, #ifdef DMC_DEBUG static int test_disassemble_next = 0; -static void db_match_dis(Binary *prog); +void db_match_dis(Binary *prog); #define TRACE erts_fprintf(stderr,"Trace: %s:%d\n",__FILE__,__LINE__) -#define FENCE_PATTERN_SIZE 1 +#define FENCE_PATTERN_SIZE (1*sizeof(Uint)) #define FENCE_PATTERN 0xDEADBEEFUL #else #define TRACE /* Nothing */ @@ -1179,14 +1188,14 @@ done: } Eterm erts_match_set_run(Process *p, Binary *mpsp, - Eterm *args, int num_args, + Eterm *args, int num_args, + enum erts_pam_run_flags in_flags, Uint32 *return_flags) { Eterm ret; - ret = db_prog_match(p, mpsp, - NIL, args, - num_args, return_flags); + ret = db_prog_match(p, mpsp, NIL, NULL, args, num_args, + in_flags, return_flags); #if defined(HARDDEBUG) if (is_non_value(ret)) { erts_fprintf(stderr, "Failed\n"); @@ -1210,9 +1219,9 @@ static Eterm erts_match_set_run_ets(Process *p, Binary *mpsp, { Eterm ret; - ret = db_prog_match(p, mpsp, - args, NULL, - num_args, return_flags); + ret = db_prog_match(p, mpsp, args, NULL, NULL, num_args, + ERTS_PAM_CONTIGUOUS_TUPLE | ERTS_PAM_COPY_RESULT, + return_flags); #if defined(HARDDEBUG) if (is_non_value(ret)) { erts_fprintf(stderr, "Failed\n"); @@ -1280,7 +1289,6 @@ Binary *db_match_compile(Eterm *matchexpr, int structure_checked; DMCRet res; int current_try_label; - Uint max_eheap_need; Binary *bp = NULL; unsigned clause_start; @@ -1293,27 +1301,24 @@ Binary *db_match_compile(Eterm *matchexpr, context.matchexpr = matchexpr; context.guardexpr = guards; context.bodyexpr = body; - context.eheap_need = 0; context.err_info = err_info; context.cflags = flags; heap.size = DMC_DEFAULT_SIZE; - heap.data = heap.def; + heap.vars = heap.vars_def; /* ** Compile the match expression */ restart: - heap.used = 0; - max_eheap_need = 0; + heap.vars_used = 0; for (context.current_match = 0; context.current_match < num_progs; ++context.current_match) { /* This loop is long, too long */ - memset(heap.data, 0, heap.size * sizeof(*heap.data)); + memset(heap.vars, 0, heap.size * sizeof(*heap.vars)); t = context.matchexpr[context.current_match]; context.stack_used = 0; - context.eheap_need = 0; structure_checked = 0; if (context.current_match < num_progs - 1) { DMC_PUSH(text,matchTryMeElse); @@ -1485,10 +1490,6 @@ restart: if (current_try_label >= 0) { DMC_POKE(text, current_try_label, DMC_STACK_NUM(text)); } - /* So, how much eheap did this part of the match program need? */ - if (context.eheap_need > max_eheap_need) { - max_eheap_need = context.eheap_need; - } } /* for (context.current_match = 0 ...) */ @@ -1524,16 +1525,13 @@ restart: ret->saved_program_buf = NULL; ret->saved_program = NIL; ret->term_save = context.save; - ret->num_bindings = heap.used; + ret->num_bindings = heap.vars_used; ret->single_variable = context.special; sys_memcpy(ret->text, DMC_STACK_DATA(text), DMC_STACK_NUM(text) * sizeof(UWord)); - ret->heap_size = ((heap.used * sizeof(Eterm)) + - (max_eheap_need * sizeof(Eterm)) + - (context.stack_need * sizeof(Eterm *)) + - (3 * (FENCE_PATTERN_SIZE * sizeof(Eterm *)))); - ret->eheap_offset = heap.used + FENCE_PATTERN_SIZE; - ret->stack_offset = ret->eheap_offset + max_eheap_need + FENCE_PATTERN_SIZE; + ret->stack_offset = heap.vars_used*sizeof(MatchVariable) + FENCE_PATTERN_SIZE; + ret->heap_size = ret->stack_offset + context.stack_need * sizeof(Eterm*) + FENCE_PATTERN_SIZE; + #ifdef DMC_DEBUG ret->prog_end = ret->text + DMC_STACK_NUM(text); #endif @@ -1551,8 +1549,8 @@ error: /* Here is were we land when compilation failed. */ DMC_FREE(text); if (context.copy != NULL) free_message_buffer(context.copy); - if (heap.data != heap.def) - erts_free(ERTS_ALC_T_DB_MS_CMPL_HEAP, (void *) heap.data); + if (heap.vars != heap.vars_def) + erts_free(ERTS_ALC_T_DB_MS_CMPL_HEAP, (void *) heap.vars); return bp; } @@ -1597,7 +1595,7 @@ erts_match_prog_foreach_offheap(Binary *bprog, */ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) { - Eterm *hp = HAlloc(psp, arity * 2); + Eterm *hp = HAllocX(psp, arity * 2, HEAP_XTRA); Eterm ret = NIL; while (--arity >= 0) { ret = CONS(hp, arr[arity], ret); @@ -1606,15 +1604,82 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) return ret; } + +#if HALFWORD_HEAP +struct heap_checkpoint_t +{ + Process *p; + Eterm* htop; + ErlHeapFragment* mbuf; + unsigned used_size; + ErlOffHeap off_heap; +}; + +static void heap_checkpoint_init(Process* p, struct heap_checkpoint_t* hcp) +{ + hcp->p = p; + hcp->htop = HEAP_TOP(p); + hcp->mbuf = MBUF(p); + hcp->used_size = hcp->mbuf ? hcp->mbuf->used_size : 0; + hcp->off_heap = MSO(p); +} + +static void heap_checkpoint_revert(struct heap_checkpoint_t* hcp) +{ + struct erl_off_heap_header* oh = MSO(hcp->p).first; + + if (oh != hcp->off_heap.first) { + ASSERT(oh != NULL); + if (hcp->off_heap.first) { + while (oh->next != hcp->off_heap.first) { + oh = oh->next; + } + oh->next = NULL; + } + erts_cleanup_offheap(&MSO(hcp->p)); + MSO(hcp->p) = hcp->off_heap; + } + if (MBUF(hcp->p) != hcp->mbuf) { + ErlHeapFragment* hf = MBUF(hcp->p); + ASSERT(hf != NULL); + if (hcp->mbuf) { + while (hf->next != hcp->mbuf) { + hf = hf->next; + } + hf->next = NULL; + } + free_message_buffer(MBUF(hcp->p)); + MBUF(hcp->p) = hcp->mbuf; + } + if (hcp->mbuf != NULL && hcp->mbuf->used_size != hcp->used_size) { + hcp->mbuf->used_size = hcp->used_size; + } + HEAP_TOP(hcp->p) = hcp->htop; +} +#endif /* HALFWORD_HEAP */ + +static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base) +{ + if (!is_immed(term)) { + Uint sz = size_object_rel(term, base); + Eterm* top = HAllocX(p, sz, HEAP_XTRA); + return copy_struct_rel(term, sz, &top, &MSO(p), base, NULL); + } + return term; +} + + /* ** Execution of the match program, this is Pam. ** May return THE_NON_VALUE, which is a bailout. -** the para meter 'arity' is only used if 'term' is actually an array, +** the parameter 'arity' is only used if 'term' is actually an array, ** i.e. 'DCOMP_TRACE' was specified */ -Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, +Eterm db_prog_match(Process *c_p, Binary *bprog, + Eterm term, Eterm* base, Eterm *termp, int arity, + enum erts_pam_run_flags in_flags, Uint32 *return_flags) { MatchProg *prog = Binary2MatchProg(bprog); @@ -1623,7 +1688,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, Eterm t; Eterm **sp; Eterm *esp; - Eterm *hp; + MatchVariable* variables; BeamInstr *cp; UWord *pc = prog->text; Eterm *ehp; @@ -1633,19 +1698,24 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, unsigned do_catch; ErtsMatchPseudoProcess *mpsp; Process *psp; + Process* build_proc; Process *tmpp; Process *current_scheduled; ErtsSchedulerData *esdp; Eterm (*bif)(Process*, ...); int fail_label; int atomic_trace; +#if HALFWORD_HEAP + struct heap_checkpoint_t c_p_checkpoint = {}; +#endif #ifdef DMC_DEBUG Uint *heap_fence; - Uint *eheap_fence; Uint *stack_fence; Uint save_op; #endif /* DMC_DEBUG */ + ASSERT(base==NULL || HALFWORD_HEAP); + mpsp = get_match_pseudo_process(c_p, prog->heap_size); psp = &mpsp->process; @@ -1655,7 +1725,6 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, esdp = ERTS_GET_SCHEDULER_DATA_FROM_PROC(c_p); ASSERT(esdp != NULL); current_scheduled = esdp->current_process; - esdp->current_process = psp; /* SMP: psp->scheduler_data is set by get_match_pseudo_process */ atomic_trace = 0; @@ -1678,11 +1747,9 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, #ifdef DMC_DEBUG save_op = 0; - heap_fence = (Uint *) mpsp->heap + prog->eheap_offset - 1; - eheap_fence = (Uint *) mpsp->heap + prog->stack_offset - 1; - stack_fence = (Uint *) mpsp->heap + prog->heap_size - 1; + heap_fence = (Eterm*)((char*) mpsp->u.heap + prog->stack_offset) - 1; + stack_fence = (Eterm*)((char*) mpsp->u.heap + prog->heap_size) - 1; *heap_fence = FENCE_PATTERN; - *eheap_fence = FENCE_PATTERN; *stack_fence = FENCE_PATTERN; #endif /* DMC_DEBUG */ @@ -1696,36 +1763,48 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, *return_flags = 0U; + variables = mpsp->u.variables; +#if HALFWORD_HEAP + c_p_checkpoint.p = NULL; +#endif + restart: ep = &term; - esp = mpsp->heap + prog->stack_offset; + esp = (Eterm*)((char*)mpsp->u.heap + prog->stack_offset); sp = (Eterm **) esp; - hp = mpsp->heap; - ehp = mpsp->heap + prog->eheap_offset; ret = am_true; do_catch = 0; fail_label = -1; + build_proc = psp; + esdp->current_process = psp; + ASSERT_HALFWORD(!c_p_checkpoint.p); + +#ifdef DEBUG + ASSERT(variables == mpsp->u.variables); + for (i=0; i<prog->num_bindings; i++) { + variables[i].term = THE_NON_VALUE; + variables[i].proc = NULL; + variables[i].base = base; + } +#endif for (;;) { -#ifdef DMC_DEBUG + + #ifdef DMC_DEBUG if (*heap_fence != FENCE_PATTERN) { erl_exit(1, "Heap fence overwritten in db_prog_match after op " "0x%08x, overwritten with 0x%08x.", save_op, *heap_fence); } - if (*eheap_fence != FENCE_PATTERN) { - erl_exit(1, "Eheap fence overwritten in db_prog_match after op " - "0x%08x, overwritten with 0x%08x.", save_op, - *eheap_fence); - } if (*stack_fence != FENCE_PATTERN) { erl_exit(1, "Stack fence overwritten in db_prog_match after op " "0x%08x, overwritten with 0x%08x.", save_op, *stack_fence); } save_op = *pc; -#endif + #endif switch (*pc++) { case matchTryMeElse: + ASSERT(fail_label == -1); fail_label = *pc++; break; case matchArray: /* only when DCOMP_TRACE, is always first @@ -1736,13 +1815,14 @@ restart: ep = termp; break; case matchArrayBind: /* When the array size is unknown. */ + ASSERT(termp); n = *pc++; - hp[n] = dpm_array_to_list(psp, termp, arity); + variables[n].term = dpm_array_to_list(psp, termp, arity); break; case matchTuple: /* *ep is a tuple of arity n */ - if (!is_tuple(*ep)) + if (!is_tuple_rel(*ep,base)) FAIL(); - ep = tuple_val(*ep); + ep = tuple_val_rel(*ep,base); n = *pc++; if (arityval(*ep) != n) FAIL(); @@ -1750,9 +1830,9 @@ restart: break; case matchPushT: /* *ep is a tuple of arity n, push ptr to first element */ - if (!is_tuple(*ep)) + if (!is_tuple_rel(*ep,base)) FAIL(); - tp = tuple_val(*ep); + tp = tuple_val_rel(*ep,base); n = *pc++; if (arityval(*tp) != n) FAIL(); @@ -1762,12 +1842,12 @@ restart: case matchList: if (!is_list(*ep)) FAIL(); - ep = list_val(*ep); + ep = list_val_rel(*ep,base); break; case matchPushL: if (!is_list(*ep)) FAIL(); - *sp++ = list_val(*ep); + *sp++ = list_val_rel(*ep,base); ++ep; break; case matchPop: @@ -1775,41 +1855,44 @@ restart: break; case matchBind: n = *pc++; - hp[n] = *ep++; + variables[n].term = *ep++; break; case matchCmp: n = *pc++; - if (!eq(hp[n],*ep)) + if (!eq_rel(variables[n].term, base, *ep, base)) FAIL(); ++ep; break; case matchEqBin: t = (Eterm) *pc++; - if (!eq(*ep,t)) + if (!eq_rel(t,NULL,*ep,base)) FAIL(); ++ep; break; case matchEqFloat: - if (!is_float(*ep)) + if (!is_float_rel(*ep,base)) FAIL(); - if (memcmp(float_val(*ep) + 1, pc, sizeof(double))) + if (memcmp(float_val_rel(*ep,base) + 1, pc, sizeof(double))) FAIL(); pc += TermWords(2); ++ep; break; - case matchEqRef: - if (!is_ref(*ep)) + case matchEqRef: { + Eterm* epc = (Eterm*)pc; + if (!is_ref_rel(*ep,base)) FAIL(); - if (!eq(*ep, make_internal_ref((Uint *) pc))) + if (!eq_rel(make_internal_ref_rel(epc, epc), epc, *ep, base)) { FAIL(); - i = thing_arityval(*((Uint *) pc)); + } + i = thing_arityval(*epc); pc += TermWords(i+1); ++ep; break; + } case matchEqBig: - if (!is_big(*ep)) + if (!is_big_rel(*ep,base)) FAIL(); - tp = big_val(*ep); + tp = big_val_rel(*ep,base); { Eterm *epc = (Eterm *) pc; if (*tp != *epc) @@ -1825,7 +1908,8 @@ restart: ++ep; break; case matchEq: - t = (Eterm) *pc++; + t = (Eterm) *pc++; + ASSERT(is_immed(t)); if (t != *ep++) FAIL(); break; @@ -1833,25 +1917,32 @@ restart: ++ep; break; /* - * Here comes guard instructions + * Here comes guard & body instructions */ case matchPushC: /* Push constant */ - *esp++ = *pc++; + if ((in_flags & ERTS_PAM_COPY_RESULT) + && do_catch && !is_immed(*pc)) { + *esp++ = copy_object(*pc++, c_p); + } + else { + *esp++ = *pc++; + } break; case matchConsA: - ehp[1] = *--esp; - ehp[0] = esp[-1]; + ehp = HAllocX(build_proc, 2, HEAP_XTRA); + CDR(ehp) = *--esp; + CAR(ehp) = esp[-1]; esp[-1] = make_list(ehp); - ehp += 2; break; case matchConsB: - ehp[0] = *--esp; - ehp[1] = esp[-1]; + ehp = HAllocX(build_proc, 2, HEAP_XTRA); + CAR(ehp) = *--esp; + CDR(ehp) = esp[-1]; esp[-1] = make_list(ehp); - ehp += 2; break; case matchMkTuple: n = *pc++; + ehp = HAllocX(build_proc, n+1, HEAP_XTRA); t = make_tuple(ehp); *ehp++ = make_arityval(n); while (n--) { @@ -1861,7 +1952,7 @@ restart: break; case matchCall0: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(psp); + t = (*bif)(build_proc); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1872,7 +1963,7 @@ restart: break; case matchCall1: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(psp, esp[-1]); + t = (*bif)(build_proc, esp[-1]); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1883,7 +1974,7 @@ restart: break; case matchCall2: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(psp, esp[-1], esp[-2]); + t = (*bif)(build_proc, esp[-1], esp[-2]); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1895,7 +1986,7 @@ restart: break; case matchCall3: bif = (Eterm (*)(Process*, ...)) *pc++; - t = (*bif)(psp, esp[-1], esp[-2], esp[-3]); + t = (*bif)(build_proc, esp[-1], esp[-2], esp[-3]); if (is_non_value(t)) { if (do_catch) t = FAIL_TERM; @@ -1905,15 +1996,73 @@ restart: esp -= 2; esp[-1] = t; break; + + #if HALFWORD_HEAP + case matchPushVGuard: + if (!base) goto case_matchPushV; + /* Build NULL-based copy on pseudo heap for easy disposal */ + n = *pc++; + ASSERT(is_value(variables[n].term)); + ASSERT(!variables[n].proc); + variables[n].term = copy_object_rel(psp, variables[n].term, base); + *esp++ = variables[n].term; + #ifdef DEBUG + variables[n].proc = psp; + variables[n].base = NULL; + #endif + break; + #endif + case matchPushVResult: + if (!(in_flags & ERTS_PAM_COPY_RESULT)) goto case_matchPushV; + + /* Build (NULL-based) copy on callers heap */ + #if HALFWORD_HEAP + if (!do_catch && !c_p_checkpoint.p) { + heap_checkpoint_init(c_p, &c_p_checkpoint); + } + #endif + n = *pc++; + ASSERT(is_value(variables[n].term)); + ASSERT(!variables[n].proc); + variables[n].term = copy_object_rel(c_p, variables[n].term, base); + *esp++ = variables[n].term; + #ifdef DEBUG + variables[n].proc = c_p; + variables[n].base = NULL; + #endif + break; case matchPushV: - *esp++ = hp[*pc++]; + case_matchPushV: + n = *pc++; + ASSERT(is_value(variables[n].term)); + ASSERT(!variables[n].base); + *esp++ = variables[n].term; break; case matchPushExpr: - *esp++ = term; + if (in_flags & ERTS_PAM_COPY_RESULT) { + Uint sz; + Eterm* top; + sz = size_object_rel(term, base); + top = HAllocX(build_proc, sz, HEAP_XTRA); + if (in_flags & ERTS_PAM_CONTIGUOUS_TUPLE) { + ASSERT(is_tuple_rel(term,base)); + *esp++ = copy_shallow_rel(tuple_val_rel(term,base), sz, + &top, &MSO(build_proc), base); + } + else { + *esp++ = copy_struct_rel(term, sz, &top, &MSO(build_proc), + base, NULL); + } + } + else { + *esp = term; + } break; case matchPushArrayAsList: + ASSERT_HALFWORD(base == NULL); n = arity; /* Only happens when 'term' is an array */ tp = termp; + ehp = HAllocX(build_proc, n*2, HEAP_XTRA); *esp++ = make_list(ehp); while (n--) { *ehp++ = *tp++; @@ -1926,7 +2075,8 @@ restart: break; case matchPushArrayAsListU: /* This instruction is NOT efficient. */ - *esp++ = dpm_array_to_list(psp, termp, arity); + ASSERT_HALFWORD(base == NULL); + *esp++ = dpm_array_to_list(build_proc, termp, arity); break; case matchTrue: if (*--esp != am_true) @@ -2012,7 +2162,8 @@ restart: case matchProcessDump: { erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); print_process_info(ERTS_PRINT_DSBUF, (void *) dsbufp, c_p); - *esp++ = new_binary(psp, (byte *)dsbufp->str, (int)dsbufp->str_len); + *esp++ = new_binary(build_proc, (byte *)dsbufp->str, + dsbufp->str_len); erts_destroy_tmp_dsbuf(dsbufp); break; } @@ -2056,29 +2207,24 @@ restart: if (SEQ_TRACE_TOKEN(c_p) == NIL) *esp++ = NIL; else { + Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p); + Uint sender_sz = is_immed(sender) ? 0 : size_object(sender); + ehp = HAllocX(build_proc, 6 + sender_sz, HEAP_XTRA); + if (sender_sz) { + sender = copy_struct(sender, sender_sz, &ehp, &MSO(build_proc)); + } *esp++ = make_tuple(ehp); ehp[0] = make_arityval(5); ehp[1] = SEQ_TRACE_TOKEN_FLAGS(c_p); ehp[2] = SEQ_TRACE_TOKEN_LABEL(c_p); ehp[3] = SEQ_TRACE_TOKEN_SERIAL(c_p); - ehp[4] = SEQ_TRACE_TOKEN_SENDER(c_p); + ehp[4] = sender; ehp[5] = SEQ_TRACE_TOKEN_LASTCNT(c_p); ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5); ASSERT(is_immed(ehp[1])); ASSERT(is_immed(ehp[2])); ASSERT(is_immed(ehp[3])); ASSERT(is_immed(ehp[5])); - if(!is_immed(ehp[4])) { - Eterm *sender = &ehp[4]; - ehp += 6; - *sender = copy_struct(*sender, - size_object(*sender), - &ehp, - &MSO(psp)); - } - else - ehp += 6; - } break; case matchEnableTrace: @@ -2127,12 +2273,12 @@ restart: if (!(c_p->cp) || !(cp = find_function_from_pc(c_p->cp))) { *esp++ = am_undefined; } else { + ehp = HAllocX(build_proc, 4, HEAP_XTRA); *esp++ = make_tuple(ehp); ehp[0] = make_arityval(3); ehp[1] = cp[0]; ehp[2] = cp[1]; ehp[3] = make_small((Uint) cp[2]); - ehp += 4; } break; case matchSilent: @@ -2209,8 +2355,12 @@ restart: } } break; - case matchCatch: + case matchCatch: /* Match success, now build result */ do_catch = 1; + if (in_flags & ERTS_PAM_COPY_RESULT) { + build_proc = c_p; + esdp->current_process = c_p; + } break; case matchHalt: goto success; @@ -2219,9 +2369,16 @@ restart: } } fail: +#if HALFWORD_HEAP + if (c_p_checkpoint.p) { + /* Dispose garbage built by guards on caller heap */ + heap_checkpoint_revert(&c_p_checkpoint); + c_p_checkpoint.p = NULL; + } +#endif *return_flags = 0U; - if (fail_label >= 0) { /* We failed during a "TryMeElse", - lets restart, with the next match + if (fail_label >= 0) { /* We failed during a "TryMeElse", + lets restart, with the next match program */ pc = (prog->text) + fail_label; cleanup_match_pseudo_process(mpsp, 1); @@ -2235,11 +2392,6 @@ success: erl_exit(1, "Heap fence overwritten in db_prog_match after op " "0x%08x, overwritten with 0x%08x.", save_op, *heap_fence); } - if (*eheap_fence != FENCE_PATTERN) { - erl_exit(1, "Eheap fence overwritten in db_prog_match after op " - "0x%08x, overwritten with 0x%08x.", save_op, - *eheap_fence); - } if (*stack_fence != FENCE_PATTERN) { erl_exit(1, "Stack fence overwritten in db_prog_match after op " "0x%08x, overwritten with 0x%08x.", save_op, @@ -2250,6 +2402,7 @@ success: esdp->current_process = current_scheduled; END_ATOMIC_TRACE(c_p); + return ret; #undef FAIL #undef FAIL_TERM @@ -2261,7 +2414,8 @@ success: /* * Convert a match program to a "magic" binary to return up to erlang */ -Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp) { +Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp) +{ return erts_mk_magic_binary_term(hpp, &MSO(p), mp); } @@ -2327,13 +2481,13 @@ void db_free_dmc_err_info(DMCErrInfo *ei){ ** Store bignum in *hpp and increase *hpp accordingly. ** *hpp is assumed to be large enough to hold the result. */ -Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr) +Eterm db_add_counter(Eterm** hpp, Wterm counter, Eterm incr) { DeclareTmpHeapNoproc(big_tmp,2); Eterm res; Sint ires; - Eterm arg1; - Eterm arg2; + Wterm arg1; + Wterm arg2; if (is_both_small(counter,incr)) { ires = signed_val(counter) + signed_val(incr); @@ -2374,6 +2528,34 @@ Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr) } } +/* Must be called to read elements after db_lookup_dbterm. +** Will decompress if needed. +** HEALFWORD_HEAP: +** Will convert from relative to Wterm format if needed. +** (but only on top level, tuples and lists will still contain rterms) +*/ +Wterm db_do_read_element(DbUpdateHandle* handle, Sint position) +{ + Eterm elem = handle->dbterm->tpl[position]; + if (!is_header(elem)) { +#if HALFWORD_HEAP + if (!is_immed(elem) + && !handle->tb->common.compress + && !(handle->abs_vec && handle->abs_vec[position])) { + return rterm2wterm(elem, handle->dbterm->tpl); + } +#endif + return elem; + } + + ASSERT(((DbTableCommon*)handle->tb)->compress); + ASSERT(!handle->mustResize); + handle->dbterm = db_alloc_tmp_uncompressed(&handle->tb->common, + handle->dbterm); + handle->mustResize = 1; + return handle->dbterm->tpl[position]; +} + /* ** Update one element: ** handle: Initialized by db_lookup_dbterm() @@ -2390,14 +2572,17 @@ void db_do_update_element(DbUpdateHandle* handle, Eterm* oldp; Uint newval_sz; Uint oldval_sz; +#if HALFWORD_HEAP + Eterm* old_base; +#endif if (is_both_immed(newval,oldval)) { handle->dbterm->tpl[position] = newval; -#ifdef DEBUG_CLONE + #ifdef DEBUG_CLONE if (handle->dbterm->debug_clone) { handle->dbterm->debug_clone[position] = newval; } -#endif + #endif return; } if (!handle->mustResize) { @@ -2406,49 +2591,78 @@ void db_do_update_element(DbUpdateHandle* handle, handle->dbterm); handle->mustResize = 1; oldval = handle->dbterm->tpl[position]; + #if HALFWORD_HEAP + old_base = NULL; + #endif } - else if (is_boxed(newval)) { - newp = boxed_val(newval); - switch (*newp & _TAG_HEADER_MASK) { - case _TAG_HEADER_POS_BIG: - case _TAG_HEADER_NEG_BIG: - case _TAG_HEADER_FLOAT: - case _TAG_HEADER_HEAP_BIN: - newval_sz = header_arity(*newp) + 1; - if (is_boxed(oldval)) { - oldp = boxed_val(oldval); - switch (*oldp & _TAG_HEADER_MASK) { - case _TAG_HEADER_POS_BIG: - case _TAG_HEADER_NEG_BIG: - case _TAG_HEADER_FLOAT: - case _TAG_HEADER_HEAP_BIN: - oldval_sz = header_arity(*oldp) + 1; - if (oldval_sz == newval_sz) { - /* "self contained" terms of same size, do memcpy */ - sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm)); - return; + else { + #if HALFWORD_HEAP + ASSERT(!handle->abs_vec); + old_base = handle->dbterm->tpl; + #endif + if (is_boxed(newval)) { + newp = boxed_val(newval); + switch (*newp & _TAG_HEADER_MASK) { + case _TAG_HEADER_POS_BIG: + case _TAG_HEADER_NEG_BIG: + case _TAG_HEADER_FLOAT: + case _TAG_HEADER_HEAP_BIN: + newval_sz = header_arity(*newp) + 1; + if (is_boxed(oldval)) { + oldp = boxed_val_rel(oldval,old_base); + switch (*oldp & _TAG_HEADER_MASK) { + case _TAG_HEADER_POS_BIG: + case _TAG_HEADER_NEG_BIG: + case _TAG_HEADER_FLOAT: + case _TAG_HEADER_HEAP_BIN: + oldval_sz = header_arity(*oldp) + 1; + if (oldval_sz == newval_sz) { + /* "self contained" terms of same size, do memcpy */ + sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm)); + return; + } + goto both_size_set; } - goto both_size_set; } + goto new_size_set; } - goto new_size_set; } } } +#if HALFWORD_HEAP + else { + old_base = (handle->tb->common.compress + || (handle->abs_vec && handle->abs_vec[position])) ? + NULL : handle->dbterm->tpl; + } +#endif /* Not possible for simple memcpy or dbterm is already non-contiguous, */ /* need to realloc... */ newval_sz = is_immed(newval) ? 0 : size_object(newval); new_size_set: - - oldval_sz = is_immed(oldval) ? 0 : size_object(oldval); + + oldval_sz = is_immed(oldval) ? 0 : size_object_rel(oldval,old_base); both_size_set: handle->new_size = handle->new_size - oldval_sz + newval_sz; - /* write new value in old dbterm, finalize will make a flat copy */ + /* write new value in old dbterm, finalize will make a flat copy */ handle->dbterm->tpl[position] = newval; handle->mustResize = 1; + +#if HALFWORD_HEAP + if (old_base && newval_sz > 0) { + ASSERT(!handle->tb->common.compress); + if (!handle->abs_vec) { + int i = header_arity(handle->dbterm->tpl[0]); + handle->abs_vec = erts_alloc(ERTS_ALC_T_TMP, (i+1)*sizeof(char)); + sys_memset(handle->abs_vec, 0, i+1); + /* abs_vec[0] not used */ + } + handle->abs_vec[position] = 1; + } +#endif } static ERTS_INLINE byte* db_realloc_term(DbTableCommon* tb, void* old, @@ -2547,7 +2761,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest, tpl[arity + 1] = alloc_size; tmp_offheap.first = NULL; - tpl[tb->keypos] = copy_struct(key, size_object(key), &top.ep, &tmp_offheap); + tpl[tb->keypos] = copy_struct_rel(key, size_object(key), &top.ep, &tmp_offheap, NULL, tpl); dest->first_oh = tmp_offheap.first; for (i=1; i<=arity; i++) { if (i != tb->keypos) { @@ -2566,7 +2780,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest, Eterm* dbg_top = erts_alloc(ERTS_ALC_T_DB_TERM, dest->size * sizeof(Eterm)); dest->debug_clone = dbg_top; tmp_offheap.first = dest->first_oh; - copy_struct(obj, dest->size, &dbg_top, &tmp_offheap); + copy_struct_rel(obj, dest->size, &dbg_top, &tmp_offheap, NULL, dbg_top); dest->first_oh = tmp_offheap.first; ASSERT(dbg_top == dest->debug_clone + dest->size); } @@ -2613,7 +2827,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) newp->size = size; top = newp->tpl; tmp_offheap.first = NULL; - copy_struct(obj, size, &top, &tmp_offheap); + copy_struct_rel(obj, size, &top, &tmp_offheap, NULL, top); newp->first_oh = tmp_offheap.first; #ifdef DEBUG_CLONE newp->debug_clone = NULL; @@ -2652,7 +2866,7 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) top = copy_to_comp(tb, obj, newp, new_sz); ASSERT(top <= basep + new_sz); - // SVERK: realloc? + /* ToDo: Maybe realloc if ((basep+new_sz) - top) > WASTED_SPACE_LIMIT */ return basep; } @@ -2673,6 +2887,9 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset) *(handle->bp) = newp; newDbTerm = (DbTerm*) (newp + offset); newDbTerm->size = handle->new_size; +#ifdef DEBUG_CLONE + newDbTerm->debug_clone = NULL; +#endif /* make a flat copy */ @@ -2682,17 +2899,38 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset) db_free_tmp_uncompressed(handle->dbterm); } else { - Eterm* top; ErlOffHeap tmp_offheap; + Eterm* tpl = handle->dbterm->tpl; + Eterm* top = newDbTerm->tpl; + tmp_offheap.first = NULL; - top = newDbTerm->tpl; - copy_struct(make_tuple(handle->dbterm->tpl), handle->new_size, - &top, &tmp_offheap); - newDbTerm->first_oh = tmp_offheap.first; -#ifdef DEBUG_CLONE - newDbTerm->debug_clone = NULL; -#endif - ASSERT((byte*)top <= (newp + alloc_sz)); + + #if HALFWORD_HEAP + if (handle->abs_vec) { + int i, arity = header_arity(handle->dbterm->tpl[0]); + + top[0] = tpl[0]; + top += arity + 1; + for (i=1; i<=arity; i++) { + Eterm* src_base = handle->abs_vec[i] ? NULL : tpl; + + newDbTerm->tpl[i] = copy_struct_rel(tpl[i], + size_object_rel(tpl[i],src_base), + &top, &tmp_offheap, src_base, + newDbTerm->tpl); + } + newDbTerm->first_oh = tmp_offheap.first; + ASSERT((byte*)top <= (newp + alloc_sz)); + erts_free(ERTS_ALC_T_TMP, handle->abs_vec); + } + else + #endif /* HALFWORD_HEAP */ + { + copy_struct_rel(make_tuple_rel(tpl,tpl), handle->new_size, &top, + &tmp_offheap, tpl, top); + newDbTerm->first_oh = tmp_offheap.first; + ASSERT((byte*)top == (newp + alloc_sz)); + } } } @@ -2705,9 +2943,9 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, hp[0] = bp->tpl[0]; *hpp += arity + 1; - hp[tb->keypos] = copy_struct(bp->tpl[tb->keypos], - size_object(bp->tpl[tb->keypos]), - hpp, off_heap); + hp[tb->keypos] = copy_struct_rel(bp->tpl[tb->keypos], + size_object_rel(bp->tpl[tb->keypos], bp->tpl), + hpp, off_heap, bp->tpl, NULL); for (i=arity; i>0; i--) { if (i != tb->keypos) { if (is_immed(bp->tpl[i])) { @@ -2721,7 +2959,7 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, } ASSERT((*hpp - hp) <= bp->size); #ifdef DEBUG_CLONE - ASSERT(eq(make_tuple(hp),make_tuple(bp->debug_clone))); + ASSERT(eq_rel(make_tuple(hp),make_tuple(bp->debug_clone),bp->debug_clone)); #endif return make_tuple(hp); } @@ -2744,14 +2982,14 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, hp += extra; HRelease(p, endp, hp); #ifdef DEBUG_CLONE - ASSERT(eq(copy,obj->debug_clone[pos])); + ASSERT(eq_rel(copy, obj->debug_clone[pos], obj->debug_clone)); #endif return copy; } else { - Uint sz = size_object(obj->tpl[pos]); + Uint sz = size_object_rel(obj->tpl[pos], obj->tpl); *hpp = HAlloc(p, sz + extra); - return copy_struct(obj->tpl[pos], sz, hpp, &MSO(p)); + return copy_struct_rel(obj->tpl[pos], sz, hpp, &MSO(p), obj->tpl, NULL); } } @@ -2765,7 +3003,7 @@ void db_cleanup_offheap_comp(DbTerm* obj) ProcBin tmp; for (u.hdr = obj->first_oh; u.hdr; u.hdr = u.hdr->next) { - if ((UWord)u.voidp % sizeof(UWord) != 0) { /* unaligned ptr */ + if ((UWord)u.voidp % sizeof(Uint) != 0) { /* unaligned ptr */ sys_memcpy(&tmp, u.voidp, sizeof(tmp)); /* Warning, must pass (void*)-variable to memcpy. Otherwise it will cause Bus error on Sparc due to false compile time assumptions @@ -2961,7 +3199,7 @@ static DMCRet dmc_one_term(DMCContext *context, ** Ouch, big integer in match variable. */ Eterm *save_hp; - ASSERT(heap->data == heap->def); + ASSERT(heap->vars == heap->vars_def); sz = sz2 = sz3 = 0; for (j = 0; j < context->num_match; ++j) { sz += size_object(context->matchexpr[j]); @@ -2999,24 +3237,23 @@ static DMCRet dmc_one_term(DMCContext *context, may be atoms that changed */ context->matchexpr[j] = context->copy->mem[j]; } - heap->data = erts_alloc(ERTS_ALC_T_DB_MS_CMPL_HEAP, - heap->size*sizeof(unsigned)); - sys_memset(heap->data, 0, - heap->size * sizeof(unsigned)); + heap->vars = erts_alloc(ERTS_ALC_T_DB_MS_CMPL_HEAP, + heap->size*sizeof(DMCVariable)); + sys_memset(heap->vars, 0, heap->size * sizeof(DMCVariable)); DMC_CLEAR(*stack); /*DMC_PUSH(*stack,NIL);*/ DMC_CLEAR(*text); return retRestart; } - if (heap->data[n]) { /* already bound ? */ + if (heap->vars[n].is_bound) { DMC_PUSH(*text,matchCmp); DMC_PUSH(*text,n); } else { /* Not bound, bind! */ - if (n >= heap->used) - heap->used = n + 1; + if (n >= heap->vars_used) + heap->vars_used = n + 1; DMC_PUSH(*text,matchBind); DMC_PUSH(*text,n); - heap->data[n] = 1; + heap->vars[n].is_bound = 1; } } else if (c == am_Underscore) { DMC_PUSH(*text, matchSkip); @@ -3041,6 +3278,8 @@ static DMCRet dmc_one_term(DMCContext *context, DMC_PUSH(*stack, c); break; case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): + { + Eterm* ref_val = internal_ref_val(c); DMC_PUSH(*text, matchEqRef); #if HALFWORD_HEAP { @@ -3048,25 +3287,27 @@ static DMCRet dmc_one_term(DMCContext *context, UWord u; Uint t[2]; } fiddle; - ASSERT(thing_arityval(*internal_ref_val(c)) == 3); - fiddle.t[0] = *internal_ref_val(c); - fiddle.t[1] = (Uint) internal_ref_val(c)[1]; + ASSERT(thing_arityval(ref_val[0]) == 3); + fiddle.t[0] = ref_val[0]; + fiddle.t[1] = ref_val[1]; DMC_PUSH(*text, fiddle.u); - fiddle.t[0] = (Uint) internal_ref_val(c)[2]; - fiddle.t[1] = (Uint) internal_ref_val(c)[3]; + fiddle.t[0] = ref_val[2]; + fiddle.t[1] = ref_val[3]; DMC_PUSH(*text, fiddle.u); } #else - n = thing_arityval(*internal_ref_val(c)); - DMC_PUSH(*text, *internal_ref_val(c)); - for (i = 1; i <= n; ++i) { - DMC_PUSH(*text, (Uint) internal_ref_val(c)[i]); + n = thing_arityval(ref_val[0]); + for (i = 0; i <= n; ++i) { + DMC_PUSH(*text, ref_val[i]); } #endif break; + } case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): - n = thing_arityval(*big_val(c)); + { + Eterm* bval = big_val(c); + n = thing_arityval(bval[0]); DMC_PUSH(*text, matchEqBig); #if HALFWORD_HEAP { @@ -3075,13 +3316,13 @@ static DMCRet dmc_one_term(DMCContext *context, Uint t[2]; } fiddle; ASSERT(n >= 1); - fiddle.t[0] = *big_val(c); - fiddle.t[1] = big_val(c)[1]; + fiddle.t[0] = bval[0]; + fiddle.t[1] = bval[1]; DMC_PUSH(*text, fiddle.u); for (i = 2; i <= n; ++i) { - fiddle.t[0] = big_val(c)[i]; + fiddle.t[0] = bval[i]; if (++i <= n) { - fiddle.t[1] = big_val(c)[i]; + fiddle.t[1] = bval[i]; } else { fiddle.t[1] = (Uint) 0; } @@ -3089,12 +3330,12 @@ static DMCRet dmc_one_term(DMCContext *context, } } #else - DMC_PUSH(*text, *big_val(c)); - for (i = 1; i <= n; ++i) { - DMC_PUSH(*text, (Uint) big_val(c)[i]); + for (i = 0; i <= n; ++i) { + DMC_PUSH(*text, (Uint) bval[i]); } #endif break; + } case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): DMC_PUSH(*text,matchEqFloat); #if HALFWORD_HEAP @@ -3227,7 +3468,6 @@ static DMCRet dmc_list(DMCContext *context, DMC_PUSH(*text, matchConsB); } --context->stack_used; /* Two objects on stack becomes one */ - context->eheap_need += 2; return retOk; } @@ -3286,7 +3526,6 @@ static DMCRet dmc_tuple(DMCContext *context, DMC_PUSH(*text, matchMkTuple); DMC_PUSH(*text, nelems); context->stack_used -= (nelems - 1); - context->eheap_need += (nelems + 1); *constant = 0; return retOk; } @@ -3304,9 +3543,6 @@ static DMCRet dmc_whole_expression(DMCContext *context, } else { ASSERT(is_tuple(context->matchexpr [context->current_match])); - context->eheap_need += - arityval(*(tuple_val(context->matchexpr - [context->current_match]))) * 2; DMC_PUSH(*text, matchPushArrayAsList); } } else { @@ -3319,6 +3555,41 @@ static DMCRet dmc_whole_expression(DMCContext *context, return retOk; } +/* Figure out which PushV instruction to use. +*/ +static void dmc_add_pushv_variant(DMCContext *context, DMCHeap *heap, + DMC_STACK_TYPE(UWord) *text, Uint n) +{ + DMCVariable* v = &heap->vars[n]; + MatchOps instr = matchPushV; + + ASSERT(n < heap->vars_used && v->is_bound); + if (context->is_guard) { + #if HALFWORD_HEAP + if (!v->first_guard_label) { + v->first_guard_label = DMC_STACK_NUM(*text); + ASSERT(v->first_guard_label); + instr = matchPushVGuard; /* may be changed to PushVResult below */ + } + #endif + } + else { /* body */ + #if HALFWORD_HEAP + if (v->first_guard_label) { + /* Avoid double-copy, copy to result heap at first encounter in guard */ + DMC_POKE(*text, v->first_guard_label, matchPushVResult); + v->is_in_body = 1; + } + #endif + if (!v->is_in_body) { + instr = matchPushVResult; + v->is_in_body = 1; + } + } + DMC_PUSH(*text, instr); + DMC_PUSH(*text, n); +} + static DMCRet dmc_variable(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, @@ -3326,13 +3597,13 @@ static DMCRet dmc_variable(DMCContext *context, int *constant) { Uint n = db_is_variable(t); - ASSERT(n >= 0); - if (n >= heap->used) - RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant); - if (heap->data[n] == 0U) + + if (n >= heap->vars_used || !heap->vars[n].is_bound) { RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant); - DMC_PUSH(*text, matchPushV); - DMC_PUSH(*text, n); + } + + dmc_add_pushv_variant(context, heap, text, n); + ++context->stack_used; if (context->stack_used > context->stack_need) context->stack_need = context->stack_used; @@ -3351,10 +3622,9 @@ static DMCRet dmc_all_bindings(DMCContext *context, DMC_PUSH(*text, matchPushC); DMC_PUSH(*text, NIL); - for (i = heap->used - 1; i >= 0; --i) { - if (heap->data[i]) { - DMC_PUSH(*text, matchPushV); - DMC_PUSH(*text, i); + for (i = heap->vars_used - 1; i >= 0; --i) { + if (heap->vars[i].is_bound) { + dmc_add_pushv_variant(context, heap, text, i); DMC_PUSH(*text, matchConsB); heap_used += 2; } @@ -3362,7 +3632,6 @@ static DMCRet dmc_all_bindings(DMCContext *context, ++context->stack_used; if ((context->stack_used + 1) > context->stack_need) context->stack_need = (context->stack_used + 1); - context->eheap_need += heap_used; *constant = 0; return retOk; } @@ -3765,10 +4034,6 @@ static DMCRet dmc_get_seq_token(DMCContext *context, *constant = 0; DMC_PUSH(*text, matchGetSeqToken); - context->eheap_need += (6 /* A 5-tuple is built */ - + EXTERNAL_THING_HEAD_SIZE + 2 /* Sender can - be an external - pid */); if (++context->stack_used > context->stack_need) context->stack_need = context->stack_used; return retOk; @@ -4065,7 +4330,6 @@ static DMCRet dmc_caller(DMCContext *context, } *constant = 0; DMC_PUSH(*text, matchCaller); /* Creates binary */ - context->eheap_need += 4; /* A 3-tuple is built */ if (++context->stack_used > context->stack_need) context->stack_need = context->stack_used; return retOk; @@ -4663,7 +4927,8 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) } save_cp = p->cp; p->cp = NULL; - res = erts_match_set_run(p, mps, arr, n, &ret_flags); + res = erts_match_set_run(p, mps, arr, n, + ERTS_PAM_COPY_RESULT, &ret_flags); p->cp = save_cp; } else { n = 0; @@ -4676,11 +4941,10 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) if (is_non_value(res)) { res = am_false; } - sz = size_object(res); + sz = 0; if (ret_flags & MATCH_SET_EXCEPTION_TRACE) sz += 2; if (ret_flags & MATCH_SET_RETURN_TRACE) sz += 2; hp = HAlloc(p, 5 + sz); - res = copy_struct(res, sz, &hp, &MSO(p)); flg = NIL; if (ret_flags & MATCH_SET_EXCEPTION_TRACE) { flg = CONS(hp, am_exception_trace, flg); @@ -4735,28 +4999,24 @@ void db_free_tmp_uncompressed(DbTerm* obj) erts_free(ERTS_ALC_T_TMP, obj); } -Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog, +Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, int all, DbTerm* obj, Eterm** hpp, Uint extra) { Uint32 dummy; + Eterm* base; Eterm res; if (tb->compress) { obj = db_alloc_tmp_uncompressed(tb, obj); + base = NULL; } + else base = HALFWORD_HEAP ? obj->tpl : NULL; - res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), NULL, 0, &dummy); + res = db_prog_match(c_p, bprog, make_tuple_rel(obj->tpl,base), base, NULL, 0, + ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy); if (is_value(res) && hpp!=NULL) { - if (all) { - *hpp = HAlloc(c_p, obj->size + extra); - res = copy_shallow(obj->tpl, obj->size, hpp, &MSO(c_p)); - } - else { - Uint sz = size_object(res); - *hpp = HAlloc(c_p, sz + extra); - res = copy_struct(res, sz, hpp, &MSO(c_p)); - } + *hpp = HAlloc(c_p, extra); } if (tb->compress) { @@ -4767,10 +5027,11 @@ Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog, #ifdef DMC_DEBUG + /* ** Disassemble match program */ -static void db_match_dis(Binary *bp) +void db_match_dis(Binary *bp) { MatchProg *prog = Binary2MatchProg(bp); UWord *t = prog->text; @@ -4985,6 +5246,18 @@ static void db_match_dis(Binary *bp) ++t; erts_printf("PushV\t%bpu\n", n); break; + #if HALFWORD_HEAP + case matchPushVGuard: + n = (Uint) *++t; + ++t; + erts_printf("PushVGuard\t%bpu\n", n); + break; + #endif + case matchPushVResult: + n = (Uint) *++t; + ++t; + erts_printf("PushVResult\t%bpu\n", n); + break; case matchTrue: ++t; erts_printf("True\n"); @@ -5095,7 +5368,6 @@ static void db_match_dis(Binary *bp) erts_printf("}\n"); erts_printf("num_bindings: %d\n", prog->num_bindings); erts_printf("heap_size: %bpu\n", prog->heap_size); - erts_printf("eheap_offset: %bpu\n", prog->eheap_offset); erts_printf("stack_offset: %bpu\n", prog->stack_offset); erts_printf("text: 0x%08x\n", (unsigned long) prog->text); erts_printf("stack_size: %d (words)\n", prog->heap_size-prog->stack_offset); diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 10ba755e80..bb1751d309 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. 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 @@ -86,6 +86,9 @@ typedef struct { Uint new_size; int mustResize; void* lck; +#if HALFWORD_HEAP + unsigned char* abs_vec; /* [i] true if dbterm->tpl[i] is absolute Eterm */ +#endif } DbUpdateHandle; @@ -206,8 +209,7 @@ typedef struct db_fixation { */ typedef struct db_table_common { - erts_refc_t ref; - erts_refc_t fixref; /* fixation counter */ + erts_refc_t ref; /* fixation counter and delete counter */ #ifdef ERTS_SMP erts_smp_rwmtx_t rwlock; /* rw lock on table */ erts_smp_mtx_t fixlock; /* Protects fixations,megasec,sec,microsec */ @@ -253,10 +255,17 @@ typedef struct db_table_common { (DB_BAG | DB_SET | DB_DUPLICATE_BAG))) #define IS_TREE_TABLE(Status) (!!((Status) & \ DB_ORDERED_SET)) -#define NFIXED(T) (erts_refc_read(&(T)->common.fixref,0)) +#define NFIXED(T) (erts_refc_read(&(T)->common.ref,0)) #define IS_FIXED(T) (NFIXED(T) != 0) -Eterm erts_ets_copy_object(Eterm, Process*); +/* + * tplp is an untagged pointer to a tuple we know is large enough + * and dth is a pointer to a DbTableHash. + */ +#define GETKEY(dth, tplp) (*((tplp) + ((DbTableCommon*)(dth))->keypos)) + + +ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj); Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ErlOffHeap* off_heap); int db_eq_comp(DbTableCommon* tb, Eterm a, DbTerm* b); @@ -265,9 +274,23 @@ DbTerm* db_alloc_tmp_uncompressed(DbTableCommon* tb, DbTerm* org); ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ErlOffHeap* off_heap); ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b); -ERTS_GLB_INLINE Eterm db_do_read_element(DbUpdateHandle* handle, Sint position); +Wterm db_do_read_element(DbUpdateHandle* handle, Sint position); #if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj) +{ + Eterm key = GETKEY(tb, obj->tpl); + if IS_CONST(key) return key; + else { + Uint size = size_object_rel(key, obj->tpl); + Eterm* hp = HAlloc(p, size); + Eterm res = copy_struct_rel(key, size, &hp, &MSO(p), obj->tpl, NULL); + ASSERT(eq_rel(res,NULL,key,obj->tpl)); + return res; + } +} + ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, Eterm** hpp, ErlOffHeap* off_heap) { @@ -275,49 +298,27 @@ ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp, return db_copy_from_comp(tb, bp, hpp, off_heap); } else { - return copy_shallow(bp->tpl, bp->size, hpp, off_heap); + return copy_shallow_rel(bp->tpl, bp->size, hpp, off_heap, bp->tpl); } } ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b) { if (!tb->compress) { - return eq(a, make_tuple(b->tpl)); + return eq_rel(a, NULL, make_tuple_rel(b->tpl,b->tpl), b->tpl); } else { return db_eq_comp(tb, a, b); } } -/* Must be called to read elements after db_lookup_dbterm. -** Will decompress if needed. */ -ERTS_GLB_INLINE Eterm db_do_read_element(DbUpdateHandle* handle, Sint position) -{ - Eterm elem = handle->dbterm->tpl[position]; - if (!is_header(elem)) { - return elem; - } - ASSERT(((DbTableCommon*)handle->tb)->compress); - ASSERT(!handle->mustResize); - handle->dbterm = db_alloc_tmp_uncompressed((DbTableCommon*)handle->tb, handle->dbterm); - handle->mustResize = 1; - return handle->dbterm->tpl[position]; -} - #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ -/* optimised version of copy_object (normal case? atomic object) */ -#define COPY_OBJECT(obj, p, objp) \ - if (IS_CONST(obj)) { *(objp) = (obj); } \ - else { *objp = erts_ets_copy_object(obj, p); } #define DB_READ (DB_PROTECTED|DB_PUBLIC) #define DB_WRITE DB_PUBLIC #define DB_INFO (DB_PROTECTED|DB_PUBLIC|DB_PRIVATE) -/* tb is an DbTableCommon and obj is an Eterm (tagged) */ -#define TERM_GETKEY(tb, obj) db_getkey((tb)->common.keypos, (obj)) - #define ONLY_WRITER(P,T) (((T)->common.status & (DB_PRIVATE|DB_PROTECTED)) \ && (T)->common.owner == (P)->id) @@ -338,12 +339,11 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p, DbTerm* obj, Uint pos, Eterm** hpp, Uint extra); int db_has_variable(Eterm obj); int db_is_variable(Eterm obj); -Eterm db_do_read_element(DbUpdateHandle* handle, Sint position); void db_do_update_element(DbUpdateHandle* handle, Sint position, Eterm newval); void db_finalize_resize(DbUpdateHandle* handle, Uint offset); -Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr); +Eterm db_add_counter(Eterm** hpp, Wterm counter, Eterm incr); Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags); Binary *db_match_set_compile(Process *p, Eterm matchexpr, Uint flags); @@ -360,7 +360,6 @@ typedef struct match_prog { struct erl_heap_fragment *saved_program_buf; Eterm saved_program; Uint heap_size; /* size of: heap + eheap + stack */ - Uint eheap_offset; Uint stack_offset; #ifdef DMC_DEBUG UWord* prog_end; /* End of program */ @@ -424,11 +423,16 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards, Eterm *body, int num_matches, Uint flags, DMCErrInfo *err_info); -Eterm db_prog_match_and_copy(DbTableCommon* tb, Process* c_p, Binary* bprog, - int all, DbTerm* obj, Eterm** hpp, Uint extra); /* Returns newly allocated MatchProg binary with refc == 0*/ -Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm *termp, int arity, + +Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog, + int all, DbTerm* obj, Eterm** hpp, Uint extra); + +Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm* base, + Eterm *termp, int arity, + enum erts_pam_run_flags in_flags, Uint32 *return_flags /* Zeroed on enter */); + /* returns DB_ERROR_NONE if matches, 1 if not matches and some db error on error. */ DMCErrInfo *db_new_dmc_err_info(void); diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c index 17b08a71d4..39bbe9633b 100644 --- a/erts/emulator/beam/erl_drv_thread.c +++ b/erts/emulator/beam/erl_drv_thread.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2010. All Rights Reserved. + * Copyright Ericsson AB 2007-2011. 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 @@ -24,6 +24,10 @@ #include "global.h" #include <string.h> +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) +#define __DARWIN__ 1 +#endif + #define ERL_DRV_THR_OPTS_SIZE(LAST_FIELD) \ (((size_t) &((ErlDrvThreadOpts *) 0)->LAST_FIELD) \ + sizeof(((ErlDrvThreadOpts *) 0)->LAST_FIELD)) @@ -692,3 +696,57 @@ erl_drv_thread_join(ErlDrvTid tid, void **respp) #endif } +#if defined(__DARWIN__) && defined(USE_THREADS) && defined(ERTS_SMP) +extern int erts_darwin_main_thread_pipe[2]; +extern int erts_darwin_main_thread_result_pipe[2]; + + +int +erl_drv_stolen_main_thread_join(ErlDrvTid tid, void **respp) +{ + void *dummy; + void **x; + if (respp == NULL) + x = &dummy; + else + x = respp; + read(erts_darwin_main_thread_result_pipe[0],x,sizeof(void *)); + return 0; +} + +int +erl_drv_steal_main_thread(char *name, + ErlDrvTid *tid, + void* (*func)(void*), + void* arg, + ErlDrvThreadOpts *opts) +{ + char buff[sizeof(void* (*)(void*)) + sizeof(void *)]; + int buff_sz = sizeof(void* (*)(void*)) + sizeof(void *); + /*struct ErlDrvTid_ *dtid; + + dtid = erts_alloc_fnf(ERTS_ALC_T_DRV_TID, + (sizeof(struct ErlDrvTid_) + + (name ? sys_strlen(name) + 1 : 0))); + if (!dtid) + return ENOMEM; + memset(dtid,0,sizeof(ErlDrvTid_)); + dtid->tid = (void * ) -1; + dtid->drv_thr = 1; + dtid->func = func; + dtid->arg = arg; + dtid->tsd = NULL; + dtid->tsd_len = 0; + dtid->name = no_name; + *tid = (ErlDrvTid) dtid; + */ + *tid = NULL; + /* Ignore options and name... */ + + memcpy(buff,&func,sizeof(void* (*)(void*))); + memcpy(buff + sizeof(void* (*)(void*)),&arg,sizeof(void *)); + write(erts_darwin_main_thread_pipe[1],buff,buff_sz); + return 0; +} + +#endif diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 2aa932e7d1..d9150d86fe 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2010. All Rights Reserved. + * Copyright Ericsson AB 2002-2011. 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 @@ -33,6 +33,7 @@ #include "erl_gc.h" #if HIPE #include "hipe_stack.h" +#include "hipe_mode_switch.h" #endif #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1 @@ -486,6 +487,9 @@ erts_garbage_collect_hibernate(Process* p) htop = heap; n = setup_rootset(p, p->arg_reg, p->arity, &rootset); +#if HIPE + hipe_empty_nstack(p); +#endif src = (char *) p->heap; src_size = (char *) p->htop - src; diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index f4e0717d30..0a57eb6d88 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -250,7 +250,7 @@ erl_init(int ncpu) erts_init_monitors(); erts_init_gc(); - init_time(); + erts_init_time(); erts_init_sys_common_misc(); erts_init_process(ncpu); erts_init_scheduling(use_multi_run_queue, @@ -289,7 +289,7 @@ erl_init(int ncpu) erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2); erts_late_init_process(); #if HAVE_ERTS_MSEG - erts_mseg_late_init(); /* Must be after timer (init_time()) and thread + erts_mseg_late_init(); /* Must be after timer (erts_init_time()) and thread initializations */ #endif #ifdef HIPE diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 7a6aaa6bbe..9e18997890 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2010. All Rights Reserved. + * Copyright Ericsson AB 2005-2011. 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 @@ -155,7 +155,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "alcu_allocator", "index" }, { "alcu_delayed_free", "index" }, { "mseg", NULL }, -#ifdef HALFWORD_HEAP +#if HALFWORD_HEAP { "pmmap", NULL }, #endif #ifdef ERTS_SMP @@ -177,6 +177,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "async_id", NULL }, { "pix_lock", "address" }, { "run_queues_lists", NULL }, + { "misc_aux_work_queue", "index" }, + { "misc_aux_work_pre_alloc_lock", "address" }, { "sched_stat", NULL }, { "run_queue_sleep_list", "address" }, #endif diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h index 0372e6850d..cdb06d4458 100644 --- a/erts/emulator/beam/erl_lock_check.h +++ b/erts/emulator/beam/erl_lock_check.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2011. 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 diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c index d873c7a701..9751b5d77c 100644 --- a/erts/emulator/beam/erl_monitors.c +++ b/erts/emulator/beam/erl_monitors.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * Copyright Ericsson AB 2004-2011. 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 @@ -85,7 +85,7 @@ static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2) if (is_ref_thing_header(*b2)) { return 1; } - return cmp(ref1,ref2); + return CMP(ref1,ref2); } #define CP_LINK_VAL(To, Hp, From) \ @@ -380,7 +380,7 @@ int erts_add_link(ErtsLink **root, Uint type, Eterm pid) state = 1; *this = create_link(type,pid); break; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { /* go left */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; @@ -415,7 +415,7 @@ erts_add_or_lookup_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid) state = 1; res = *this = create_suspend_monitor(pid); break; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { /* go left */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; @@ -453,7 +453,7 @@ ErtsLink *erts_add_or_lookup_link(ErtsLink **root, Uint type, Eterm pid) *this = create_link(type,pid); ret = *this; break; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { /* go left */ dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; @@ -663,7 +663,7 @@ ErtsLink *erts_remove_link(ErtsLink **root, Eterm pid) for (;;) { if (!*this) { /* Failure */ return NULL; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -715,7 +715,7 @@ erts_delete_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid) for (;;) { if (!*this) { /* Nothing found */ return; - } else if ((c = cmp(pid,(*this)->pid)) < 0) { + } else if ((c = CMP(pid,(*this)->pid)) < 0) { dstack[dpos++] = DIR_LEFT; tstack[tpos++] = this; this = &((*this)->left); @@ -771,7 +771,7 @@ ErtsLink *erts_lookup_link(ErtsLink *root, Eterm pid) Sint c; for (;;) { - if (root == NULL || (c = cmp(pid,root->pid)) == 0) { + if (root == NULL || (c = CMP(pid,root->pid)) == 0) { return root; } else if (c < 0) { root = root->left; @@ -787,7 +787,7 @@ erts_lookup_suspend_monitor(ErtsSuspendMonitor *root, Eterm pid) Sint c; for (;;) { - if (root == NULL || (c = cmp(pid,root->pid)) == 0) { + if (root == NULL || (c = CMP(pid,root->pid)) == 0) { return root; } else if (c < 0) { root = root->left; diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index a680097c2d..135c6b0ccc 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * Copyright Ericsson AB 2009-2011. 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 @@ -81,7 +81,6 @@ static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, unsigned need) static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp) { - unsigned frag_sz; env->hp = hp; if (env->heap_frag == NULL) { ASSERT(HEAP_LIMIT(env->proc) == env->hp_end); @@ -91,11 +90,11 @@ static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp) env->heap_frag->used_size = hp - env->heap_frag->mem; ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size); } - frag_sz = need + MIN_HEAP_FRAG_SZ; - hp = erts_heap_alloc(env->proc, frag_sz); - env->hp = hp + need; - env->hp_end = hp + frag_sz; + hp = erts_heap_alloc(env->proc, need, MIN_HEAP_FRAG_SZ); env->heap_frag = MBUF(env->proc); + env->hp = hp + need; + env->hp_end = env->heap_frag->mem + env->heap_frag->alloc_size; + return hp; } @@ -574,7 +573,7 @@ int enif_is_identical(Eterm lhs, Eterm rhs) int enif_compare(Eterm lhs, Eterm rhs) { - return cmp(lhs,rhs); + return CMP(lhs,rhs); } int enif_get_tuple(ErlNifEnv* env, Eterm tpl, int* arity, const Eterm** array) @@ -939,21 +938,26 @@ ERL_NIF_TERM enif_make_list_cell(ErlNifEnv* env, Eterm car, Eterm cdr) ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...) { - Eterm* hp = alloc_heap(env,cnt*2); - Eterm ret = make_list(hp); - Eterm* last = &ret; - va_list ap; - - va_start(ap,cnt); - while (cnt--) { - *last = make_list(hp); - *hp = va_arg(ap,Eterm); - last = ++hp; - ++hp; + if (cnt == 0) { + return NIL; + } + else { + Eterm* hp = alloc_heap(env,cnt*2); + Eterm ret = make_list(hp); + Eterm* last = &ret; + va_list ap; + + va_start(ap,cnt); + while (cnt--) { + *last = make_list(hp); + *hp = va_arg(ap,Eterm); + last = ++hp; + ++hp; + } + va_end(ap); + *last = NIL; + return ret; } - va_end(ap); - *last = NIL; - return ret; } ERL_NIF_TERM enif_make_list_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt) @@ -1474,7 +1478,13 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) ret = load_nif_error(BIF_P, bad_lib, "Library version (%d.%d) not compatible (with %d.%d).", entry->major, entry->minor, ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION); - } + } + else if (entry->minor >= 1 + && sys_strcmp(entry->vm_variant, ERL_NIF_VM_VARIANT) != 0) { + ret = load_nif_error(BIF_P, bad_lib, "Library (%s) not compiled for " + "this vm variant (%s).", + entry->vm_variant, ERL_NIF_VM_VARIANT); + } else if (!erts_is_atom_str((char*)entry->name, mod_atom)) { ret = load_nif_error(BIF_P, bad_lib, "Library module name '%s' does not" " match calling module '%T'", entry->name, mod_atom); diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index ee3a7cd5f4..8050b3640a 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * Copyright Ericsson AB 2009-2011. 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 @@ -30,9 +30,10 @@ ** 0.1: R13B03 ** 1.0: R13B04 ** 2.0: R14A +** 2.1: R14B02 "vm_variant" */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 0 +#define ERL_NIF_MINOR_VERSION 1 #include <stdlib.h> @@ -80,8 +81,10 @@ typedef long long ErlNifSInt64; #endif #ifdef HALFWORD_HEAP_EMULATOR +# define ERL_NIF_VM_VARIANT "beam.halfword" typedef unsigned int ERL_NIF_TERM; #else +# define ERL_NIF_VM_VARIANT "beam.vanilla" typedef unsigned long ERL_NIF_TERM; #endif @@ -105,7 +108,8 @@ typedef struct enif_entry_t int (*load) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); int (*reload) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); - void (*unload) (ErlNifEnv*, void* priv_data); + void (*unload) (ErlNifEnv*, void* priv_data); + const char* vm_variant; }ErlNifEntry; @@ -198,6 +202,7 @@ extern TWinDynNifCallbacks WinDynNifCallbacks; #define ERL_NIF_INIT(NAME, FUNCS, LOAD, RELOAD, UPGRADE, UNLOAD) \ ERL_NIF_INIT_PROLOGUE \ ERL_NIF_INIT_GLOB \ +ERL_NIF_INIT_DECL(NAME); \ ERL_NIF_INIT_DECL(NAME) \ { \ static ErlNifEntry entry = \ @@ -207,7 +212,8 @@ ERL_NIF_INIT_DECL(NAME) \ #NAME, \ sizeof(FUNCS) / sizeof(*FUNCS), \ FUNCS, \ - LOAD, RELOAD, UPGRADE, UNLOAD \ + LOAD, RELOAD, UPGRADE, UNLOAD, \ + ERL_NIF_VM_VARIANT \ }; \ ERL_NIF_INIT_BODY; \ return &entry; \ diff --git a/erts/emulator/beam/erl_nmgc.c b/erts/emulator/beam/erl_nmgc.c index 626d4e295a..d7bfb2ab12 100644 --- a/erts/emulator/beam/erl_nmgc.c +++ b/erts/emulator/beam/erl_nmgc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * Copyright Ericsson AB 2004-2011. 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 @@ -26,7 +26,6 @@ #include "erl_nmgc.h" #include "erl_debug.h" #if HIPE -#include "hipe_bif0.h" /* for hipe_constants_{start,next} */ #include "hipe_stack.h" #endif diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h index ae1316eba2..2c67e781e0 100644 --- a/erts/emulator/beam/erl_node_container_utils.h +++ b/erts/emulator/beam/erl_node_container_utils.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2010. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 @@ -255,19 +255,32 @@ extern int erts_use_r9_pids_ports; #define internal_ref_no_of_numbers(x) \ (internal_ref_data((x))[0]) +#define internal_thing_ref_no_of_numbers(thing) \ + (internal_thing_ref_data(thing)[0]) #define internal_ref_numbers(x) \ (&internal_ref_data((x))[1]) +#define internal_thing_ref_numbers(thing) \ + (&internal_thing_ref_data(thing)[1]) #define external_ref_no_of_numbers(x) \ (external_ref_data((x))[0]) +#define external_thing_ref_no_of_numbers(thing) \ + (external_thing_ref_data(thing)[0]) #define external_ref_numbers(x) \ (&external_ref_data((x))[1]) +#define external_thing_ref_numbers(thing) \ + (&external_thing_ref_data(thing)[1]) + #else #define internal_ref_no_of_numbers(x) (internal_ref_data_words((x))) +#define internal_thing_ref_no_of_numbers(t) (internal_thing_ref_data_words(t)) #define internal_ref_numbers(x) (internal_ref_data((x))) +#define internal_thing_ref_numbers(t) (internal_thing_ref_data(t)) #define external_ref_no_of_numbers(x) (external_ref_data_words((x))) +#define external_thing_ref_no_of_numbers(t) (external_thing_ref_data_words((t))) #define external_ref_numbers(x) (external_ref_data((x))) +#define external_thing_ref_numbers(t) (external_thing_ref_data((t))) #endif @@ -311,6 +324,8 @@ extern int erts_use_r9_pids_ports; : external_ref_channel_no((x))) #define is_ref(x) (is_internal_ref((x)) \ || is_external_ref((x))) +#define is_ref_rel(x,Base) (is_internal_ref_rel((x),Base) \ + || is_external_ref_rel((x),Base)) #define is_not_ref(x) (!is_ref(x)) #endif diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h index 714b4ea7dd..3e2c5f07ab 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2010. All Rights Reserved. + * Copyright Ericsson AB 2006-2011. 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 @@ -102,6 +102,7 @@ erts_port_task_init_sched(ErtsPortTaskSched *ptsp) ERTS_GLB_INLINE int erts_port_task_have_outstanding_io_tasks(void) { + ERTS_THR_MEMORY_BARRIER; return erts_smp_atomic_read(&erts_port_task_outstanding_io_tasks) != 0; } diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index d9f132f067..b71404fd27 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2010. All Rights Reserved. + * Copyright Ericsson AB 2005-2011. 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 @@ -216,233 +216,289 @@ static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount) } +#define PRT_BAR ((Eterm) 0) +#define PRT_COMMA ((Eterm) 1) +#define PRT_CLOSE_LIST ((Eterm) 2) +#define PRT_CLOSE_TUPLE ((Eterm) 3) +#define PRT_TERM ((Eterm) 4) +#define PRT_ONE_CONS ((Eterm) 5) +#define PRT_PATCH_FUN_SIZE ((Eterm) 6) +#define PRT_LAST_ARRAY_ELEMENT ((Eterm) 7) /* Note! Must be last... */ static int print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) { + DECLARE_WSTACK(s); int res; int i; + Eterm val; Uint32 *ref_num; Eterm* nobj; +#if HALFWORD_HEAP + UWord wobj; +#endif res = 0; - if ((*dcount)-- <= 0) - return res; - -#ifdef HYBRID___NOT_ACTIVE - /* Color coded output based on memory location */ - if(ptr_val(obj) >= global_heap && ptr_val(obj) < global_hend) - PRINT_STRING(res, fn, arg, "\033[32m"); -#ifdef INCREMENTAL - else if(ptr_val(obj) >= inc_fromspc && ptr_val(obj) < inc_fromend) - PRINT_STRING(res, fn, arg, "\033[33m"); + goto L_jump_start; + + L_outer_loop: + while (!WSTACK_ISEMPTY(s)) { + switch (val = WSTACK_POP(s)) { + case PRT_COMMA: + PRINT_CHAR(res, fn, arg, ','); + goto L_outer_loop; + case PRT_BAR: + PRINT_CHAR(res, fn, arg, '|'); + goto L_outer_loop; + case PRT_CLOSE_LIST: + PRINT_CHAR(res, fn, arg, ']'); + goto L_outer_loop; + case PRT_CLOSE_TUPLE: + PRINT_CHAR(res, fn, arg, '}'); + goto L_outer_loop; + default: +#if HALFWORD_HEAP + obj = (Eterm) (wobj = WSTACK_POP(s)); +#else + obj = WSTACK_POP(s); #endif - else if(IS_CONST(obj)) - PRINT_STRING(res, fn, arg, "\033[34m"); - else - PRINT_STRING(res, fn, arg, "\033[31m"); + switch (val) { + case PRT_TERM: + break; + case PRT_ONE_CONS: + L_print_one_cons: + { + Eterm* cons = list_val(obj); + Eterm tl; + + obj = CAR(cons); + tl = CDR(cons); + if (is_not_nil(tl)) { + if (is_list(tl)) { + WSTACK_PUSH(s, tl); + WSTACK_PUSH(s, PRT_ONE_CONS); + WSTACK_PUSH(s, PRT_COMMA); + } else { + WSTACK_PUSH(s, tl); + WSTACK_PUSH(s, PRT_TERM); + WSTACK_PUSH(s, PRT_BAR); + } + } + } + break; + case PRT_LAST_ARRAY_ELEMENT: + { +#if HALFWORD_HEAP + Eterm* ptr = (Eterm *) wobj; +#else + Eterm* ptr = (Eterm *) obj; #endif + obj = *ptr; + } + break; + default: /* PRT_LAST_ARRAY_ELEMENT+1 and upwards */ + { +#if HALFWORD_HEAP + Eterm* ptr = (Eterm *) wobj; +#else + Eterm* ptr = (Eterm *) obj; +#endif + obj = *ptr++; + WSTACK_PUSH(s, (UWord) ptr); + WSTACK_PUSH(s, val-1); + WSTACK_PUSH(s, PRT_COMMA); + } + break; + } + break; + } - if (is_CP(obj)) { - PRINT_STRING(res, fn, arg, "<cp/header:"); - PRINT_POINTER(res, fn, arg, cp_val(obj)); - PRINT_CHAR(res, fn, arg, '>'); - return res; - } + L_jump_start: - switch (tag_val_def(obj)) { - case NIL_DEF: - PRINT_STRING(res, fn, arg, "[]"); - break; - case ATOM_DEF: { - int tres = print_atom_name(fn, arg, obj, dcount); - if (tres < 0) - return tres; - res += tres; - if (*dcount <= 0) - return res; - break; - } - case SMALL_DEF: - PRINT_SLONG(res, fn, arg, 'd', 0, 1, (signed long) signed_val(obj)); - break; - case BIG_DEF: { - int print_res; - char def_buf[64]; - char *buf, *big_str; - Uint sz = (Uint) big_decimal_estimate(obj); - sz++; - if (sz <= 64) - buf = &def_buf[0]; - else - buf = erts_alloc(ERTS_ALC_T_TMP, sz); - big_str = erts_big_to_string(obj, buf, sz); - print_res = erts_printf_string(fn, arg, big_str); - if (buf != &def_buf[0]) - erts_free(ERTS_ALC_T_TMP, (void *) buf); - if (print_res < 0) - return print_res; - res += print_res; - break; - } - case REF_DEF: - case EXTERNAL_REF_DEF: - PRINT_STRING(res, fn, arg, "#Ref<"); - PRINT_ULONG(res, fn, arg, 'u', 0, 1, - (unsigned long) ref_channel_no(obj)); - ref_num = ref_numbers(obj); - for (i = ref_no_of_numbers(obj)-1; i >= 0; i--) { - PRINT_CHAR(res, fn, arg, '.'); - PRINT_ULONG(res, fn, arg, 'u', 0, 1, (unsigned long) ref_num[i]); + if ((*dcount)-- <= 0) + goto L_done; + + if (is_CP(obj)) { + PRINT_STRING(res, fn, arg, "<cp/header:"); + PRINT_POINTER(res, fn, arg, cp_val(obj)); + PRINT_CHAR(res, fn, arg, '>'); + goto L_done; } - PRINT_CHAR(res, fn, arg, '>'); - break; - case PID_DEF: - case EXTERNAL_PID_DEF: - PRINT_CHAR(res, fn, arg, '<'); - PRINT_ULONG(res, fn, arg, 'u', 0, 1, - (unsigned long) pid_channel_no(obj)); - PRINT_CHAR(res, fn, arg, '.'); - PRINT_ULONG(res, fn, arg, 'u', 0, 1, - (unsigned long) pid_number(obj)); - PRINT_CHAR(res, fn, arg, '.'); - PRINT_ULONG(res, fn, arg, 'u', 0, 1, - (unsigned long) pid_serial(obj)); - PRINT_CHAR(res, fn, arg, '>'); - break; - case PORT_DEF: - case EXTERNAL_PORT_DEF: - PRINT_STRING(res, fn, arg, "#Port<"); - PRINT_ULONG(res, fn, arg, 'u', 0, 1, - (unsigned long) port_channel_no(obj)); - PRINT_CHAR(res, fn, arg, '.'); - PRINT_ULONG(res, fn, arg, 'u', 0, 1, - (unsigned long) port_number(obj)); - PRINT_CHAR(res, fn, arg, '>'); - break; - case LIST_DEF: - if (is_printable_string(obj)) { - int c; - PRINT_CHAR(res, fn, arg, '"'); - nobj = list_val(obj); - while (1) { - if ((*dcount)-- <= 0) - return res; - c = signed_val(*nobj++); - if (c == '\n') - PRINT_STRING(res, fn, arg, "\\n"); - else { - if (c == '"') - PRINT_CHAR(res, fn, arg, '\\'); - PRINT_CHAR(res, fn, arg, (char) c); - } - if (is_not_list(*nobj)) - break; - nobj = list_val(*nobj); - } - PRINT_CHAR(res, fn, arg, '"'); - } else { - PRINT_CHAR(res, fn, arg, '['); - nobj = list_val(obj); - while (1) { - int tres = print_term(fn, arg, *nobj++, dcount); - if (tres < 0) - return tres; - res += tres; - if (*dcount <= 0) - return res; - if (is_not_list(*nobj)) - break; - PRINT_CHAR(res, fn, arg, ','); - nobj = list_val(*nobj); - } - if (is_not_nil(*nobj)) { - int tres; - PRINT_CHAR(res, fn, arg, '|'); - tres = print_term(fn, arg, *nobj, dcount); - if (tres < 0) - return tres; - res += tres; - if (*dcount <= 0) - return res; + + switch (tag_val_def(obj)) { + case NIL_DEF: + PRINT_STRING(res, fn, arg, "[]"); + break; + case ATOM_DEF: { + int tres = print_atom_name(fn, arg, obj, dcount); + if (tres < 0) { + res = tres; + goto L_done; } - PRINT_CHAR(res, fn, arg, ']'); - } - break; - case TUPLE_DEF: - nobj = tuple_val(obj); /* pointer to arity */ - i = arityval(*nobj); /* arity */ - PRINT_CHAR(res, fn, arg, '{'); - while (i--) { - int tres = print_term(fn, arg, *++nobj, dcount); - if (tres < 0) - return tres; res += tres; if (*dcount <= 0) - return res; - if (i >= 1) - PRINT_CHAR(res, fn, arg, ','); - } - PRINT_CHAR(res, fn, arg, '}'); - break; - case FLOAT_DEF: { - FloatDef ff; - GET_DOUBLE(obj, ff); - PRINT_DOUBLE(res, fn, arg, 'e', 6, 0, ff.fd); + goto L_done; + break; } - break; - case BINARY_DEF: - { - ProcBin* pb = (ProcBin *) binary_val(obj); - if (pb->size == 1) - PRINT_STRING(res, fn, arg, "<<1 byte>>"); - else { - PRINT_STRING(res, fn, arg, "<<"); - PRINT_ULONG(res, fn, arg, 'u', 0, 1, (unsigned long) pb->size); - PRINT_STRING(res, fn, arg, " bytes>>"); + case SMALL_DEF: + PRINT_SLONG(res, fn, arg, 'd', 0, 1, (signed long) signed_val(obj)); + break; + case BIG_DEF: { + int print_res; + char def_buf[64]; + char *buf, *big_str; + Uint sz = (Uint) big_decimal_estimate(obj); + sz++; + if (sz <= 64) + buf = &def_buf[0]; + else + buf = erts_alloc(ERTS_ALC_T_TMP, sz); + big_str = erts_big_to_string(obj, buf, sz); + print_res = erts_printf_string(fn, arg, big_str); + if (buf != &def_buf[0]) + erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (print_res < 0) { + res = print_res; + goto L_done; } + res += print_res; + break; } - break; - case EXPORT_DEF: - { - Export* ep = *((Export **) (export_val(obj) + 1)); - Atom* module = atom_tab(atom_val(ep->code[0])); - Atom* name = atom_tab(atom_val(ep->code[1])); - - PRINT_STRING(res, fn, arg, "#Fun<"); - PRINT_BUF(res, fn, arg, module->name, module->len); + case REF_DEF: + case EXTERNAL_REF_DEF: + PRINT_STRING(res, fn, arg, "#Ref<"); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) ref_channel_no(obj)); + ref_num = ref_numbers(obj); + for (i = ref_no_of_numbers(obj)-1; i >= 0; i--) { + PRINT_CHAR(res, fn, arg, '.'); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, (unsigned long) ref_num[i]); + } + PRINT_CHAR(res, fn, arg, '>'); + break; + case PID_DEF: + case EXTERNAL_PID_DEF: + PRINT_CHAR(res, fn, arg, '<'); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) pid_channel_no(obj)); PRINT_CHAR(res, fn, arg, '.'); - PRINT_BUF(res, fn, arg, name->name, name->len); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) pid_number(obj)); PRINT_CHAR(res, fn, arg, '.'); - PRINT_SLONG(res, fn, arg, 'd', 0, 1, - (signed long) ep->code[2]); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) pid_serial(obj)); PRINT_CHAR(res, fn, arg, '>'); - } - break; - case FUN_DEF: - { - ErlFunThing *funp = (ErlFunThing *) fun_val(obj); - Atom *ap = atom_tab(atom_val(funp->fe->module)); - - PRINT_STRING(res, fn, arg, "#Fun<"); - PRINT_BUF(res, fn, arg, ap->name, ap->len); - PRINT_CHAR(res, fn, arg, '.'); - PRINT_SLONG(res, fn, arg, 'd', 0, 1, - (signed long) funp->fe->old_index); + break; + case PORT_DEF: + case EXTERNAL_PORT_DEF: + PRINT_STRING(res, fn, arg, "#Port<"); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) port_channel_no(obj)); PRINT_CHAR(res, fn, arg, '.'); - PRINT_SLONG(res, fn, arg, 'd', 0, 1, - (signed long) funp->fe->old_uniq); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) port_number(obj)); PRINT_CHAR(res, fn, arg, '>'); + break; + case LIST_DEF: + if (is_printable_string(obj)) { + int c; + PRINT_CHAR(res, fn, arg, '"'); + nobj = list_val(obj); + while (1) { + if ((*dcount)-- <= 0) + goto L_done; + c = signed_val(*nobj++); + if (c == '\n') + PRINT_STRING(res, fn, arg, "\\n"); + else { + if (c == '"') + PRINT_CHAR(res, fn, arg, '\\'); + PRINT_CHAR(res, fn, arg, (char) c); + } + if (is_not_list(*nobj)) + break; + nobj = list_val(*nobj); + } + PRINT_CHAR(res, fn, arg, '"'); + } else { + PRINT_CHAR(res, fn, arg, '['); + WSTACK_PUSH(s,PRT_CLOSE_LIST); + goto L_print_one_cons; + } + break; + case TUPLE_DEF: + nobj = tuple_val(obj); /* pointer to arity */ + i = arityval(*nobj); /* arity */ + PRINT_CHAR(res, fn, arg, '{'); + WSTACK_PUSH(s,PRT_CLOSE_TUPLE); + ++nobj; + if (i > 0) { + WSTACK_PUSH(s, (UWord) nobj); + WSTACK_PUSH(s, PRT_LAST_ARRAY_ELEMENT+i-1); + } + break; + case FLOAT_DEF: { + FloatDef ff; + GET_DOUBLE(obj, ff); + PRINT_DOUBLE(res, fn, arg, 'e', 6, 0, ff.fd); + } + break; + case BINARY_DEF: + { + ProcBin* pb = (ProcBin *) binary_val(obj); + if (pb->size == 1) + PRINT_STRING(res, fn, arg, "<<1 byte>>"); + else { + PRINT_STRING(res, fn, arg, "<<"); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, (unsigned long) pb->size); + PRINT_STRING(res, fn, arg, " bytes>>"); + } + } + break; + case EXPORT_DEF: + { + Export* ep = *((Export **) (export_val(obj) + 1)); + Atom* module = atom_tab(atom_val(ep->code[0])); + Atom* name = atom_tab(atom_val(ep->code[1])); + + PRINT_STRING(res, fn, arg, "#Fun<"); + PRINT_BUF(res, fn, arg, module->name, module->len); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_BUF(res, fn, arg, name->name, name->len); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_SLONG(res, fn, arg, 'd', 0, 1, + (signed long) ep->code[2]); + PRINT_CHAR(res, fn, arg, '>'); + } + break; + case FUN_DEF: + { + ErlFunThing *funp = (ErlFunThing *) fun_val(obj); + Atom *ap = atom_tab(atom_val(funp->fe->module)); + + PRINT_STRING(res, fn, arg, "#Fun<"); + PRINT_BUF(res, fn, arg, ap->name, ap->len); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_SLONG(res, fn, arg, 'd', 0, 1, + (signed long) funp->fe->old_index); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_SLONG(res, fn, arg, 'd', 0, 1, + (signed long) funp->fe->old_uniq); + PRINT_CHAR(res, fn, arg, '>'); + } + break; + default: + PRINT_STRING(res, fn, arg, "<unknown:"); + PRINT_POINTER(res, fn, arg, (UWord) obj); + PRINT_CHAR(res, fn, arg, '>'); + break; } - break; - default: - PRINT_STRING(res, fn, arg, "<unknown:"); - PRINT_POINTER(res, fn, arg, (UWord) obj); - PRINT_CHAR(res, fn, arg, '>'); - break; } + L_done: + + DESTROY_WSTACK(s); return res; } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 77ee1d6ac5..f8997f3c07 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -590,6 +590,118 @@ erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flags) } } +typedef struct erts_misc_aux_work_t_ erts_misc_aux_work_t; +struct erts_misc_aux_work_t_ { + erts_misc_aux_work_t *next; + void (*func)(void *); + void *arg; +}; + +typedef struct { + erts_smp_mtx_t mtx; + erts_misc_aux_work_t *first; + erts_misc_aux_work_t *last; +} erts_misc_aux_work_q_t; + +typedef union { + erts_misc_aux_work_q_t data; + char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_misc_aux_work_q_t))]; +} erts_algnd_misc_aux_work_q_t; + +static erts_algnd_misc_aux_work_q_t *misc_aux_work_queues; + +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(misc_aux_work, + erts_misc_aux_work_t, + 200, + ERTS_ALC_T_MISC_AUX_WORK) + +static void +init_misc_aux_work(void) +{ + int ix; + + init_misc_aux_work_alloc(); + + misc_aux_work_queues = + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_MISC_AUX_WORK_Q, + erts_no_schedulers * + sizeof(erts_algnd_misc_aux_work_q_t)); + + for (ix = 0; ix < erts_no_schedulers; ix++) { + erts_smp_mtx_init_x(&misc_aux_work_queues[ix].data.mtx, + "misc_aux_work_queue", + make_small(ix + 1)); + misc_aux_work_queues[ix].data.first = NULL; + misc_aux_work_queues[ix].data.last = NULL; + } +} + +static void +handle_misc_aux_work(ErtsSchedulerData *esdp) +{ + int ix = (int) esdp->no - 1; + erts_misc_aux_work_t *mawp; + + erts_smp_mtx_lock(&misc_aux_work_queues[ix].data.mtx); + mawp = misc_aux_work_queues[ix].data.first; + misc_aux_work_queues[ix].data.first = NULL; + misc_aux_work_queues[ix].data.last = NULL; + erts_smp_mtx_unlock(&misc_aux_work_queues[ix].data.mtx); + + while (mawp) { + erts_misc_aux_work_t *free_mawp; + mawp->func(mawp->arg); + free_mawp = mawp; + mawp = mawp->next; + misc_aux_work_free(free_mawp); + } +} + +void +erts_smp_schedule_misc_aux_work(int ignore_self, + int max_sched, + void (*func)(void *), + void *arg) +{ + int ix, ignore_ix = -1; + + if (ignore_self) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + if (esdp) + ignore_ix = (int) esdp->no - 1; + } + + ASSERT(0 <= max_sched && max_sched <= erts_no_schedulers); + + for (ix = 0; ix < max_sched; ix++) { + erts_aint32_t aux_work; + erts_misc_aux_work_t *mawp; + ErtsSchedulerSleepInfo *ssi; + if (ix == ignore_ix) + continue; + + mawp = misc_aux_work_alloc(); + + mawp->func = func; + mawp->arg = arg; + mawp->next = NULL; + + erts_smp_mtx_lock(&misc_aux_work_queues[ix].data.mtx); + if (!misc_aux_work_queues[ix].data.last) + misc_aux_work_queues[ix].data.first = mawp; + else + misc_aux_work_queues[ix].data.last->next = mawp; + misc_aux_work_queues[ix].data.last = mawp; + erts_smp_mtx_unlock(&misc_aux_work_queues[ix].data.mtx); + + ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); + aux_work = erts_smp_atomic32_bor(&ssi->aux_work, + ERTS_SSI_AUX_WORK_MISC); + if ((aux_work & ERTS_SSI_AUX_WORK_MISC) == 0) + erts_sched_poke(ssi); + } +} + #ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN void erts_smp_notify_check_children_needed(void) @@ -615,6 +727,12 @@ blockable_aux_work(ErtsSchedulerData *esdp, erts_aint32_t aux_work) { if (aux_work & ERTS_SSI_BLOCKABLE_AUX_WORK_MASK) { + if (aux_work & ERTS_SSI_AUX_WORK_MISC) { + aux_work = erts_smp_atomic32_band(&ssi->aux_work, + ~ERTS_SSI_AUX_WORK_MISC); + aux_work &= ~ERTS_SSI_AUX_WORK_MISC; + handle_misc_aux_work(esdp); + } #ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN if (aux_work & ERTS_SSI_AUX_WORK_CHECK_CHILDREN) { aux_work = erts_smp_atomic32_band(&ssi->aux_work, @@ -693,15 +811,31 @@ erts_active_schedulers(void) return as; } +#ifdef ERTS_SMP + +static ERTS_INLINE void +clear_sys_scheduling(void) +{ + erts_smp_atomic32_set_relb(&doing_sys_schedule, 0); +} + +static ERTS_INLINE int +try_set_sys_scheduling(void) +{ + return 0 == erts_smp_atomic32_cmpxchg_acqb(&doing_sys_schedule, 1, 0); +} + +#endif + static ERTS_INLINE int prepare_for_sys_schedule(void) { #ifdef ERTS_SMP while (!erts_port_task_have_outstanding_io_tasks() - && !erts_smp_atomic32_xchg(&doing_sys_schedule, 1)) { + && try_set_sys_scheduling()) { if (!erts_port_task_have_outstanding_io_tasks()) return 1; - erts_smp_atomic32_set(&doing_sys_schedule, 0); + clear_sys_scheduling(); } return 0; #else @@ -997,8 +1131,8 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erl_sys_schedule(1); /* Might give us something to do */ - dt = do_time_read_and_reset(); - if (dt) bump_timer(dt); + dt = erts_do_time_read_and_reset(); + if (dt) erts_bump_timer(dt); sys_aux_work: @@ -1031,7 +1165,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * call erl_sys_schedule() until it is handled. */ if (erts_port_task_have_outstanding_io_tasks()) { - erts_smp_atomic32_set(&doing_sys_schedule, 0); + clear_sys_scheduling(); /* * Got to check that we still got I/O tasks; otherwise * we have to continue checking for I/O... @@ -1050,7 +1184,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * sleep in erl_sys_schedule(). */ if (erts_port_task_have_outstanding_io_tasks()) { - erts_smp_atomic32_set(&doing_sys_schedule, 0); + clear_sys_scheduling(); /* * Got to check that we still got I/O tasks; otherwise @@ -1094,8 +1228,8 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erl_sys_schedule(0); - dt = do_time_read_and_reset(); - if (dt) bump_timer(dt); + dt = erts_do_time_read_and_reset(); + if (dt) erts_bump_timer(dt); flgs = sched_prep_cont_spin_wait(ssi); if (flgs & ERTS_SSI_FLG_WAITING) @@ -1104,7 +1238,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sys_woken: erts_smp_runq_lock(rq); sys_locked_woken: - erts_smp_atomic32_set(&doing_sys_schedule, 0); + clear_sys_scheduling(); if (flgs & ~ERTS_SSI_FLG_SUSPENDED) erts_smp_atomic32_band(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); sched_active_sys(esdp->no, rq); @@ -1167,6 +1301,7 @@ wake_scheduler(ErtsRunQueue *rq, int incq, int one) res = sl->list != NULL; erts_smp_spin_unlock(&sl->lock); + ERTS_THR_MEMORY_BARRIER; flgs = ssi_flags_set_wake(ssi); erts_sched_finish_poke(ssi, flgs); @@ -1176,6 +1311,8 @@ wake_scheduler(ErtsRunQueue *rq, int incq, int one) else { sl->list = NULL; erts_smp_spin_unlock(&sl->lock); + + ERTS_THR_MEMORY_BARRIER; do { ErtsSchedulerSleepInfo *wake_ssi = ssi; ssi = ssi->next; @@ -2393,16 +2530,9 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) n = (int) (mrq ? no_schedulers : 1); - erts_aligned_run_queues = erts_alloc(ERTS_ALC_T_RUNQS, - (sizeof(ErtsAlignedRunQueue)*(n+1))); - if ((((UWord) erts_aligned_run_queues) & ERTS_CACHE_LINE_MASK) != 0) - erts_aligned_run_queues = ((ErtsAlignedRunQueue *) - ((((UWord) erts_aligned_run_queues) - & ~ERTS_CACHE_LINE_MASK) - + ERTS_CACHE_LINE_SIZE)); - - ASSERT((((UWord) erts_aligned_run_queues) & ERTS_CACHE_LINE_MASK) == 0); - + erts_aligned_run_queues = + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_RUNQS, + sizeof(ErtsAlignedRunQueue) * n); #ifdef ERTS_SMP erts_smp_atomic32_init(&no_empty_run_queues, 0); #endif @@ -2497,14 +2627,10 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) #ifdef ERTS_SMP /* Create and initialize scheduler sleep info */ - aligned_sched_sleep_info = erts_alloc(ERTS_ALC_T_SCHDLR_SLP_INFO, - (sizeof(ErtsAlignedSchedulerSleepInfo) - *(n+1))); - if ((((UWord) aligned_sched_sleep_info) & ERTS_CACHE_LINE_MASK) == 0) - aligned_sched_sleep_info = ((ErtsAlignedSchedulerSleepInfo *) - ((((UWord) aligned_sched_sleep_info) - & ~ERTS_CACHE_LINE_MASK) - + ERTS_CACHE_LINE_SIZE)); + aligned_sched_sleep_info = + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_SLP_INFO, + n * sizeof(ErtsAlignedSchedulerSleepInfo)); + for (ix = 0; ix < n; ix++) { ErtsSchedulerSleepInfo *ssi = ERTS_SCHED_SLEEP_INFO_IX(ix); #if 0 /* no need to initialize these... */ @@ -2519,16 +2645,9 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) /* Create and initialize scheduler specific data */ - erts_aligned_scheduler_data = erts_alloc(ERTS_ALC_T_SCHDLR_DATA, - (sizeof(ErtsAlignedSchedulerData) - *(n+1))); - if ((((UWord) erts_aligned_scheduler_data) & ERTS_CACHE_LINE_MASK) != 0) - erts_aligned_scheduler_data = ((ErtsAlignedSchedulerData *) - ((((UWord) erts_aligned_scheduler_data) - & ~ERTS_CACHE_LINE_MASK) - + ERTS_CACHE_LINE_SIZE)); - - ASSERT((((UWord) erts_aligned_scheduler_data) & ERTS_CACHE_LINE_MASK) == 0); + erts_aligned_scheduler_data = + erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA, + n*sizeof(ErtsAlignedSchedulerData)); for (ix = 0; ix < n; ix++) { ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix); @@ -2612,6 +2731,8 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) erts_smp_atomic32_init(&doing_sys_schedule, 0); + init_misc_aux_work(); + #else /* !ERTS_SMP */ { ErtsSchedulerData *esdp; @@ -2628,6 +2749,15 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) /* init port tasks */ erts_port_task_init(); + +#ifndef ERTS_SMP +#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC + erts_scheduler_data->verify_unused_temp_alloc + = erts_alloc_get_verify_unused_temp_alloc( + &erts_scheduler_data->verify_unused_temp_alloc_data); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL); +#endif +#endif } ErtsRunQueue * @@ -2739,6 +2869,19 @@ resume_process(Process *p) p->rstatus = P_FREE; } +int +erts_get_max_no_executing_schedulers(void) +{ +#ifdef ERTS_SMP + if (erts_smp_atomic32_read(&schdlr_sspnd.changing)) + return (int) erts_no_schedulers; + ERTS_THR_MEMORY_BARRIER; + return (int) erts_smp_atomic32_read(&schdlr_sspnd.active); +#else + return 1; +#endif +} + #ifdef ERTS_SMP static void @@ -3574,6 +3717,13 @@ sched_thread_func(void *vesdp) } erts_smp_mtx_unlock(&schdlr_sspnd.mtx); +#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC + ((ErtsSchedulerData *) vesdp)->verify_unused_temp_alloc + = erts_alloc_get_verify_unused_temp_alloc( + &((ErtsSchedulerData *) vesdp)->verify_unused_temp_alloc_data); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL); +#endif + process_main(); /* No schedulers should *ever* terminate */ erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %bpu terminated\n", @@ -5070,10 +5220,10 @@ Process *schedule(Process *p, int calls) ERTS_SMP_CHK_NO_PROC_LOCKS; - dt = do_time_read_and_reset(); + dt = erts_do_time_read_and_reset(); if (dt) { erts_smp_runq_unlock(rq); - bump_timer(dt); + erts_bump_timer(dt); erts_smp_runq_lock(rq); } BM_STOP_TIMER(system); @@ -5214,11 +5364,11 @@ Process *schedule(Process *p, int calls) #endif erts_smp_runq_unlock(rq); erl_sys_schedule(runnable); - dt = do_time_read_and_reset(); - if (dt) bump_timer(dt); + dt = erts_do_time_read_and_reset(); + if (dt) erts_bump_timer(dt); #ifdef ERTS_SMP erts_smp_runq_lock(rq); - erts_smp_atomic32_set(&doing_sys_schedule, 0); + clear_sys_scheduling(); goto continue_check_activities_to_run; #else if (!runnable) @@ -6931,11 +7081,11 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext) DeclareTmpHeapNoproc(lhp,3); ErtsProcLocks rp_locks = (ERTS_PROC_LOCK_LINK | ERTS_PROC_LOCKS_MSG_SEND); - UseTmpHeapNoproc(3); rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks); if (rp == NULL) { goto done; } + UseTmpHeapNoproc(3); rmon = erts_remove_monitor(&(rp->monitors),mon->ref); if (rmon) { erts_destroy_monitor(rmon); @@ -7476,7 +7626,7 @@ cancel_timer(Process* p) #ifdef ERTS_SMP erts_cancel_smp_ptimer(p->u.ptimer); #else - erl_cancel_timer(&p->u.tm); + erts_cancel_timer(&p->u.tm); #endif } @@ -7502,7 +7652,7 @@ set_timer(Process* p, Uint timeout) (ErlTimeoutProc) timeout_proc, timeout); #else - erl_set_timer(&p->u.tm, + erts_set_timer(&p->u.tm, (ErlTimeoutProc) timeout_proc, NULL, (void*) p, @@ -7550,7 +7700,7 @@ erts_program_counter_info(int to, void *to_arg, Process *p) * only cause problems. */ for (i = 0; i < p->arity; i++) - erts_print(to, to_arg, " %T\n", p->arg_reg[i]); + erts_print(to, to_arg, " %.*T\n", INT_MAX, p->arg_reg[i]); } } } diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 8e32121a68..8f78a7d76e 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -28,6 +28,12 @@ #define ERTS_INCLUDE_SCHEDULER_INTERNALS #endif +/* #define ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC */ + +#if !defined(ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC) && defined(DEBUG) +# define ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC +#endif + typedef struct process Process; #include "sys.h" @@ -236,16 +242,14 @@ typedef enum { | ERTS_SSI_FLG_WAITING \ | ERTS_SSI_FLG_SUSPENDED) - -#if !defined(ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK) \ - && defined(ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN) #define ERTS_SCHED_NEED_BLOCKABLE_AUX_WORK -#endif #define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 0) +#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 1) #define ERTS_SSI_BLOCKABLE_AUX_WORK_MASK \ - (ERTS_SSI_AUX_WORK_CHECK_CHILDREN) + (ERTS_SSI_AUX_WORK_CHECK_CHILDREN \ + | ERTS_SSI_AUX_WORK_MISC) #define ERTS_SSI_NONBLOCKABLE_AUX_WORK_MASK \ (0) @@ -423,6 +427,11 @@ struct ErtsSchedulerData_ { /* NOTE: These fields are modified under held mutexes by other threads */ erts_smp_atomic32_t chk_cpu_bind; /* Only used when common run queue */ #endif + +#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC + erts_alloc_verify_func_t verify_unused_temp_alloc; + Allctr_t *verify_unused_temp_alloc_data; +#endif }; typedef union { @@ -826,7 +835,7 @@ ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp) } #endif /* inline */ -Eterm* erts_heap_alloc(Process* p, Uint need); +Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra); #ifdef CHECK_FOR_HOLES Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz); #endif @@ -1034,6 +1043,7 @@ int erts_sched_set_wakeup_limit(char *str); #ifdef DEBUG void erts_dbg_multi_scheduling_return_trap(Process *, Eterm); #endif +int erts_get_max_no_executing_schedulers(void); #ifdef ERTS_SMP ErtsSchedSuspendResult erts_schedulers_state(Uint *, Uint *, Uint *, int); @@ -1048,6 +1058,11 @@ int erts_is_multi_scheduling_blocked(void); Eterm erts_multi_scheduling_blockers(Process *); void erts_start_schedulers(void); void erts_smp_notify_check_children_needed(void); +void +erts_smp_schedule_misc_aux_work(int ignore_self, + int max_sched, + void (*func)(void *), + void *arg); #endif void erts_sched_notify_check_cpu_bind(void); Uint erts_active_schedulers(void); @@ -1141,6 +1156,20 @@ Uint erts_debug_nbalance(void); # define ERTS_PROC_GET_SCHDATA(PROC) (erts_scheduler_data) #endif +#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC +# define ERTS_VERIFY_UNUSED_TEMP_ALLOC(P) \ +do { \ + ErtsSchedulerData *esdp__ = ((P) \ + ? ERTS_PROC_GET_SCHDATA((Process *) (P)) \ + : erts_get_scheduler_data()); \ + if (esdp__) \ + esdp__->verify_unused_temp_alloc( \ + esdp__->verify_unused_temp_alloc_data); \ +} while (0) +#else +# define ERTS_VERIFY_UNUSED_TEMP_ALLOC(ESDP) +#endif + #if defined(ERTS_SMP) || defined(USE_THREADS) ErtsSchedulerData *erts_get_scheduler_data(void); #else @@ -1563,7 +1592,9 @@ ERTS_GLB_INLINE void erts_sched_poke(ErtsSchedulerSleepInfo *ssi); ERTS_GLB_INLINE void erts_sched_poke(ErtsSchedulerSleepInfo *ssi) { - erts_aint32_t flags = erts_smp_atomic32_read(&ssi->flags); + erts_aint32_t flags; + ERTS_THR_MEMORY_BARRIER; + flags = erts_smp_atomic32_read(&ssi->flags); ASSERT(!(flags & ERTS_SSI_FLG_SLEEPING) || (flags & ERTS_SSI_FLG_WAITING)); if (flags & ERTS_SSI_FLG_SLEEPING) { diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 7a7042abe4..68fda01597 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2010. All Rights Reserved. + * Copyright Ericsson AB 2003-2011. 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 @@ -261,139 +261,139 @@ print_function_from_pc(int to, void *to_arg, BeamInstr* x) static void heap_dump(int to, void *to_arg, Eterm x) { + DeclareTmpHeapNoproc(last,1); + Eterm* next = last; Eterm* ptr; - Eterm last = OUR_NIL; - Eterm* next = &last; if (is_immed(x) || is_CP(x)) { return; } - - again: - if (x == OUR_NIL) { /* We are done. */ - return; - } if (is_CP(x)) { - next = (Eterm *) EXPAND_POINTER(x); - } else if (is_list(x)) { - ptr = list_val(x); - if (ptr[0] != OUR_NIL) { - erts_print(to, to_arg, ADDR_FMT ":l", ptr); - dump_element(to, to_arg, ptr[0]); - erts_putc(to, to_arg, '|'); - dump_element(to, to_arg, ptr[1]); - erts_putc(to, to_arg, '\n'); - if (is_immed(ptr[1])) { - ptr[1] = make_small(0); - } - x = ptr[0]; - ptr[0] = (Eterm) COMPRESS_POINTER(next); - next = ptr + 1; - goto again; - } - } else if (is_boxed(x)) { - Eterm hdr; - - ptr = boxed_val(x); - hdr = *ptr; - if (hdr != OUR_NIL) { /* If not visited */ - erts_print(to, to_arg, ADDR_FMT ":", ptr); - if (is_arity_value(hdr)) { - Uint i; - Uint arity = arityval(hdr); - - erts_print(to, to_arg, "t" WORD_FMT ":", arity); - for (i = 1; i <= arity; i++) { - dump_element(to, to_arg, ptr[i]); - if (is_immed(ptr[i])) { - ptr[i] = make_small(0); - } - if (i < arity) { - erts_putc(to, to_arg, ','); - } - } + UseTmpHeapNoproc(1); + *last = OUR_NIL; + + while (x != OUR_NIL) { + if (is_CP(x)) { + next = (Eterm *) EXPAND_POINTER(x); + } else if (is_list(x)) { + ptr = list_val(x); + if (ptr[0] != OUR_NIL) { + erts_print(to, to_arg, ADDR_FMT ":l", ptr); + dump_element(to, to_arg, ptr[0]); + erts_putc(to, to_arg, '|'); + dump_element(to, to_arg, ptr[1]); erts_putc(to, to_arg, '\n'); - if (arity == 0) { - ptr[0] = OUR_NIL; - } else { - x = ptr[arity]; - ptr[0] = (Eterm) COMPRESS_POINTER(next); - next = ptr + arity - 1; - goto again; + if (is_immed(ptr[1])) { + ptr[1] = make_small(0); } - } else if (hdr == HEADER_FLONUM) { - FloatDef f; - char sbuf[31]; - int i; - - GET_DOUBLE_DATA((ptr+1), f); - i = sys_double_to_chars(f.fd, (char*) sbuf); - sys_memset(sbuf+i, 0, 31-i); - erts_print(to, to_arg, "F%X:%s\n", i, sbuf); - *ptr = OUR_NIL; - } else if (_is_bignum_header(hdr)) { - erts_print(to, to_arg, "B%T\n", x); - *ptr = OUR_NIL; - } else if (is_binary_header(hdr)) { - Uint tag = thing_subtag(hdr); - Uint size = binary_size(x); - Uint i; - - if (tag == HEAP_BINARY_SUBTAG) { - byte* p; - - erts_print(to, to_arg, "Yh%X:", size); - p = binary_bytes(x); - for (i = 0; i < size; i++) { - erts_print(to, to_arg, "%02X", p[i]); + x = ptr[0]; + ptr[0] = (Eterm) COMPRESS_POINTER(next); + next = ptr + 1; + continue; + } + } else if (is_boxed(x)) { + Eterm hdr; + + ptr = boxed_val(x); + hdr = *ptr; + if (hdr != OUR_NIL) { /* If not visited */ + erts_print(to, to_arg, ADDR_FMT ":", ptr); + if (is_arity_value(hdr)) { + Uint i; + Uint arity = arityval(hdr); + + erts_print(to, to_arg, "t" WORD_FMT ":", arity); + for (i = 1; i <= arity; i++) { + dump_element(to, to_arg, ptr[i]); + if (is_immed(ptr[i])) { + ptr[i] = make_small(0); + } + if (i < arity) { + erts_putc(to, to_arg, ','); + } } - } else if (tag == REFC_BINARY_SUBTAG) { - ProcBin* pb = (ProcBin *) binary_val(x); - Binary* val = pb->val; - - if (erts_smp_atomic_xchg(&val->refc, 0) != 0) { - val->flags = (UWord) all_binaries; - all_binaries = val; + erts_putc(to, to_arg, '\n'); + if (arity == 0) { + ptr[0] = OUR_NIL; + } else { + x = ptr[arity]; + ptr[0] = (Eterm) COMPRESS_POINTER(next); + next = ptr + arity - 1; + continue; } - erts_print(to, to_arg, "Yc%X:%X:%X", val, - pb->bytes - (byte *)val->orig_bytes, - size); - } else if (tag == SUB_BINARY_SUBTAG) { - ErlSubBin* Sb = (ErlSubBin *) binary_val(x); - Eterm* real_bin = binary_val(Sb->orig); - void* val; - - if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) { - ProcBin* pb = (ProcBin *) real_bin; - val = pb->val; - } else { /* Heap binary */ - val = real_bin; + } else if (hdr == HEADER_FLONUM) { + FloatDef f; + char sbuf[31]; + int i; + + GET_DOUBLE_DATA((ptr+1), f); + i = sys_double_to_chars(f.fd, (char*) sbuf); + sys_memset(sbuf+i, 0, 31-i); + erts_print(to, to_arg, "F%X:%s\n", i, sbuf); + *ptr = OUR_NIL; + } else if (_is_bignum_header(hdr)) { + erts_print(to, to_arg, "B%T\n", x); + *ptr = OUR_NIL; + } else if (is_binary_header(hdr)) { + Uint tag = thing_subtag(hdr); + Uint size = binary_size(x); + Uint i; + + if (tag == HEAP_BINARY_SUBTAG) { + byte* p; + + erts_print(to, to_arg, "Yh%X:", size); + p = binary_bytes(x); + for (i = 0; i < size; i++) { + erts_print(to, to_arg, "%02X", p[i]); + } + } else if (tag == REFC_BINARY_SUBTAG) { + ProcBin* pb = (ProcBin *) binary_val(x); + Binary* val = pb->val; + + if (erts_smp_atomic_xchg(&val->refc, 0) != 0) { + val->flags = (UWord) all_binaries; + all_binaries = val; + } + erts_print(to, to_arg, "Yc%X:%X:%X", val, + pb->bytes - (byte *)val->orig_bytes, + size); + } else if (tag == SUB_BINARY_SUBTAG) { + ErlSubBin* Sb = (ErlSubBin *) binary_val(x); + Eterm* real_bin = binary_val(Sb->orig); + void* val; + + if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) { + ProcBin* pb = (ProcBin *) real_bin; + val = pb->val; + } else { /* Heap binary */ + val = real_bin; + } + erts_print(to, to_arg, "Ys%X:%X:%X", val, Sb->offs, size); } - erts_print(to, to_arg, "Ys%X:%X:%X", val, Sb->offs, size); + erts_putc(to, to_arg, '\n'); + *ptr = OUR_NIL; + } else if (is_external_pid_header(hdr)) { + erts_print(to, to_arg, "P%T\n", x); + *ptr = OUR_NIL; + } else if (is_external_port_header(hdr)) { + erts_print(to, to_arg, "p<%bpu.%bpu>\n", + port_channel_no(x), port_number(x)); + *ptr = OUR_NIL; + } else { + /* + * All other we dump in the external term format. + */ + dump_externally(to, to_arg, x); + erts_putc(to, to_arg, '\n'); + *ptr = OUR_NIL; } - erts_putc(to, to_arg, '\n'); - *ptr = OUR_NIL; - } else if (is_external_pid_header(hdr)) { - erts_print(to, to_arg, "P%T\n", x); - *ptr = OUR_NIL; - } else if (is_external_port_header(hdr)) { - erts_print(to, to_arg, "p<%bpu.%bpu>\n", - port_channel_no(x), port_number(x)); - *ptr = OUR_NIL; - } else { - /* - * All other we dump in the external term format. - */ - dump_externally(to, to_arg, x); - erts_putc(to, to_arg, '\n'); - *ptr = OUR_NIL; } } + x = *next; + *next = OUR_NIL; + next--; } - - x = *next; - *next = OUR_NIL; - next--; - goto again; + UnUseTmpHeapNoproc(1); } static void diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index c6458a0e45..f77e8b798f 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2010. All Rights Reserved. + * Copyright Ericsson AB 2000-2011. 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 @@ -58,9 +58,9 @@ do { \ #endif #if ET_DEBUG -unsigned tag_val_def_debug(Eterm x, const char *file, unsigned line) +unsigned tag_val_def_debug(Wterm x, const char *file, unsigned line) #else -unsigned tag_val_def(Eterm x) +unsigned tag_val_def(Wterm x) #define file __FILE__ #define line __LINE__ #endif @@ -125,10 +125,10 @@ FUNTY checked_##FUN(ARGTY x, const char *file, unsigned line) \ ET_DEFINE_CHECKED(Eterm,make_boxed,Eterm*,_is_taggable_pointer); ET_DEFINE_CHECKED(int,is_boxed,Eterm,!is_header); -ET_DEFINE_CHECKED(Eterm*,boxed_val,Eterm,_boxed_precond); +ET_DEFINE_CHECKED(Eterm*,boxed_val,Wterm,_boxed_precond); ET_DEFINE_CHECKED(Eterm,make_list,Eterm*,_is_taggable_pointer); ET_DEFINE_CHECKED(int,is_not_list,Eterm,!is_header); -ET_DEFINE_CHECKED(Eterm*,list_val,Eterm,_list_precond); +ET_DEFINE_CHECKED(Eterm*,list_val,Wterm,_list_precond); ET_DEFINE_CHECKED(Uint,unsigned_val,Eterm,is_small); ET_DEFINE_CHECKED(Sint,signed_val,Eterm,is_small); ET_DEFINE_CHECKED(Uint,atom_val,Eterm,is_atom); @@ -136,34 +136,35 @@ ET_DEFINE_CHECKED(Uint,header_arity,Eterm,is_header); ET_DEFINE_CHECKED(Uint,arityval,Eterm,is_arity_value); ET_DEFINE_CHECKED(Uint,thing_arityval,Eterm,is_thing); ET_DEFINE_CHECKED(Uint,thing_subtag,Eterm,is_thing); -ET_DEFINE_CHECKED(Eterm*,binary_val,Eterm,is_binary); -ET_DEFINE_CHECKED(Eterm*,fun_val,Eterm,is_fun); +ET_DEFINE_CHECKED(Eterm*,binary_val,Wterm,is_binary); +ET_DEFINE_CHECKED(Eterm*,fun_val,Wterm,is_fun); ET_DEFINE_CHECKED(int,bignum_header_is_neg,Eterm,_is_bignum_header); ET_DEFINE_CHECKED(Eterm,bignum_header_neg,Eterm,_is_bignum_header); ET_DEFINE_CHECKED(Uint,bignum_header_arity,Eterm,_is_bignum_header); -ET_DEFINE_CHECKED(Eterm*,big_val,Eterm,is_big); -ET_DEFINE_CHECKED(Eterm*,float_val,Eterm,is_float); -ET_DEFINE_CHECKED(Eterm*,tuple_val,Eterm,is_tuple); +ET_DEFINE_CHECKED(Eterm*,big_val,Wterm,is_big); +ET_DEFINE_CHECKED(Eterm*,float_val,Wterm,is_float); +ET_DEFINE_CHECKED(Eterm*,tuple_val,Wterm,is_tuple); ET_DEFINE_CHECKED(Uint,internal_pid_data,Eterm,is_internal_pid); ET_DEFINE_CHECKED(struct erl_node_*,internal_pid_node,Eterm,is_internal_pid); ET_DEFINE_CHECKED(Uint,internal_port_data,Eterm,is_internal_port); ET_DEFINE_CHECKED(struct erl_node_*,internal_port_node,Eterm,is_internal_port); -ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Eterm,is_internal_ref); -ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Eterm,is_internal_ref); -ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Eterm,is_internal_ref); +ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Wterm,is_internal_ref); +ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Wterm,is_internal_ref); +ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Wterm,is_internal_ref); ET_DEFINE_CHECKED(struct erl_node_*,internal_ref_node,Eterm,is_internal_ref); -ET_DEFINE_CHECKED(Eterm*,external_val,Eterm,is_external); -ET_DEFINE_CHECKED(Uint,external_data_words,Eterm,is_external); -ET_DEFINE_CHECKED(Uint,external_pid_data_words,Eterm,is_external_pid); -ET_DEFINE_CHECKED(Uint,external_pid_data,Eterm,is_external_pid); -ET_DEFINE_CHECKED(struct erl_node_*,external_pid_node,Eterm,is_external_pid); -ET_DEFINE_CHECKED(Uint,external_port_data_words,Eterm,is_external_port); -ET_DEFINE_CHECKED(Uint,external_port_data,Eterm,is_external_port); -ET_DEFINE_CHECKED(struct erl_node_*,external_port_node,Eterm,is_external_port); -ET_DEFINE_CHECKED(Uint,external_ref_data_words,Eterm,is_external_ref); -ET_DEFINE_CHECKED(Uint32*,external_ref_data,Eterm,is_external_ref); +ET_DEFINE_CHECKED(Eterm*,external_val,Wterm,is_external); +ET_DEFINE_CHECKED(Uint,external_data_words,Wterm,is_external); +ET_DEFINE_CHECKED(Uint,external_pid_data_words,Wterm,is_external_pid); +ET_DEFINE_CHECKED(Uint,external_pid_data,Wterm,is_external_pid); +ET_DEFINE_CHECKED(struct erl_node_*,external_pid_node,Wterm,is_external_pid); +ET_DEFINE_CHECKED(Uint,external_port_data_words,Wterm,is_external_port); +ET_DEFINE_CHECKED(Uint,external_port_data,Wterm,is_external_port); +ET_DEFINE_CHECKED(struct erl_node_*,external_port_node,Wterm,is_external_port); +ET_DEFINE_CHECKED(Uint,external_ref_data_words,Wterm,is_external_ref); +ET_DEFINE_CHECKED(Uint32*,external_ref_data,Wterm,is_external_ref); ET_DEFINE_CHECKED(struct erl_node_*,external_ref_node,Eterm,is_external_ref); -ET_DEFINE_CHECKED(Eterm*,export_val,Eterm,is_export); +ET_DEFINE_CHECKED(Eterm*,export_val,Wterm,is_export); +ET_DEFINE_CHECKED(Uint,external_thing_data_words,ExternalThing*,is_thing_ptr); ET_DEFINE_CHECKED(Eterm,make_cp,UWord *,_is_taggable_pointer); ET_DEFINE_CHECKED(UWord *,cp_val,Eterm,is_CP); diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index b8e4473141..1d75fa313c 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2010. All Rights Reserved. + * Copyright Ericsson AB 2000-2011. 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 @@ -22,6 +22,8 @@ #include "sys.h" /* defines HALFWORD_HEAP */ +typedef UWord Wterm; /* Full word terms */ + #if HALFWORD_HEAP # define HEAP_ON_C_STACK 0 # if HALFWORD_ASSERT @@ -193,7 +195,7 @@ struct erl_node_; /* Declared in erl_node_tables.h */ #endif #define _is_aligned(x) (((Uint)(x) & 0x3) == 0) #define _unchecked_make_boxed(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_BOXED) -_ET_DECLARE_CHECKED(Eterm,make_boxed,Eterm*); +_ET_DECLARE_CHECKED(Eterm,make_boxed,Eterm*) #define make_boxed(x) _ET_APPLY(make_boxed,(x)) #if 1 #define _is_not_boxed(x) ((x) & (_TAG_PRIMARY_MASK-TAG_PRIMARY_BOXED)) @@ -204,12 +206,12 @@ _ET_DECLARE_CHECKED(int,is_boxed,Eterm) #define is_boxed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED) #endif #define _unchecked_boxed_val(x) ((Eterm*) EXPAND_POINTER(((x) - TAG_PRIMARY_BOXED))) -_ET_DECLARE_CHECKED(Eterm*,boxed_val,Eterm); +_ET_DECLARE_CHECKED(Eterm*,boxed_val,Wterm) #define boxed_val(x) _ET_APPLY(boxed_val,(x)) /* cons cell ("list") access methods */ #define _unchecked_make_list(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_LIST) -_ET_DECLARE_CHECKED(Eterm,make_list,Eterm*); +_ET_DECLARE_CHECKED(Eterm,make_list,Eterm*) #define make_list(x) _ET_APPLY(make_list,(x)) #if 1 #define _unchecked_is_not_list(x) ((x) & (_TAG_PRIMARY_MASK-TAG_PRIMARY_LIST)) @@ -226,7 +228,7 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm) #define _list_precond(x) (is_list(x)) #endif #define _unchecked_list_val(x) ((Eterm*) EXPAND_POINTER((x) - TAG_PRIMARY_LIST)) -_ET_DECLARE_CHECKED(Eterm*,list_val,Eterm); +_ET_DECLARE_CHECKED(Eterm*,list_val,Wterm) #define list_val(x) _ET_APPLY(list_val,(x)) #define CONS(hp, car, cdr) \ @@ -240,6 +242,8 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Eterm); #define ptr_val(x) _unchecked_ptr_val((x)) /*XXX*/ #define _unchecked_offset_ptr(x,offs) ((x)+((offs)*sizeof(Eterm))) #define offset_ptr(x,offs) _unchecked_offset_ptr(x,offs) /*XXX*/ +#define _unchecked_byte_offset_ptr(x,byte_offs) ((x)+(offs)) +#define byte_offset_ptr(x,offs) _unchecked_byte_offset_ptr(x,offs) /*XXX*/ /* fixnum ("small") access methods */ #if defined(ARCH_64) && !HALFWORD_HEAP @@ -305,6 +309,7 @@ _ET_DECLARE_CHECKED(Uint,arityval,Eterm) /* thing access methods */ #define is_thing(x) (is_header((x)) && header_is_thing((x))) +#define is_thing_ptr(t) (is_thing((t)->header)) #define _unchecked_thing_arityval(x) _unchecked_header_arity((x)) _ET_DECLARE_CHECKED(Uint,thing_arityval,Eterm) #define thing_arityval(x) _ET_APPLY(thing_arityval,(x)) @@ -339,7 +344,7 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm) #define is_binary(x) (is_boxed((x)) && is_binary_header(*boxed_val((x)))) #define is_not_binary(x) (!is_binary((x))) #define _unchecked_binary_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,binary_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,binary_val,Wterm) #define binary_val(x) _ET_APPLY(binary_val,(x)) /* process binaries stuff (special case of binaries) */ @@ -356,7 +361,7 @@ _ET_DECLARE_CHECKED(Eterm*,binary_val,Eterm) #define is_fun(x) (is_boxed((x)) && is_fun_header(*boxed_val((x)))) #define is_not_fun(x) (!is_fun((x))) #define _unchecked_fun_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,fun_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,fun_val,Wterm) #define fun_val(x) _ET_APPLY(fun_val,(x)) /* export access methods */ @@ -364,7 +369,7 @@ _ET_DECLARE_CHECKED(Eterm*,fun_val,Eterm) #define is_export(x) (is_boxed((x)) && is_export_header(*boxed_val((x)))) #define is_not_export(x) (!is_export((x))) #define _unchecked_export_val(x) _unchecked_boxed_val(x) -_ET_DECLARE_CHECKED(Eterm*,export_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,export_val,Wterm) #define export_val(x) _ET_APPLY(export_val,(x)) #define is_export_header(x) ((x) == HEADER_EXPORT) #if HALFWORD_HEAP @@ -391,7 +396,7 @@ _ET_DECLARE_CHECKED(Uint,bignum_header_arity,Eterm) #define is_big(x) (is_boxed((x)) && _is_bignum_header(*boxed_val((x)))) #define is_not_big(x) (!is_big((x))) #define _unchecked_big_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,big_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,big_val,Wterm) #define big_val(x) _ET_APPLY(big_val,(x)) /* flonum ("float") access methods */ @@ -404,7 +409,7 @@ _ET_DECLARE_CHECKED(Eterm*,big_val,Eterm) #define is_float(x) (is_boxed((x)) && *boxed_val((x)) == HEADER_FLONUM) #define is_not_float(x) (!is_float(x)) #define _unchecked_float_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,float_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,float_val,Wterm) #define float_val(x) _ET_APPLY(float_val,(x)) /* Float definition for byte and word access */ @@ -422,15 +427,16 @@ typedef union float_def } FloatDef; #if defined(ARCH_64) && !HALFWORD_HEAP -#define GET_DOUBLE(x, f) (f).fdw = *(float_val(x)+1) + +#define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fdw = *((fval)+1) #define PUT_DOUBLE(f, x) *(x) = HEADER_FLONUM, \ *((x)+1) = (f).fdw #define GET_DOUBLE_DATA(p, f) (f).fdw = *((Uint *) (p)) #define PUT_DOUBLE_DATA(f,p) *((Uint *) (p)) = (f).fdw #else -#define GET_DOUBLE(x, f) (f).fw[0] = *(float_val(x)+1), \ - (f).fw[1] = *(float_val(x)+2) +#define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fw[0] = *((fval)+1), \ + (f).fw[1] = *((fval)+2) #define PUT_DOUBLE(f, x) *(x) = HEADER_FLONUM, \ *((x)+1) = (f).fw[0], \ @@ -440,6 +446,9 @@ typedef union float_def #define PUT_DOUBLE_DATA(f,p) *((Uint *) (p)) = (f).fw[0],\ *(((Uint *) (p))+1) = (f).fw[1] #endif + +#define GET_DOUBLE(x, f) FLOAT_VAL_GET_DOUBLE(float_val(x), f) + #define DOUBLE_DATA_WORDS (sizeof(ieee754_8)/sizeof(Eterm)) #define FLOAT_SIZE_OBJECT (DOUBLE_DATA_WORDS+1) @@ -451,7 +460,7 @@ typedef union float_def (is_boxed((x)) && *boxed_val((x)) == make_arityval((a))) #define is_not_tuple_arity(x, a) (!is_tuple_arity((x),(a))) #define _unchecked_tuple_val(x) _unchecked_boxed_val(x) -_ET_DECLARE_CHECKED(Eterm*,tuple_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,tuple_val,Wterm) #define tuple_val(x) _ET_APPLY(tuple_val,(x)) #define TUPLE0(t) \ @@ -790,21 +799,24 @@ do { \ ((RefThing*) internal_ref_val(x)) #define is_internal_ref(x) \ - (_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x)))) + (_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x)))) + #define is_not_internal_ref(x) \ (!is_internal_ref((x))) #define _unchecked_internal_ref_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Wterm) #define internal_ref_val(x) _ET_APPLY(internal_ref_val,(x)) +#define internal_thing_ref_data_words(t) (thing_arityval(*(Eterm*)(t))) #define _unchecked_internal_ref_data_words(x) \ (_unchecked_thing_arityval(*_unchecked_internal_ref_val(x))) -_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Eterm) +_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Wterm) #define internal_ref_data_words(x) _ET_APPLY(internal_ref_data_words,(x)) -#define _unchecked_internal_ref_data(x) (_unchecked_ref_thing_ptr(x)->data.ui32) -_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Eterm) +#define internal_thing_ref_data(thing) ((thing)->data.ui32) +#define _unchecked_internal_ref_data(x) (internal_thing_ref_data(_unchecked_ref_thing_ptr(x))) +_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Wterm) #define internal_ref_data(x) _ET_APPLY(internal_ref_data,(x)) #define _unchecked_internal_ref_node(x) erts_this_node @@ -889,14 +901,14 @@ typedef struct external_thing_ { #define is_external_header(x) \ (((x) & (_TAG_HEADER_MASK-_BINARY_XXX_MASK)) == _TAG_HEADER_EXTERNAL_PID) -#define is_external(x) \ - (is_boxed((x)) && is_external_header(*boxed_val((x)))) +#define is_external(x) (is_boxed((x)) && is_external_header(*boxed_val((x)))) + #define is_external_pid(x) \ (is_boxed((x)) && is_external_pid_header(*boxed_val((x)))) #define is_external_port(x) \ - (is_boxed((x)) && is_external_port_header(*boxed_val((x)))) -#define is_external_ref(x) \ - (_unchecked_is_boxed((x)) && is_external_ref_header(*boxed_val((x)))) + (is_boxed((x)) && is_external_port_header(*boxed_val((x)))) + +#define is_external_ref(x) (_unchecked_is_boxed((x)) && is_external_ref_header(*boxed_val((x)))) #define _unchecked_is_external(x) \ (_unchecked_is_boxed((x)) && is_external_header(*_unchecked_boxed_val((x)))) @@ -914,17 +926,21 @@ typedef struct external_thing_ { #define make_external_ref make_external #define _unchecked_external_val(x) _unchecked_boxed_val((x)) -_ET_DECLARE_CHECKED(Eterm*,external_val,Eterm) +_ET_DECLARE_CHECKED(Eterm*,external_val,Wterm) #define external_val(x) _ET_APPLY(external_val,(x)) #define external_thing_ptr(x) ((ExternalThing *) external_val((x))) #define _unchecked_external_thing_ptr(x) \ ((ExternalThing *) _unchecked_external_val((x))) +#define _unchecked_external_thing_data_words(thing) \ + (_unchecked_thing_arityval((thing)->header) + (1 - EXTERNAL_THING_HEAD_SIZE)) +_ET_DECLARE_CHECKED(Uint,external_thing_data_words,ExternalThing*) +#define external_thing_data_words(thing) _ET_APPLY(external_thing_data_words,(thing)) + #define _unchecked_external_data_words(x) \ - (_unchecked_thing_arityval(_unchecked_external_thing_ptr((x))->header) \ - + (1 - EXTERNAL_THING_HEAD_SIZE)) -_ET_DECLARE_CHECKED(Uint,external_data_words,Eterm) + _unchecked_external_thing_data_words(_unchecked_external_thing_ptr((x))) +_ET_DECLARE_CHECKED(Uint,external_data_words,Wterm) #define external_data_words(x) _ET_APPLY(external_data_words,(x)) #define _unchecked_external_data(x) (_unchecked_external_thing_ptr((x))->data.ui) @@ -935,15 +951,15 @@ _ET_DECLARE_CHECKED(Uint,external_data_words,Eterm) #define _unchecked_external_pid_data_words(x) \ _unchecked_external_data_words((x)) -_ET_DECLARE_CHECKED(Uint,external_pid_data_words,Eterm) +_ET_DECLARE_CHECKED(Uint,external_pid_data_words,Wterm) #define external_pid_data_words(x) _ET_APPLY(external_pid_data_words,(x)) #define _unchecked_external_pid_data(x) _unchecked_external_data((x))[0] -_ET_DECLARE_CHECKED(Uint,external_pid_data,Eterm) +_ET_DECLARE_CHECKED(Uint,external_pid_data,Wterm) #define external_pid_data(x) _ET_APPLY(external_pid_data,(x)) #define _unchecked_external_pid_node(x) _unchecked_external_node((x)) -_ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Eterm) +_ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Wterm) #define external_pid_node(x) _ET_APPLY(external_pid_node,(x)) #define external_pid_number(x) _GET_PID_NUM(external_pid_data((x))) @@ -951,27 +967,29 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Eterm) #define _unchecked_external_port_data_words(x) \ _unchecked_external_data_words((x)) -_ET_DECLARE_CHECKED(Uint,external_port_data_words,Eterm) +_ET_DECLARE_CHECKED(Uint,external_port_data_words,Wterm) #define external_port_data_words(x) _ET_APPLY(external_port_data_words,(x)) #define _unchecked_external_port_data(x) _unchecked_external_data((x))[0] -_ET_DECLARE_CHECKED(Uint,external_port_data,Eterm) +_ET_DECLARE_CHECKED(Uint,external_port_data,Wterm) #define external_port_data(x) _ET_APPLY(external_port_data,(x)) #define _unchecked_external_port_node(x) _unchecked_external_node((x)) -_ET_DECLARE_CHECKED(struct erl_node_*,external_port_node,Eterm) +_ET_DECLARE_CHECKED(struct erl_node_*,external_port_node,Wterm) #define external_port_node(x) _ET_APPLY(external_port_node,(x)) #define external_port_number(x) _GET_PORT_NUM(external_port_data((x))) #define _unchecked_external_ref_data_words(x) \ _unchecked_external_data_words((x)) -_ET_DECLARE_CHECKED(Uint,external_ref_data_words,Eterm) +_ET_DECLARE_CHECKED(Uint,external_ref_data_words,Wterm) #define external_ref_data_words(x) _ET_APPLY(external_ref_data_words,(x)) +#define external_thing_ref_data_words(thing) external_thing_data_words(thing) #define _unchecked_external_ref_data(x) (_unchecked_external_thing_ptr((x))->data.ui32) -_ET_DECLARE_CHECKED(Uint32*,external_ref_data,Eterm) +_ET_DECLARE_CHECKED(Uint32*,external_ref_data,Wterm) #define external_ref_data(x) _ET_APPLY(external_ref_data,(x)) +#define external_thing_ref_data(thing) ((thing)->data.ui32) #define _unchecked_external_ref_node(x) _unchecked_external_node((x)) _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm) @@ -995,14 +1013,14 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm) #endif #define _unchecked_make_cp(x) ((Eterm) COMPRESS_POINTER(x)) -_ET_DECLARE_CHECKED(Eterm,make_cp,BeamInstr*); +_ET_DECLARE_CHECKED(Eterm,make_cp,BeamInstr*) #define make_cp(x) _ET_APPLY(make_cp,(x)) #define is_not_CP(x) ((x) & _CPMASK) #define is_CP(x) (!is_not_CP(x)) #define _unchecked_cp_val(x) ((BeamInstr*) EXPAND_POINTER(x)) -_ET_DECLARE_CHECKED(BeamInstr*,cp_val,Eterm); +_ET_DECLARE_CHECKED(BeamInstr*,cp_val,Eterm) #define cp_val(x) _ET_APPLY(cp_val,(x)) #define make_catch(x) (((x) << _TAG_IMMED2_SIZE) | _TAG_IMMED2_CATCH) @@ -1083,10 +1101,10 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint) #define SMALL_DEF 0xf #if ET_DEBUG -extern unsigned tag_val_def_debug(Eterm, const char*, unsigned); +extern unsigned tag_val_def_debug(Wterm, const char*, unsigned); #define tag_val_def(x) tag_val_def_debug((x),__FILE__,__LINE__) #else -extern unsigned tag_val_def(Eterm); +extern unsigned tag_val_def(Wterm); #endif #define not_eq_tags(X,Y) (tag_val_def((X)) ^ tag_val_def((Y))) @@ -1102,5 +1120,81 @@ extern unsigned tag_val_def(Eterm); #define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF) #define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF) +#if HALFWORD_HEAP +#define ptr2rel(PTR,BASE) ((Eterm*)((char*)(PTR) - (char*)(BASE))) +#define rterm2wterm(REL,BASE) ((Wterm)(REL) + (Wterm)(BASE)) + +#else /* HALFWORD_HEAP */ + +#define ptr2rel(PTR,BASE) (PTR) +#define rterm2wterm(REL,BASE) (REL) + +#endif /* !HALFWORD_HEAP */ + +#define make_list_rel(PTR, BASE) make_list(ptr2rel(PTR,BASE)) +#define make_boxed_rel(PTR, BASE) make_boxed(ptr2rel(PTR,BASE)) +#define make_fun_rel make_boxed_rel +#define make_binary_rel make_boxed_rel +#define make_tuple_rel make_boxed_rel +#define make_external_rel make_boxed_rel +#define make_internal_ref_rel make_boxed_rel + +#define binary_val_rel(RTERM, BASE) binary_val(rterm2wterm(RTERM, BASE)) +#define list_val_rel(RTERM, BASE) list_val(rterm2wterm(RTERM, BASE)) +#define boxed_val_rel(RTERM, BASE) boxed_val(rterm2wterm(RTERM, BASE)) +#define tuple_val_rel(RTERM, BASE) tuple_val(rterm2wterm(RTERM, BASE)) +#define export_val_rel(RTERM, BASE) export_val(rterm2wterm(RTERM, BASE)) +#define fun_val_rel(RTERM, BASE) fun_val(rterm2wterm(RTERM, BASE)) +#define big_val_rel(RTERM,BASE) big_val(rterm2wterm(RTERM,BASE)) +#define float_val_rel(RTERM,BASE) float_val(rterm2wterm(RTERM,BASE)) +#define internal_ref_val_rel(RTERM,BASE) internal_ref_val(rterm2wterm(RTERM,BASE)) + +#define external_thing_ptr_rel(RTERM, BASE) external_thing_ptr(rterm2wterm(RTERM, BASE)) +#define external_data_words_rel(RTERM,BASE) external_data_words(rterm2wterm(RTERM,BASE)) + +#define external_port_node_rel(RTERM,BASE) external_port_node(rterm2wterm(RTERM,BASE)) +#define external_port_data_rel(RTERM,BASE) external_port_data(rterm2wterm(RTERM,BASE)) + +#define is_external_pid_rel(RTERM,BASE) is_external_pid(rterm2wterm(RTERM,BASE)) +#define external_pid_node_rel(RTERM,BASE) external_pid_node(rterm2wterm(RTERM,BASE)) +#define external_pid_data_rel(RTERM,BASE) external_pid_data(rterm2wterm(RTERM,BASE)) + +#define is_binary_rel(RTERM,BASE) is_binary(rterm2wterm(RTERM,BASE)) +#define is_float_rel(RTERM,BASE) is_float(rterm2wterm(RTERM,BASE)) +#define is_fun_rel(RTERM,BASE) is_fun(rterm2wterm(RTERM,BASE)) +#define is_big_rel(RTERM,BASE) is_big(rterm2wterm(RTERM,BASE)) +#define is_export_rel(RTERM,BASE) is_export(rterm2wterm(RTERM,BASE)) +#define is_tuple_rel(RTERM,BASE) is_tuple(rterm2wterm(RTERM,BASE)) + +#define GET_DOUBLE_REL(RTERM, f, BASE) GET_DOUBLE(rterm2wterm(RTERM,BASE), f) + +#define ref_thing_ptr_rel(RTERM,BASE) ref_thing_ptr(rterm2wterm(RTERM,BASE)) +#define is_internal_ref_rel(RTERM,BASE) is_internal_ref(rterm2wterm(RTERM,BASE)) +#define is_external_rel(RTERM,BASE) is_external(rterm2wterm(RTERM,BASE)) +#define is_external_port_rel(RTERM,BASE) is_external_port(rterm2wterm(RTERM,BASE)) +#define is_external_ref_rel(RTERM,BASE) is_external_ref(rterm2wterm(RTERM,BASE)) + +#define external_node_rel(RTERM,BASE) external_node(rterm2wterm(RTERM,BASE)) + + +#if HALFWORD_HEAP +ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) +{ + /* If bases differ, assume a and b are on different "heaps", + ie can only be same if immed */ + ASSERT(a_base == b_base || is_immed(a) || is_immed(b) + || rterm2wterm(a,a_base) != rterm2wterm(b,b_base)); + + return a == b && (a_base == b_base || is_immed(a)); +} +#endif + +#else /* !HALFWORD_HEAP */ +#define is_same(A,A_BASE,B,B_BASE) ((A)==(B)) +#endif + #endif /* __ERL_TERM_H */ diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 84a20b51f2..8c9cace0c5 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2010. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 @@ -36,6 +36,16 @@ #include "erl_lock_count.h" #include "erl_term.h" +#if defined(__GLIBC__) && (__GLIBC__ << 16) + __GLIBC_MINOR__ < (2 << 16) + 4 +/* + * pthread_mutex_destroy() may return EBUSY when it shouldn't :( We have + * only seen this bug in glibc versions before 2.4. Note that condition + * variables, rwmutexes, spinlocks, and rwspinlocks also may be effected by + * this bug since these implementations may use mutexes internally. + */ +# define ERTS_THR_HAVE_BUSY_DESTROY_BUG +#endif + #define ERTS_THR_MEMORY_BARRIER ETHR_MEMORY_BARRIER #ifdef ERTS_ENABLE_LOCK_COUNT @@ -175,6 +185,9 @@ typedef struct { int gcc_is_buggy; } erts_rwlock_t; #endif /* #ifdef USE_THREADS */ #define ERTS_AINT_T_MAX (~(((erts_aint_t) 1) << (sizeof(erts_aint_t)*8-1))) +#define ERTS_AINT_T_MIN ((((erts_aint_t) 1) << (sizeof(erts_aint_t)*8-1))) +#define ERTS_AINT32_T_MAX (~(((erts_aint32_t) 1) << (sizeof(erts_aint32_t)*8-1))) +#define ERTS_AINT32_T_MIN ((((erts_aint32_t) 1) << (sizeof(erts_aint32_t)*8-1))) ERTS_GLB_INLINE void erts_thr_init(erts_thr_init_data_t *id); ERTS_GLB_INLINE void erts_thr_late_init(erts_thr_late_init_data_t *id); @@ -551,8 +564,16 @@ erts_mtx_destroy(erts_mtx_t *mtx) erts_lcnt_destroy_lock(&mtx->lcnt); #endif res = ethr_mutex_destroy(&mtx->mtx); - if (res) + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy mutex destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif erts_thr_fatal_error(res, "destroy mutex"); + } #endif } @@ -647,8 +668,16 @@ erts_cnd_destroy(erts_cnd_t *cnd) { #ifdef USE_THREADS int res = ethr_cond_destroy(cnd); - if (res) + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy cond destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif erts_thr_fatal_error(res, "destroy condition variable"); + } #endif } @@ -774,8 +803,16 @@ erts_rwmtx_destroy(erts_rwmtx_t *rwmtx) erts_lcnt_destroy_lock(&rwmtx->lcnt); #endif res = ethr_rwmutex_destroy(&rwmtx->rwmtx); - if (res != 0) + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy rwmutex destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif erts_thr_fatal_error(res, "destroy rwmutex"); + } #endif } @@ -1452,8 +1489,16 @@ erts_spinlock_destroy(erts_spinlock_t *lock) erts_lcnt_destroy_lock(&lock->lcnt); #endif res = ethr_spinlock_destroy(&lock->slck); - if (res) - erts_thr_fatal_error(res, "destroy spinlock"); + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy spinlock destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif + erts_thr_fatal_error(res, "destroy rwlock"); + } #else (void)lock; #endif @@ -1562,8 +1607,16 @@ erts_rwlock_destroy(erts_rwlock_t *lock) erts_lcnt_destroy_lock(&lock->lcnt); #endif res = ethr_rwlock_destroy(&lock->rwlck); - if (res) + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy rwlock destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif erts_thr_fatal_error(res, "destroy rwlock"); + } #else (void)lock; #endif diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index 6f6b971d34..d0ad73cd81 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2011. 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 @@ -20,11 +20,15 @@ #ifndef ERL_TIME_H__ #define ERL_TIME_H__ +extern erts_smp_atomic_t do_time; /* set at clock interrupt */ +extern SysTimeval erts_first_emu_time; + /* ** Timer entry: */ typedef struct erl_timer { struct erl_timer* next; /* next entry tiw slot or chain */ + struct erl_timer* prev; /* prev entry tiw slot or chain */ Uint slot; /* slot in timer wheel */ Uint count; /* number of loops remaining */ int active; /* 1=activated, 0=deactivated */ @@ -39,7 +43,6 @@ typedef void (*ErlTimeoutProc)(void*); typedef void (*ErlCancelProc)(void*); #ifdef ERTS_SMP - /* * Process and port timer */ @@ -61,7 +64,66 @@ void erts_create_smp_ptimer(ErtsSmpPTimer **timer_ref, ErlTimeoutProc timeout_func, Uint timeout); void erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer); +#endif + +/* timer-wheel api */ +void erts_init_time(void); +void erts_set_timer(ErlTimer*, ErlTimeoutProc, ErlCancelProc, void*, Uint); +void erts_cancel_timer(ErlTimer*); +void erts_bump_timer(erts_aint_t); +Uint erts_timer_wheel_memory_size(void); +Uint erts_time_left(ErlTimer *); +erts_aint_t erts_next_time(void); + +#ifdef DEBUG +void erts_p_slpq(void); #endif +ERTS_GLB_INLINE erts_aint_t erts_do_time_read_and_reset(void); +ERTS_GLB_INLINE void erts_do_time_add(long); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE erts_aint_t erts_do_time_read_and_reset(void) { return erts_smp_atomic_xchg(&do_time, 0L); } +ERTS_GLB_INLINE void erts_do_time_add(long elapsed) { erts_smp_atomic_add(&do_time, elapsed); } + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + +/* time_sup */ + +#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME)) +# ifndef HAVE_ERTS_NOW_CPU +# define HAVE_ERTS_NOW_CPU +# ifdef HAVE_GETHRVTIME +# define erts_start_now_cpu() sys_start_hrvtime() +# define erts_stop_now_cpu() sys_stop_hrvtime() +# endif +# endif +void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec); #endif + +void erts_get_timeval(SysTimeval *tv); +long erts_get_time(void); +void erts_get_emu_time(SysTimeval *); + +ERTS_GLB_INLINE int erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE int +erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p) +{ + if (t1p->tv_sec == t2p->tv_sec) { + if (t1p->tv_usec < t2p->tv_usec) + return -1; + else if (t1p->tv_usec > t2p->tv_usec) + return 1; + return 0; + } + return t1p->tv_sec < t2p->tv_sec ? -1 : 1; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ +#endif /* ERL_TIME_H__ */ diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 7b8706ea13..ca4b54188e 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -358,10 +358,6 @@ static int clock_resolution; ** instead of something like select. */ -#if defined(ERTS_TIMER_THREAD) -static ERTS_INLINE void init_erts_deliver_time(const SysTimeval *inittv) { } -static ERTS_INLINE void do_erts_deliver_time(const SysTimeval *current) { } -#else static SysTimeval last_delivered; static void init_erts_deliver_time(const SysTimeval *inittv) @@ -389,11 +385,10 @@ static void do_erts_deliver_time(const SysTimeval *current) this by simply pretend as if the time stood still. :) */ if (elapsed > 0) { - do_time_add(elapsed); + erts_do_time_add(elapsed); last_delivered = cur_time; } } -#endif int erts_init_time_sup(void) @@ -786,7 +781,6 @@ get_sys_now(Uint* megasec, Uint* sec, Uint* microsec) to a struct timeval representing current time (to save a gettimeofday() where possible) or NULL */ -#if !defined(ERTS_TIMER_THREAD) void erts_deliver_time(void) { SysTimeval now; @@ -797,7 +791,6 @@ void erts_deliver_time(void) { erts_smp_mtx_unlock(&erts_timeofday_mtx); } -#endif /* get *real* time (not ticks) remaining until next timeout - if there isn't one, give a "long" time, that is guaranteed @@ -806,14 +799,12 @@ void erts_deliver_time(void) { void erts_time_remaining(SysTimeval *rem_time) { int ticks; -#if !defined(ERTS_TIMER_THREAD) SysTimeval cur_time; -#endif long elapsed; - /* next_time() returns no of ticks to next timeout or -1 if none */ + /* erts_next_time() returns no of ticks to next timeout or -1 if none */ - if ((ticks = next_time()) == -1) { + if ((ticks = erts_next_time()) == -1) { /* timer queue empty */ /* this will cause at most 100000000 ticks */ rem_time->tv_sec = 100000; @@ -822,9 +813,6 @@ void erts_time_remaining(SysTimeval *rem_time) /* next timeout after ticks ticks */ ticks *= CLOCK_RESOLUTION; -#if defined(ERTS_TIMER_THREAD) - elapsed = 0; -#else erts_smp_mtx_lock(&erts_timeofday_mtx); get_tolerant_timeofday(&cur_time); @@ -839,7 +827,6 @@ void erts_time_remaining(SysTimeval *rem_time) rem_time->tv_sec = rem_time->tv_usec = 0; return; } -#endif rem_time->tv_sec = (ticks - elapsed) / 1000; rem_time->tv_usec = 1000 * ((ticks - elapsed) % 1000); } diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 3043bb1e8c..c0397ca6c3 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2010. All Rights Reserved. + * Copyright Ericsson AB 1999-2011. 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 @@ -1668,7 +1668,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, return_flags = 0; if (match_spec) { pam_result = erts_match_set_run(p, match_spec, args, arity, - &return_flags); + ERTS_PAM_TMP_RESULT, &return_flags); if (is_non_value(pam_result)) { erts_match_set_release_result(p); #if !HEAP_ON_C_STACK @@ -1815,7 +1815,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, return_flags = 0; if (match_spec) { pam_result = erts_match_set_run(p, match_spec, args, arity, - &return_flags); + ERTS_PAM_TMP_RESULT, &return_flags); if (is_non_value(pam_result)) { erts_match_set_release_result(p); UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 48fa99934e..e7fd144ec3 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -47,7 +47,7 @@ #define SEQ_TRACE 1 #define CONTEXT_REDS 2000 /* Swap process out after this number */ -#define MAX_ARG 256 /* Max number of arguments allowed */ +#define MAX_ARG 255 /* Max number of arguments allowed */ #define MAX_REG 1024 /* Max number of x(N) registers used */ /* Scheduler stores data for temporary heaps if @@ -120,14 +120,15 @@ * Allocate heap memory, first on the ordinary heap; * failing that, in a heap fragment. */ -#define HAlloc(p, sz) \ +#define HAllocX(p, sz, xtra) \ (ASSERT_EXPR((sz) >= 0), \ ErtsHAllocLockCheck(p), \ (IS_FORCE_HEAP_FRAGS || (((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \ - ? erts_heap_alloc((p),(sz)) \ + ? erts_heap_alloc((p),(sz),(xtra)) \ : (INIT_HEAP_MEM(p,sz), \ HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz)))) +#define HAlloc(P, SZ) HAllocX(P,SZ,0) #define HRelease(p, endp, ptr) \ if ((ptr) == (endp)) { \ diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 328aa2be6a..1a102f7187 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -1264,7 +1264,7 @@ external_size_1(Process* p, Eterm Term) Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { - int size; + Uint size; Eterm bin; size_t real_size; byte* endp; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index c948af14ae..432bdd705b 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -834,7 +834,7 @@ do { \ void erts_emasculate_writable_binary(ProcBin* pb); Eterm erts_new_heap_binary(Process *p, byte *buf, int len, byte** datap); Eterm erts_new_mso_binary(Process*, byte*, int); -Eterm new_binary(Process*, byte*, int); +Eterm new_binary(Process*, byte*, Uint); Eterm erts_realloc_binary(Eterm bin, size_t size); /* erl_bif_info.c */ @@ -890,9 +890,31 @@ void erl_error(char*, va_list); /* copy.c */ void init_copy(void); Eterm copy_object(Eterm, Process*); + +#if HALFWORD_HEAP +Uint size_object_rel(Eterm, Eterm*); +# define size_object(A) size_object_rel(A,NULL) + +Eterm copy_struct_rel(Eterm, Uint, Eterm**, ErlOffHeap*, Eterm* src_base, Eterm* dst_base); +# define copy_struct(OBJ,SZ,HPP,OH) copy_struct_rel(OBJ,SZ,HPP,OH, NULL,NULL) + +Eterm copy_shallow_rel(Eterm*, Uint, Eterm**, ErlOffHeap*, Eterm* src_base); +# define copy_shallow(A,B,C,D) copy_shallow_rel(A,B,C,D,NULL) + +#else /* !HALFWORD_HEAP */ + Uint size_object(Eterm); +# define size_object_rel(A,B) size_object(A) + Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); +# define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH) + Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); +# define copy_shallow_rel(A,B,C,D, BASE) copy_shallow(A,B,C,D) + +#endif + + void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first, Eterm* refs, unsigned nrefs); @@ -1425,84 +1447,6 @@ void erl_drv_thr_init(void); /* time.c */ -ERTS_GLB_INLINE erts_aint_t do_time_read_and_reset(void); -#ifdef ERTS_TIMER_THREAD -ERTS_GLB_INLINE int next_time(void); -ERTS_GLB_INLINE void bump_timer(erts_aint_t); -#else -erts_aint_t next_time(void); -void bump_timer(erts_aint_t); -extern erts_smp_atomic_t do_time; /* set at clock interrupt */ -ERTS_GLB_INLINE void do_time_add(erts_aint_t); -#endif - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -#ifdef ERTS_TIMER_THREAD -ERTS_GLB_INLINE erts_aint_t do_time_read_and_reset(void) { return 0; } -ERTS_GLB_INLINE erts_aint_t next_time(void) { return -1; } -ERTS_GLB_INLINE void bump_timer(erts_aint_t ignore) { } -#else -ERTS_GLB_INLINE erts_aint_t do_time_read_and_reset(void) -{ - return erts_smp_atomic_xchg(&do_time, 0L); -} -ERTS_GLB_INLINE void do_time_add(erts_aint_t elapsed) -{ - erts_smp_atomic_add(&do_time, elapsed); -} -#endif - -#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ - -void init_time(void); -void erl_set_timer(ErlTimer*, ErlTimeoutProc, ErlCancelProc, void*, Uint); -void erl_cancel_timer(ErlTimer*); -Uint time_left(ErlTimer *); - -Uint erts_timer_wheel_memory_size(void); - -#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME)) -# ifndef HAVE_ERTS_NOW_CPU -# define HAVE_ERTS_NOW_CPU -# ifdef HAVE_GETHRVTIME -# define erts_start_now_cpu() sys_start_hrvtime() -# define erts_stop_now_cpu() sys_stop_hrvtime() -# endif -# endif -void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec); -#endif - -void erts_get_timeval(SysTimeval *tv); -long erts_get_time(void); - -extern SysTimeval erts_first_emu_time; - -void erts_get_emu_time(SysTimeval *); - -ERTS_GLB_INLINE int erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p); - -#if ERTS_GLB_INLINE_INCL_FUNC_DEF - -ERTS_GLB_INLINE int -erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p) -{ - if (t1p->tv_sec == t2p->tv_sec) { - if (t1p->tv_usec < t2p->tv_usec) - return -1; - else if (t1p->tv_usec > t2p->tv_usec) - return 1; - return 0; - } - return t1p->tv_sec < t2p->tv_sec ? -1 : 1; -} - -#endif - -#ifdef DEBUG -void p_slpq(void); -#endif - /* utils.c */ /* @@ -1561,16 +1505,30 @@ void erts_init_utils_mem(void); erts_dsprintf_buf_t *erts_create_tmp_dsbuf(Uint); void erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *); +#if HALFWORD_HEAP +int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base); +# define eq(A,B) eq_rel(A,NULL,B,NULL) +#else int eq(Eterm, Eterm); +# define eq_rel(A,A_BASE,B,B_BASE) eq(A,B) +#endif + #define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y)))) +#if HALFWORD_HEAP +Sint cmp_rel(Eterm, Eterm*, Eterm, Eterm*); +#define CMP(A,B) cmp_rel(A,NULL,B,NULL) +#else Sint cmp(Eterm, Eterm); -#define cmp_lt(a,b) (cmp((a),(b)) < 0) -#define cmp_le(a,b) (cmp((a),(b)) <= 0) -#define cmp_eq(a,b) (cmp((a),(b)) == 0) -#define cmp_ne(a,b) (cmp((a),(b)) != 0) -#define cmp_ge(a,b) (cmp((a),(b)) >= 0) -#define cmp_gt(a,b) (cmp((a),(b)) > 0) +#define cmp_rel(A,A_BASE,B,B_BASE) cmp(A,B) +#define CMP(A,B) cmp(A,B) +#endif +#define cmp_lt(a,b) (CMP((a),(b)) < 0) +#define cmp_le(a,b) (CMP((a),(b)) <= 0) +#define cmp_eq(a,b) (CMP((a),(b)) == 0) +#define cmp_ne(a,b) (CMP((a),(b)) != 0) +#define cmp_ge(a,b) (CMP((a),(b)) >= 0) +#define cmp_gt(a,b) (CMP((a),(b)) > 0) #define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b))) #define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b))) @@ -1742,6 +1700,7 @@ Uint erts_current_reductions(Process* current, Process *p); int erts_print_system_version(int to, void *arg, Process *c_p); +int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg); #define seq_trace_output(token, msg, type, receiver, process) \ seq_trace_output_generic((token), (msg), (type), (receiver), (process), NIL) #define seq_trace_output_exit(token, msg, type, receiver, exitfrom) \ @@ -1799,8 +1758,15 @@ do { \ extern Binary *erts_match_set_compile(Process *p, Eterm matchexpr); Eterm erts_match_set_lint(Process *p, Eterm matchexpr); extern void erts_match_set_release_result(Process* p); + +enum erts_pam_run_flags { + ERTS_PAM_TMP_RESULT=0, + ERTS_PAM_COPY_RESULT=1, + ERTS_PAM_CONTIGUOUS_TUPLE=2 +}; extern Eterm erts_match_set_run(Process *p, Binary *mpsp, Eterm *args, int num_args, + enum erts_pam_run_flags in_flags, Uint32 *return_flags); extern Eterm erts_match_set_get_source(Binary *mpsp); extern void erts_match_prog_foreach_offheap(Binary *b, diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index f6c6a01fb2..f21a96c754 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -670,7 +670,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ #ifdef ERTS_SMP erts_cancel_smp_ptimer(port->ptimer); #else - erl_cancel_timer(&(port->tm)); + erts_cancel_timer(&(port->tm)); #endif stopq(port); kill_port(port); @@ -1839,7 +1839,7 @@ terminate_port(Port *prt) #ifdef ERTS_SMP erts_cancel_smp_ptimer(prt->ptimer); #else - erl_cancel_timer(&prt->tm); + erts_cancel_timer(&prt->tm); #endif drv = prt->drv_ptr; @@ -4068,7 +4068,7 @@ drv_cancel_timer(Port *prt) #ifdef ERTS_SMP erts_cancel_smp_ptimer(prt->ptimer); #else - erl_cancel_timer(&prt->tm); + erts_cancel_timer(&prt->tm); #endif if (erts_port_task_is_scheduled(&prt->timeout_task)) erts_port_task_abort(prt->id, &prt->timeout_task); @@ -4092,7 +4092,7 @@ int driver_set_timer(ErlDrvPort ix, UWord t) (ErlTimeoutProc) schedule_port_timeout, t); #else - erl_set_timer(&prt->tm, + erts_set_timer(&prt->tm, (ErlTimeoutProc) schedule_port_timeout, NULL, prt, @@ -4123,9 +4123,9 @@ driver_read_timer(ErlDrvPort ix, unsigned long* t) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SMP - *t = prt->ptimer ? time_left(&prt->ptimer->timer.tm) : 0; + *t = prt->ptimer ? erts_time_left(&prt->ptimer->timer.tm) : 0; #else - *t = time_left(&prt->tm); + *t = erts_time_left(&prt->tm); #endif return 0; } diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index a2439d5582..6caa1e0b2d 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -101,16 +101,16 @@ return %macro: test_heap TestHeap -pack allocate t t -allocate_heap I I I +allocate_heap t I t deallocate I init y allocate_zero t t -allocate_heap_zero I I I +allocate_heap_zero t I t trim N Remaining => i_trim N i_trim I -test_heap I I +test_heap I t allocate_heap S u==0 R => allocate S R allocate_heap_zero S u==0 R => allocate_zero S R @@ -124,7 +124,7 @@ init Y1 | init Y2 => init2 Y1 Y2 # Selecting values -select_val S=q Fail=f Size=u Rest=* => const_select_val(S, Fail, Size, Rest) +select_val S=aiq Fail=f Size=u Rest=* => const_select_val(S, Fail, Size, Rest) select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \ gen_jump_tab(S, Fail, Size, Rest) @@ -132,34 +132,59 @@ select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \ is_integer Fail=f S | select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \ gen_jump_tab(S, Fail, Size, Rest) +is_integer TypeFail=f S | select_val S=s Fail=f Size=u Rest=* | \ + mixed_types(Size, Rest) => \ + gen_split_values(S, TypeFail, Fail, Size, Rest) + select_val S=s Fail=f Size=u Rest=* | mixed_types(Size, Rest) => \ - gen_split_values(S, Fail, Size, Rest) + gen_split_values(S, Fail, Fail, Size, Rest) -is_integer Fail=f S | select_val S=s Fail=f Size=u Rest=* | \ +is_integer Fail=f S | select_val S=d Fail=f Size=u Rest=* | \ fixed_size_values(Size, Rest) => gen_select_val(S, Fail, Size, Rest) -is_atom Fail=f S | select_val S=s Fail=f Size=u Rest=* | \ +is_atom Fail=f S | select_val S=d Fail=f Size=u Rest=* | \ fixed_size_values(Size, Rest) => gen_select_val(S, Fail, Size, Rest) -select_val S=s Fail=f Size=u Rest=* | fixed_size_values(Size, Rest) => \ - gen_select_val(S, Fail, Size, Rest) +select_val S=s Fail=f Size=u Rest=* | floats_or_bignums(Size, Rest) => \ + gen_select_literals(S, Fail, Size, Rest) -select_val S=s Fail=f Size=u Rest=* | all_values_are_big(Size, Rest) => \ - gen_select_big(S, Fail, Size, Rest) +select_val S=d Fail=f Size=u Rest=* | fixed_size_values(Size, Rest) => \ + gen_select_val(S, Fail, Size, Rest) -is_tuple Fail=f S | select_tuple_arity S=s Fail=f Size=u Rest=* => \ +is_tuple Fail=f S | select_tuple_arity S=d Fail=f Size=u Rest=* => \ gen_select_tuple_arity(S, Fail, Size, Rest) -select_tuple_arity S=s Fail=f Size=u Rest=* => \ +select_tuple_arity S=d Fail=f Size=u Rest=* => \ gen_select_tuple_arity(S, Fail, Size, Rest) -i_select_val s f I -i_select_tuple_arity s f I -i_select_big s f -i_select_float s f I +i_select_val r f I +i_select_val x f I +i_select_val y f I + +i_select_val2 r f c f c f +i_select_val2 x f c f c f +i_select_val2 y f c f c f + +i_select_tuple_arity2 r f A f A f +i_select_tuple_arity2 x f A f A f +i_select_tuple_arity2 y f A f A f + +i_select_tuple_arity r f I +i_select_tuple_arity x f I +i_select_tuple_arity y f I + +i_jump_on_val_zero r f I +i_jump_on_val_zero x f I +i_jump_on_val_zero y f I + +i_jump_on_val r f I I +i_jump_on_val x f I I +i_jump_on_val y f I I -i_jump_on_val_zero s f I -i_jump_on_val s f I I +jump Target | label Lbl | same_label(Target, Lbl) => label Lbl + +is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \ + is_eq_exact Fail S1 S2 | label L2 %macro: get_list GetList -pack get_list x x x @@ -234,11 +259,17 @@ is_number Fail Literal=q => move Literal x | is_number Fail x jump f -case_end Literal=q => move Literal x | case_end x -badmatch Literal=q => move Literal x | badmatch x +case_end Literal=cq => move Literal x | case_end x +badmatch Literal=cq => move Literal x | badmatch x + +case_end r +case_end x +case_end y + +badmatch r +badmatch x +badmatch y -case_end s -badmatch s if_end raise s s @@ -248,12 +279,33 @@ system_limit j move R R => +move C=cxy r | jump Lbl => move_jump Lbl C + +%macro: move_jump MoveJump -nonext +move_jump f n +move_jump f c +move_jump f x +move_jump f y + move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2 move Y1=y X1=x | move Y2=y X2=x => move2 Y1 X1 Y2 X2 +move X1=x X2=x | move X3=x X4=x => move2 X1 X2 X3 X4 + +move C=aiq X=x==1 => move_x1 C +move C=aiq X=x==2 => move_x2 C + +move_x1 c +move_x2 c %macro: move2 Move2 -pack move2 x y x y move2 y x y x +move2 x x x x + +# The compiler almost never generates a "move Literal y(Y)" instruction, +# so let's cheat if we encounter one. +move S=n D=y => init D +move S=c D=y => move S x | move x D %macro:move Move -pack -gen_dest move x x @@ -265,15 +317,10 @@ move r x move r y move c r move c x -move c y move n x move n r move y y -%cold -move s d -%hot - # Receive operations. loop_rec Fail Src | smp_mark_target_label(Fail) => i_loop_rec Fail Src @@ -306,55 +353,78 @@ i_wait_error_locked send # -# Comparisions. +# Optimized comparisons with one immediate/literal operand. +# + +is_eq_exact Lbl R=rxy C=ian => i_is_eq_exact_immed Lbl R C +is_eq_exact Lbl R=rxy C=q => i_is_eq_exact_literal R Lbl C + +is_ne_exact Lbl R=rxy C=ian => i_is_ne_exact_immed Lbl R C +is_ne_exact Lbl R=rxy C=q => i_is_ne_exact_literal R Lbl C + +%macro: i_is_eq_exact_immed EqualImmed -fail_action +i_is_eq_exact_immed f r c +i_is_eq_exact_immed f x c +i_is_eq_exact_immed f y c + +i_is_eq_exact_literal r f c +i_is_eq_exact_literal x f c +i_is_eq_exact_literal y f c + +%macro: i_is_ne_exact_immed NotEqualImmed -fail_action +i_is_ne_exact_immed f r c +i_is_ne_exact_immed f x c +i_is_ne_exact_immed f y c + +i_is_ne_exact_literal r f c +i_is_ne_exact_literal x f c +i_is_ne_exact_literal y f c + +# +# All other comparisons. # -is_eq_exact Lbl=f R=rxy C=ian => i_is_eq_immed Lbl R C -is_eq Lbl=f R=rxy C=an => i_is_eq_immed Lbl R C +is_eq_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_eq_exact Lbl +is_ne_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_ne_exact Lbl is_ge Lbl S1 S2 => i_fetch S1 S2 | i_is_ge Lbl is_lt Lbl S1 S2 => i_fetch S1 S2 | i_is_lt Lbl is_eq Lbl S1 S2 => i_fetch S1 S2 | i_is_eq Lbl is_ne Lbl S1 S2 => i_fetch S1 S2 | i_is_ne Lbl -is_eq_exact Lbl=f S1 S2 => i_fetch S1 S2 | i_is_eq_exact Lbl -is_ne_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_ne_exact Lbl - +i_is_eq_exact f +i_is_ne_exact f i_is_lt f i_is_ge f i_is_eq f i_is_ne f -i_is_eq_exact f -i_is_ne_exact f - -%macro: i_is_eq_immed EqualImmed -fail_action -i_is_eq_immed f r c -i_is_eq_immed f x c -i_is_eq_immed f y c # # Putting things. # -put_tuple Arity Dst | put V => i_put_tuple Arity V Dst +put_tuple Arity Dst => i_put_tuple Dst u -%macro: i_put_tuple PutTuple -pack -i_put_tuple A x x -i_put_tuple A y x -i_put_tuple A r x -i_put_tuple A n x -i_put_tuple A c x -i_put_tuple A x y -i_put_tuple A x r -i_put_tuple A y r -i_put_tuple A n r -i_put_tuple A c r +i_put_tuple Dst Arity Puts=* | put S1 | put S2 | \ + put S3 | put S4 | put S5 => \ + tuple_append_put5(Arity, Dst, Puts, S1, S2, S3, S4, S5) -%cold -i_put_tuple A r y -i_put_tuple A y y -i_put_tuple A c y -%hot +i_put_tuple Dst Arity Puts=* | put S => \ + tuple_append_put(Arity, Dst, Puts, S) + +i_put_tuple/2 + +%macro:i_put_tuple PutTuple -pack -goto:do_put_tuple +i_put_tuple r I +i_put_tuple x I +i_put_tuple y I + +# +# The instruction "put_list Const [] Dst" will not be generated by +# the current BEAM compiler. But until R15A, play it safe by handling +# that instruction with the following transformation. +# +put_list Const=c n Dst => move Const x | put_list x n Dst %macro:put_list PutList -pack -gen_dest @@ -362,10 +432,8 @@ put_list x n x put_list y n x put_list x x x put_list y x x -put_list c n x put_list x x r put_list y r r -put_list c n r put_list y y x put_list x y x @@ -376,6 +444,13 @@ put_list y y r put_list y r x put_list r n x +put_list x r x +put_list x y r +put_list y x r +put_list y x x + +put_list x r r + # put_list SrcReg Constant Dst put_list r c r put_list r c x @@ -403,17 +478,9 @@ put_list c y x put_list c y y %cold -put_list x r r put_list s s d %hot -%macro: put Put -put x -put r -put y -put c -put n - %macro: i_fetch FetchArgs -pack i_fetch c c i_fetch c r @@ -464,19 +531,20 @@ move_return n r move S r | deallocate D | return => move_deallocate_return S r D -%macro: move_deallocate_return MoveDeallocateReturn -nonext -move_deallocate_return x r P -move_deallocate_return y r P -move_deallocate_return c r P -move_deallocate_return n r P +%macro: move_deallocate_return MoveDeallocateReturn -pack -nonext +move_deallocate_return x r Q +move_deallocate_return y r Q +move_deallocate_return c r Q +move_deallocate_return n r Q deallocate D | return => deallocate_return D %macro: deallocate_return DeallocateReturn -nonext -deallocate_return P +deallocate_return Q test_heap Need u==1 | put_list Y=y r r => test_heap_1_put_list Need Y +%macro: test_heap_1_put_list TestHeapPutList -pack test_heap_1_put_list I y # Test tuple & arity (head) @@ -576,14 +644,14 @@ is_list f y is_nonempty_list Fail=f S=rx | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs -%macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -is_nonempty_list_allocate f x I I -is_nonempty_list_allocate f r I I +%macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -pack +is_nonempty_list_allocate f x I t +is_nonempty_list_allocate f r I t is_nonempty_list F=f r | test_heap I1 I2 => is_non_empty_list_test_heap F r I1 I2 -%macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -is_non_empty_list_test_heap f r I I +%macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -pack +is_non_empty_list_test_heap f r I t %macro: is_nonempty_list IsNonemptyList -fail_action is_nonempty_list f x @@ -912,8 +980,13 @@ node x node y %hot -i_fast_element j I s d -i_element j s s d +i_fast_element r j I d +i_fast_element x j I d +i_fast_element y j I d + +i_element r j s d +i_element x j s d +i_element y j s d bif1 f b s d bif1_body b s d @@ -940,11 +1013,11 @@ move S r | call_last Ar P=f D => move_call_last S r P D i_move_call_last f P c r -%macro:move_call_last MoveCallLast -arg_f -nonext +%macro:move_call_last MoveCallLast -arg_f -nonext -pack move_call_last/4 -move_call_last x r f P -move_call_last y r f P +move_call_last x r f Q +move_call_last y r f Q move S=c r | call_only Ar P=f => i_move_call_only P S r move S=x r | call_only Ar P=f => move_call_only S r P @@ -993,7 +1066,7 @@ is_function f y is_function f r is_function Fail=f c => jump Fail -func_info M=a F=a A=u | label L => gen_func_info(M, F, A, L) +func_info M F A => i_func_info u M F A # ================================================================ # New bit syntax matching (R11B). @@ -1307,6 +1380,8 @@ fconv Arg=iqan Dst=l => move Arg x | fconv x Dst fmove q l fmove d l +fmove l d + fconv d l i_fadd l l l @@ -1322,12 +1397,6 @@ fcheckerror p => i_fcheckerror i_fcheckerror fclearerror -fmove FR=l Dst=d | new_float_allocation() => fmove_new FR Dst - -# The new instruction for moving a float out of a floating point register. -# (No allocation.) -fmove_new l d - # # New apply instructions in R10B. # @@ -1336,7 +1405,21 @@ apply I apply_last I P # -# New GCing arithmetic instructions. +# Optimize addition and subtraction of small literals using +# the i_increment/4 instruction (in bodies, not in guards). +# + +gc_bif2 p Live u$bif:erlang:splus/2 Int=i Reg=d Dst => \ + gen_increment(Reg, Int, Live, Dst) +gc_bif2 p Live u$bif:erlang:splus/2 Reg=d Int=i Dst => \ + gen_increment(Reg, Int, Live, Dst) + +gc_bif2 p Live u$bif:erlang:sminus/2 Reg=d Int=i Dst | \ + negation_is_small(Int) => \ + gen_increment_from_minus(Reg, Int, Live, Dst) + +# +# GCing arithmetic instructions. # gc_bif2 Fail I u$bif:erlang:splus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_plus Fail I Dst @@ -1359,6 +1442,10 @@ gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst gc_bif1 Fail I u$bif:erlang:sminus/1 Src Dst=d => i_fetch i Src | i_minus Fail I Dst gc_bif1 Fail I u$bif:erlang:splus/1 Src Dst=d => i_fetch i Src | i_plus Fail I Dst +i_increment r I I d +i_increment x I I d +i_increment y I I d + i_plus j I d i_minus j I d i_times j I d diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 5a4dad0a28..e64c43de6e 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -39,13 +39,6 @@ #define ENABLE_CHILD_WAITER_THREAD 1 #endif -/* The ERTS_TIMER_TREAD #define must be visible to the - erl_${OS}_sys.h #include files: it controls whether - certain optional facilities should be defined or not. */ -#if defined(ERTS_SMP) && 0 -#define ERTS_TIMER_THREAD -#endif - #if defined (__WIN32__) # include "erl_win_sys.h" #elif defined (VXWORKS) @@ -232,14 +225,14 @@ int real_printf(const char *fmt, ...); #else #error Neither 32 nor 64 bit architecture #endif -#ifdef ARCH_64 -# ifdef HALFWORD_HEAP_EMULATOR +#if defined(ARCH_64) && defined(HALFWORD_HEAP_EMULATOR) # define HALFWORD_HEAP 1 # define HALFWORD_ASSERT 0 -# else +# define ASSERT_HALFWORD(COND) ASSERT(COND) +#else # define HALFWORD_HEAP 0 # define HALFWORD_ASSERT 0 -# endif +# define ASSERT_HALFWORD(COND) #endif #if SIZEOF_VOID_P != SIZEOF_SIZE_T @@ -338,12 +331,16 @@ typedef unsigned char byte; (((size_t) 8) - (((size_t) (X)) & ((size_t) 7))) #include "erl_lock_check.h" + +/* needed by erl_smp.h */ +int erts_send_warning_to_logger_str_nogl(char *); + #include "erl_smp.h" #ifdef ERTS_WANT_BREAK_HANDLING # ifdef ERTS_SMP -extern erts_smp_atomic_t erts_break_requested; -# define ERTS_BREAK_REQUESTED ((int) erts_smp_atomic_read(&erts_break_requested)) +extern erts_smp_atomic32_t erts_break_requested; +# define ERTS_BREAK_REQUESTED ((int) erts_smp_atomic32_read(&erts_break_requested)) # else extern volatile int erts_break_requested; # define ERTS_BREAK_REQUESTED erts_break_requested @@ -356,8 +353,8 @@ void erts_do_break_handling(void); # define ERTS_GOT_SIGUSR1 0 # else # ifdef ERTS_SMP -extern erts_smp_atomic_t erts_got_sigusr1; -# define ERTS_GOT_SIGUSR1 ((int) erts_smp_atomic_read(&erts_got_sigusr1)) +extern erts_smp_atomic32_t erts_got_sigusr1; +# define ERTS_GOT_SIGUSR1 ((int) erts_smp_atomic32_read(&erts_got_sigusr1)) # else extern volatile int erts_got_sigusr1; # define ERTS_GOT_SIGUSR1 erts_got_sigusr1 @@ -524,7 +521,8 @@ int erts_send_info_to_logger_nogl(erts_dsprintf_buf_t *); int erts_send_warning_to_logger_nogl(erts_dsprintf_buf_t *); int erts_send_error_to_logger_nogl(erts_dsprintf_buf_t *); int erts_send_info_to_logger_str_nogl(char *); -int erts_send_warning_to_logger_str_nogl(char *); +/* needed by erl_smp.h (declared above) + int erts_send_warning_to_logger_str_nogl(char *); */ int erts_send_error_to_logger_str_nogl(char *); typedef struct preload { @@ -540,8 +538,8 @@ typedef struct preload { */ typedef struct _SysDriverOpts { - int ifd; /* Input file descriptor (fd driver). */ - int ofd; /* Outputfile descriptor (fd driver). */ + Uint ifd; /* Input file descriptor (fd driver). */ + Uint ofd; /* Outputfile descriptor (fd driver). */ int packet_bytes; /* Number of bytes in packet header. */ int read_write; /* Read and write bits. */ int use_stdio; /* Use standard I/O: TRUE or FALSE. */ @@ -562,11 +560,7 @@ extern char *erts_default_arg0; extern char os_type[]; extern int sys_init_time(void); -#if defined(ERTS_TIMER_THREAD) -#define erts_deliver_time() -#else extern void erts_deliver_time(void); -#endif extern void erts_time_remaining(SysTimeval *); extern int erts_init_time_sup(void); extern void erts_sys_init_float(void); diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index 9cb6ea34ef..a00faff912 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -99,76 +99,18 @@ static erts_smp_mtx_t tiw_lock; static ErlTimer** tiw; /* the timing wheel, allocated in init_time() */ static Uint tiw_pos; /* current position in wheel */ static Uint tiw_nto; /* number of timeouts in wheel */ +static Uint tiw_min; +static ErlTimer *tiw_min_ptr; /* END tiw_lock protected variables */ /* Actual interval time chosen by sys_init_time() */ static int itime; /* Constant after init */ -#if defined(ERTS_TIMER_THREAD) -static SysTimeval time_start; /* start of current time interval */ -static erts_aint_t ticks_end; /* time_start+ticks_end == time_wakeup */ -static erts_aint_t ticks_latest; /* delta from time_start at latest time update*/ - -static ERTS_INLINE erts_aint_t time_gettimeofday(SysTimeval *now) -{ - erts_aint_t elapsed; - - erts_get_timeval(now); - now->tv_usec = 1000 * (now->tv_usec / 1000); /* ms resolution */ - elapsed = (1000 * (now->tv_sec - time_start.tv_sec) + - (now->tv_usec - time_start.tv_usec) / 1000); - // elapsed /= CLOCK_RESOLUTION; - return elapsed; -} - -static erts_aint_t do_time_update(void) -{ - SysTimeval now; - erts_aint_t elapsed; - - elapsed = time_gettimeofday(&now); - ticks_latest = elapsed; - return elapsed; -} - -static ERTS_INLINE erts_aint_t do_time_read(void) -{ - return ticks_latest; -} - -static erts_aint_t do_time_reset(void) -{ - SysTimeval now; - erts_aint_t elapsed; - - elapsed = time_gettimeofday(&now); - time_start = now; - ticks_end = LONG_MAX; - ticks_latest = 0; - return elapsed; -} - -static ERTS_INLINE void do_time_init(void) -{ - (void)do_time_reset(); -} - -#else erts_smp_atomic_t do_time; /* set at clock interrupt */ -static ERTS_INLINE erts_aint_t do_time_read(void) -{ - return erts_smp_atomic_read(&do_time); -} -static ERTS_INLINE erts_aint_t do_time_update(void) -{ - return do_time_read(); -} -static ERTS_INLINE void do_time_init(void) -{ - erts_smp_atomic_init(&do_time, (erts_aint_t) 0); -} -#endif +static ERTS_INLINE erts_aint_t do_time_read(void) { return erts_smp_atomic_read(&do_time); } +static ERTS_INLINE erts_aint_t do_time_update(void) { return do_time_read(); } +static ERTS_INLINE void do_time_init(void) { erts_smp_atomic_init(&do_time, 0L); } /* get the time (in units of itime) to the next timeout, or -1 if there are no timeouts */ @@ -182,6 +124,12 @@ static erts_aint_t next_time_internal(void) /* PRE: tiw_lock taken by caller */ if (tiw_nto == 0) return -1; /* no timeouts in wheel */ + + if (tiw_min_ptr) { + min = tiw_min; + dt = do_time_read(); + return ((min >= dt) ? (min - dt) : 0); + } /* start going through wheel to find next timeout */ tm = nto = 0; @@ -194,11 +142,17 @@ static erts_aint_t next_time_internal(void) /* PRE: tiw_lock taken by caller */ if (p->count == 0) { /* found next timeout */ dt = do_time_read(); + /* p->count is zero */ + tiw_min_ptr = p; + tiw_min = tm; return ((tm >= dt) ? (tm - dt) : 0); } else { /* keep shortest time in 'min' */ - if (tm + p->count*TIW_SIZE < min) + if (tm + p->count*TIW_SIZE < min) { min = tm + p->count*TIW_SIZE; + tiw_min_ptr = p; + tiw_min = min; + } } p = p->next; } @@ -211,9 +165,33 @@ static erts_aint_t next_time_internal(void) /* PRE: tiw_lock taken by caller */ return ((min >= dt) ? (min - dt) : 0); } -#if !defined(ERTS_TIMER_THREAD) +static void remove_timer(ErlTimer *p) { + /* first */ + if (!p->prev) { + tiw[p->slot] = p->next; + if(p->next) + p->next->prev = NULL; + } else { + p->prev->next = p->next; + } + + /* last */ + if (!p->next) { + if (p->prev) + p->prev->next = NULL; + } else { + p->next->prev = p->prev; + } + + p->next = NULL; + p->prev = NULL; + /* Make sure cancel callback isn't called */ + p->active = 0; + tiw_nto--; +} + /* Private export to erl_time_sup.c */ -erts_aint_t next_time(void) +erts_aint_t erts_next_time(void) { erts_aint_t ret; @@ -223,7 +201,6 @@ erts_aint_t next_time(void) erts_smp_mtx_unlock(&tiw_lock); return ret; } -#endif static ERTS_INLINE void bump_timer_internal(erts_aint_t dt) /* PRE: tiw_lock is write-locked */ { @@ -251,12 +228,16 @@ static ERTS_INLINE void bump_timer_internal(erts_aint_t dt) /* PRE: tiw_lock is if (tiw_pos == keep_pos) count--; prev = &tiw[tiw_pos]; while ((p = *prev) != NULL) { + ASSERT( p != p->next); if (p->count < count) { /* we have a timeout */ - *prev = p->next; /* Remove from list */ - tiw_nto--; - p->next = NULL; - p->active = 0; /* Make sure cancel callback - isn't called */ + /* remove min time */ + if (tiw_min_ptr == p) { + tiw_min_ptr = NULL; + tiw_min = 0; + } + + /* Remove from list */ + remove_timer(p); *timeout_tail = p; /* Insert in timeout queue */ timeout_tail = &p->next; } @@ -270,6 +251,8 @@ static ERTS_INLINE void bump_timer_internal(erts_aint_t dt) /* PRE: tiw_lock is dtime--; } tiw_pos = keep_pos; + if (tiw_min_ptr) + tiw_min -= dt; erts_smp_mtx_unlock(&tiw_lock); @@ -284,24 +267,17 @@ static ERTS_INLINE void bump_timer_internal(erts_aint_t dt) /* PRE: tiw_lock is * callback is called. */ p->next = NULL; + p->prev = NULL; p->slot = 0; (*p->timeout)(p->arg); } } -#if defined(ERTS_TIMER_THREAD) -static void timer_thread_bump_timer(void) -{ - erts_smp_mtx_lock(&tiw_lock); - bump_timer_internal(do_time_reset()); -} -#else -void bump_timer(erts_aint_t dt) /* dt is value from do_time */ +void erts_bump_timer(erts_aint_t dt) /* dt is value from do_time */ { erts_smp_mtx_lock(&tiw_lock); bump_timer_internal(dt); } -#endif Uint erts_timer_wheel_memory_size(void) @@ -309,82 +285,10 @@ erts_timer_wheel_memory_size(void) return (Uint) TIW_SIZE * sizeof(ErlTimer*); } -#if defined(ERTS_TIMER_THREAD) -static struct erts_iwait *timer_thread_iwait; - -static int timer_thread_setup_delay(SysTimeval *rem_time) -{ - erts_aint_t elapsed; - erts_aint_t ticks; - - erts_smp_mtx_lock(&tiw_lock); - elapsed = do_time_update(); - ticks = next_time_internal(); - if (ticks == -1) /* timer queue empty */ - ticks = 100*1000*1000; - if (elapsed > ticks) - elapsed = ticks; - ticks -= elapsed; - //ticks *= CLOCK_RESOLUTION; - rem_time->tv_sec = ticks / 1000; - rem_time->tv_usec = 1000 * (ticks % 1000); - ticks_end = ticks; - erts_smp_mtx_unlock(&tiw_lock); - return ticks; -} - -static void *timer_thread_start(void *ignore) -{ - SysTimeval delay; - -#ifdef ERTS_ENABLE_LOCK_CHECK - erts_lc_set_thread_name("timer"); -#endif - erts_register_blockable_thread(); - - for(;;) { - if (timer_thread_setup_delay(&delay)) { - erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); - ASSERT_NO_LOCKED_LOCKS; - erts_iwait_wait(timer_thread_iwait, &delay); - ASSERT_NO_LOCKED_LOCKS; - erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); - } - else - erts_smp_chk_system_block(NULL, NULL, NULL); - timer_thread_bump_timer(); - ASSERT_NO_LOCKED_LOCKS; - } - /*NOTREACHED*/ - return NULL; -} - -static ERTS_INLINE void timer_thread_post_insert(Uint ticks) -{ - if ((Sint)ticks < ticks_end) - erts_iwait_interrupt(timer_thread_iwait); -} - -static void timer_thread_init(void) -{ - erts_thr_opts_t opts = ERTS_THR_OPTS_DEFAULT_INITER; - erts_tid_t tid; - - opts->detached = 1; - - timer_thread_iwait = erts_iwait_init(); - erts_thr_create(&tid, timer_thread_start, NULL, &opts); -} - -#else -static ERTS_INLINE void timer_thread_post_insert(Uint ticks) { } -static ERTS_INLINE void timer_thread_init(void) { } -#endif - /* this routine links the time cells into a free list at the start and sets the time queue as empty */ void -init_time(void) +erts_init_time(void) { int i; @@ -400,10 +304,13 @@ init_time(void) tiw[i] = NULL; do_time_init(); tiw_pos = tiw_nto = 0; - - timer_thread_init(); + tiw_min_ptr = NULL; + tiw_min = 0; } + + + /* ** Insert a process into the time queue, with a timeout 't' */ @@ -433,16 +340,31 @@ insert_timer(ErlTimer* p, Uint t) /* insert at head of list at slot */ p->next = tiw[tm]; + p->prev = NULL; + if (p->next != NULL) + p->next->prev = p; tiw[tm] = p; - tiw_nto++; - timer_thread_post_insert(ticks); + + /* insert min time */ + if ((tiw_nto == 0) || ((tiw_min_ptr != NULL) && (ticks < tiw_min))) { + tiw_min = ticks; + tiw_min_ptr = p; + } + if ((tiw_min_ptr == p) && (ticks > tiw_min)) { + /* some other timer might be 'min' now */ + tiw_min = 0; + tiw_min_ptr = NULL; + } + + tiw_nto++; } void -erl_set_timer(ErlTimer* p, ErlTimeoutProc timeout, ErlCancelProc cancel, +erts_set_timer(ErlTimer* p, ErlTimeoutProc timeout, ErlCancelProc cancel, void* arg, Uint t) { + erts_deliver_time(); erts_smp_mtx_lock(&tiw_lock); if (p->active) { /* XXX assert ? */ @@ -455,42 +377,34 @@ erl_set_timer(ErlTimer* p, ErlTimeoutProc timeout, ErlCancelProc cancel, p->active = 1; insert_timer(p, t); erts_smp_mtx_unlock(&tiw_lock); -#if defined(ERTS_SMP) && !defined(ERTS_TIMER_THREAD) +#if defined(ERTS_SMP) if (t <= (Uint) LONG_MAX) erts_sys_schedule_interrupt_timed(1, (long) t); #endif } void -erl_cancel_timer(ErlTimer* p) +erts_cancel_timer(ErlTimer* p) { - ErlTimer *tp; - ErlTimer **prev; - erts_smp_mtx_lock(&tiw_lock); if (!p->active) { /* allow repeated cancel (drivers) */ erts_smp_mtx_unlock(&tiw_lock); return; } - /* find p in linked list at slot p->slot and remove it */ - prev = &tiw[p->slot]; - while ((tp = *prev) != NULL) { - if (tp == p) { - *prev = p->next; /* Remove from list */ - tiw_nto--; - p->next = NULL; - p->slot = p->count = 0; - p->active = 0; - if (p->cancel != NULL) { - erts_smp_mtx_unlock(&tiw_lock); - (*p->cancel)(p->arg); - } else { - erts_smp_mtx_unlock(&tiw_lock); - } - return; - } else { - prev = &tp->next; - } + + /* is it the 'min' timer, remove min */ + if (p == tiw_min_ptr) { + tiw_min_ptr = NULL; + tiw_min = 0; + } + + remove_timer(p); + p->slot = p->count = 0; + + if (p->cancel != NULL) { + erts_smp_mtx_unlock(&tiw_lock); + (*p->cancel)(p->arg); + return; } erts_smp_mtx_unlock(&tiw_lock); } @@ -502,7 +416,7 @@ erl_cancel_timer(ErlTimer* p) immediately if it hadn't been cancelled). */ Uint -time_left(ErlTimer *p) +erts_time_left(ErlTimer *p) { Uint left; erts_aint_t dt; @@ -530,8 +444,7 @@ time_left(ErlTimer *p) } #ifdef DEBUG - -void p_slpq() +void erts_p_slpq() { int i; ErlTimer* p; @@ -560,5 +473,4 @@ void p_slpq() erts_smp_mtx_unlock(&tiw_lock); } - #endif /* DEBUG */ diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 2bf283d9ec..f531d1430b 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -59,13 +59,6 @@ /* profile_scheduler mini message queue */ -#ifdef ERTS_TIMER_THREAD -/* A timer thread is not welcomed with this lock violation work around. - * - Bj�rn-Egil - */ -#error Timer thread may not be enabled due to lock violation. -#endif - typedef struct { Uint scheduler_id; Uint no_schedulers; @@ -98,7 +91,7 @@ dispatch_profile_msg_q(profile_sched_msg_q *psmq) Eterm* -erts_heap_alloc(Process* p, Uint need) +erts_heap_alloc(Process* p, Uint need, Uint xtra) { ErlHeapFragment* bp; Eterm* htop; @@ -124,7 +117,7 @@ erts_heap_alloc(Process* p, Uint need) p->space_verified_from = NULL; #endif /* FORCE_HEAP_FRAGS */ - n = need; + n = need + xtra; bp = MBUF(p); if (bp != NULL && need <= (bp->alloc_size - bp->used_size)) { Eterm* ret = bp->mem + bp->used_size; @@ -160,7 +153,7 @@ erts_heap_alloc(Process* p, Uint need) bp->next = MBUF(p); MBUF(p) = bp; bp->alloc_size = n; - bp->used_size = n; + bp->used_size = need; MBUF_SIZE(p) += n; bp->off_heap.first = NULL; bp->off_heap.overhead = 0; @@ -1901,34 +1894,36 @@ erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp) erts_free(ERTS_ALC_T_TMP_DSBUF, (void *) dsbufp); } - /* eq and cmp are written as separate functions a eq is a little faster */ /* * Test for equality of two terms. * Returns 0 if not equal, or a non-zero value otherwise. */ - +#if HALFWORD_HEAP +int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) +#else int eq(Eterm a, Eterm b) +#endif { DECLARE_WSTACK(stack); Sint sz; Eterm* aa; - Eterm* bb; + Eterm* bb; tailrecur: - if (a == b) goto pop_next; + if (is_same(a, a_base, b, b_base)) goto pop_next; tailrecur_ne: switch (primary_tag(a)) { case TAG_PRIMARY_LIST: if (is_list(b)) { - Eterm* aval = list_val(a); - Eterm* bval = list_val(b); + Eterm* aval = list_val_rel(a, a_base); + Eterm* bval = list_val_rel(b, b_base); while (1) { Eterm atmp = CAR(aval); Eterm btmp = CAR(bval); - if (atmp != btmp) { + if (!is_same(atmp,a_base,btmp,b_base)) { WSTACK_PUSH2(stack,(UWord) CDR(bval),(UWord) CDR(aval)); a = atmp; b = btmp; @@ -1936,7 +1931,7 @@ tailrecur_ne: } atmp = CDR(aval); btmp = CDR(bval); - if (atmp == btmp) { + if (is_same(atmp,a_base,btmp,b_base)) { goto pop_next; } if (is_not_list(atmp) || is_not_list(btmp)) { @@ -1944,22 +1939,22 @@ tailrecur_ne: b = btmp; goto tailrecur_ne; } - aval = list_val(atmp); - bval = list_val(btmp); + aval = list_val_rel(atmp, a_base); + bval = list_val_rel(btmp, b_base); } } break; /* not equal */ case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val(a); + Eterm hdr = *boxed_val_rel(a,a_base); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { - aa = tuple_val(a); - if (!is_boxed(b) || *boxed_val(b) != *aa) + aa = tuple_val_rel(a, a_base); + if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa) goto not_equal; - bb = tuple_val(b); + bb = tuple_val_rel(b,b_base); if ((sz = arityval(*aa)) == 0) goto pop_next; ++aa; ++bb; @@ -1978,16 +1973,16 @@ tailrecur_ne: Uint a_bitoffs; Uint b_bitoffs; - if (is_not_binary(b)) { + if (!is_binary_rel(b,b_base)) { goto not_equal; } - a_size = binary_size(a); - b_size = binary_size(b); + a_size = binary_size_rel(a,a_base); + b_size = binary_size_rel(b,b_base); if (a_size != b_size) { goto not_equal; } - ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); - ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); + ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base); + ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base); if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { if (sys_memcmp(a_ptr, b_ptr, a_size) == 0) goto pop_next; } else if (a_bitsize == b_bitsize) { @@ -1998,9 +1993,9 @@ tailrecur_ne: } case EXPORT_SUBTAG: { - if (is_export(b)) { - Export* a_exp = *((Export **) (export_val(a) + 1)); - Export* b_exp = *((Export **) (export_val(b) + 1)); + if (is_export_rel(b,b_base)) { + Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1)); + Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1)); if (a_exp == b_exp) goto pop_next; } break; /* not equal */ @@ -2010,10 +2005,10 @@ tailrecur_ne: ErlFunThing* f1; ErlFunThing* f2; - if (is_not_fun(b)) + if (!is_fun_rel(b,b_base)) goto not_equal; - f1 = (ErlFunThing *) fun_val(a); - f2 = (ErlFunThing *) fun_val(b); + f1 = (ErlFunThing *) fun_val_rel(a,a_base); + f2 = (ErlFunThing *) fun_val_rel(b,b_base); if (f1->fe->module != f2->fe->module || f1->fe->old_index != f2->fe->old_index || f1->fe->old_uniq != f2->fe->old_uniq || @@ -2031,15 +2026,15 @@ tailrecur_ne: ExternalThing *ap; ExternalThing *bp; - if(is_not_external(b)) + if(!is_external_rel(b,b_base)) goto not_equal; - ap = external_thing_ptr(a); - bp = external_thing_ptr(b); + ap = external_thing_ptr_rel(a,a_base); + bp = external_thing_ptr_rel(b,b_base); if(ap->header == bp->header && ap->node == bp->node) { - ASSERT(1 == external_data_words(a)); - ASSERT(1 == external_data_words(b)); + ASSERT(1 == external_data_words_rel(a,a_base)); + ASSERT(1 == external_data_words_rel(b,b_base)); if (ap->data.ui[0] == bp->data.ui[0]) goto pop_next; } @@ -2057,27 +2052,36 @@ tailrecur_ne: Uint alen; Uint blen; Uint i; + ExternalThing* athing; + ExternalThing* bthing; - if(is_not_external_ref(b)) + if(!is_external_ref_rel(b,b_base)) goto not_equal; - if(external_node(a) != external_node(b)) + athing = external_thing_ptr_rel(a,a_base); + bthing = external_thing_ptr_rel(b,b_base); + + if(athing->node != bthing->node) goto not_equal; - anum = external_ref_numbers(a); - bnum = external_ref_numbers(b); - alen = external_ref_no_of_numbers(a); - blen = external_ref_no_of_numbers(b); + anum = external_thing_ref_numbers(athing); + bnum = external_thing_ref_numbers(bthing); + alen = external_thing_ref_no_of_numbers(athing); + blen = external_thing_ref_no_of_numbers(bthing); goto ref_common; case REF_SUBTAG: - - if (is_not_internal_ref(b)) + if (!is_internal_ref_rel(b,b_base)) goto not_equal; - alen = internal_ref_no_of_numbers(a); - blen = internal_ref_no_of_numbers(b); - anum = internal_ref_numbers(a); - bnum = internal_ref_numbers(b); + + { + RefThing* athing = ref_thing_ptr_rel(a,a_base); + RefThing* bthing = ref_thing_ptr_rel(b,b_base); + alen = internal_thing_ref_no_of_numbers(athing); + blen = internal_thing_ref_no_of_numbers(bthing); + anum = internal_thing_ref_numbers(athing); + bnum = internal_thing_ref_numbers(bthing); + } ref_common: ASSERT(alen > 0 && blen > 0); @@ -2122,10 +2126,10 @@ tailrecur_ne: { int i; - if (is_not_big(b)) + if (!is_big_rel(b,b_base)) goto not_equal; - aa = big_val(a); /* get pointer to thing */ - bb = big_val(b); + aa = big_val_rel(a,a_base); + bb = big_val_rel(b,b_base); if (*aa != *bb) goto not_equal; i = BIG_ARITY(aa); @@ -2140,9 +2144,9 @@ tailrecur_ne: FloatDef af; FloatDef bf; - if (is_float(b)) { - GET_DOUBLE(a, af); - GET_DOUBLE(b, bf); + if (is_float_rel(b,b_base)) { + GET_DOUBLE_REL(a, af, a_base); + GET_DOUBLE_REL(b, bf, b_base); if (af.fd == bf.fd) goto pop_next; } break; /* not equal */ @@ -2161,7 +2165,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'sz' */ Eterm* bp = bb; Sint i = sz; for (;;) { - if (*ap != *bp) break; + if (!is_same(*ap,a_base,*bp,b_base)) break; if (--i == 0) goto pop_next; ++ap; ++bp; @@ -2250,7 +2254,11 @@ static int cmp_atoms(Eterm a, Eterm b) bb->name+3, bb->len-3); } +#if HALFWORD_HEAP +Sint cmp_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base) +#else Sint cmp(Eterm a, Eterm b) +#endif { DECLARE_WSTACK(stack); Eterm* aa; @@ -2284,7 +2292,7 @@ Sint cmp(Eterm a, Eterm b) tailrecur: - if (a == b) { /* Equal values or pointers. */ + if (is_same(a,a_base,b,b_base)) { /* Equal values or pointers. */ goto pop_next; } tailrecur_ne: @@ -2310,9 +2318,9 @@ tailrecur_ne: if (is_internal_port(b)) { bnode = erts_this_node; bdata = internal_port_data(b); - } else if (is_external_port(b)) { - bnode = external_port_node(b); - bdata = external_port_data(b); + } else if (is_external_port_rel(b,b_base)) { + bnode = external_port_node_rel(b,b_base); + bdata = external_port_data_rel(b,b_base); } else { a_tag = PORT_DEF; goto mixed_types; @@ -2328,9 +2336,9 @@ tailrecur_ne: if (is_internal_pid(b)) { bnode = erts_this_node; bdata = internal_pid_data(b); - } else if (is_external_pid(b)) { - bnode = external_pid_node(b); - bdata = external_pid_data(b); + } else if (is_external_pid_rel(b,b_base)) { + bnode = external_pid_node_rel(b,b_base); + bdata = external_pid_data_rel(b,b_base); } else { a_tag = PID_DEF; goto mixed_types; @@ -2363,12 +2371,12 @@ tailrecur_ne: a_tag = LIST_DEF; goto mixed_types; } - aa = list_val(a); - bb = list_val(b); + aa = list_val_rel(a,a_base); + bb = list_val_rel(b,b_base); while (1) { Eterm atmp = CAR(aa); Eterm btmp = CAR(bb); - if (atmp != btmp) { + if (!is_same(atmp,a_base,btmp,b_base)) { WSTACK_PUSH2(stack,(UWord) CDR(bb),(UWord) CDR(aa)); a = atmp; b = btmp; @@ -2376,7 +2384,7 @@ tailrecur_ne: } atmp = CDR(aa); btmp = CDR(bb); - if (atmp == btmp) { + if (is_same(atmp,a_base,btmp,b_base)) { goto pop_next; } if (is_not_list(atmp) || is_not_list(btmp)) { @@ -2384,20 +2392,20 @@ tailrecur_ne: b = btmp; goto tailrecur_ne; } - aa = list_val(atmp); - bb = list_val(btmp); + aa = list_val_rel(atmp,a_base); + bb = list_val_rel(btmp,b_base); } case TAG_PRIMARY_BOXED: { - Eterm ahdr = *boxed_val(a); + Eterm ahdr = *boxed_val_rel(a,a_base); switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): - if (is_not_tuple(b)) { + if (!is_tuple_rel(b,b_base)) { a_tag = TUPLE_DEF; goto mixed_types; } - aa = tuple_val(a); - bb = tuple_val(b); + aa = tuple_val_rel(a,a_base); + bb = tuple_val_rel(b,b_base); /* compare the arities */ i = arityval(ahdr); /* get the arity*/ if (i != arityval(*bb)) { @@ -2411,31 +2419,31 @@ tailrecur_ne: goto term_array; case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): - if (is_not_float(b)) { + if (!is_float_rel(b,b_base)) { a_tag = FLOAT_DEF; goto mixed_types; } else { FloatDef af; FloatDef bf; - GET_DOUBLE(a, af); - GET_DOUBLE(b, bf); + GET_DOUBLE_REL(a, af, a_base); + GET_DOUBLE_REL(b, bf, b_base); ON_CMP_GOTO(float_comp(af.fd, bf.fd)); } case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): - if (is_not_big(b)) { + if (!is_big_rel(b,b_base)) { a_tag = BIG_DEF; goto mixed_types; } - ON_CMP_GOTO(big_comp(a, b)); + ON_CMP_GOTO(big_comp(rterm2wterm(a,a_base), rterm2wterm(b,b_base))); case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): - if (is_not_export(b)) { + if (!is_export_rel(b,b_base)) { a_tag = EXPORT_DEF; goto mixed_types; } else { - Export* a_exp = *((Export **) (export_val(a) + 1)); - Export* b_exp = *((Export **) (export_val(b) + 1)); + Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1)); + Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1)); if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) { RETURN_NEQ(j); @@ -2447,12 +2455,12 @@ tailrecur_ne: } break; case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): - if (is_not_fun(b)) { + if (!is_fun_rel(b,b_base)) { a_tag = FUN_DEF; goto mixed_types; } else { - ErlFunThing* f1 = (ErlFunThing *) fun_val(a); - ErlFunThing* f2 = (ErlFunThing *) fun_val(b); + ErlFunThing* f1 = (ErlFunThing *) fun_val_rel(a,a_base); + ErlFunThing* f2 = (ErlFunThing *) fun_val_rel(b,b_base); Sint diff; diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name, @@ -2484,51 +2492,57 @@ tailrecur_ne: if (is_internal_pid(b)) { bnode = erts_this_node; bdata = internal_pid_data(b); - } else if (is_external_pid(b)) { - bnode = external_pid_node(b); - bdata = external_pid_data(b); + } else if (is_external_pid_rel(b,b_base)) { + bnode = external_pid_node_rel(b,b_base); + bdata = external_pid_data_rel(b,b_base); } else { a_tag = EXTERNAL_PID_DEF; goto mixed_types; } - anode = external_pid_node(a); - adata = external_pid_data(a); + anode = external_pid_node_rel(a,a_base); + adata = external_pid_data_rel(a,a_base); goto pid_common; case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): if (is_internal_port(b)) { bnode = erts_this_node; bdata = internal_port_data(b); - } else if (is_external_port(b)) { - bnode = external_port_node(b); - bdata = external_port_data(b); + } else if (is_external_port_rel(b,b_base)) { + bnode = external_port_node_rel(b,b_base); + bdata = external_port_data_rel(b,b_base); } else { a_tag = EXTERNAL_PORT_DEF; goto mixed_types; } - anode = external_port_node(a); - adata = external_port_data(a); + anode = external_port_node_rel(a,a_base); + adata = external_port_data_rel(a,a_base); goto port_common; case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): /* * Note! When comparing refs we need to compare ref numbers * (32-bit words), *not* ref data words. */ + - if (is_internal_ref(b)) { + if (is_internal_ref_rel(b,b_base)) { + RefThing* bthing = ref_thing_ptr_rel(b,b_base); bnode = erts_this_node; - bnum = internal_ref_numbers(b); - blen = internal_ref_no_of_numbers(b); - } else if(is_external_ref(b)) { - bnode = external_ref_node(b); - bnum = external_ref_numbers(b); - blen = external_ref_no_of_numbers(b); + bnum = internal_thing_ref_numbers(bthing); + blen = internal_thing_ref_no_of_numbers(bthing); + } else if(is_external_ref_rel(b,b_base)) { + ExternalThing* bthing = external_thing_ptr_rel(b,b_base); + bnode = bthing->node; + bnum = external_thing_ref_numbers(bthing); + blen = external_thing_ref_no_of_numbers(bthing); } else { a_tag = REF_DEF; goto mixed_types; } - anode = erts_this_node; - anum = internal_ref_numbers(a); - alen = internal_ref_no_of_numbers(a); + { + RefThing* athing = ref_thing_ptr_rel(a,a_base); + anode = erts_this_node; + anum = internal_thing_ref_numbers(athing); + alen = internal_thing_ref_no_of_numbers(athing); + } ref_common: CMP_NODES(anode, bnode); @@ -2557,31 +2571,36 @@ tailrecur_ne: RETURN_NEQ((Sint32) (anum[i] - bnum[i])); goto pop_next; case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): - if (is_internal_ref(b)) { + if (is_internal_ref_rel(b,b_base)) { + RefThing* bthing = ref_thing_ptr_rel(b,b_base); bnode = erts_this_node; - bnum = internal_ref_numbers(b); - blen = internal_ref_no_of_numbers(b); - } else if (is_external_ref(b)) { - bnode = external_ref_node(b); - bnum = external_ref_numbers(b); - blen = external_ref_no_of_numbers(b); + bnum = internal_thing_ref_numbers(bthing); + blen = internal_thing_ref_no_of_numbers(bthing); + } else if (is_external_ref_rel(b,b_base)) { + ExternalThing* bthing = external_thing_ptr_rel(b,b_base); + bnode = bthing->node; + bnum = external_thing_ref_numbers(bthing); + blen = external_thing_ref_no_of_numbers(bthing); } else { a_tag = EXTERNAL_REF_DEF; goto mixed_types; } - anode = external_ref_node(a); - anum = external_ref_numbers(a); - alen = external_ref_no_of_numbers(a); + { + ExternalThing* athing = external_thing_ptr_rel(a,a_base); + anode = athing->node; + anum = external_thing_ref_numbers(athing); + alen = external_thing_ref_no_of_numbers(athing); + } goto ref_common; default: /* Must be a binary */ - ASSERT(is_binary(a)); - if (is_not_binary(b)) { + ASSERT(is_binary_rel(a,a_base)); + if (!is_binary_rel(b,b_base)) { a_tag = BINARY_DEF; goto mixed_types; } else { - Uint a_size = binary_size(a); - Uint b_size = binary_size(b); + Uint a_size = binary_size_rel(a,a_base); + Uint b_size = binary_size_rel(b,b_base); Uint a_bitsize; Uint b_bitsize; Uint a_bitoffs; @@ -2590,8 +2609,8 @@ tailrecur_ne: int cmp; byte* a_ptr; byte* b_ptr; - ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); - ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); + ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base); + ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base); if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { min_size = (a_size < b_size) ? a_size : b_size; if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) { @@ -2618,7 +2637,6 @@ tailrecur_ne: */ mixed_types: - b_tag = tag_val_def(b); { FloatDef f1, f2; @@ -2628,39 +2646,47 @@ tailrecur_ne: #else Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap; #endif +#if HALFWORD_HEAP + Wterm aw = is_immed(a) ? a : rterm2wterm(a,a_base); + Wterm bw = is_immed(b) ? b : rterm2wterm(b,b_base); +#else + Eterm aw = a; + Eterm bw = b; +#endif + b_tag = tag_val_def(bw); switch(_NUMBER_CODE(a_tag, b_tag)) { case SMALL_BIG: big = small_to_big(signed_val(a), big_buf); - j = big_comp(big, b); + j = big_comp(big, bw); break; case SMALL_FLOAT: f1.fd = signed_val(a); - GET_DOUBLE(b, f2); + GET_DOUBLE(bw, f2); j = float_comp(f1.fd, f2.fd); break; case BIG_SMALL: big = small_to_big(signed_val(b), big_buf); - j = big_comp(a, big); + j = big_comp(aw, big); break; case BIG_FLOAT: - if (big_to_double(a, &f1.fd) < 0) { + if (big_to_double(aw, &f1.fd) < 0) { j = big_sign(a) ? -1 : 1; } else { - GET_DOUBLE(b, f2); + GET_DOUBLE(bw, f2); j = float_comp(f1.fd, f2.fd); } break; case FLOAT_SMALL: - GET_DOUBLE(a, f1); + GET_DOUBLE(aw, f1); f2.fd = signed_val(b); j = float_comp(f1.fd, f2.fd); break; case FLOAT_BIG: - if (big_to_double(b, &f2.fd) < 0) { + if (big_to_double(bw, &f2.fd) < 0) { j = big_sign(b) ? 1 : -1; } else { - GET_DOUBLE(a, f1); + GET_DOUBLE(aw, f1); j = float_comp(f1.fd, f2.fd); } break; @@ -3183,7 +3209,7 @@ erts_create_smp_ptimer(ErtsSmpPTimer **timer_ref, *timer_ref = res; - erl_set_timer(&res->timer.tm, + erts_set_timer(&res->timer.tm, (ErlTimeoutProc) ptimer_timeout, (ErlCancelProc) ptimer_cancelled, (void*) res, @@ -3197,7 +3223,7 @@ erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer) ASSERT(*ptimer->timer.timer_ref == ptimer); *ptimer->timer.timer_ref = NULL; ptimer->timer.flags |= ERTS_PTMR_FLG_CANCELLED; - erl_cancel_timer(&ptimer->timer.tm); + erts_cancel_timer(&ptimer->timer.tm); } } diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 786fa7da77..4e9b5005c1 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -385,7 +385,6 @@ struct t_data ErlDrvBinary *binp; int size; int offset; - char name[1]; } read_file; struct { struct t_readdir_buf *first_buf; @@ -1117,7 +1116,7 @@ static void invoke_read_file(void *data) Sint64 size; if (! (d->result_ok = - efile_openfile(&d->errInfo, d->c.read_file.name, + efile_openfile(&d->errInfo, d->b, EFILE_MODE_READ, &fd, &size))) { goto done; } @@ -3071,7 +3070,7 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->command = command; d->reply = !0; /* Copy name */ - FILENAME_COPY(d->c.read_file.name, filename); + FILENAME_COPY(d->b, filename); d->c.read_file.binp = NULL; d->invoke = invoke_read_file; d->free = free_read_file; diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 1382d1dfe4..59f4cfb9b4 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2010. All Rights Reserved. + * Copyright Ericsson AB 1997-2011. 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 @@ -4945,39 +4945,45 @@ static int inet_ctl_getifaddrs(inet_descriptor* desc_p, *buf_p++ = '\0'; *buf_p++ = INET_IFOPT_FLAGS; put_int32(IFGET_FLAGS(ifa_p->ifa_flags), buf_p); buf_p += 4; - if (ifa_p->ifa_addr->sa_family == AF_INET + if (ifa_p->ifa_addr) { + if (ifa_p->ifa_addr->sa_family == AF_INET #if defined(AF_INET6) - || ifa_p->ifa_addr->sa_family == AF_INET6 + || ifa_p->ifa_addr->sa_family == AF_INET6 #endif - ) { - SOCKADDR_TO_BUF(INET_IFOPT_ADDR, ifa_p->ifa_addr); - BUF_ENSURE(1); - SOCKADDR_TO_BUF(INET_IFOPT_NETMASK, ifa_p->ifa_netmask); - if (ifa_p->ifa_flags & IFF_POINTOPOINT) { - BUF_ENSURE(1); - SOCKADDR_TO_BUF(INET_IFOPT_DSTADDR, ifa_p->ifa_dstaddr); - } else if (ifa_p->ifa_flags & IFF_BROADCAST) { - BUF_ENSURE(1); - SOCKADDR_TO_BUF(INET_IFOPT_BROADADDR, ifa_p->ifa_broadaddr); + ) { + SOCKADDR_TO_BUF(INET_IFOPT_ADDR, ifa_p->ifa_addr); + if (ifa_p->ifa_netmask) { + BUF_ENSURE(1); + SOCKADDR_TO_BUF(INET_IFOPT_NETMASK, ifa_p->ifa_netmask); + } + if (ifa_p->ifa_dstaddr && + (ifa_p->ifa_flags & IFF_POINTOPOINT)) { + BUF_ENSURE(1); + SOCKADDR_TO_BUF(INET_IFOPT_DSTADDR, ifa_p->ifa_dstaddr); + } else if (ifa_p->ifa_broadaddr && + (ifa_p->ifa_flags & IFF_BROADCAST)) { + BUF_ENSURE(1); + SOCKADDR_TO_BUF(INET_IFOPT_BROADADDR, ifa_p->ifa_broadaddr); + } } - } #if defined(AF_LINK) || defined(AF_PACKET) - else if ( + else if ( #if defined(AF_LINK) - ifa_p->ifa_addr->sa_family == AF_LINK + ifa_p->ifa_addr->sa_family == AF_LINK #else - 0 + 0 #endif #if defined(AF_PACKET) - || ifa_p->ifa_addr->sa_family == AF_PACKET + || ifa_p->ifa_addr->sa_family == AF_PACKET #endif - ) { - char *bp = buf_p; - BUF_ENSURE(1); - SOCKADDR_TO_BUF(INET_IFOPT_HWADDR, ifa_p->ifa_addr); - if (buf_p - bp < 4) buf_p = bp; /* Empty hwaddr */ - } + ) { + char *bp = buf_p; + BUF_ENSURE(1); + SOCKADDR_TO_BUF(INET_IFOPT_HWADDR, ifa_p->ifa_addr); + if (buf_p - bp < 4) buf_p = bp; /* Empty hwaddr */ + } #endif + } BUF_ENSURE(1); *buf_p++ = '\0'; } @@ -5044,9 +5050,17 @@ static STATUS wrap_sockopt(STATUS (*function)() /* Yep, no parameter } #endif +/* Per H @ Tail-f: The original code here had problems that possibly + only occur if you abuse it for non-INET sockets, but anyway: + a) If the getsockopt for SO_PRIORITY or IP_TOS failed, the actual + requested setsockopt was never even attempted. + b) If {get,set}sockopt for one of IP_TOS and SO_PRIORITY failed, + but ditto for the other worked and that was actually the requested + option, failure was still reported to erlang. */ + #if defined(IP_TOS) && defined(SOL_IP) && defined(SO_PRIORITY) static int setopt_prio_tos_trick - (int fd, int proto, int type, char* arg_ptr, int arg_sz) + (int fd, int proto, int type, char* arg_ptr, int arg_sz, int propagate) { /* The relations between SO_PRIORITY, TOS and other options is not what you (or at least I) would expect...: @@ -5059,6 +5073,8 @@ static int setopt_prio_tos_trick int tmp_ival_prio; int tmp_ival_tos; int res; + int res_prio; + int res_tos; #ifdef HAVE_SOCKLEN_T socklen_t #else @@ -5067,28 +5083,35 @@ static int setopt_prio_tos_trick tmp_arg_sz_prio = sizeof(tmp_ival_prio), tmp_arg_sz_tos = sizeof(tmp_ival_tos); - res = sock_getopt(fd, SOL_SOCKET, SO_PRIORITY, + res_prio = sock_getopt(fd, SOL_SOCKET, SO_PRIORITY, (char *) &tmp_ival_prio, &tmp_arg_sz_prio); - if (res == 0) { - res = sock_getopt(fd, SOL_IP, IP_TOS, + res_tos = sock_getopt(fd, SOL_IP, IP_TOS, (char *) &tmp_ival_tos, &tmp_arg_sz_tos); - if (res == 0) { res = sock_setopt(fd, proto, type, arg_ptr, arg_sz); if (res == 0) { if (type != SO_PRIORITY) { - if (type != IP_TOS) { - res = sock_setopt(fd, + if (type != IP_TOS && res_tos == 0) { + res_tos = sock_setopt(fd, SOL_IP, IP_TOS, (char *) &tmp_ival_tos, tmp_arg_sz_tos); + if (propagate) + res = res_tos; } - if (res == 0) { - res = sock_setopt(fd, + if (res == 0 && res_prio == 0) { + res_prio = sock_setopt(fd, SOL_SOCKET, SO_PRIORITY, (char *) &tmp_ival_prio, tmp_arg_sz_prio); + if (propagate) { + /* Some kernels set a SO_PRIORITY by default that you are not permitted to reset, + silently ignore this error condition */ + if (res_prio != 0 && sock_errno() == EPERM) { + res = 0; + } else { + res = res_prio; } } } @@ -5434,7 +5457,7 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) return -1; } #if defined(IP_TOS) && defined(SOL_IP) && defined(SO_PRIORITY) - res = setopt_prio_tos_trick (desc->s, proto, type, arg_ptr, arg_sz); + res = setopt_prio_tos_trick (desc->s, proto, type, arg_ptr, arg_sz, propagate); #else res = sock_setopt (desc->s, proto, type, arg_ptr, arg_sz); #endif @@ -5964,7 +5987,7 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len) return -1; } #if defined(IP_TOS) && defined(SOL_IP) && defined(SO_PRIORITY) - res = setopt_prio_tos_trick (desc->s, proto, type, arg_ptr, arg_sz); + res = setopt_prio_tos_trick (desc->s, proto, type, arg_ptr, arg_sz, 1); #else res = sock_setopt (desc->s, proto, type, arg_ptr, arg_sz); #endif @@ -8527,7 +8550,9 @@ static int tcp_deliver(tcp_descriptor* desc, int len) len = 0; if (!desc->inet.active) { - driver_cancel_timer(desc->inet.port); + if (!desc->busy_on_send) { + driver_cancel_timer(desc->inet.port); + } sock_select(INETP(desc),(FD_READ|FD_CLOSE),0); if (desc->i_buf != NULL) tcp_restart_input(desc); diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 6297ccb8bc..4b3934657c 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -620,7 +620,7 @@ efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ if (IS_DOT_OR_DOTDOT(dirp->d_name)) continue; buffer[0] = '\0'; - strncat(buffer, dirp->d_name, size-1); + strncat(buffer, dirp->d_name, (*size)-1); *size = strlen(dirp->d_name); return 1; } diff --git a/erts/emulator/drivers/win32/win_con.c b/erts/emulator/drivers/win32/win_con.c index 2202ca655f..c788ad409d 100644 --- a/erts/emulator/drivers/win32/win_con.c +++ b/erts/emulator/drivers/win32/win_con.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * Copyright Ericsson AB 1997-2011. 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 @@ -704,6 +704,18 @@ FrameWndProc(HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM lParam) } write_inbuf(&c, 1); return 0; + case WM_MOUSEWHEEL: + { + int delta = GET_WHEEL_DELTA_WPARAM(wParam); + if (delta < 0) { + PostMessage(hClientWnd, WM_VSCROLL, MAKELONG(SB_THUMBTRACK, + (iVscrollPos + 5)),0); + } else { + WORD pos = ((iVscrollPos - 5) < 0) ? 0 : (iVscrollPos - 5); + PostMessage(hClientWnd, WM_VSCROLL, MAKELONG(SB_THUMBTRACK,pos),0); + } + return 0; + } case WM_CHAR: c = (TCHAR)wParam; write_inbuf(&c,1); diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index 4ec9579529..3d59564f7b 100755 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2010. All Rights Reserved. + * Copyright Ericsson AB 1997-2011. 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 @@ -1016,8 +1016,8 @@ efile_write_info(Efile_error* errInfo, } \ } - MKTIME(ModifyFileTime, pInfo->accessTime, mtime); - MKTIME(AccessFileTime, pInfo->modifyTime, atime); + MKTIME(ModifyFileTime, pInfo->modifyTime, mtime); + MKTIME(AccessFileTime, pInfo->accessTime, atime); MKTIME(CreationFileTime, pInfo->cTime, ctime); #undef MKTIME diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S index 2bce01954e..8c1c55b216 100644 --- a/erts/emulator/hipe/hipe_arm_glue.S +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2011. 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 diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 2a877d8ace..e7fb850530 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2010. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 @@ -450,52 +450,13 @@ BIF_RETTYPE hipe_bifs_alloc_data_2(BIF_ALIST_2) } /* - * Memory area for constant Erlang terms. - * - * These constants must not be forwarded by the gc. - * Therefore, the gc needs to be able to distinguish between - * collectible objects and constants. Unfortunately, an Erlang - * process' collectible objects are scattered around in two - * heaps and a list of message buffers, so testing "is X a - * collectible object?" can be expensive. - * - * Instead, constants are placed in a single contiguous area, - * which allows for an inexpensive "is X a constant?" test. - * - * XXX: Allow this area to be grown. + * Statistics on hipe constants: size of HiPE constants, in words. */ - -/* not static, needed by garbage collector */ -Eterm *hipe_constants_start = NULL; -Eterm *hipe_constants_next = NULL; -static unsigned constants_avail_words = 0; -#define CONSTANTS_BYTES (1536*1024*sizeof(Eterm)) /* 1.5 M words */ - -static Eterm *constants_alloc(unsigned nwords) -{ - Eterm *next; - - /* initialise at the first call */ - if ((next = hipe_constants_next) == NULL) { - next = (Eterm*)erts_alloc(ERTS_ALC_T_HIPE, CONSTANTS_BYTES); - hipe_constants_start = next; - hipe_constants_next = next; - constants_avail_words = CONSTANTS_BYTES / sizeof(Eterm); - } - if (nwords > constants_avail_words) { - fprintf(stderr, "Native code constants pool depleted!\r\n"); - /* Must terminate immediately. erl_exit() seems to - continue running some code which then SIGSEGVs. */ - exit(1); - } - constants_avail_words -= nwords; - hipe_constants_next = next + nwords; - return next; -} +unsigned int hipe_constants_size = 0; BIF_RETTYPE hipe_bifs_constants_size_0(BIF_ALIST_0) { - BIF_RET(make_small(hipe_constants_next - hipe_constants_start)); + BIF_RET(make_small(hipe_constants_size)); } /* @@ -526,14 +487,17 @@ static void *const_term_alloc(void *tmpl) { Eterm obj; Uint size; + Uint alloc_size; Eterm *hp; struct const_term *p; obj = (Eterm)tmpl; ASSERT(is_not_immed(obj)); size = size_object(obj); + alloc_size = size + (offsetof(struct const_term, mem)/sizeof(Eterm)); + hipe_constants_size += alloc_size; - p = (struct const_term*)constants_alloc(size + (offsetof(struct const_term, mem)/sizeof(Eterm))); + p = (struct const_term*)erts_alloc(ERTS_ALC_T_HIPE, alloc_size * sizeof(Eterm)); /* I have absolutely no idea if having a private 'off_heap' works or not. _Some_ off_heap object is required for diff --git a/erts/emulator/hipe/hipe_bif0.h b/erts/emulator/hipe/hipe_bif0.h index ed27d5616a..c5c1c30619 100644 --- a/erts/emulator/hipe/hipe_bif0.h +++ b/erts/emulator/hipe/hipe_bif0.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 @@ -26,10 +26,6 @@ extern Uint *hipe_bifs_find_pc_from_mfa(Eterm mfa); -/* shared with ggc.c -- NOT an official API */ -extern Eterm *hipe_constants_start; -extern Eterm *hipe_constants_next; - extern void hipe_mfa_info_table_init(void); extern void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a); extern Eterm hipe_find_na_or_make_stub(Process*, Eterm, Eterm, Eterm); diff --git a/erts/emulator/hipe/hipe_bif1.c b/erts/emulator/hipe/hipe_bif1.c index 8f43811537..2369ad4fa8 100644 --- a/erts/emulator/hipe/hipe_bif1.c +++ b/erts/emulator/hipe/hipe_bif1.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c index f992b758be..6bcd5046e9 100644 --- a/erts/emulator/hipe/hipe_bif2.c +++ b/erts/emulator/hipe/hipe_bif2.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 @@ -33,7 +33,6 @@ #include "big.h" #include "hipe_debug.h" #include "hipe_mode_switch.h" -#include "hipe_bif0.h" /* hipe_constants_{start,next} */ #include "hipe_arch.h" #include "hipe_stack.h" @@ -124,18 +123,6 @@ BIF_RETTYPE hipe_bifs_show_term_1(BIF_ALIST_1) BIF_RET(am_true); } -BIF_RETTYPE hipe_bifs_show_literals_0(BIF_ALIST_0) -{ - Eterm *p; - - p = hipe_constants_start; - for (; p < hipe_constants_next; ++p) - printf("0x%0*lx: 0x%0*lx\r\n", - 2*(int)sizeof(long), (unsigned long)p, - 2*(int)sizeof(long), *p); - BIF_RET(am_true); -} - BIF_RETTYPE hipe_bifs_in_native_0(BIF_ALIST_0) { BIF_RET(am_false); diff --git a/erts/emulator/hipe/hipe_bif2.tab b/erts/emulator/hipe/hipe_bif2.tab index d8d627e370..51323ce7af 100644 --- a/erts/emulator/hipe/hipe_bif2.tab +++ b/erts/emulator/hipe/hipe_bif2.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# Copyright Ericsson AB 2001-2011. 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 @@ -26,7 +26,6 @@ bif hipe_bifs:show_nstack/1 bif hipe_bifs:nstack_used_size/0 bif hipe_bifs:show_pcb/1 bif hipe_bifs:show_term/1 -bif hipe_bifs:show_literals/0 bif hipe_bifs:in_native/0 bif hipe_bifs:modeswitch_debug_on/0 bif hipe_bifs:modeswitch_debug_off/0 diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c index 6c9e1d9ba7..a8b6c20dd0 100644 --- a/erts/emulator/hipe/hipe_gc.c +++ b/erts/emulator/hipe/hipe_gc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2010. All Rights Reserved. + * Copyright Ericsson AB 2004-2011. 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 @@ -28,7 +28,6 @@ #include "hipe_stack.h" #include "hipe_gc.h" -#include "hipe_bif0.h" /* for hipe_constants_{start,next} */ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) { diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index 900dfc5a8a..25e21ed79e 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index e5de244d25..53ebcd4008 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 @@ -208,6 +208,8 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) #endif p->i = NULL; + /* Set current_function to undefined. stdlib hibernate tests rely on it. */ + p->current = NULL; DPRINTF("cmd == %#x (%s)", cmd, code_str(cmd)); HIPE_CHECK_PCB(p); @@ -322,20 +324,31 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) * We need to remove the BIF's parameters from the native * stack: to this end hipe_${ARCH}_glue.S stores the BIF's * arity in p->hipe.narity. + * + * If the BIF emptied the stack (typically hibernate), p->hipe.nsp is + * NULL and there is no need to get rid of stacked parameters. */ - unsigned int i, is_recursive, callee_arity; + unsigned int i, is_recursive = 0; /* Save p->arity, then update it with the original BIF's arity. Get rid of any stacked parameters in that call. */ /* XXX: hipe_call_from_native_is_recursive() copies data to reg[], which is useless in the TRAP case. Maybe write a specialised hipe_trap_from_native_is_recursive() later. */ - callee_arity = p->arity; - p->arity = p->hipe.narity; /* caller's arity */ - is_recursive = hipe_call_from_native_is_recursive(p, reg); - - p->i = (Eterm *)(p->def_arg_reg[3]); - p->arity = callee_arity; + if (p->hipe.nsp != NULL) { + unsigned int callee_arity; + callee_arity = p->arity; + p->arity = p->hipe.narity; /* caller's arity */ + is_recursive = hipe_call_from_native_is_recursive(p, reg); + + p->i = (Eterm *)(p->def_arg_reg[3]); + p->arity = callee_arity; + } + + /* If process is in P_WAITING state, we schedule the next process */ + if (p->status == P_WAITING) { + goto do_schedule; + } for (i = 0; i < p->arity; ++i) reg[i] = p->def_arg_reg[i]; @@ -592,6 +605,17 @@ void hipe_inc_nstack(Process *p) } #endif +void hipe_empty_nstack(Process *p) +{ + if (p->hipe.nstack) { + erts_free(ERTS_ALC_T_HIPE, p->hipe.nstack); + } + p->hipe.nstgraylim = NULL; + p->hipe.nsp = NULL; + p->hipe.nstack = NULL; + p->hipe.nstend = NULL; +} + static void hipe_check_nstack(Process *p, unsigned nwords) { while (hipe_nstack_avail(p) < nwords) diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h index 187b9145e2..e0c6c1b5f5 100644 --- a/erts/emulator/hipe/hipe_mode_switch.h +++ b/erts/emulator/hipe/hipe_mode_switch.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 @@ -54,6 +54,7 @@ void hipe_mode_switch_init(void); void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure); Process *hipe_mode_switch(Process*, unsigned, Eterm*); void hipe_inc_nstack(Process *p); +void hipe_empty_nstack(Process *p); void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free); Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s); diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S index c010f4f047..c766099102 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.S +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * Copyright Ericsson AB 2004-2011. 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 diff --git a/erts/emulator/hipe/hipe_sparc_glue.S b/erts/emulator/hipe/hipe_sparc_glue.S index 73cefd4896..aa07137116 100644 --- a/erts/emulator/hipe/hipe_sparc_glue.S +++ b/erts/emulator/hipe/hipe_sparc_glue.S @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 diff --git a/erts/emulator/hipe/hipe_x86_glue.S b/erts/emulator/hipe/hipe_x86_glue.S index 43392111fe..af2d0cb970 100644 --- a/erts/emulator/hipe/hipe_x86_glue.S +++ b/erts/emulator/hipe/hipe_x86_glue.S @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c index 0c61e7bf96..e515f1cd60 100644 --- a/erts/emulator/hipe/hipe_x86_signal.c +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index b1ee165489..ceb290b644 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2010. All Rights Reserved. + * Copyright Ericsson AB 2002-2011. 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 @@ -35,6 +35,7 @@ #include "global.h" #include "erl_threads.h" #include "erl_mtrace.h" +#include "erl_time.h" #include "big.h" #if HAVE_ERTS_MSEG @@ -76,8 +77,10 @@ static int atoms_initialized; static Uint cache_check_interval; +typedef struct mem_kind_t MemKind; + static void check_cache(void *unused); -static void mseg_clear_cache(void); +static void mseg_clear_cache(MemKind*); static int is_cache_check_scheduled; #ifdef ERTS_THREADS_NO_SMP static int is_cache_check_requested; @@ -122,6 +125,9 @@ static int mmap_fd; #error "Not supported" #endif /* #if HAVE_MMAP */ +#if defined(ERTS_MSEG_FAKE_SEGMENTS) && HALFWORD_HEAP +# warning "ERTS_MSEG_FAKE_SEGMENTS will only be used for high memory segments" +#endif #if defined(ERTS_MSEG_FAKE_SEGMENTS) #undef CAN_PARTLY_DESTROY @@ -159,14 +165,43 @@ static struct { CallCounter check_cache; } calls; -static cache_desc_t cache_descs[MAX_CACHE_SIZE]; -static cache_desc_t *free_cache_descs; -static cache_desc_t *cache; -static cache_desc_t *cache_end; -static Uint cache_hits; -static Uint cache_size; -static Uint min_cached_seg_size; -static Uint max_cached_seg_size; +struct mem_kind_t { + cache_desc_t cache_descs[MAX_CACHE_SIZE]; + cache_desc_t *free_cache_descs; + cache_desc_t *cache; + cache_desc_t *cache_end; + + Uint cache_size; + Uint min_cached_seg_size; + Uint max_cached_seg_size; + Uint cache_hits; + + struct { + struct { + Uint watermark; + Uint no; + Uint sz; + } current; + struct { + Uint no; + Uint sz; + } max; + struct { + Uint no; + Uint sz; + } max_ever; + } segments; + + const char* name; + MemKind* next; +};/*MemKind*/ + +#if HALFWORD_HEAP +static MemKind low_mem, hi_mem; +#else +static MemKind the_mem; +#endif +static MemKind* mk_list = NULL; static Uint max_cache_size; static Uint abs_max_cache_bad_fit; @@ -176,47 +211,32 @@ static Uint rel_max_cache_bad_fit; static Uint min_seg_size; #endif -struct { - struct { - Uint watermark; - Uint no; - Uint sz; - } current; - struct { - Uint no; - Uint sz; - } max; - struct { - Uint no; - Uint sz; - } max_ever; -} segments; -#define ERTS_MSEG_ALLOC_STAT(SZ) \ +#define ERTS_MSEG_ALLOC_STAT(C,SZ) \ do { \ - segments.current.no++; \ - if (segments.max.no < segments.current.no) \ - segments.max.no = segments.current.no; \ - if (segments.current.watermark < segments.current.no) \ - segments.current.watermark = segments.current.no; \ - segments.current.sz += (SZ); \ - if (segments.max.sz < segments.current.sz) \ - segments.max.sz = segments.current.sz; \ + C->segments.current.no++; \ + if (C->segments.max.no < C->segments.current.no) \ + C->segments.max.no = C->segments.current.no; \ + if (C->segments.current.watermark < C->segments.current.no) \ + C->segments.current.watermark = C->segments.current.no; \ + C->segments.current.sz += (SZ); \ + if (C->segments.max.sz < C->segments.current.sz) \ + C->segments.max.sz = C->segments.current.sz; \ } while (0) -#define ERTS_MSEG_DEALLOC_STAT(SZ) \ +#define ERTS_MSEG_DEALLOC_STAT(C,SZ) \ do { \ - ASSERT(segments.current.no > 0); \ - segments.current.no--; \ - ASSERT(segments.current.sz >= (SZ)); \ - segments.current.sz -= (SZ); \ + ASSERT(C->segments.current.no > 0); \ + C->segments.current.no--; \ + ASSERT(C->segments.current.sz >= (SZ)); \ + C->segments.current.sz -= (SZ); \ } while (0) -#define ERTS_MSEG_REALLOC_STAT(OSZ, NSZ) \ +#define ERTS_MSEG_REALLOC_STAT(C,OSZ, NSZ) \ do { \ - ASSERT(segments.current.sz >= (OSZ)); \ - segments.current.sz -= (OSZ); \ - segments.current.sz += (NSZ); \ + ASSERT(C->segments.current.sz >= (OSZ)); \ + C->segments.current.sz -= (OSZ); \ + C->segments.current.sz += (NSZ); \ } while (0) #define ONE_GIGA (1000000000) @@ -271,7 +291,7 @@ schedule_cache_check(void) #endif { cache_check_timer.active = 0; - erl_set_timer(&cache_check_timer, + erts_set_timer(&cache_check_timer, check_cache, NULL, NULL, @@ -302,38 +322,45 @@ check_schedule_cache_check(void) static void mseg_shutdown(void) { + MemKind* mk; erts_mtx_lock(&mseg_mutex); - mseg_clear_cache(); + for (mk=mk_list; mk; mk=mk->next) { + mseg_clear_cache(mk); + } erts_mtx_unlock(&mseg_mutex); } static ERTS_INLINE void * -mseg_create(Uint size) +mseg_create(MemKind* mk, Uint size) { void *seg; ASSERT(size % page_size == 0); -#if defined(ERTS_MSEG_FAKE_SEGMENTS) - seg = erts_sys_alloc(ERTS_ALC_N_INVALID, NULL, size); -#elif HAVE_MMAP #if HALFWORD_HEAP - seg = pmmap(size); -#else - seg = (void *) mmap((void *) 0, (size_t) size, - MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0); - if (seg == (void *) MAP_FAILED) - seg = NULL; -#endif -#if HALFWORD_HEAP - if ((unsigned long) seg & CHECK_POINTER_MASK) { - erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg); - return NULL; + if (mk == &low_mem) { + seg = pmmap(size); + if ((unsigned long) seg & CHECK_POINTER_MASK) { + erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg); + return NULL; + } } + else #endif + { +#if defined(ERTS_MSEG_FAKE_SEGMENTS) + seg = erts_sys_alloc(ERTS_ALC_N_INVALID, NULL, size); +#elif HAVE_MMAP + { + seg = (void *) mmap((void *) 0, (size_t) size, + MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0); + if (seg == (void *) MAP_FAILED) + seg = NULL; + } #else -#error "Missing mseg_create() implementation" +# error "Missing mseg_create() implementation" #endif + } INC_CC(create); @@ -341,25 +368,29 @@ mseg_create(Uint size) } static ERTS_INLINE void -mseg_destroy(void *seg, Uint size) +mseg_destroy(MemKind* mk, void *seg, Uint size) { -#if defined(ERTS_MSEG_FAKE_SEGMENTS) - erts_sys_free(ERTS_ALC_N_INVALID, NULL, seg); -#elif HAVE_MMAP + int res; -#ifdef DEBUG - int res = -#endif #if HALFWORD_HEAP - pmunmap((void *) seg, size); + if (mk == &low_mem) { + res = pmunmap((void *) seg, size); + } + else +#endif + { +#ifdef ERTS_MSEG_FAKE_SEGMENTS + erts_sys_free(ERTS_ALC_N_INVALID, NULL, seg); + res = 0; +#elif HAVE_MMAP + res = munmap((void *) seg, size); #else - munmap((void *) seg, size); +# error "Missing mseg_destroy() implementation" #endif + } + ASSERT(size % page_size == 0); ASSERT(res == 0); -#else -#error "Missing mseg_destroy() implementation" -#endif INC_CC(destroy); @@ -368,39 +399,44 @@ mseg_destroy(void *seg, Uint size) #if HAVE_MSEG_RECREATE static ERTS_INLINE void * -mseg_recreate(void *old_seg, Uint old_size, Uint new_size) +mseg_recreate(MemKind* mk, void *old_seg, Uint old_size, Uint new_size) { void *new_seg; ASSERT(old_size % page_size == 0); ASSERT(new_size % page_size == 0); -#if defined(ERTS_MSEG_FAKE_SEGMENTS) - new_seg = erts_sys_realloc(ERTS_ALC_N_INVALID, NULL, old_seg, new_size); -#elif HAVE_MREMAP #if HALFWORD_HEAP - new_seg = (void *) pmremap((void *) old_seg, - (size_t) old_size, - (size_t) new_size); -#elif defined(__NetBSD__) - new_seg = (void *) mremap((void *) old_seg, - (size_t) old_size, - NULL, - (size_t) new_size, - 0); - if (new_seg == (void *) MAP_FAILED) - new_seg = NULL; -#else - new_seg = (void *) mremap((void *) old_seg, - (size_t) old_size, - (size_t) new_size, - MREMAP_MAYMOVE); - if (new_seg == (void *) MAP_FAILED) - new_seg = NULL; + if (mk == &low_mem) { + new_seg = (void *) pmremap((void *) old_seg, + (size_t) old_size, + (size_t) new_size); + } + else #endif + { +#if defined(ERTS_MSEG_FAKE_SEGMENTS) + new_seg = erts_sys_realloc(ERTS_ALC_N_INVALID, NULL, old_seg, new_size); +#elif HAVE_MREMAP + + #if defined(__NetBSD__) + new_seg = (void *) mremap((void *) old_seg, + (size_t) old_size, + NULL, + (size_t) new_size, + 0); + #else + new_seg = (void *) mremap((void *) old_seg, + (size_t) old_size, + (size_t) new_size, + MREMAP_MAYMOVE); + #endif + if (new_seg == (void *) MAP_FAILED) + new_seg = NULL; #else #error "Missing mseg_recreate() implementation" #endif + } INC_CC(recreate); @@ -411,134 +447,142 @@ mseg_recreate(void *old_seg, Uint old_size, Uint new_size) static ERTS_INLINE cache_desc_t * -alloc_cd(void) +alloc_cd(MemKind* mk) { - cache_desc_t *cd = free_cache_descs; + cache_desc_t *cd = mk->free_cache_descs; ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); if (cd) - free_cache_descs = cd->next; + mk->free_cache_descs = cd->next; return cd; } static ERTS_INLINE void -free_cd(cache_desc_t *cd) +free_cd(MemKind* mk, cache_desc_t *cd) { ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - cd->next = free_cache_descs; - free_cache_descs = cd; + cd->next = mk->free_cache_descs; + mk->free_cache_descs = cd; } static ERTS_INLINE void -link_cd(cache_desc_t *cd) +link_cd(MemKind* mk, cache_desc_t *cd) { ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - if (cache) - cache->prev = cd; - cd->next = cache; + if (mk->cache) + mk->cache->prev = cd; + cd->next = mk->cache; cd->prev = NULL; - cache = cd; + mk->cache = cd; - if (!cache_end) { + if (!mk->cache_end) { ASSERT(!cd->next); - cache_end = cd; + mk->cache_end = cd; } - cache_size++; + mk->cache_size++; } +#if CAN_PARTLY_DESTROY static ERTS_INLINE void -end_link_cd(cache_desc_t *cd) +end_link_cd(MemKind* mk, cache_desc_t *cd) { ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - if (cache_end) - cache_end->next = cd; + if (mk->cache_end) + mk->cache_end->next = cd; cd->next = NULL; - cd->prev = cache_end; - cache_end = cd; + cd->prev = mk->cache_end; + mk->cache_end = cd; - if (!cache) { + if (!mk->cache) { ASSERT(!cd->prev); - cache = cd; + mk->cache = cd; } - cache_size++; + mk->cache_size++; } +#endif static ERTS_INLINE void -unlink_cd(cache_desc_t *cd) +unlink_cd(MemKind* mk, cache_desc_t *cd) { ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); if (cd->next) cd->next->prev = cd->prev; else - cache_end = cd->prev; + mk->cache_end = cd->prev; if (cd->prev) cd->prev->next = cd->next; else - cache = cd->next; - ASSERT(cache_size > 0); - cache_size--; + mk->cache = cd->next; + ASSERT(mk->cache_size > 0); + mk->cache_size--; } static ERTS_INLINE void -check_cache_limits(void) +check_cache_limits(MemKind* mk) { cache_desc_t *cd; ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - max_cached_seg_size = 0; - min_cached_seg_size = ~((Uint) 0); - for (cd = cache; cd; cd = cd->next) { - if (cd->size < min_cached_seg_size) - min_cached_seg_size = cd->size; - if (cd->size > max_cached_seg_size) - max_cached_seg_size = cd->size; + mk->max_cached_seg_size = 0; + mk->min_cached_seg_size = ~((Uint) 0); + for (cd = mk->cache; cd; cd = cd->next) { + if (cd->size < mk->min_cached_seg_size) + mk->min_cached_seg_size = cd->size; + if (cd->size > mk->max_cached_seg_size) + mk->max_cached_seg_size = cd->size; } - } static ERTS_INLINE void -adjust_cache_size(int force_check_limits) +adjust_cache_size(MemKind* mk, int force_check_limits) { cache_desc_t *cd; int check_limits = force_check_limits; - Sint max_cached = ((Sint) segments.current.watermark - - (Sint) segments.current.no); + Sint max_cached = ((Sint) mk->segments.current.watermark + - (Sint) mk->segments.current.no); ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&mseg_mutex)); - while (((Sint) cache_size) > max_cached && ((Sint) cache_size) > 0) { - ASSERT(cache_end); - cd = cache_end; + while (((Sint) mk->cache_size) > max_cached && ((Sint) mk->cache_size) > 0) { + ASSERT(mk->cache_end); + cd = mk->cache_end; if (!check_limits && - !(min_cached_seg_size < cd->size - && cd->size < max_cached_seg_size)) { + !(mk->min_cached_seg_size < cd->size + && cd->size < mk->max_cached_seg_size)) { check_limits = 1; } if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); - mseg_destroy(cd->seg, cd->size); - unlink_cd(cd); - free_cd(cd); + mseg_destroy(mk, cd->seg, cd->size); + unlink_cd(mk,cd); + free_cd(mk,cd); } if (check_limits) - check_cache_limits(); - + check_cache_limits(mk); } static void -check_cache(void *unused) +check_one_cache(MemKind* mk) { + if (mk->segments.current.watermark > mk->segments.current.no) + mk->segments.current.watermark--; + adjust_cache_size(mk, 0); + + if (mk->cache_size) + schedule_cache_check(); +} + +static void check_cache(void* unused) +{ + MemKind* mk; erts_mtx_lock(&mseg_mutex); is_cache_check_scheduled = 0; - if (segments.current.watermark > segments.current.no) - segments.current.watermark--; - adjust_cache_size(0); - - if (cache_size) - schedule_cache_check(); + for (mk=mk_list; mk; mk=mk->next) { + check_one_cache(mk); + } INC_CC(check_cache); @@ -546,28 +590,45 @@ check_cache(void *unused) } static void -mseg_clear_cache(void) +mseg_clear_cache(MemKind* mk) { - segments.current.watermark = 0; + mk->segments.current.watermark = 0; - adjust_cache_size(1); + adjust_cache_size(mk, 1); - ASSERT(!cache); - ASSERT(!cache_end); - ASSERT(!cache_size); + ASSERT(!mk->cache); + ASSERT(!mk->cache_end); + ASSERT(!mk->cache_size); - segments.current.watermark = segments.current.no; + mk->segments.current.watermark = mk->segments.current.no; INC_CC(clear_cache); } +static ERTS_INLINE MemKind* type2mk(ErtsAlcType_t atype) +{ +#if HALFWORD_HEAP + switch (atype) { + case ERTS_ALC_A_ETS: + case ERTS_ALC_A_BINARY: + case ERTS_ALC_A_FIXED_SIZE: + case ERTS_ALC_A_DRIVER: + return &hi_mem; + default: + return &low_mem; + } +#else + return &the_mem; +#endif +} + static void * mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) { - Uint max, min, diff_size, size; cache_desc_t *cd, *cand_cd; void *seg; + MemKind* mk = type2mk(atype); INC_CC(alloc); @@ -580,11 +641,11 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) if (!opt->cache) { create_seg: - adjust_cache_size(0); - seg = mseg_create(size); + adjust_cache_size(mk,0); + seg = mseg_create(mk, size); if (!seg) { - mseg_clear_cache(); - seg = mseg_create(size); + mseg_clear_cache(mk); + seg = mseg_create(mk, size); if (!seg) size = 0; } @@ -593,17 +654,17 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) if (seg) { if (erts_mtrace_enabled) erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size); - ERTS_MSEG_ALLOC_STAT(size); + ERTS_MSEG_ALLOC_STAT(mk,size); } return seg; } - if (size > max_cached_seg_size) + if (size > mk->max_cached_seg_size) goto create_seg; - if (size < min_cached_seg_size) { + if (size < mk->min_cached_seg_size) { - diff_size = min_cached_seg_size - size; + diff_size = mk->min_cached_seg_size - size; if (diff_size > abs_max_cache_bad_fit) goto create_seg; @@ -617,7 +678,7 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) min = ~((Uint) 0); cand_cd = NULL; - for (cd = cache; cd; cd = cd->next) { + for (cd = mk->cache; cd; cd = cd->next) { if (cd->size >= size) { if (!cand_cd) { cand_cd = cd; @@ -638,8 +699,8 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) min = cd->size; } - min_cached_seg_size = min; - max_cached_seg_size = max; + mk->min_cached_seg_size = min; + mk->max_cached_seg_size = max; if (!cand_cd) goto create_seg; @@ -648,20 +709,20 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) if (diff_size > abs_max_cache_bad_fit || 100*PAGES(diff_size) > rel_max_cache_bad_fit*PAGES(size)) { - if (max_cached_seg_size < cand_cd->size) - max_cached_seg_size = cand_cd->size; - if (min_cached_seg_size > cand_cd->size) - min_cached_seg_size = cand_cd->size; + if (mk->max_cached_seg_size < cand_cd->size) + mk->max_cached_seg_size = cand_cd->size; + if (mk->min_cached_seg_size > cand_cd->size) + mk->min_cached_seg_size = cand_cd->size; goto create_seg; } - cache_hits++; + mk->cache_hits++; size = cand_cd->size; seg = cand_cd->seg; - unlink_cd(cand_cd); - free_cd(cand_cd); + unlink_cd(mk,cand_cd); + free_cd(mk,cand_cd); *size_p = size; @@ -671,7 +732,8 @@ mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) } if (seg) - ERTS_MSEG_ALLOC_STAT(size); + ERTS_MSEG_ALLOC_STAT(mk,size); + return seg; } @@ -680,41 +742,42 @@ static void mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, const ErtsMsegOpt_t *opt) { + MemKind* mk = type2mk(atype); cache_desc_t *cd; - ERTS_MSEG_DEALLOC_STAT(size); + ERTS_MSEG_DEALLOC_STAT(mk,size); if (!opt->cache || max_cache_size == 0) { if (erts_mtrace_enabled) erts_mtrace_crr_free(atype, SEGTYPE, seg); - mseg_destroy(seg, size); + mseg_destroy(mk, seg, size); } else { int check_limits = 0; - if (size < min_cached_seg_size) - min_cached_seg_size = size; - if (size > max_cached_seg_size) - max_cached_seg_size = size; - - if (!free_cache_descs) { - cd = cache_end; - if (!(min_cached_seg_size < cd->size - && cd->size < max_cached_seg_size)) { + if (size < mk->min_cached_seg_size) + mk->min_cached_seg_size = size; + if (size > mk->max_cached_seg_size) + mk->max_cached_seg_size = size; + + if (!mk->free_cache_descs) { + cd = mk->cache_end; + if (!(mk->min_cached_seg_size < cd->size + && cd->size < mk->max_cached_seg_size)) { check_limits = 1; } if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); - mseg_destroy(cd->seg, cd->size); - unlink_cd(cd); - free_cd(cd); + mseg_destroy(mk, cd->seg, cd->size); + unlink_cd(mk,cd); + free_cd(mk,cd); } - cd = alloc_cd(); + cd = alloc_cd(mk); ASSERT(cd); cd->seg = seg; cd->size = size; - link_cd(cd); + link_cd(mk,cd); if (erts_mtrace_enabled) { erts_mtrace_crr_free(atype, SEGTYPE, seg); @@ -724,7 +787,7 @@ mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, /* ASSERT(segments.current.watermark >= segments.current.no + cache_size); */ if (check_limits) - check_cache_limits(); + check_cache_limits(mk); schedule_cache_check(); @@ -737,6 +800,7 @@ static void * mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, const ErtsMsegOpt_t *opt) { + MemKind* mk = type2mk(atype); void *new_seg; Uint new_size; @@ -774,15 +838,15 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, #if CAN_PARTLY_DESTROY if (shrink_sz > min_seg_size - && free_cache_descs + && mk->free_cache_descs && opt->cache) { cache_desc_t *cd; - cd = alloc_cd(); + cd = alloc_cd(mk); ASSERT(cd); cd->seg = ((char *) seg) + new_size; cd->size = shrink_sz; - end_link_cd(cd); + end_link_cd(mk,cd); if (erts_mtrace_enabled) { erts_mtrace_crr_realloc(new_seg, @@ -801,7 +865,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, SEGTYPE, seg, new_size); - mseg_destroy(((char *) seg) + new_size, shrink_sz); + mseg_destroy(mk, ((char *) seg) + new_size, shrink_sz); } #elif HAVE_MSEG_RECREATE @@ -835,7 +899,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, #if !CAN_PARTLY_DESTROY do_recreate: #endif - new_seg = mseg_recreate((void *) seg, old_size, new_size); + new_seg = mseg_recreate(mk, (void *) seg, old_size, new_size); if (erts_mtrace_enabled) erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size); if (!new_seg) @@ -858,7 +922,7 @@ mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, *new_size_p = new_size; - ERTS_MSEG_REALLOC_STAT(old_size, new_size); + ERTS_MSEG_REALLOC_STAT(mk, old_size, new_size); return new_seg; } @@ -874,6 +938,8 @@ static struct { Eterm mcs; Eterm cci; + Eterm memkind; + Eterm name; Eterm status; Eterm cached_segments; Eterm cache_hits; @@ -923,6 +989,8 @@ init_atoms(void) #endif AM_INIT(version); + AM_INIT(memkind); + AM_INIT(name); AM_INIT(options); AM_INIT(amcbf); @@ -1133,65 +1201,88 @@ info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) } static Eterm -info_status(int *print_to_p, - void *print_to_arg, - int begin_new_max_period, - Uint **hpp, - Uint *szp) +info_status(MemKind* mk, int *print_to_p, void *print_to_arg, + int begin_new_max_period, Uint **hpp, Uint *szp) { Eterm res = THE_NON_VALUE; - if (segments.max_ever.no < segments.max.no) - segments.max_ever.no = segments.max.no; - if (segments.max_ever.sz < segments.max.sz) - segments.max_ever.sz = segments.max.sz; + if (mk->segments.max_ever.no < mk->segments.max.no) + mk->segments.max_ever.no = mk->segments.max.no; + if (mk->segments.max_ever.sz < mk->segments.max.sz) + mk->segments.max_ever.sz = mk->segments.max.sz; if (print_to_p) { int to = *print_to_p; void *arg = print_to_arg; - erts_print(to, arg, "cached_segments: %bpu\n", cache_size); - erts_print(to, arg, "cache_hits: %bpu\n", cache_hits); + erts_print(to, arg, "cached_segments: %bpu\n", mk->cache_size); + erts_print(to, arg, "cache_hits: %bpu\n", mk->cache_hits); erts_print(to, arg, "segments: %bpu %bpu %bpu\n", - segments.current.no, segments.max.no, segments.max_ever.no); + mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no); erts_print(to, arg, "segments_size: %bpu %bpu %bpu\n", - segments.current.sz, segments.max.sz, segments.max_ever.sz); + mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz); erts_print(to, arg, "segments_watermark: %bpu\n", - segments.current.watermark); + mk->segments.current.watermark); } if (hpp || szp) { res = NIL; add_2tup(hpp, szp, &res, am.segments_watermark, - bld_unstable_uint(hpp, szp, segments.current.watermark)); + bld_unstable_uint(hpp, szp, mk->segments.current.watermark)); add_4tup(hpp, szp, &res, am.segments_size, - bld_unstable_uint(hpp, szp, segments.current.sz), - bld_unstable_uint(hpp, szp, segments.max.sz), - bld_unstable_uint(hpp, szp, segments.max_ever.sz)); + bld_unstable_uint(hpp, szp, mk->segments.current.sz), + bld_unstable_uint(hpp, szp, mk->segments.max.sz), + bld_unstable_uint(hpp, szp, mk->segments.max_ever.sz)); add_4tup(hpp, szp, &res, am.segments, - bld_unstable_uint(hpp, szp, segments.current.no), - bld_unstable_uint(hpp, szp, segments.max.no), - bld_unstable_uint(hpp, szp, segments.max_ever.no)); + bld_unstable_uint(hpp, szp, mk->segments.current.no), + bld_unstable_uint(hpp, szp, mk->segments.max.no), + bld_unstable_uint(hpp, szp, mk->segments.max_ever.no)); add_2tup(hpp, szp, &res, am.cache_hits, - bld_unstable_uint(hpp, szp, cache_hits)); + bld_unstable_uint(hpp, szp, mk->cache_hits)); add_2tup(hpp, szp, &res, am.cached_segments, - bld_unstable_uint(hpp, szp, cache_size)); + bld_unstable_uint(hpp, szp, mk->cache_size)); } if (begin_new_max_period) { - segments.max.no = segments.current.no; - segments.max.sz = segments.current.sz; + mk->segments.max.no = mk->segments.current.no; + mk->segments.max.sz = mk->segments.current.sz; } return res; } +static Eterm info_memkind(MemKind* mk, int *print_to_p, void *print_to_arg, + int begin_max_per, Uint **hpp, Uint *szp) +{ + Eterm res = THE_NON_VALUE; + Eterm atoms[3]; + Eterm values[3]; + + if (print_to_p) { + erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", mk->name); + } + if (hpp || szp) { + atoms[0] = am.name; + atoms[1] = am.status; + atoms[2] = am.calls; + values[0] = erts_bld_string(hpp, szp, mk->name); + } + values[1] = info_status(mk, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[2] = info_calls(print_to_p, print_to_arg, hpp, szp); + + if (hpp || szp) + res = bld_2tup_list(hpp, szp, 3, atoms, values); + + return res; +} + + static Eterm info_version(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { @@ -1238,6 +1329,7 @@ erts_mseg_info(int *print_to_p, Eterm res = THE_NON_VALUE; Eterm atoms[4]; Eterm values[4]; + Uint n = 0; erts_mtx_lock(&mseg_mutex); @@ -1248,17 +1340,19 @@ erts_mseg_info(int *print_to_p, atoms[0] = am.version; atoms[1] = am.options; - atoms[2] = am.status; - atoms[3] = am.calls; + atoms[2] = am.memkind; + atoms[3] = am.memkind; } - - values[0] = info_version(print_to_p, print_to_arg, hpp, szp); - values[1] = info_options("option ", print_to_p, print_to_arg, hpp, szp); - values[2] = info_status(print_to_p, print_to_arg, begin_max_per, hpp, szp); - values[3] = info_calls(print_to_p, print_to_arg, hpp, szp); - + values[n++] = info_version(print_to_p, print_to_arg, hpp, szp); + values[n++] = info_options("option ", print_to_p, print_to_arg, hpp, szp); +#if HALFWORD_HEAP + values[n++] = info_memkind(&low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[n++] = info_memkind(&hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); +#else + values[n++] = info_memkind(&the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); +#endif if (hpp || szp) - res = bld_2tup_list(hpp, szp, 4, atoms, values); + res = bld_2tup_list(hpp, szp, n, atoms, values); erts_mtx_unlock(&mseg_mutex); @@ -1317,17 +1411,23 @@ erts_mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, void erts_mseg_clear_cache(void) { + MemKind* mk; erts_mtx_lock(&mseg_mutex); - mseg_clear_cache(); + for (mk=mk_list; mk; mk=mk->next) { + mseg_clear_cache(mk); + } erts_mtx_unlock(&mseg_mutex); } Uint erts_mseg_no(void) { - Uint n; + MemKind* mk; + Uint n = 0; erts_mtx_lock(&mseg_mutex); - n = segments.current.no; + for (mk=mk_list; mk; mk=mk->next) { + n += mk->segments.current.no; + } erts_mtx_unlock(&mseg_mutex); return n; } @@ -1338,11 +1438,43 @@ erts_mseg_unit_size(void) return page_size; } -void -erts_mseg_init(ErtsMsegInit_t *init) +static void mem_kind_init(MemKind* mk, const char* name) { unsigned i; + mk->cache = NULL; + mk->cache_end = NULL; + mk->max_cached_seg_size = 0; + mk->min_cached_seg_size = ~((Uint) 0); + mk->cache_size = 0; + mk->cache_hits = 0; + + if (max_cache_size > 0) { + for (i = 0; i < max_cache_size - 1; i++) + mk->cache_descs[i].next = &mk->cache_descs[i + 1]; + mk->cache_descs[max_cache_size - 1].next = NULL; + mk->free_cache_descs = &mk->cache_descs[0]; + } + else + mk->free_cache_descs = NULL; + + mk->segments.current.watermark = 0; + mk->segments.current.no = 0; + mk->segments.current.sz = 0; + mk->segments.max.no = 0; + mk->segments.max.sz = 0; + mk->segments.max_ever.no = 0; + mk->segments.max_ever.sz = 0; + + mk->name = name; + mk->next = mk_list; + mk_list = mk; +} + + +void +erts_mseg_init(ErtsMsegInit_t *init) +{ atoms_initialized = 0; is_init_done = 0; @@ -1385,40 +1517,33 @@ erts_mseg_init(ErtsMsegInit_t *init) min_seg_size = ~((Uint) 0); #endif - cache = NULL; - cache_end = NULL; - cache_hits = 0; - max_cached_seg_size = 0; - min_cached_seg_size = ~((Uint) 0); - cache_size = 0; + if (max_cache_size > MAX_CACHE_SIZE) + max_cache_size = MAX_CACHE_SIZE; + +#if HALFWORD_HEAP + mem_kind_init(&low_mem, "low memory"); + mem_kind_init(&hi_mem, "high memory"); +#else + mem_kind_init(&the_mem, "all memory"); +#endif is_cache_check_scheduled = 0; #ifdef ERTS_THREADS_NO_SMP is_cache_check_requested = 0; #endif +} - if (max_cache_size > MAX_CACHE_SIZE) - max_cache_size = MAX_CACHE_SIZE; - if (max_cache_size > 0) { - for (i = 0; i < max_cache_size - 1; i++) - cache_descs[i].next = &cache_descs[i + 1]; - cache_descs[max_cache_size - 1].next = NULL; - free_cache_descs = &cache_descs[0]; +static ERTS_INLINE Uint tot_cache_size(void) +{ + MemKind* mk; + Uint sz = 0; + for (mk=mk_list; mk; mk=mk->next) { + sz += mk->cache_size; } - else - free_cache_descs = NULL; - - segments.current.watermark = 0; - segments.current.no = 0; - segments.current.sz = 0; - segments.max.no = 0; - segments.max.sz = 0; - segments.max_ever.no = 0; - segments.max_ever.sz = 0; + return sz; } - /* * erts_mseg_late_init() have to be called after all allocators, * threads and timers have been initialized. @@ -1436,7 +1561,7 @@ erts_mseg_late_init(void) #ifdef ERTS_THREADS_NO_SMP async_handle = handle; #endif - if (cache_size) + if (tot_cache_size()) schedule_cache_check(); erts_mtx_unlock(&mseg_mutex); } @@ -1477,7 +1602,7 @@ erts_mseg_test(unsigned long op, case 0x406: { unsigned long res; erts_mtx_lock(&mseg_mutex); - res = (unsigned long) cache_size; + res = (unsigned long) tot_cache_size(); erts_mtx_unlock(&mseg_mutex); return res; } @@ -1568,11 +1693,14 @@ static void *do_map(void *ptr, size_t sz) return NULL; } - +#if HAVE_MMAP res = mmap(ptr, sz, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, -1 , 0); +#else +# error "Missing mmap support" +#endif if (res == MAP_FAILED) { #ifdef HARDDEBUG @@ -1672,10 +1800,19 @@ static int initialize_pmmap(void) MAP_NORESERVE | EXTRA_MAP_FLAGS, -1 , 0); #ifdef HARDDEBUG - printf("rsz = %ld, pages = %ld, rptr = %p\r\n", - (unsigned long) rsz, (unsigned long) (rsz / pagsz), - (void *) rptr); + printf("p=%p, rsz = %ld, pages = %ld, got range = %p -> %p\r\n", + p, (unsigned long) rsz, (unsigned long) (rsz / pagsz), + (void *) rptr, (void*)(rptr + rsz)); #endif + if ((UWord)(rptr + rsz) > RANGE_MAX) { + size_t rsz_trunc = RANGE_MAX - (UWord)rptr; +#ifdef HARDDEBUG + printf("Reducing mmap'ed memory from %lu to %lu Mb, reduced range = %p -> %p\r\n", + rsz/(1024*1024), rsz_trunc/(1024*1024), rptr, rptr+rsz_trunc); +#endif + munmap((void*)RANGE_MAX, rsz - rsz_trunc); + rsz = rsz_trunc; + } if (!do_map(rptr,pagsz)) { erl_exit(1,"Could not actually mmap first page for halfword emulator...\n"); } @@ -1756,6 +1893,7 @@ static int pmunmap(void *p, size_t size) FreeBlock *last; FreeBlock *nb = (FreeBlock *) p; + ASSERT(((unsigned long)p & CHECK_POINTER_MASK)==0); if (real_size > pagsz) { if (do_unmap(((char *) p) + pagsz,real_size - pagsz)) { return 1; diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 4d0ca97889..3ae5b8d747 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2010. All Rights Reserved. + * Copyright Ericsson AB 2006-2011. 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 @@ -124,25 +124,11 @@ erts_smp_mtx_unlock(&(PS)->mtx) #define ERTS_POLLSET_SET_POLLED_CHK(PS) \ - ((int) erts_smp_atomic_xchg(&(PS)->polled, (erts_aint_t) 1)) + ((int) erts_atomic32_xchg(&(PS)->polled, (erts_aint32_t) 1)) #define ERTS_POLLSET_UNSET_POLLED(PS) \ - erts_smp_atomic_set(&(PS)->polled, (erts_aint_t) 0) + erts_atomic32_set(&(PS)->polled, (erts_aint32_t) 0) #define ERTS_POLLSET_IS_POLLED(PS) \ - ((int) erts_smp_atomic_read(&(PS)->polled)) - -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) set_poller_woken_chk((PS)) -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \ -do { \ - ERTS_THR_MEMORY_BARRIER; \ - erts_smp_atomic_set(&(PS)->woken, (erts_aint_t) 1); \ -} while (0) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \ -do { \ - erts_smp_atomic_set(&(PS)->woken, (erts_aint_t) 0); \ - ERTS_THR_MEMORY_BARRIER; \ -} while (0) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \ - ((int) erts_smp_atomic_read(&(PS)->woken)) + ((int) erts_atomic32_read(&(PS)->polled)) #else @@ -152,69 +138,21 @@ do { \ #define ERTS_POLLSET_UNSET_POLLED(PS) #define ERTS_POLLSET_IS_POLLED(PS) 0 -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - -/* - * Ideally, the ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) operation would - * be atomic. This operation isn't, but we will do okay anyway. The - * "woken check" is only an optimization. The only requirement we have: - * If (PS)->woken is set to a value != 0 when interrupting, we have to - * write on the the wakeup pipe at least once. Multiple writes are okay. - */ -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) ((PS)->woken++) -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) ((PS)->woken = 1, (void) 0) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) ((PS)->woken = 0, (void) 0) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) ((PS)->woken) - -#else - -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) 1 -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) 1 - -#endif - #endif #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE #define ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(PS) \ - erts_smp_atomic_set(&(PS)->have_update_requests, (erts_aint_t) 1) + erts_smp_atomic32_set(&(PS)->have_update_requests, (erts_aint32_t) 1) #define ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(PS) \ - erts_smp_atomic_set(&(PS)->have_update_requests, (erts_aint_t) 0) + erts_smp_atomic32_set(&(PS)->have_update_requests, (erts_aint32_t) 0) #define ERTS_POLLSET_HAVE_UPDATE_REQUESTS(PS) \ - ((int) erts_smp_atomic_read(&(PS)->have_update_requests)) + ((int) erts_smp_atomic32_read(&(PS)->have_update_requests)) #else #define ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(PS) #define ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(PS) #define ERTS_POLLSET_HAVE_UPDATE_REQUESTS(PS) 0 #endif -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) - -#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) unset_interrupted_chk((PS)) -#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) ((PS)->interrupt = 0, (void) 0) -#define ERTS_POLLSET_SET_INTERRUPTED(PS) ((PS)->interrupt = 1, (void) 0) -#define ERTS_POLLSET_IS_INTERRUPTED(PS) ((PS)->interrupt) - -#else - -#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) unset_interrupted_chk((PS)) -#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \ -do { \ - erts_smp_atomic_set(&(PS)->interrupt, (erts_aint_t) 0); \ - ERTS_THR_MEMORY_BARRIER; \ -} while (0) -#define ERTS_POLLSET_SET_INTERRUPTED(PS) \ -do { \ - ERTS_THR_MEMORY_BARRIER; \ - erts_smp_atomic_set(&(PS)->interrupt, (erts_aint_t) 1); \ -} while (0) -#define ERTS_POLLSET_IS_INTERRUPTED(PS) \ - ((int) erts_smp_atomic_read(&(PS)->interrupt)) - -#endif - #if ERTS_POLL_USE_FALLBACK # if ERTS_POLL_USE_POLL # define ERTS_POLL_NEED_FALLBACK(PS) ((PS)->no_poll_fds > 1) @@ -318,14 +256,12 @@ struct ErtsPollSet_ { #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE ErtsPollSetUpdateRequestsBlock update_requests; ErtsPollSetUpdateRequestsBlock *curr_upd_req_block; - erts_smp_atomic_t have_update_requests; + erts_smp_atomic32_t have_update_requests; #endif #ifdef ERTS_SMP - erts_smp_atomic_t polled; - erts_smp_atomic_t woken; + erts_atomic32_t polled; erts_smp_mtx_t mtx; #elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - volatile int woken; #endif #if ERTS_POLL_USE_WAKEUP_PIPE int wake_fds[2]; @@ -333,12 +269,12 @@ struct ErtsPollSet_ { #if ERTS_POLL_USE_FALLBACK int fallback_used; #endif -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) - volatile int interrupt; -#else - erts_smp_atomic_t interrupt; +#ifdef ERTS_SMP + erts_atomic32_t wakeup_state; +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + volatile int wakeup_state; #endif - erts_smp_atomic_t timeout; + erts_smp_atomic32_t timeout; #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS erts_smp_atomic_t no_avoided_wakeups; erts_smp_atomic_t no_avoided_interrupts; @@ -346,34 +282,6 @@ struct ErtsPollSet_ { #endif }; -static ERTS_INLINE int -unset_interrupted_chk(ErtsPollSet ps) -{ - int res; -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) - /* This operation isn't atomic, but we have no need at all for an - atomic operation here... */ - res = ps->interrupt; - ps->interrupt = 0; -#else - res = (int) erts_smp_atomic_xchg(&ps->interrupt, (erts_aint_t) 0); - ERTS_THR_MEMORY_BARRIER; -#endif - return res; - -} - -#ifdef ERTS_SMP - -static ERTS_INLINE int -set_poller_woken_chk(ErtsPollSet ps) -{ - ERTS_THR_MEMORY_BARRIER; - return (int) erts_smp_atomic_xchg(&ps->woken, (erts_aint_t) 1); -} - -#endif - void erts_silence_warn_unused_result(long unused); static void fatal_error(char *format, ...); static void fatal_error_async_signal_safe(char *error_str); @@ -430,6 +338,64 @@ static void check_poll_status(ErtsPollSet ps); static void print_misc_debug_info(void); #endif +#define ERTS_POLL_NOT_WOKEN 0 +#define ERTS_POLL_WOKEN -1 +#define ERTS_POLL_WOKEN_INTR 1 + +static ERTS_INLINE void +reset_wakeup_state(ErtsPollSet ps) +{ +#ifdef ERTS_SMP + erts_atomic32_set(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); + ERTS_THR_MEMORY_BARRIER; +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + ps->wakeup_state = 0; +#endif +} + +static ERTS_INLINE int +is_woken(ErtsPollSet ps) +{ +#ifdef ERTS_SMP + return erts_atomic32_read_acqb(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN; +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + return ps->wakeup_state != ERTS_POLL_NOT_WOKEN; +#else + return 0; +#endif +} + +static ERTS_INLINE int +is_interrupted_reset(ErtsPollSet ps) +{ +#ifdef ERTS_SMP + return (erts_atomic32_xchg(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN) + == ERTS_POLL_WOKEN_INTR); +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + int res = ps->wakeup_state == ERTS_POLL_WOKEN_INTR; + ps->wakeup_state = ERTS_POLL_NOT_WOKEN; + return res; +#else + return 0; +#endif +} + +static ERTS_INLINE void +woke_up(ErtsPollSet ps) +{ +#ifdef ERTS_SMP + erts_aint32_t wakeup_state = erts_atomic32_read(&ps->wakeup_state); + if (wakeup_state == ERTS_POLL_NOT_WOKEN) + (void) erts_atomic32_cmpxchg(&ps->wakeup_state, + ERTS_POLL_WOKEN, + ERTS_POLL_NOT_WOKEN); + ASSERT(erts_atomic32_read(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN); +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + if (ps->wakeup_state == ERTS_POLL_NOT_WOKEN) + ps->wakeup_state = ERTS_POLL_WOKEN; +#endif +} + /* * --- Wakeup pipe ----------------------------------------------------------- */ @@ -437,14 +403,34 @@ static void print_misc_debug_info(void); #if ERTS_POLL_USE_WAKEUP_PIPE static ERTS_INLINE void -wake_poller(ErtsPollSet ps) +wake_poller(ErtsPollSet ps, int interrupted) { + int wake; +#ifdef ERTS_SMP + erts_aint32_t wakeup_state; + if (!interrupted) + wakeup_state = erts_atomic32_cmpxchg_relb(&ps->wakeup_state, + ERTS_POLL_WOKEN, + ERTS_POLL_NOT_WOKEN); + else { + /* + * We might unnecessarily write to the pipe, however, + * that isn't problematic. + */ + wakeup_state = erts_atomic32_read(&ps->wakeup_state); + erts_atomic32_set_relb(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR); + } + wake = wakeup_state == ERTS_POLL_NOT_WOKEN; +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + wake = ps->wakeup_state == ERTS_POLL_NOT_WOKEN; + ps->wakeup_state = interrupted ? ERTS_POLL_WOKEN_INTR : ERTS_POLL_NOT_WOKEN; +#endif /* * NOTE: This function might be called from signal handlers in the * non-smp case; therefore, it has to be async-signal safe in * the non-smp case. */ - if (!ERTS_POLLSET_SET_POLLER_WOKEN_CHK(ps)) { + if (wake) { ssize_t res; if (ps->wake_fds[1] < 0) return; /* Not initialized yet */ @@ -1387,9 +1373,7 @@ handle_update_requests(ErtsPollSet ps) #endif /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */ static ERTS_INLINE ErtsPollEvents -poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, - int *have_set_have_update_requests, - int *do_wake) +poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, int *do_wake) { ErtsPollEvents new_events; @@ -1493,7 +1477,6 @@ ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet ps, int len) { int i; - int hshur = 0; int do_wake; int final_do_wake = 0; @@ -1505,17 +1488,17 @@ ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet ps, pcev[i].fd, pcev[i].events, pcev[i].on, - &hshur, &do_wake); final_do_wake |= do_wake; } + ERTS_POLLSET_UNLOCK(ps); + #ifdef ERTS_SMP if (final_do_wake) - wake_poller(ps); + wake_poller(ps, 0); #endif /* ERTS_SMP */ - ERTS_POLLSET_UNLOCK(ps); } ErtsPollEvents @@ -1526,20 +1509,20 @@ ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet ps, int* do_wake) /* In: Wake up polling thread */ /* Out: Poller is woken */ { - int hshur = 0; ErtsPollEvents res; ERTS_POLLSET_LOCK(ps); - res = poll_control(ps, fd, events, on, &hshur, do_wake); + res = poll_control(ps, fd, events, on, do_wake); + + ERTS_POLLSET_UNLOCK(ps); #ifdef ERTS_SMP if (*do_wake) { - wake_poller(ps); + wake_poller(ps, 0); } #endif /* ERTS_SMP */ - ERTS_POLLSET_UNLOCK(ps); return res; } @@ -1918,9 +1901,11 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked) return 0; } else { - erts_aint_t timeout = tv->tv_sec*1000 + tv->tv_usec/1000; + long timeout = tv->tv_sec*1000 + tv->tv_usec/1000; + if (timeout > ERTS_AINT32_T_MAX) + timeout = ERTS_AINT32_T_MAX; ASSERT(timeout >= 0); - erts_smp_atomic_set(&ps->timeout, timeout); + erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout); #if ERTS_POLL_USE_FALLBACK if (!(ps->fallback_used = ERTS_POLL_NEED_FALLBACK(ps))) { @@ -2042,15 +2027,14 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, (int) tv->tv_sec*1000 + tv->tv_usec/1000); #endif - ERTS_POLLSET_UNSET_POLLER_WOKEN(ps); if (ERTS_POLLSET_SET_POLLED_CHK(ps)) { res = EINVAL; /* Another thread is in erts_poll_wait() on this pollset... */ goto done; } - if (ERTS_POLLSET_IS_INTERRUPTED(ps)) { - /* Interrupt use zero timeout */ + if (is_woken(ps)) { + /* Use zero timeout */ itv.tv_sec = 0; itv.tv_usec = 0; tvp = &itv; @@ -2067,7 +2051,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, ps_locked = 0; res = check_fd_events(ps, tvp, no_fds, &ps_locked); - ERTS_POLLSET_SET_POLLER_WOKEN(ps); + woke_up(ps); if (res == 0) { res = ETIMEDOUT; @@ -2099,9 +2083,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, check_poll_result(pr, no_fds); #endif - res = (no_fds == 0 - ? (ERTS_POLLSET_UNSET_INTERRUPTED_CHK(ps) ? EINTR : EAGAIN) - : 0); + res = (no_fds == 0 ? (is_interrupted_reset(ps) ? EINTR : EAGAIN) : 0); *len = no_fds; } @@ -2112,7 +2094,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, #endif done: - erts_smp_atomic_set(&ps->timeout, ERTS_AINT_T_MAX); + erts_smp_atomic32_set_relb(&ps->timeout, ERTS_AINT32_T_MAX); #ifdef ERTS_POLL_DEBUG_PRINT erts_printf("Leaving %s = erts_poll_wait()\n", res == 0 ? "0" : erl_errno_id(res)); @@ -2128,20 +2110,17 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet ps, int set) { +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) /* * NOTE: This function might be called from signal handlers in the * non-smp case; therefore, it has to be async-signal safe in * the non-smp case. */ - if (set) { - ERTS_POLLSET_SET_INTERRUPTED(ps); -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) - wake_poller(ps); + if (!set) + reset_wakeup_state(ps); + else + wake_poller(ps, 1); #endif - } - else { - ERTS_POLLSET_UNSET_INTERRUPTED(ps); - } } /* @@ -2154,13 +2133,12 @@ ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps, int set, long msec) { - if (set) { - if (erts_smp_atomic_read(&ps->timeout) > (erts_aint_t) msec) { - ERTS_POLLSET_SET_INTERRUPTED(ps); #if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) - wake_poller(ps); -#endif - } + if (!set) + reset_wakeup_state(ps); + else { + if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec) + wake_poller(ps, 1); #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS else { if (ERTS_POLLSET_IS_POLLED(ps)) @@ -2170,9 +2148,7 @@ ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps, erts_smp_atomic_inc(&ps->no_interrupt_timed); #endif } - else { - ERTS_POLLSET_UNSET_INTERRUPTED(ps); - } +#endif } int @@ -2283,14 +2259,16 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) ps->update_requests.next = NULL; ps->update_requests.len = 0; ps->curr_upd_req_block = &ps->update_requests; - erts_smp_atomic_init(&ps->have_update_requests, 0); + erts_smp_atomic32_init(&ps->have_update_requests, 0); #endif #ifdef ERTS_SMP - erts_smp_atomic_init(&ps->polled, 0); - erts_smp_atomic_init(&ps->woken, 0); + erts_atomic32_init(&ps->polled, 0); erts_smp_mtx_init(&ps->mtx, "pollset"); +#endif +#ifdef ERTS_SMP + erts_atomic32_init(&ps->wakeup_state, (erts_aint32_t) 0); #elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - ps->woken = 0; + ps->wakeup_state = 0; #endif #if ERTS_POLL_USE_WAKEUP_PIPE create_wakeup_pipe(ps); @@ -2312,12 +2290,7 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) ps->internal_fd_limit = kp_fd + 1; ps->kp_fd = kp_fd; #endif -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) - ps->interrupt = 0; -#else - erts_smp_atomic_init(&ps->interrupt, 0); -#endif - erts_smp_atomic_init(&ps->timeout, ERTS_AINT_T_MAX); + erts_smp_atomic32_init(&ps->timeout, ERTS_AINT32_T_MAX); #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS erts_smp_atomic_init(&ps->no_avoided_wakeups, 0); erts_smp_atomic_init(&ps->no_avoided_interrupts, 0); diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 2d5ef882f6..d8d51b192c 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * Copyright Ericsson AB 1997-2011. 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 @@ -329,11 +329,4 @@ extern int exit_async(void); #define ERTS_EXIT_AFTER_DUMP _exit -#ifdef ERTS_TIMER_THREAD -struct erts_iwait; /* opaque for clients */ -extern struct erts_iwait *erts_iwait_init(void); -extern void erts_iwait_wait(struct erts_iwait *iwait, struct timeval *delay); -extern void erts_iwait_interrupt(struct erts_iwait *iwait); -#endif /* ERTS_TIMER_THREAD */ - #endif /* #ifndef _ERL_UNIX_SYS_H */ diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index d021baa6bf..bafbbb0f6c 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -53,6 +53,11 @@ #define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */ #include "sys.h" +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) +#define __DARWIN__ 1 +#endif + + #ifdef USE_THREADS #include "erl_threads.h" #endif @@ -160,14 +165,14 @@ static int debug_log = 0; #endif #ifdef ERTS_SMP -erts_smp_atomic_t erts_got_sigusr1; +erts_smp_atomic32_t erts_got_sigusr1; #define ERTS_SET_GOT_SIGUSR1 \ - erts_smp_atomic_set(&erts_got_sigusr1, 1) + erts_smp_atomic32_set(&erts_got_sigusr1, 1) #define ERTS_UNSET_GOT_SIGUSR1 \ - erts_smp_atomic_set(&erts_got_sigusr1, 0) -static erts_smp_atomic_t have_prepared_crash_dump; + erts_smp_atomic32_set(&erts_got_sigusr1, 0) +static erts_smp_atomic32_t have_prepared_crash_dump; #define ERTS_PREPARED_CRASH_DUMP \ - ((int) erts_smp_atomic_xchg(&have_prepared_crash_dump, 1)) + ((int) erts_smp_atomic32_xchg(&have_prepared_crash_dump, 1)) #else volatile int erts_got_sigusr1; #define ERTS_SET_GOT_SIGUSR1 (erts_got_sigusr1 = 1) @@ -235,11 +240,11 @@ static int max_files = -1; * a few variables used by the break handler */ #ifdef ERTS_SMP -erts_smp_atomic_t erts_break_requested; +erts_smp_atomic32_t erts_break_requested; #define ERTS_SET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 1) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 1) #define ERTS_UNSET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 0) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 0) #else volatile int erts_break_requested = 0; #define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) @@ -504,9 +509,9 @@ erts_sys_pre_init(void) #endif } #ifdef ERTS_SMP - erts_smp_atomic_init(&erts_break_requested, 0); - erts_smp_atomic_init(&erts_got_sigusr1, 0); - erts_smp_atomic_init(&have_prepared_crash_dump, 0); + erts_smp_atomic32_init(&erts_break_requested, 0); + erts_smp_atomic32_init(&erts_got_sigusr1, 0); + erts_smp_atomic32_init(&have_prepared_crash_dump, 0); #else erts_break_requested = 0; erts_got_sigusr1 = 0; @@ -2989,11 +2994,27 @@ init_smp_sig_notify(void) NULL, &thr_opts); } +#ifdef __DARWIN__ + +int erts_darwin_main_thread_pipe[2]; +int erts_darwin_main_thread_result_pipe[2]; +static void initialize_darwin_main_thread_pipes(void) +{ + if (pipe(erts_darwin_main_thread_pipe) < 0 || + pipe(erts_darwin_main_thread_result_pipe) < 0) { + erl_exit(1,"Fatal error initializing Darwin main thread stealing"); + } +} + +#endif void erts_sys_main_thread(void) { erts_thread_disable_fpe(); +#ifdef __DARWIN__ + initialize_darwin_main_thread_pipes(); +#endif /* Become signal receiver thread... */ #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_set_thread_name("signal_receiver"); @@ -3002,6 +3023,27 @@ erts_sys_main_thread(void) smp_sig_notify(0); /* Notify initialized */ while (1) { /* Wait for a signal to arrive... */ +#ifdef __DARWIN__ + /* + * The wx driver needs to be able to steal the main thread for Cocoa to + * work properly. + */ + fd_set readfds; + int res; + + FD_ZERO(&readfds); + FD_SET(erts_darwin_main_thread_pipe[0], &readfds); + res = select(erts_darwin_main_thread_pipe[0] + 1, &readfds, NULL, NULL, NULL); + if (res > 0 && FD_ISSET(erts_darwin_main_thread_pipe[0],&readfds)) { + void* (*func)(void*); + void* arg; + void *resp; + read(erts_darwin_main_thread_pipe[0],&func,sizeof(void* (*)(void*))); + read(erts_darwin_main_thread_pipe[0],&arg, sizeof(void*)); + resp = (*func)(arg); + write(erts_darwin_main_thread_result_pipe[1],&resp,sizeof(void *)); + } +#else #ifdef DEBUG int res = #else @@ -3010,6 +3052,7 @@ erts_sys_main_thread(void) select(0, NULL, NULL, NULL, NULL); ASSERT(res < 0); ASSERT(errno == EINTR); +#endif } } @@ -3109,226 +3152,3 @@ erl_sys_args(int* argc, char** argv) } *argc = j; } - -#ifdef ERTS_TIMER_THREAD - -/* - * Interruptible-wait facility: low-level synchronisation state - * and methods that are implementation dependent. - * - * Constraint: Every implementation must define 'struct erts_iwait' - * with a field 'erts_smp_atomic_t state;'. - */ - -/* values for struct erts_iwait's state field */ -#define IWAIT_WAITING 0 -#define IWAIT_AWAKE 1 -#define IWAIT_INTERRUPT 2 - -#if 0 /* XXX: needs feature test in erts/configure.in */ - -/* - * This is an implementation of the interruptible wait facility on - * top of Linux-specific futexes. - */ -#include <asm/unistd.h> -#define FUTEX_WAIT 0 -#define FUTEX_WAKE 1 -static int sys_futex(void *futex, int op, int val, const struct timespec *timeout) -{ - return syscall(__NR_futex, futex, op, val, timeout); -} - -struct erts_iwait { - erts_smp_atomic_t state; /* &state.counter is our futex */ -}; - -static void iwait_lowlevel_init(struct erts_iwait *iwait) { /* empty */ } - -static void iwait_lowlevel_wait(struct erts_iwait *iwait, struct timeval *delay) -{ - struct timespec timeout; - int res; - - timeout.tv_sec = delay->tv_sec; - timeout.tv_nsec = delay->tv_usec * 1000; - res = sys_futex((void*)&iwait->state.counter, FUTEX_WAIT, IWAIT_WAITING, &timeout); - if (res < 0 && errno != ETIMEDOUT && errno != EWOULDBLOCK && errno != EINTR) - perror("FUTEX_WAIT"); -} - -static void iwait_lowlevel_interrupt(struct erts_iwait *iwait) -{ - int res = sys_futex((void*)&iwait->state.counter, FUTEX_WAKE, 1, NULL); - if (res < 0) - perror("FUTEX_WAKE"); -} - -#else /* using poll() or select() */ - -/* - * This is an implementation of the interruptible wait facility on - * top of pipe(), poll() or select(), read(), and write(). - */ -struct erts_iwait { - erts_smp_atomic_t state; - int read_fd; /* wait polls and reads this fd */ - int write_fd; /* interrupt writes this fd */ -}; - -static void iwait_lowlevel_init(struct erts_iwait *iwait) -{ - int fds[2]; - - if (pipe(fds) < 0) { - perror("pipe()"); - exit(1); - } - iwait->read_fd = fds[0]; - iwait->write_fd = fds[1]; -} - -#if defined(ERTS_USE_POLL) - -#include <sys/poll.h> -#define PERROR_POLL "poll()" - -static int iwait_lowlevel_poll(int read_fd, struct timeval *delay) -{ - struct pollfd pollfd; - int timeout; - - pollfd.fd = read_fd; - pollfd.events = POLLIN; - pollfd.revents = 0; - timeout = delay->tv_sec * 1000 + delay->tv_usec / 1000; - return poll(&pollfd, 1, timeout); -} - -#else /* !ERTS_USE_POLL */ - -#include <sys/select.h> -#define PERROR_POLL "select()" - -static int iwait_lowlevel_poll(int read_fd, struct timeval *delay) -{ - fd_set readfds; - - FD_ZERO(&readfds); - FD_SET(read_fd, &readfds); - return select(read_fd + 1, &readfds, NULL, NULL, delay); -} - -#endif /* !ERTS_USE_POLL */ - -static void iwait_lowlevel_wait(struct erts_iwait *iwait, struct timeval *delay) -{ - int res; - char buf[64]; - - res = iwait_lowlevel_poll(iwait->read_fd, delay); - if (res > 0) - (void)read(iwait->read_fd, buf, sizeof buf); - else if (res < 0 && errno != EINTR) - perror(PERROR_POLL); -} - -static void iwait_lowlevel_interrupt(struct erts_iwait *iwait) -{ - int res = write(iwait->write_fd, "!", 1); - if (res < 0) - perror("write()"); -} - -#endif /* using poll() or select() */ - -#if 0 /* not using poll() or select() */ -/* - * This is an implementation of the interruptible wait facility on - * top of pthread_cond_timedwait(). This has two problems: - * 1. pthread_cond_timedwait() requires an absolute time point, - * so the relative delay must be converted to absolute time. - * Worse, this breaks if the machine's time is adjusted while - * we're preparing to wait. - * 2. Each cond operation requires additional mutex lock/unlock operations. - * - * Problem 2 is probably not too bad on Linux (they'll just become - * relatively cheap futex operations), but problem 1 is the real killer. - * Only use this implementation if no better alternatives are available! - */ -struct erts_iwait { - erts_smp_atomic_t state; - pthread_cond_t cond; - pthread_mutex_t mutex; -}; - -static void iwait_lowlevel_init(struct erts_iwait *iwait) -{ - iwait->cond = (pthread_cond_t) PTHREAD_COND_INITIALIZER; - iwait->mutex = (pthread_mutex_t) PTHREAD_MUTEX_INITIALIZER; -} - -static void iwait_lowlevel_wait(struct erts_iwait *iwait, struct timeval *delay) -{ - struct timeval tmp; - struct timespec timeout; - - /* Due to pthread_cond_timedwait()'s use of absolute - time, this must be the real gettimeofday(), _not_ - the "smoothed" one beam/erl_time_sup.c implements. */ - gettimeofday(&tmp, NULL); - - tmp.tv_sec += delay->tv_sec; - tmp.tv_usec += delay->tv_usec; - if (tmp.tv_usec >= 1000*1000) { - tmp.tv_usec -= 1000*1000; - tmp.tv_sec += 1; - } - timeout.tv_sec = tmp.tv_sec; - timeout.tv_nsec = tmp.tv_usec * 1000; - pthread_mutex_lock(&iwait->mutex); - pthread_cond_timedwait(&iwait->cond, &iwait->mutex, &timeout); - pthread_mutex_unlock(&iwait->mutex); -} - -static void iwait_lowlevel_interrupt(struct erts_iwait *iwait) -{ - pthread_mutex_lock(&iwait->mutex); - pthread_cond_signal(&iwait->cond); - pthread_mutex_unlock(&iwait->mutex); -} - -#endif /* not using POLL */ - -/* - * Interruptible-wait facility. This is just a wrapper around the - * low-level synchronisation code, where we maintain our logical - * state in order to suppress some state transitions. - */ - -struct erts_iwait *erts_iwait_init(void) -{ - struct erts_iwait *iwait = malloc(sizeof *iwait); - if (!iwait) { - perror("malloc"); - exit(1); - } - iwait_lowlevel_init(iwait); - erts_smp_atomic_init(&iwait->state, IWAIT_AWAKE); - return iwait; -} - -void erts_iwait_wait(struct erts_iwait *iwait, struct timeval *delay) -{ - if (erts_smp_atomic_xchg(&iwait->state, IWAIT_WAITING) != IWAIT_INTERRUPT) - iwait_lowlevel_wait(iwait, delay); - erts_smp_atomic_set(&iwait->state, IWAIT_AWAKE); -} - -void erts_iwait_interrupt(struct erts_iwait *iwait) -{ - if (erts_smp_atomic_xchg(&iwait->state, IWAIT_INTERRUPT) == IWAIT_WAITING) - iwait_lowlevel_interrupt(iwait); -} - -#endif /* ERTS_TIMER_THREAD */ diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 6e9376b0f3..8ec7b31ce0 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2010. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. 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 @@ -36,11 +36,6 @@ erts_sys_init_float(void) # endif } -static ERTS_INLINE void set_current_fp_exception(unsigned long pc) -{ - /* nothing to do */ -} - #else /* !NO_FPE_SIGNALS */ #ifdef ERTS_SMP diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c index 411b4b37cf..c6e7b65f32 100644 --- a/erts/emulator/sys/vxworks/sys.c +++ b/erts/emulator/sys/vxworks/sys.c @@ -85,7 +85,7 @@ EXTERN_FUNCTION(void, erl_exit, (int n, char*, _DOTS_)); EXTERN_FUNCTION(void, erl_error, (char*, va_list)); EXTERN_FUNCTION(int, driver_interrupt, (int, int)); EXTERN_FUNCTION(void, increment_time, (int)); -EXTERN_FUNCTION(int, next_time, (_VOID_)); +EXTERN_FUNCTION(int, erts_next_time, (_VOID_)); EXTERN_FUNCTION(void, set_reclaim_free_function, (FreeFunction)); EXTERN_FUNCTION(int, erl_mem_info_get, (MEM_PART_STATS *)); EXTERN_FUNCTION(void, erl_crash_dump, (char* file, int line, char* fmt, ...)); diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index d84ae2ede2..7662f190ef 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2010. All Rights Reserved. + * Copyright Ericsson AB 2007-2011. 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 @@ -274,7 +274,6 @@ struct ErtsPollSet_ { Waiter** waiter; int allocated_waiters; /* Size ow waiter array */ int num_waiters; /* Number of waiter threads. */ - erts_atomic_t sys_io_ready; /* Tells us there is I/O ready (already). */ int restore_events; /* Tells us to restore waiters events next time around */ HANDLE event_io_ready; /* To be used when waiting for io */ @@ -282,12 +281,11 @@ struct ErtsPollSet_ { volatile int standby_wait_counter; /* Number of threads to wait for */ CRITICAL_SECTION standby_crit; /* CS to guard the counter */ HANDLE standby_wait_event; /* Event signalled when counte == 0 */ + erts_atomic32_t wakeup_state; #ifdef ERTS_SMP - erts_smp_atomic_t woken; erts_smp_mtx_t mtx; - erts_smp_atomic_t interrupt; #endif - erts_smp_atomic_t timeout; + erts_smp_atomic32_t timeout; }; #ifdef ERTS_SMP @@ -296,126 +294,24 @@ struct ErtsPollSet_ { erts_smp_mtx_lock(&(PS)->mtx) #define ERTS_POLLSET_UNLOCK(PS) \ erts_smp_mtx_unlock(&(PS)->mtx) -#define ERTS_POLLSET_SET_POLLED_CHK(PS) \ - ((int) erts_smp_atomic_xchg(&(PS)->polled, (erts_aint_t) 1)) -#define ERTS_POLLSET_SET_POLLED(PS) \ - erts_smp_atomic_set(&(PS)->polled, (erts_aint_t) 1) -#define ERTS_POLLSET_UNSET_POLLED(PS) \ - erts_smp_atomic_set(&(PS)->polled, (erts_aint_t) 0) -#define ERTS_POLLSET_IS_POLLED(PS) \ - ((int) erts_smp_atomic_read(&(PS)->polled)) - -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) set_poller_woken_chk((PS)) -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \ -do { \ - ERTS_THR_MEMORY_BARRIER; \ - erts_smp_atomic_set(&(PS)->woken, (erts_aint_t) 1); \ -} while (0) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \ -do { \ - erts_smp_atomic_set(&(PS)->woken, (erts_aint_t) 0); \ - ERTS_THR_MEMORY_BARRIER; \ -} while (0) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \ - ((int) erts_smp_atomic_read(&(PS)->woken)) - -#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) unset_interrupted_chk((PS)) -#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \ -do { \ - erts_smp_atomic_set(&(PS)->interrupt, (erts_aint_t) 0); \ - ERTS_THR_MEMORY_BARRIER; \ -} while (0) -#define ERTS_POLLSET_SET_INTERRUPTED(PS) \ -do { \ - ERTS_THR_MEMORY_BARRIER; \ - erts_smp_atomic_set(&(PS)->interrupt, (erts_aint_t) 1); \ -} while (0) -#define ERTS_POLLSET_IS_INTERRUPTED(PS) \ - ((int) erts_smp_atomic_read(&(PS)->interrupt)) - -static ERTS_INLINE int -unset_interrupted_chk(ErtsPollSet ps) -{ - int res = (int) erts_smp_atomic_xchg(&ps->interrupt, (erts_aint_t) 0); - ERTS_THR_MEMORY_BARRIER; - return res; - -} - -static ERTS_INLINE int -set_poller_woken_chk(ErtsPollSet ps) -{ - ERTS_THR_MEMORY_BARRIER; - return (int) erts_smp_atomic_xchg(&ps->woken, (erts_aint_t) 1); -} #else #define ERTS_POLLSET_LOCK(PS) #define ERTS_POLLSET_UNLOCK(PS) -#define ERTS_POLLSET_SET_POLLED_CHK(PS) 0 -#define ERTS_POLLSET_UNSET_POLLED(PS) -#define ERTS_POLLSET_IS_POLLED(PS) 0 -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) 1 -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) 1 - #endif /* - * While atomics are not yet implemented for windows in the common library... - * - * MSDN doc states that SMP machines and old compilers require - * InterLockedExchange to properly read and write interlocked - * variables, otherwise the processors might reschedule - * the access and order of atomics access is destroyed... - * While they only mention it in white-papers, the problem - * in VS2003 is due to the IA64 arch, so we can still count - * on the CPU not rescheduling the access to volatile in X86 arch using - * even the slightly older compiler... - * - * So here's (hopefully) a subset of the generally working atomic - * variable access... - */ - -#if defined(__GNUC__) -# if defined(__i386__) || defined(__x86_64__) -# define VOLATILE_IN_SEQUENCE 1 -# else -# define VOLATILE_IN_SEQUENCE 0 -# endif -#elif defined(_MSC_VER) -# if _MSC_VER < 1300 -# define VOLATILE_IN_SEQUENCE 0 /* Dont trust really old compilers */ -# else -# if defined(_M_IX86) -# define VOLATILE_IN_SEQUENCE 1 -# else /* I.e. IA64 */ -# if _MSC_VER >= 1400 -# define VOLATILE_IN_SEQUENCE 1 -# else -# define VOLATILE_IN_SEQUENCE 0 -# endif -# endif -# endif -#else -# define VOLATILE_IN_SEQUENCE 0 -#endif - - - -/* * Communication with sys_interrupt */ #ifdef ERTS_SMP -extern erts_smp_atomic_t erts_break_requested; +extern erts_smp_atomic32_t erts_break_requested; #define ERTS_SET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 1) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 1) #define ERTS_UNSET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 0) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 0) #else extern volatile int erts_break_requested; #define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) @@ -424,7 +320,7 @@ extern volatile int erts_break_requested; static erts_mtx_t break_waiter_lock; static HANDLE break_happened_event; -static erts_atomic_t break_waiter_state; +static erts_atomic32_t break_waiter_state; #define BREAK_WAITER_GOT_BREAK 1 #define BREAK_WAITER_GOT_HALT 2 @@ -467,29 +363,172 @@ do { \ wait_standby(PS); \ } while(0) -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) +#define ERTS_POLL_NOT_WOKEN ((erts_aint32_t) 0) +#define ERTS_POLL_WOKEN_IO_READY ((erts_aint32_t) 1) +#define ERTS_POLL_WOKEN_INTR ((erts_aint32_t) 2) +#define ERTS_POLL_WOKEN_TIMEDOUT ((erts_aint32_t) 3) static ERTS_INLINE int -unset_interrupted_chk(ErtsPollSet ps) +is_io_ready(ErtsPollSet ps) { - /* This operation isn't atomic, but we have no need at all for an - atomic operation here... */ - int res = ps->interrupt; - ps->interrupt = 0; - return res; + return erts_atomic32_read(&ps->wakeup_state) == ERTS_POLL_WOKEN_IO_READY; } +static ERTS_INLINE void +woke_up(ErtsPollSet ps) +{ + if (erts_atomic32_read(&ps->wakeup_state) == ERTS_POLL_NOT_WOKEN) + erts_atomic32_cmpxchg(&ps->wakeup_state, + ERTS_POLL_WOKEN_TIMEDOUT, + ERTS_POLL_NOT_WOKEN); +#ifdef DEBUG + { + erts_aint32_t wakeup_state = erts_atomic32_read(&ps->wakeup_state); + switch (wakeup_state) { + case ERTS_POLL_WOKEN_IO_READY: + case ERTS_POLL_WOKEN_INTR: + case ERTS_POLL_WOKEN_TIMEDOUT: + break; + default: + ASSERT(0); + break; + } + } #endif +} + +static ERTS_INLINE int +wakeup_cause(ErtsPollSet ps) +{ + int res; + erts_aint32_t wakeup_state = erts_atomic32_read(&ps->wakeup_state); + switch (wakeup_state) { + case ERTS_POLL_WOKEN_IO_READY: + res = 0; + break; + case ERTS_POLL_WOKEN_INTR: + res = EINTR; + break; + case ERTS_POLL_WOKEN_TIMEDOUT: + res = ETIMEDOUT; + break; + default: + res = 0; + erl_exit(ERTS_ABORT_EXIT, + "%s:%d: Internal error: Invalid wakeup_state=%d\n", + __FILE__, __LINE__, (int) wakeup_state); + } + return res; +} + +static ERTS_INLINE DWORD +poll_wait_timeout(ErtsPollSet ps, SysTimeval *tvp) +{ + time_t timeout = tvp->tv_sec * 1000 + tvp->tv_usec / 1000; + + if (timeout <= 0) { + woke_up(ps); + return (DWORD) 0; + } + + ResetEvent(ps->event_io_ready); + /* + * Since we don't know the internals of ResetEvent() we issue + * a memory barrier as a safety precaution ensuring that + * the load of wakeup_state wont be reordered with stores made + * by ResetEvent(). + */ + ERTS_THR_MEMORY_BARRIER; + if (erts_atomic32_read(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN) + return (DWORD) 0; + + if (timeout > ERTS_AINT32_T_MAX) /* Also prevents DWORD overflow */ + timeout = ERTS_AINT32_T_MAX; + + erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout); + return (DWORD) timeout; +} -#ifdef ERTS_SMP static ERTS_INLINE void -wake_poller(ErtsPollSet ps) +wake_poller(ErtsPollSet ps, int io_ready) { - if (!ERTS_POLLSET_SET_POLLER_WOKEN_CHK(ps)) { + erts_aint32_t wakeup_state; + if (io_ready) { + /* We may set the event multiple times. This is, however, harmless. */ + wakeup_state = erts_atomic32_read(&ps->wakeup_state); + erts_atomic32_set_relb(&ps->wakeup_state, ERTS_POLL_WOKEN_IO_READY); + } + else { + ERTS_THR_MEMORY_BARRIER; + wakeup_state = erts_atomic32_read(&ps->wakeup_state); + while (wakeup_state != ERTS_POLL_WOKEN_IO_READY + && wakeup_state != ERTS_POLL_WOKEN_INTR) { + erts_aint32_t act = erts_atomic32_cmpxchg(&ps->wakeup_state, + ERTS_POLL_WOKEN_INTR, + wakeup_state); + if (act == wakeup_state) { + wakeup_state = act; + break; + } + wakeup_state = act; + } + } + if (wakeup_state == ERTS_POLL_NOT_WOKEN) { + /* + * Since we don't know the internals of SetEvent() we issue + * a memory barrier as a safety precaution ensuring that + * the store we just made to wakeup_state wont be reordered + * with loads in SetEvent(). + */ + ERTS_THR_MEMORY_BARRIER; SetEvent(ps->event_io_ready); } } -#endif + +static ERTS_INLINE void +reset_io_ready(ErtsPollSet ps) +{ + erts_atomic32_set(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); +} + +static ERTS_INLINE void +restore_io_ready(ErtsPollSet ps) +{ + erts_atomic32_set(&ps->wakeup_state, ERTS_POLL_WOKEN_IO_READY); +} + +/* + * notify_io_ready() is used by threads waiting for events, when + * notifying a poller thread about I/O ready. + */ +static ERTS_INLINE void +notify_io_ready(ErtsPollSet ps) +{ + wake_poller(ps, 1); +} + +static ERTS_INLINE void +reset_interrupt(ErtsPollSet ps) +{ + /* We need to keep io-ready if set */ + erts_aint32_t wakeup_state = erts_atomic32_read(&ps->wakeup_state); + while (wakeup_state != ERTS_POLL_WOKEN_IO_READY + && wakeup_state != ERTS_POLL_NOT_WOKEN) { + erts_aint32_t act = erts_atomic32_cmpxchg(&ps->wakeup_state, + ERTS_POLL_NOT_WOKEN, + wakeup_state); + if (wakeup_state == act) + break; + wakeup_state = act; + } + ERTS_THR_MEMORY_BARRIER; +} + +static ERTS_INLINE void +set_interrupt(ErtsPollSet ps) +{ + wake_poller(ps, 0); +} static void setup_standby_wait(ErtsPollSet ps, int num_threads) { @@ -653,14 +692,14 @@ static void *break_waiter(void *param) case WAIT_OBJECT_0: ResetEvent(harr[0]); erts_mtx_lock(&break_waiter_lock); - erts_atomic_set(&break_waiter_state,BREAK_WAITER_GOT_BREAK); + erts_atomic32_set(&break_waiter_state,BREAK_WAITER_GOT_BREAK); SetEvent(break_happened_event); erts_mtx_unlock(&break_waiter_lock); break; case (WAIT_OBJECT_0+1): ResetEvent(harr[1]); erts_mtx_lock(&break_waiter_lock); - erts_atomic_set(&break_waiter_state,BREAK_WAITER_GOT_HALT); + erts_atomic32_set(&break_waiter_state,BREAK_WAITER_GOT_HALT); SetEvent(break_happened_event); erts_mtx_unlock(&break_waiter_lock); break; @@ -767,12 +806,7 @@ event_happened: consistency_check(w); #endif ASSERT(WAIT_OBJECT_0 < i && i < WAIT_OBJECT_0+w->active_events); - if (!erts_atomic_xchg(&ps->sys_io_ready,1)) { - HARDDEBUGF(("SET EventIoReady (%d)",erts_atomic_read(&ps->sys_io_ready))); - SetEvent(ps->event_io_ready); - } else { - HARDDEBUGF(("DONT SET EventIoReady")); - } + notify_io_ready(ps); /* * The main thread wont start working on our arrays untill we're @@ -967,15 +1001,10 @@ static int cancel_driver_select(ErtsPollSet ps, HANDLE event) void erts_poll_interrupt(ErtsPollSet ps, int set /* bool */) { HARDTRACEF(("In erts_poll_interrupt(%d)",set)); -#ifdef ERTS_SMP - if (set) { - ERTS_POLLSET_SET_INTERRUPTED(ps); - wake_poller(ps); - } - else { - ERTS_POLLSET_UNSET_INTERRUPTED(ps); - } -#endif + if (!set) + reset_interrupt(ps); + else + set_interrupt(ps); HARDTRACEF(("Out erts_poll_interrupt(%d)",set)); } @@ -984,17 +1013,10 @@ void erts_poll_interrupt_timed(ErtsPollSet ps, long msec) { HARDTRACEF(("In erts_poll_interrupt_timed(%d,%ld)",set,msec)); -#ifdef ERTS_SMP - if (set) { - if (erts_smp_atomic_read(&ps->timeout) > (erts_aint_t) msec) { - ERTS_POLLSET_SET_INTERRUPTED(ps); - wake_poller(ps); - } - } - else { - ERTS_POLLSET_UNSET_INTERRUPTED(ps); - } -#endif + if (!set) + reset_interrupt(ps); + else if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec) + set_interrupt(ps); HARDTRACEF(("Out erts_poll_interrupt_timed")); } @@ -1068,10 +1090,8 @@ void erts_poll_controlv(ErtsPollSet ps, int erts_poll_wait(ErtsPollSet ps, ErtsPollResFd pr[], int *len, - SysTimeval *utvp) + SysTimeval *tvp) { - SysTimeval *tvp = utvp; - SysTimeval itv; int no_fds; DWORD timeout; EventData* ev; @@ -1084,7 +1104,7 @@ int erts_poll_wait(ErtsPollSet ps, HARDTRACEF(("In erts_poll_wait")); ERTS_POLLSET_LOCK(ps); - if (!erts_atomic_read(&ps->sys_io_ready) && ps->restore_events) { + if (!is_io_ready(ps) && ps->restore_events) { HARDDEBUGF(("Restore events: %d",ps->num_waiters)); ps->restore_events = 0; for (i = 0; i < ps->num_waiters; ++i) { @@ -1102,7 +1122,7 @@ int erts_poll_wait(ErtsPollSet ps, if (w->highwater != w->active_events) { HARDDEBUGF(("Oups!")); /* Oups, got signalled before we took the lock, can't reset */ - if(erts_atomic_read(&ps->sys_io_ready) == 0) { + if(!is_io_ready(ps)) { erl_exit(1,"Internal error: " "Inconsistent io structures in erl_poll.\n"); } @@ -1127,39 +1147,27 @@ int erts_poll_wait(ErtsPollSet ps, no_fds = ERTS_POLL_MAX_RES; #endif + timeout = poll_wait_timeout(ps, tvp); - ResetEvent(ps->event_io_ready); - ERTS_POLLSET_UNSET_POLLER_WOKEN(ps); - -#ifdef ERTS_SMP - if (ERTS_POLLSET_IS_INTERRUPTED(ps)) { - /* Interrupt use zero timeout */ - itv.tv_sec = 0; - itv.tv_usec = 0; - tvp = &itv; - } -#endif - - timeout = tvp->tv_sec * 1000 + tvp->tv_usec / 1000; /*HARDDEBUGF(("timeout = %ld",(long) timeout));*/ - erts_smp_atomic_set(&ps->timeout, timeout); - if (timeout > 0 && ! erts_atomic_read(&ps->sys_io_ready) && ! erts_atomic_read(&break_waiter_state)) { + if (timeout > 0 && !erts_atomic32_read(&break_waiter_state)) { HANDLE harr[2] = {ps->event_io_ready, break_happened_event}; int num_h = 2; - HARDDEBUGF(("Start waiting %d [%d]",num_h, (long) timeout)); + HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout)); ERTS_POLLSET_UNLOCK(ps); WaitForMultipleObjects(num_h, harr, FALSE, timeout); ERTS_POLLSET_LOCK(ps); - HARDDEBUGF(("Stop waiting %d [%d]",num_h, (long) timeout)); + HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout)); + woke_up(ps); } ERTS_UNSET_BREAK_REQUESTED; - if(erts_atomic_read(&break_waiter_state)) { + if(erts_atomic32_read(&break_waiter_state)) { erts_mtx_lock(&break_waiter_lock); - break_state = erts_atomic_read(&break_waiter_state); - erts_atomic_set(&break_waiter_state,0); + break_state = erts_atomic32_read(&break_waiter_state); + erts_atomic32_set(&break_waiter_state,0); ResetEvent(break_happened_event); erts_mtx_unlock(&break_waiter_lock); switch (break_state) { @@ -1174,15 +1182,13 @@ int erts_poll_wait(ErtsPollSet ps, } } - ERTS_POLLSET_SET_POLLER_WOKEN(ps); - - if (!erts_atomic_read(&ps->sys_io_ready)) { - res = EINTR; - HARDDEBUGF(("EINTR!")); - goto done; + res = wakeup_cause(ps); + if (res != 0) { + HARDDEBUGF(("%s!", res == EINTR ? "EINTR" : "ETIMEDOUT")); + goto done; } - erts_atomic_set(&ps->sys_io_ready,0); + reset_io_ready(ps); n = ps->num_waiters; @@ -1204,9 +1210,9 @@ int erts_poll_wait(ErtsPollSet ps, if (num >= no_fds) { w->highwater=j+1; erts_mtx_unlock(&w->mtx); - /* This might mean we still have data to report, set - back the global flag! */ - erts_atomic_set(&ps->sys_io_ready,1); + /* This might mean we still have data to report, + restore flag indicating I/O ready! */ + restore_io_ready(ps); HARDDEBUGF(("To many FD's to report!")); goto done; } @@ -1228,7 +1234,7 @@ int erts_poll_wait(ErtsPollSet ps, erts_mtx_unlock(&w->mtx); } done: - erts_smp_atomic_set(&ps->timeout, ERTS_AINT_T_MAX); + erts_smp_atomic32_set(&ps->timeout, ERTS_AINT32_T_MAX); *len = num; ERTS_POLLSET_UNLOCK(ps); HARDTRACEF(("Out erts_poll_wait")); @@ -1306,15 +1312,13 @@ ErtsPollSet erts_poll_create_pollset(void) ps->standby_wait_counter = 0; ps->event_io_ready = CreateManualEvent(FALSE); ps->standby_wait_event = CreateManualEvent(FALSE); - erts_atomic_init(&ps->sys_io_ready,0); ps->restore_events = 0; + erts_atomic32_init(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); #ifdef ERTS_SMP - erts_smp_atomic_init(&ps->woken, 0); erts_smp_mtx_init(&ps->mtx, "pollset"); - erts_smp_atomic_init(&ps->interrupt, 0); #endif - erts_smp_atomic_init(&ps->timeout, ERTS_AINT_T_MAX); + erts_smp_atomic32_init(&ps->timeout, ERTS_AINT32_T_MAX); HARDTRACEF(("Out erts_poll_create_pollset")); return ps; @@ -1366,7 +1370,7 @@ void erts_poll_init(void) erts_mtx_init(&break_waiter_lock,"break_waiter_lock"); break_happened_event = CreateManualEvent(FALSE); - erts_atomic_init(&break_waiter_state, 0); + erts_atomic32_init(&break_waiter_state, 0); erts_thr_create(&thread, &break_waiter, NULL, NULL); ERTS_UNSET_BREAK_REQUESTED; diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h index 1347eead91..ecb06868d5 100644 --- a/erts/emulator/sys/win32/erl_win_dyn_driver.h +++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * Copyright Ericsson AB 2003-2011. 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 diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 37041ed987..a2159d063c 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 @@ -75,7 +75,7 @@ static int create_pipe(LPHANDLE, LPHANDLE, BOOL, BOOL); static int application_type(const char* originalName, char fullPath[MAX_PATH], BOOL search_in_path, BOOL handle_quotes, int *error_return); -static int application_type_w(const char* originalName, WCHAR fullPath[MAX_PATH], +static int application_type_w(const WCHAR *originalName, WCHAR fullPath[MAX_PATH], BOOL search_in_path, BOOL handle_quotes, int *error_return); @@ -260,7 +260,7 @@ erts_sys_prepare_crash_dump(void) } static void -init_console() +init_console(void) { char* mode = erts_read_env("ERL_CONSOLE_MODE"); @@ -280,7 +280,7 @@ init_console() erts_free_read_env(mode); } -int sys_max_files() +int sys_max_files(void) { return max_files; } @@ -296,10 +296,7 @@ int sys_max_files() */ static int -get_and_remove_option(argc, argv, option) - int* argc; /* Number of arguments. */ - char* argv[]; /* The argument vector. */ - const char* option; /* Option to search for and remove. */ +get_and_remove_option(int* argc, char* argv[], const char *option) { int i; @@ -349,9 +346,7 @@ static char *get_and_remove_option2(int *argc, char **argv, char os_type[] = "win32"; void -os_flavor(namebuf, size) -char* namebuf; /* Where to return the name. */ -unsigned size; /* Size of name buffer. */ +os_flavor(char *namebuf, unsigned size) { switch (int_os_version.dwPlatformId) { case VER_PLATFORM_WIN32_WINDOWS: @@ -624,12 +619,7 @@ struct erl_drv_entry async_driver_entry = { */ static DriverData* -new_driver_data(port_num, packet_bytes, wait_objs_required, use_threads) - int port_num; /* The port number. */ - int packet_bytes; /* Number of bytes in header. */ - int wait_objs_required; /* The number objects this port is going - /* wait for (typically 1 or 2). */ - int use_threads; /* TRUE if threads are intended to be used. */ +new_driver_data(int port_num, int packet_bytes, int wait_objs_required, int use_threads) { DriverData* dp; @@ -867,12 +857,7 @@ threaded_handle_closer(LPVOID param) */ static ErlDrvData -set_driver_data(dp, ifd, ofd, read_write, report_exit) - DriverData* dp; - HANDLE ifd; - HANDLE ofd; - int read_write; - int report_exit; +set_driver_data(DriverData* dp, HANDLE ifd, HANDLE ofd, int read_write, int report_exit) { int index = dp - driver_data; int result; @@ -896,6 +881,31 @@ set_driver_data(dp, ifd, ofd, read_write, report_exit) return (ErlDrvData)index; } +static ErlDrvData +reuse_driver_data(DriverData *dp, HANDLE ifd, HANDLE ofd, int read_write, ErlDrvPort port_num) +{ + int index = dp - driver_data; + int result; + + dp->port_num = port_num; + dp->in.fd = ifd; + dp->out.fd = ofd; + dp->report_exit = 0; + + if (read_write & DO_READ) { + result = driver_select(dp->port_num, (ErlDrvEvent)dp->in.ov.hEvent, + ERL_DRV_READ|ERL_DRV_USE, 1); + ASSERT(result != -1); + } + + if (read_write & DO_WRITE) { + result = driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, + ERL_DRV_WRITE|ERL_DRV_USE, 1); + ASSERT(result != -1); + } + return (ErlDrvData)index; +} + /* * Initialises an AsyncIo structure. */ @@ -969,10 +979,7 @@ release_async_io(AsyncIo* aio, ErlDrvPort port_num) */ static void -async_read_file(aio, buf, numToRead) - AsyncIo* aio; /* Pointer to driver data. */ - LPVOID buf; /* Pointer to buffer to receive data. */ - DWORD numToRead; /* Number of bytes to read. */ +async_read_file(AsyncIo* aio, LPVOID buf, DWORD numToRead) { aio->pendingError = NO_ERROR; #ifdef HARD_POLL_DEBUG @@ -1023,10 +1030,9 @@ async_read_file(aio, buf, numToRead) * ---------------------------------------------------------------------- */ static int -async_write_file(aio, buf, numToWrite) - AsyncIo* aio; /* Pointer to async control block. */ - LPVOID buf; /* Pointer to buffer with data to write. */ - DWORD numToWrite; /* Number of bytes to write. */ +async_write_file(AsyncIo* aio, /* Pointer to async control block. */ + LPVOID buf, /* Pointer to buffer with data to write. */ + DWORD numToWrite) /* Number of bytes to write. */ { aio->pendingError = NO_ERROR; if (aio->thread != (HANDLE) -1) { @@ -1070,12 +1076,12 @@ async_write_file(aio, buf, numToWrite) * ---------------------------------------------------------------------- */ static int -get_overlapped_result(aio, pBytesRead, wait) - AsyncIo* aio; /* Pointer to async control block. */ - LPDWORD pBytesRead; /* Where to place the number of bytes - * transferred. - */ - BOOL wait; /* If true, wait until result is ready. */ +get_overlapped_result(AsyncIo* aio, /* Pointer to async control block. */ + LPDWORD pBytesRead, /* Where to place the number of bytes + * transferred. + */ + BOOL wait /* If true, wait until result is ready. */ + ) { DWORD error = NO_ERROR; /* Error status from last function. */ @@ -1145,7 +1151,7 @@ fd_init(void) return 0; } static int -spawn_init() +spawn_init(void) { int i; #if defined(ERTS_SMP) && defined(USE_CANCELIOEX) @@ -1532,7 +1538,7 @@ create_child_process siStartInfo.hStdOutput = hStdout; siStartInfo.hStdError = hStderr; - applType = application_type_w(origcmd, (char *) execPath, FALSE, FALSE, + applType = application_type_w((WCHAR *) origcmd, execPath, FALSE, FALSE, errno_return); if (applType == APPL_NONE) { return FALSE; @@ -1555,7 +1561,7 @@ create_child_process if (run_cmd) { WCHAR cmdPath[MAX_PATH]; int cmdType; - cmdType = application_type_w((char *) L"cmd.exe", (char *) cmdPath, TRUE, FALSE, errno_return); + cmdType = application_type_w(L"cmd.exe", cmdPath, TRUE, FALSE, errno_return); if (cmdType == APPL_NONE || cmdType == APPL_DOS) { return FALSE; } @@ -1921,7 +1927,7 @@ static int application_type return applType; } -static int application_type_w (const char *originalName, /* Name of the application to find. */ +static int application_type_w (const WCHAR *originalName, /* Name of the application to find. */ WCHAR wfullpath[MAX_PATH],/* Filled with complete path to * application. */ BOOL search_in_path, /* If we should search the system wide path */ @@ -1937,25 +1943,24 @@ static int application_type_w (const char *originalName, /* Name of the applicat static WCHAR extensions[][5] = {L"", L".com", L".exe", L".bat"}; int is_quoted; int len; - WCHAR *wname = (WCHAR *) originalName; WCHAR xfullpath[MAX_PATH]; - len = wcslen(wname); - is_quoted = handle_quotes && len > 0 && wname[0] == L'"' && - wname[len-1] == L'"'; + len = wcslen(originalName); + is_quoted = handle_quotes && len > 0 && originalName[0] == L'"' && + originalName[len-1] == L'"'; applType = APPL_NONE; *error_return = ENOENT; for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { if(is_quoted) { - lstrcpynW(xfullpath, wname+1, MAX_PATH - 7); /* Cannot start using StringCchCopy yet, we support + lstrcpynW(xfullpath, originalName+1, MAX_PATH - 7); /* Cannot start using StringCchCopy yet, we support older platforms */ len = wcslen(xfullpath); if(len > 0) { xfullpath[len-1] = L'\0'; } } else { - lstrcpynW(xfullpath, wname, MAX_PATH - 5); + lstrcpynW(xfullpath, originalName, MAX_PATH - 5); } wcscat(xfullpath, extensions[i]); /* It seems that the Unicode version does not allow in and out parameter to overlap. */ @@ -2080,9 +2085,10 @@ threaded_reader(LPVOID param) buf = OV_BUFFER_PTR(aio); numToRead = OV_NUM_TO_READ(aio); aio->pendingError = 0; - if (!ReadFile(aio->fd, buf, numToRead, &aio->bytesTransferred, NULL)) - aio->pendingError = GetLastError(); - else if (aio->flags & DF_XLAT_CR) { + if (!ReadFile(aio->fd, buf, numToRead, &aio->bytesTransferred, NULL)) { + int error = GetLastError(); + aio->pendingError = error; + } else if (aio->flags & DF_XLAT_CR) { char *s; int n; @@ -2209,56 +2215,79 @@ translate_fd(int fd) return handle; } +/* Driver level locking, start function is serialized */ +static DriverData *save_01_port = NULL; +static DriverData *save_22_port = NULL; + static ErlDrvData fd_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) { DriverData* dp; int is_std_error = (opts->ofd == 2); - - opts->ifd = (int) translate_fd(opts->ifd); - opts->ofd = (int) translate_fd(opts->ofd); - if ((dp = new_driver_data(port_num, opts->packet_bytes, 2, TRUE)) == NULL) - return ERL_DRV_ERROR_GENERAL; - - if (!create_file_thread(&dp->in, DO_READ)) { - dp->port_num = PORT_FREE; - return ERL_DRV_ERROR_GENERAL; - } - - if (!create_file_thread(&dp->out, DO_WRITE)) { - dp->port_num = PORT_FREE; - return ERL_DRV_ERROR_GENERAL; - } - - fd_driver_input = &(dp->in); - dp->in.flags = DF_XLAT_CR; - if (is_std_error) { - dp->out.flags |= DF_DROP_IF_INVH; /* Just drop messages if stderror - is an invalid handle */ + int in = opts->ifd, out = opts->ofd; + + opts->ifd = (Uint) translate_fd(in); + opts->ofd = (Uint) translate_fd(out); + if ( in == 0 && out == 1 && save_01_port != NULL) { + dp = save_01_port; + return reuse_driver_data(dp, (HANDLE) opts->ifd, (HANDLE) opts->ofd, opts->read_write, port_num); + } else if (in == 2 && out == 2 && save_22_port != NULL) { + dp = save_22_port; + return reuse_driver_data(dp, (HANDLE) opts->ifd, (HANDLE) opts->ofd, opts->read_write, port_num); + } else { + if ((dp = new_driver_data(port_num, opts->packet_bytes, 2, TRUE)) == NULL) + return ERL_DRV_ERROR_GENERAL; + + if (!create_file_thread(&dp->in, DO_READ)) { + dp->port_num = PORT_FREE; + return ERL_DRV_ERROR_GENERAL; + } + + if (!create_file_thread(&dp->out, DO_WRITE)) { + dp->port_num = PORT_FREE; + return ERL_DRV_ERROR_GENERAL; + } + + fd_driver_input = &(dp->in); + dp->in.flags = DF_XLAT_CR; + if (is_std_error) { + dp->out.flags |= DF_DROP_IF_INVH; /* Just drop messages if stderror + is an invalid handle */ + } + + if ( in == 0 && out == 1) { + save_01_port = dp; + } else if (in == 2 && out == 2) { + save_22_port = dp; + } + return set_driver_data(dp, (HANDLE) opts->ifd, (HANDLE) opts->ofd, opts->read_write, 0); } - return set_driver_data(dp, opts->ifd, opts->ofd, opts->read_write, 0); } static void fd_stop(ErlDrvData d) { int fd = (int)d; + DriverData* dp = driver_data+fd; /* - * I don't know a clean way to terminate the threads - * (TerminateThread() doesn't release the stack), - * so will we'll let the threads live. Normally, the fd - * driver is only used to support the -oldshell option, - * so this shouldn't be a problem in practice. - * - * Since we will not attempt to terminate the threads, - * better not close the input or output files either. + * There's no way we can terminate an fd port in a consistent way. + * Instead we let it live until it's opened again (which it is, + * as the only FD-drivers are for 0,1 and 2 adn the only time they + * get closed is by init:reboot). + * So - just deselect them and let everything be as is. + * They get woken up in fd_start again, where the DriverData is + * remembered. /PaN */ + if (dp->in.ov.hEvent != NULL) { + (void) driver_select(dp->port_num, + (ErlDrvEvent)dp->in.ov.hEvent, + ERL_DRV_READ, 0); + } + if (dp->out.ov.hEvent != NULL) { + (void) driver_select(dp->port_num, + (ErlDrvEvent)dp->out.ov.hEvent, + ERL_DRV_WRITE, 0); + } - driver_data[fd].in.thread = (HANDLE) -1; - driver_data[fd].out.thread = (HANDLE) -1; - driver_data[fd].in.fd = INVALID_HANDLE_VALUE; - driver_data[fd].out.fd = INVALID_HANDLE_VALUE; - - /*return */ common_stop(fd); } static ErlDrvData @@ -2350,7 +2379,6 @@ threaded_exiter(LPVOID param) * because it is an auto reset event. Therefore, always set the * exit flag and signal the event. */ - i = 0; if (dp->out.thread != (HANDLE) -1) { dp->out.flags = DF_EXIT_THREAD; @@ -2718,6 +2746,7 @@ ready_input(ErlDrvData drv_data, ErlDrvEvent ready_event) driver_failure_eof(dp->port_num); } else { /* Report real errors. */ int error = GetLastError(); + (void) driver_select(dp->port_num, ready_event, ERL_DRV_READ, 0); _dosmaperr(error); driver_failure_posix(dp->port_num, errno); diff --git a/erts/emulator/sys/win32/sys_interrupt.c b/erts/emulator/sys/win32/sys_interrupt.c index 262f84babc..943c338794 100644 --- a/erts/emulator/sys/win32/sys_interrupt.c +++ b/erts/emulator/sys/win32/sys_interrupt.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2010. All Rights Reserved. + * Copyright Ericsson AB 1997-2011. 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 @@ -31,11 +31,11 @@ #endif #ifdef ERTS_SMP -erts_smp_atomic_t erts_break_requested; +erts_smp_atomic32_t erts_break_requested; #define ERTS_SET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 1) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 1) #define ERTS_UNSET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 0) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 0) #else volatile int erts_break_requested = 0; #define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 7259e1b84d..4d0c87bf12 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# Copyright Ericsson AB 1997-2011. 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 @@ -122,10 +122,14 @@ NO_OPT= bs_bincomp \ bs_utf \ guard +NATIVE= hibernate NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE) NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl) +NATIVE_MODULES= $(NATIVE:%=%_native_SUITE) +NATIVE_ERL_FILES= $(NATIVE_MODULES:%=%.erl) + ERL_FILES= $(MODULES:%=%.erl) TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) @@ -151,7 +155,7 @@ ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include # Targets # ---------------------------------------------------- -make_emakefile: $(NO_OPT_ERL_FILES) +make_emakefile: $(NO_OPT_ERL_FILES) $(NATIVE_ERL_FILES) # This special rule can be removed when communication with R7B nodes # is no longer supported. $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) +compressed -o$(EBIN) \ @@ -160,6 +164,8 @@ make_emakefile: $(NO_OPT_ERL_FILES) $(MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +native $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(NATIVE_MODULES) >> $(EMAKEFILE) tests debug opt: make_emakefile erl $(ERL_MAKE_FLAGS) -make @@ -178,6 +184,9 @@ docs: %_no_opt_SUITE.erl: %_SUITE.erl sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ +%_native_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -190,7 +199,8 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) $(EMAKEFILE) $(TEST_SPEC_FILES) \ $(ERL_FILES) $(RELSYSDIR) $(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + $(INSTALL_DATA) $(NATIVE_ERL_FILES) $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl index e9d653a7c4..b541be3df6 100644 --- a/erts/emulator/test/a_SUITE.erl +++ b/erts/emulator/test/a_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2011. 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 @@ -26,15 +26,32 @@ %%%------------------------------------------------------------------- -module(a_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1, long_timers/1, pollset_size/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, long_timers/1, pollset_size/1]). -all(doc) -> - []; -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [long_timers, pollset_size]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + long_timers(doc) -> []; long_timers(suite) -> diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl index 3e1a871408..7cc329cc69 100644 --- a/erts/emulator/test/after_SUITE.erl +++ b/erts/emulator/test/after_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -21,27 +21,48 @@ %% Tests receive after. --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1, t_after/1, receive_after/1, receive_after_big/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + t_after/1, receive_after/1, receive_after_big/1, receive_after_errors/1, receive_var_zero/1, receive_zero/1, multi_timeout/1, receive_after_32bit/1]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([init_per_testcase/2, end_per_testcase/2]). %% Internal exports. -export([timeout_g/0]). -all(suite) -> - [t_after, receive_after, receive_after_big, receive_after_errors, - receive_var_zero, receive_zero, multi_timeout, receive_after_32bit]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [t_after, receive_after, receive_after_big, + receive_after_errors, receive_var_zero, receive_zero, + multi_timeout, receive_after_32bit]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(3)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 94766dc6e9..22b5d93983 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2011. 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 @@ -18,7 +18,8 @@ -module(alloc_SUITE). -author('[email protected]'). --export([all/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). -export([basic/1, coalesce/1, @@ -29,28 +30,40 @@ rbtree/1, mseg_clear_cache/1]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([init_per_testcase/2, end_per_testcase/2]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -define(DEFAULT_TIMETRAP_SECS, 240). -all(doc) -> []; -all(suite) -> [basic, - coalesce, - threads, - realloc_copy, - bucket_index, - bucket_mask, - rbtree, - mseg_clear_cache]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [basic, coalesce, threads, realloc_copy, bucket_index, + bucket_mask, rbtree, mseg_clear_cache]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), [{watchdog, Dog},{testcase, Case}|Config]. -fin_per_testcase(_Case, Config) when is_list(Config) -> +end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index 228ff15341..02c6e19686 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. 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 @@ -19,16 +19,37 @@ -module(beam_SUITE). --export([all/1, packed_registers/1, apply_last/1, apply_last_bif/1, - buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + packed_registers/1, apply_last/1, apply_last_bif/1, + buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1, + select_val/1]). -export([applied/2]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [packed_registers, apply_last, apply_last_bif, + buildo_mucho, heap_sizes, big_lists, select_val]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [packed_registers, apply_last, apply_last_bif, buildo_mucho, - heap_sizes, big_lists]. %% Verify that apply(M, F, A) is really tail recursive. @@ -302,3 +323,19 @@ do_fconv(nil, Float) when is_float(Float) -> Float + []; do_fconv(tuple_literal, Float) when is_float(Float) -> Float + {a,b}. + +select_val(Config) when is_list(Config) -> + ?line zero = do_select_val(0), + ?line big = do_select_val(1 bsl 64), + ?line integer = do_select_val(42), + ok. + +do_select_val(X) -> + case X of + 0 -> + zero; + 1 bsl 64 -> + big; + Int when is_integer(Int) -> + integer + end. diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl index 75841adbfc..85236e4203 100644 --- a/erts/emulator/test/beam_literals_SUITE.erl +++ b/erts/emulator/test/beam_literals_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -18,21 +18,41 @@ %% -module(beam_literals_SUITE). --export([all/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). -export([putting/1, matching_smalls/1, matching_smalls_jt/1, matching_bigs/1, matching_more_bigs/1, matching_bigs_and_smalls/1, badmatch/1, case_clause/1, receiving/1, literal_type_tests/1, - put_list/1, fconv/1, literal_case_expression/1]). + put_list/1, fconv/1, literal_case_expression/1, + increment/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [putting, matching_smalls, matching_smalls_jt, matching_bigs, matching_more_bigs, matching_bigs_and_smalls, badmatch, case_clause, - receiving, literal_type_tests, - put_list, fconv, literal_case_expression]. + receiving, literal_type_tests, put_list, fconv, + literal_case_expression, increment]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + putting(doc) -> "Test creating lists and tuples containing big number literals."; putting(Config) when is_list(Config) -> @@ -48,6 +68,7 @@ matching_bigs(doc) -> "Test matching of a few big number literals (in Beam," matching_bigs(Config) when is_list(Config) -> a = matching1(3972907842873739), b = matching1(-389789298378939783333333333333333333784), + other = matching1(3141699999999999999999999999999999999), other = matching1(42). matching_smalls(doc) -> "Test matching small numbers (both positive and negative)."; @@ -236,14 +257,14 @@ make_test([{T,L}|Ts]) -> make_test([]) -> []. test(T, L) -> - S = lists:flatten(io_lib:format("begin io:format(\"~~p~~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L])), + S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L])), {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), {match,0,{atom,0,Val},hd(E)}. test(T, A, L) -> - S = lists:flatten(io_lib:format("begin io:format(\"~~p~~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", + S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", [T,L,A,T,L,A])), {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), @@ -405,14 +426,51 @@ fconv_2(F) when is_float(F) -> literal_case_expression(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), ?line Src = filename:join(DataDir, "literal_case_expression"), - ?line {ok,literal_case_expression=Mod,Code} = compile:file(Src, [from_asm,binary]), + ?line {ok,literal_case_expression=Mod,Code} = + compile:file(Src, [from_asm,binary]), ?line {module,Mod} = code:load_binary(Mod, Src, Code), ?line ok = Mod:x(), ?line ok = Mod:y(), + ?line ok = Mod:zi1(), + ?line ok = Mod:zi2(), + ?line ok = Mod:za1(), + ?line ok = Mod:za2(), ?line true = code:delete(Mod), ?line code:purge(Mod), ok. +%% Test the i_increment instruction. +increment(Config) when is_list(Config) -> + %% In the 32-bit emulator, Neg32 can be represented as a small, + %% but -Neg32 cannot. Therefore the i_increment instruction must + %% not be used in the subtraction that follows (since i_increment + %% cannot handle a bignum literal). + Neg32 = -(1 bsl 27), + Big32 = id(1 bsl 32), + Result32 = (1 bsl 32) + (1 bsl 27), + ?line Result32 = Big32 + (1 bsl 27), + ?line Result32 = Big32 - Neg32, + + %% Same thing, but for the 64-bit emulator. + Neg64 = -(1 bsl 59), + Big64 = id(1 bsl 64), + Result64 = (1 bsl 64) + (1 bsl 59), + ?line Result64 = Big64 + (1 bsl 59), + ?line Result64 = Big64 - Neg64, + + %% Test error handling for the i_increment instruction. + Bad = id(bad), + ?line {'EXIT',{badarith,_}} = (catch Bad + 42), + + %% Small operands, but a big result. + Res32 = 1 bsl 27, + Small32 = id(Res32-1), + ?line Res32 = Small32 + 1, + Res64 = 1 bsl 59, + Small64 = id(Res64-1), + ?line Res64 = Small64 + 1, + ok. + %% Help functions. chksum(Term) -> diff --git a/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S b/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S index c0ffe9ab53..bfdfc079dc 100644 --- a/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S +++ b/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S @@ -1,10 +1,11 @@ {module, literal_case_expression}. %% version = 0 -{exports, [{module_info,0},{module_info,1},{x,0},{y,0}]}. +{exports, [{module_info,0},{module_info,1},{x,0},{y,0}, + {zi1,0},{zi2,0},{za1,0},{za2,0}]}. {attributes, []}. -{labels, 15}. +{labels, 32}. {function, x, 0, 2}. @@ -52,6 +53,81 @@ {label,10}. {case_end,{float,34.0000}}. +{function, zi1, 0, 16}. + {label,15}. + {func_info,{atom,literal_case_expression},{atom,zi1},0}. + {label,16}. + {test,is_integer,{f,19},[{integer,42}]}. + {select_val,{integer,42}, + {f,18}, + {list,[{integer,42}, + {f,17}, + {integer,1000}, + {f,18}]}}. + {label,17}. + {move,{atom,ok},{x,0}}. + return. + {label,18}. + {move,{atom,error},{x,0}}. + return. + {label,19}. + {case_end,{integer,42}}. + +{function, zi2, 0, 16}. + {label,20}. + {func_info,{atom,literal_case_expression},{atom,zi2},0}. + {label,21}. + {test,is_integer,{f,23},[{integer,42}]}. + {select_val,{integer,42}, + {f,23}, + {list,[{integer,42}, + {f,22}, + {integer,1000}, + {f,23}]}}. + {label,22}. + {move,{atom,ok},{x,0}}. + return. + {label,23}. + {move,{atom,error},{x,0}}. + return. + +{function, za1, 0, 25}. + {label,24}. + {func_info,{atom,literal_case_expression},{atom,za1},0}. + {label,25}. + {test,is_atom,{f,28},[{atom,x}]}. + {select_val,{atom,x}, + {f,27}, + {list,[{atom,a}, + {f,27}, + {atom,x}, + {f,26}]}}. + {label,26}. + {move,{atom,ok},{x,0}}. + return. + {label,27}. + {move,{atom,error},{x,0}}. + return. + {label,28}. + {case_end,{atom,x}}. + +{function, za2, 0, 30}. + {label,29}. + {func_info,{atom,literal_case_expression},{atom,za2},0}. + {label,30}. + {test,is_atom,{f,32},[{atom,x}]}. + {select_val,{atom,x}, + {f,32}, + {list,[{atom,a}, + {f,32}, + {atom,x}, + {f,31}]}}. + {label,31}. + {move,{atom,ok},{x,0}}. + return. + {label,32}. + {move,{atom,error},{x,0}}. + return. {function, module_info, 0, 12}. {label,11}. diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index b4ef0e6d5a..c7617d3b90 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. 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 @@ -19,27 +19,74 @@ -module(bif_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, + display/1, display_huge/0, types/1, t_list_to_existing_atom/1,os_env/1,otp_7526/1, binary_to_atom/1,binary_to_existing_atom/1, atom_to_binary/1,min_max/1]). -all(suite) -> - [types,t_list_to_existing_atom,os_env,otp_7526, - atom_to_binary,binary_to_atom,binary_to_existing_atom, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [types, t_list_to_existing_atom, os_env, otp_7526, + display, + atom_to_binary, binary_to_atom, binary_to_existing_atom, min_max]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(1)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). + +display(suite) -> + []; +display(doc) -> + ["Uses erlang:display to test that erts_printf does not do deep recursion"]; +display(Config) when is_list(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + {ok, Node} = test_server:start_node(display_huge_term,peer, + [{args, "-pa "++Pa}]), + true = rpc:call(Node,?MODULE,display_huge,[]), + test_server:stop_node(Node), + ok. + +display_huge() -> + erlang:display(deeep(100000)). + +deeep(0,Acc) -> + Acc; +deeep(N,Acc) -> + deeep(N-1,[Acc|[]]). + +deeep(N) -> + deeep(N,[hello]). + + types(Config) when is_list(Config) -> c:l(erl_bif_types), case erlang:function_exported(erl_bif_types, module_info, 0) of diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl index 6cedd39009..3487917677 100644 --- a/erts/emulator/test/big_SUITE.erl +++ b/erts/emulator/test/big_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -19,9 +19,10 @@ -module(big_SUITE). --export([all/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). -export([t_div/1, eq_28/1, eq_32/1, eq_big/1, eq_math/1, big_literals/1, - borders/1, negative/1, big_float/1, big_float_1/1, big_float_2/1, + borders/1, negative/1, big_float_1/1, big_float_2/1, shift_limit_1/1, powmod/1, system_limit/1, otp_6692/1]). %% Internal exports. @@ -30,19 +31,38 @@ -export([fac/1, fib/1, pow/2, gcd/2, lcm/2]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([init_per_testcase/2, end_per_testcase/2]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [t_div, eq_28, eq_32, eq_big, eq_math, big_literals, + borders, negative, {group, big_float}, shift_limit_1, + powmod, system_limit, otp_6692]. + +groups() -> + [{big_float, [], [big_float_1, big_float_2]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [t_div, eq_28, eq_32, eq_big, eq_math, big_literals, borders, - negative, big_float, shift_limit_1, powmod, system_limit, otp_6692]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(3)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). @@ -260,10 +280,6 @@ big_literals(Config) when is_list(Config) -> ?line ok = Mod:t(), ok. -big_float(doc) -> - ["Test cases for mixing bignums and floats"]; -big_float(suite) -> - [big_float_1, big_float_2]. big_float_1(doc) -> ["OTP-2436, part 1"]; diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 77d2579848..7e409f053e 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -40,9 +40,11 @@ %% phash2(Binary, N) %% --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1, init_per_testcase/2, fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2, copy_terms/1, conversions/1, deep_lists/1, deep_bitstr_lists/1, bad_list_to_binary/1, bad_binary_to_list/1, t_split_binary/1, bad_split/1, t_concat_binary/1, @@ -61,24 +63,42 @@ %% Internal exports. -export([sleeper/0]). -all(suite) -> - [copy_terms,conversions,deep_lists,deep_bitstr_lists, +suite() -> [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,2}}]. + +all() -> + [copy_terms, conversions, deep_lists, deep_bitstr_lists, t_split_binary, bad_split, t_concat_binary, - bad_list_to_binary, bad_binary_to_list, terms, terms_float, - external_size, t_iolist_size, - bad_binary_to_term_2,safe_binary_to_term2, - bad_binary_to_term, bad_terms, t_hash, bad_size, bad_term_to_binary, - more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, - gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, - deep,obsolete_funs,robustness,otp_8180]. + bad_list_to_binary, bad_binary_to_list, terms, + terms_float, external_size, t_iolist_size, + bad_binary_to_term_2, safe_binary_to_term2, + bad_binary_to_term, bad_terms, t_hash, bad_size, + bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, + ordering, unaligned_order, gc_test, + bit_sized_binary_sizes, otp_6817, otp_8117, deep, + obsolete_funs, robustness, otp_8180]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?t:timetrap(?t:minutes(2)), - [{watchdog, Dog}|Config]. + Config. -fin_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog). +end_per_testcase(_Func, _Config) -> + ok. -define(heap_binary_size, 64). @@ -1041,7 +1061,7 @@ test_terms(Test_Func) -> ?line Test_Func(F = fun(A) -> 42*A end), ?line Test_Func(lists:duplicate(32, F)), - ?line Test_Func(FF = fun binary_SUITE:all/1), + ?line Test_Func(FF = fun binary_SUITE:all/0), ?line Test_Func(lists:duplicate(32, FF)), ok. @@ -1301,11 +1321,4 @@ unaligned_sub_bin(Bin0, Offs) -> <<_:Offs,Bin:Sz/binary,_:Roffs>> = id(Bin1), Bin. -hostname() -> - from($@, atom_to_list(node())). - -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(_, []) -> []. - id(I) -> I. diff --git a/erts/emulator/test/bs_bincomp_SUITE.erl b/erts/emulator/test/bs_bincomp_SUITE.erl index 4e83d97689..f1c2dff560 100644 --- a/erts/emulator/test/bs_bincomp_SUITE.erl +++ b/erts/emulator/test/bs_bincomp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2011. 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 @@ -22,15 +22,34 @@ -module(bs_bincomp_SUITE). --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, byte_aligned/1,bit_aligned/1,extended_byte_aligned/1, extended_bit_aligned/1,mixed/1,tracing/1]). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [byte_aligned, bit_aligned, extended_byte_aligned, + extended_bit_aligned, mixed, tracing]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [byte_aligned,bit_aligned,extended_byte_aligned, - extended_bit_aligned,mixed,tracing]. byte_aligned(Config) when is_list(Config) -> diff --git a/erts/emulator/test/bs_bit_binaries_SUITE.erl b/erts/emulator/test/bs_bit_binaries_SUITE.erl index 52bb925385..ff1088118d 100644 --- a/erts/emulator/test/bs_bit_binaries_SUITE.erl +++ b/erts/emulator/test/bs_bit_binaries_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2011. 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 @@ -22,18 +22,38 @@ -module(bs_bit_binaries_SUITE). --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, misc/1,horrid_match/1,test_bitstr/1,test_bit_size/1,asymmetric_tests/1, big_asymmetric_tests/1,binary_to_and_from_list/1, big_binary_to_and_from_list/1,send_and_receive/1, send_and_receive_alot/1,append/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [misc, horrid_match, test_bitstr, test_bit_size, + asymmetric_tests, big_asymmetric_tests, + binary_to_and_from_list, big_binary_to_and_from_list, + send_and_receive, send_and_receive_alot, append]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [misc,horrid_match,test_bitstr,test_bit_size,asymmetric_tests, - big_asymmetric_tests,binary_to_and_from_list,big_binary_to_and_from_list, - send_and_receive,send_and_receive_alot,append]. misc(Config) when is_list(Config) -> ?line <<1:100>> = id(<<1:100>>), diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index 3d9b51d278..1959803385 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -21,22 +21,39 @@ -module(bs_construct_SUITE). --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, not_used/1, in_guard/1, mem_leak/1, coerce_to_float/1, bjorn/1, huge_float_field/1, huge_binary/1, system_limit/1, badarg/1, copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1, - otp_7422/1]). + otp_7422/1, zero_width/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -all(suite) -> - [test1, test2, test3, test4, test5, testf, - not_used, in_guard, mem_leak, coerce_to_float, bjorn, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [test1, test2, test3, test4, test5, testf, not_used, + in_guard, mem_leak, coerce_to_float, bjorn, huge_float_field, huge_binary, system_limit, badarg, - copy_writable_binary, kostis, dynamic, bs_add, - otp_7422]. + copy_writable_binary, kostis, dynamic, bs_add, otp_7422, zero_width]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. big(1) -> 57285702734876389752897683. @@ -786,5 +803,20 @@ otp_7422_bin(N) when N < 512 -> end), otp_7422_bin(N+1); otp_7422_bin(_) -> ok. + +zero_width(Config) when is_list(Config) -> + ?line Z = id(0), + Small = id(42), + Big = id(1 bsl 128), + ?line <<>> = <<Small:Z>>, + ?line <<>> = <<Small:0>>, + ?line <<>> = <<Big:Z>>, + ?line <<>> = <<Big:0>>, + + ?line {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), + ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), + ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), + + ok. id(I) -> I. diff --git a/erts/emulator/test/bs_match_bin_SUITE.erl b/erts/emulator/test/bs_match_bin_SUITE.erl index 3d054a279f..96e69dbc0b 100644 --- a/erts/emulator/test/bs_match_bin_SUITE.erl +++ b/erts/emulator/test/bs_match_bin_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -19,12 +19,32 @@ -module(bs_match_bin_SUITE). --export([all/1,byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [byte_split_binary, bit_split_binary, match_huge_bin]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [byte_split_binary,bit_split_binary,match_huge_bin]. byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions."; byte_split_binary(Config) when is_list(Config) -> diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl index 99dee7c7bc..ce03ecb548 100644 --- a/erts/emulator/test/bs_match_int_SUITE.erl +++ b/erts/emulator/test/bs_match_int_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -18,16 +18,36 @@ -module(bs_match_int_SUITE). --export([all/1,integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, match_huge_int/1,bignum/1,unaligned_32_bit/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -import(lists, [seq/2]). -all(suite) -> - [integer,signed_integer,dynamic,more_dynamic,mml,match_huge_int,bignum, - unaligned_32_bit]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [integer, signed_integer, dynamic, more_dynamic, mml, + match_huge_int, bignum, unaligned_32_bit]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + integer(Config) when is_list(Config) -> ?line 0 = get_int(mkbin([])), diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl index 6de2ef67e5..b022f96740 100644 --- a/erts/emulator/test/bs_match_misc_SUITE.erl +++ b/erts/emulator/test/bs_match_misc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2011. 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 @@ -18,18 +18,38 @@ %% -module(bs_match_misc_SUITE). --export([all/1,bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1, kenneth/1,encode_binary/1,native/1,happi/1, size_var/1,wiger/1,x0_context/1,huge_float_field/1, writable_binary_matched/1,otp_7198/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [bound_var, bound_tail, t_float, little_float, sean, + kenneth, encode_binary, native, happi, size_var, wiger, + x0_context, huge_float_field, writable_binary_matched, + otp_7198]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [bound_var,bound_tail,t_float,little_float,sean, - kenneth,encode_binary,native,happi, - size_var,wiger,x0_context,huge_float_field, - writable_binary_matched,otp_7198]. bound_var(doc) -> "Test matching of bound variables."; bound_var(Config) when is_list(Config) -> diff --git a/erts/emulator/test/bs_match_tail_SUITE.erl b/erts/emulator/test/bs_match_tail_SUITE.erl index b0b0779b65..1397f2069c 100644 --- a/erts/emulator/test/bs_match_tail_SUITE.erl +++ b/erts/emulator/test/bs_match_tail_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -20,11 +20,31 @@ -module(bs_match_tail_SUITE). -author('[email protected]'). --export([all/1,aligned/1,unaligned/1,zero_tail/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2,aligned/1,unaligned/1,zero_tail/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [aligned, unaligned, zero_tail]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> [aligned,unaligned,zero_tail]. aligned(doc) -> "Test aligned tails."; aligned(Config) when is_list(Config) -> diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl index 87adc5197b..72c656c400 100644 --- a/erts/emulator/test/bs_utf_SUITE.erl +++ b/erts/emulator/test/bs_utf_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -19,13 +19,15 @@ -module(bs_utf_SUITE). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, utf8_roundtrip/1,utf16_roundtrip/1,utf32_roundtrip/1, utf8_illegal_sequences/1,utf16_illegal_sequences/1, utf32_illegal_sequences/1, bad_construction/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). @@ -33,14 +35,32 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(6)), [{watchdog,Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog). -all(suite) -> - [utf8_roundtrip,utf16_roundtrip,utf32_roundtrip, - utf8_illegal_sequences,utf16_illegal_sequences, - utf32_illegal_sequences,bad_construction]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [utf8_roundtrip, utf16_roundtrip, utf32_roundtrip, + utf8_illegal_sequences, utf16_illegal_sequences, + utf32_illegal_sequences, bad_construction]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + utf8_roundtrip(Config) when is_list(Config) -> ?line utf8_roundtrip(0, 16#D7FF), diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 7350aef4ec..8365e1c540 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -19,21 +19,40 @@ -module(busy_port_SUITE). --export([all/1, io_to_busy/1, message_order/1, send_3/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + io_to_busy/1, message_order/1, send_3/1, system_monitor/1, no_trap_exit/1, no_trap_exit_unlinked/1, trap_exit/1, multiple_writers/1, hard_busy_driver/1, soft_busy_driver/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %% Internal exports. -export([init/2]). -all(suite) -> {req, [dynamic_loading], - [io_to_busy, message_order, send_3, - system_monitor, no_trap_exit, - no_trap_exit_unlinked, trap_exit, multiple_writers, - hard_busy_driver, soft_busy_driver]}. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [io_to_busy, message_order, send_3, system_monitor, + no_trap_exit, no_trap_exit_unlinked, trap_exit, + multiple_writers, hard_busy_driver, soft_busy_driver]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + %% Tests I/O operations to a busy port, to make sure a suspended send %% operation is correctly restarted. This used to crash Beam. diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index e0528955b0..93fdc157f7 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -20,7 +20,9 @@ -module(call_trace_SUITE). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, hipe/1,process_specs/1,basic/1,flags/1,errors/1,pam/1,change_pam/1, return_trace/1,exception_trace/1,on_load/1,deep_exception/1, exception_nocatch/1,bit_syntax/1]). @@ -35,25 +37,44 @@ -export([abbr/1,abbr/2]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -define(P, 20). -all(suite) -> - Common = [errors,on_load], - NotHipe = [process_specs,basic,flags,pam,change_pam,return_trace, - exception_trace,deep_exception,exception_nocatch,bit_syntax], +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + Common = [errors, on_load], + NotHipe = [process_specs, basic, flags, pam, change_pam, + return_trace, exception_trace, deep_exception, + exception_nocatch, bit_syntax], Hipe = [hipe], - case test_server:is_native(?MODULE) of + case test_server:is_native(call_trace_SUITE) of true -> Hipe ++ Common; false -> NotHipe ++ Common end. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:seconds(30)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog). diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 33351a3cc9..703a00a598 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -18,18 +18,38 @@ %% -module(code_SUITE). --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, new_binary_types/1,t_check_process_code/1,t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, make_stub_many_funs/1,constant_pools/1, false_dependency/1,coverage/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [new_binary_types, t_check_process_code, + t_check_process_code_ets, external_fun, get_chunk, + module_md5, make_stub, make_stub_many_funs, + constant_pools, false_dependency, coverage]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [new_binary_types,t_check_process_code,t_check_process_code_ets, - external_fun,get_chunk,module_md5,make_stub,make_stub_many_funs, - constant_pools,false_dependency,coverage]. new_binary_types(Config) when is_list(Config) -> ?line Data = ?config(data_dir, Config), @@ -320,6 +340,9 @@ make_stub(Config) when is_list(Config) -> (catch code:make_stub_module(my_code_test, bit_sized_binary(Code), {[],[]})), + ?line {'EXIT',{badarg,_}} = + (catch code:make_stub_module(my_code_test_with_wrong_name, + Code, {[],[]})), ok. make_stub_many_funs(Config) when is_list(Config) -> diff --git a/erts/emulator/test/crypto_SUITE.erl b/erts/emulator/test/crypto_SUITE.erl index e3d34b923d..a82bd4fe38 100644 --- a/erts/emulator/test/crypto_SUITE.erl +++ b/erts/emulator/test/crypto_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -19,14 +19,34 @@ -module(crypto_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, t_md5/1,t_md5_update/1,error/1,unaligned_context/1,random_lists/1, misc_errors/1]). -all(suite) -> - [t_md5,t_md5_update,error,unaligned_context,random_lists,misc_errors]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [t_md5, t_md5_update, error, unaligned_context, + random_lists, misc_errors]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + misc_errors(doc) -> diff --git a/erts/emulator/test/crypto_reference.erl b/erts/emulator/test/crypto_reference.erl index 99107e3b57..b91535a50e 100644 --- a/erts/emulator/test/crypto_reference.erl +++ b/erts/emulator/test/crypto_reference.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2010. 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 diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl index 79047d7de5..6e15c228cd 100644 --- a/erts/emulator/test/ddll_SUITE.erl +++ b/erts/emulator/test/ddll_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -30,7 +30,8 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([all/1, ddll_test/1, errors/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, ddll_test/1, errors/1, reference_count/1, kill_port/1, dont_kill_port/1]). -export([unload_on_process_exit/1, delayed_unload_with_ports/1, @@ -50,35 +51,39 @@ -import(ordsets, [subtract/2]). --include("test_server.hrl"). - -all(suite) -> - [ddll_test, errors, - reference_count, - kill_port, - dont_kill_port, - properties, - load_and_unload, - unload_on_process_exit, - delayed_unload_with_ports, +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ddll_test, errors, reference_count, kill_port, + dont_kill_port, properties, load_and_unload, + unload_on_process_exit, delayed_unload_with_ports, unload_due_to_process_exit, - no_unload_due_to_process_exit, - no_unload_due_to_process_exit_2, - unload_reload_thingie, - unload_reload_thingie_2, - unload_reload_thingie_3, - reload_pending, - load_fail_init, - reload_pending_fail_init, - reload_pending_kill, - more_error_codes, - forced_port_killing, - no_trap_exit_and_kill_ports, - monitor_demonitor, - monitor_demonitor_load, - new_interface, - lock_driver - ]. + no_unload_due_to_process_exit, + no_unload_due_to_process_exit_2, unload_reload_thingie, + unload_reload_thingie_2, unload_reload_thingie_3, + reload_pending, load_fail_init, + reload_pending_fail_init, reload_pending_kill, + more_error_codes, forced_port_killing, + no_trap_exit_and_kill_ports, monitor_demonitor, + monitor_demonitor_load, new_interface, lock_driver]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + unload_on_process_exit(suite) -> []; diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl index d9e961be2f..c0499554eb 100644 --- a/erts/emulator/test/decode_packet_SUITE.erl +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -21,14 +21,34 @@ -module(decode_packet_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1]). -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [basic, packet_size, neg, http, line, ssl, otp_8536]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Seed = {S1,S2,S3} = now(), random:seed(S1,S2,S3), @@ -36,7 +56,7 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(1)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). diff --git a/erts/emulator/test/dgawd_handler.erl b/erts/emulator/test/dgawd_handler.erl index 881354b9da..27085b7b7e 100644 --- a/erts/emulator/test/dgawd_handler.erl +++ b/erts/emulator/test/dgawd_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2010. 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 diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 79252d0593..4bebae51cc 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -22,30 +22,30 @@ %% Tests distribution and the tcp driver. --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1, - ping/1, bulk_send/1, bulk_send_small/1, - bulk_send_big/1, - bulk_send_bigbig/1, - local_send/1, local_send_small/1, local_send_big/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + ping/1, bulk_send_small/1, + bulk_send_big/1, bulk_send_bigbig/1, + local_send_small/1, local_send_big/1, local_send_legal/1, link_to_busy/1, exit_to_busy/1, lost_exit/1, link_to_dead/1, link_to_dead_new_node/1, applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1, - trap_bif/1, trap_bif_1/1, trap_bif_2/1, trap_bif_3/1, - stop_dist/1, dist_auto_connect/1, + trap_bif_1/1, trap_bif_2/1, trap_bif_3/1, + stop_dist/1, dist_auto_connect_never/1, dist_auto_connect_once/1, dist_parallel_send/1, atom_roundtrip/1, atom_roundtrip_r12b/1, contended_atom_cache_entry/1, - bad_dist_ext/1, + bad_dist_structure/1, bad_dist_ext_receive/1, bad_dist_ext_process_info/1, bad_dist_ext_control/1, bad_dist_ext_connection_id/1]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([init_per_testcase/2, end_per_testcase/2]). %% Internal exports. -export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0, @@ -54,15 +54,39 @@ dist_evil_parallel_receiver/0, sendersender/4, sendersender2/4]). -all(suite) -> [ - ping, bulk_send, local_send, link_to_busy, exit_to_busy, - lost_exit, link_to_dead, link_to_dead_new_node, - applied_monitor_node, ref_port_roundtrip, nil_roundtrip, - stop_dist, trap_bif, dist_auto_connect, dist_parallel_send, - atom_roundtrip, atom_roundtrip_r12b, - contended_atom_cache_entry, - bad_dist_ext - ]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ping, {group, bulk_send}, {group, local_send}, + link_to_busy, exit_to_busy, lost_exit, link_to_dead, + link_to_dead_new_node, applied_monitor_node, + ref_port_roundtrip, nil_roundtrip, stop_dist, + {group, trap_bif}, {group, dist_auto_connect}, + dist_parallel_send, atom_roundtrip, atom_roundtrip_r12b, + contended_atom_cache_entry, bad_dist_structure, {group, bad_dist_ext}]. + +groups() -> + [{bulk_send, [], [bulk_send_small, bulk_send_big, bulk_send_bigbig]}, + {local_send, [], + [local_send_small, local_send_big, local_send_legal]}, + {trap_bif, [], [trap_bif_1, trap_bif_2, trap_bif_3]}, + {dist_auto_connect, [], + [dist_auto_connect_never, dist_auto_connect_once]}, + {bad_dist_ext, [], + [bad_dist_ext_receive, bad_dist_ext_process_info, + bad_dist_ext_control, bad_dist_ext_connection_id]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -define(DEFAULT_TIMETRAP, 4*60*1000). @@ -70,7 +94,7 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?DEFAULT_TIMETRAP), [{watchdog, Dog},{testcase, Func}|Config]. -fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> +end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). @@ -118,13 +142,6 @@ ping(Config) when is_list(Config) -> ok. -bulk_send(doc) -> - ["Tests sending large amount of data to another node and measure", - "the time. This tests that a process that is suspended on a ", - "busy port will eventually be resumed."]; -bulk_send(suite) -> - [bulk_send_small, bulk_send_big, bulk_send_bigbig]. - bulk_send_small(Config) when is_list(Config) -> ?line bulk_send(64, 32). @@ -174,7 +191,7 @@ bulk_sendsend2(Terms, BinSize, BusyBufSize) -> ?line {ok, NodeRecv} = start_node(bulk_receiver), ?line Recv = spawn(NodeRecv, erlang, apply, [fun receiver/2, [0, 0]]), ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)), - ?line Size = Terms*size(Bin), + %%?line Size = Terms*size(Bin), %% SLF LEFT OFF HERE. %% When the caller uses small hunks, like 4k via @@ -187,7 +204,7 @@ bulk_sendsend2(Terms, BinSize, BusyBufSize) -> ?line {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ integer_to_list(BusyBufSize)), ?line _Send = spawn(NodeSend, erlang, apply, [fun sendersender/4, [self(), Recv, Bin, Terms]]), - ?line {Elapsed, {TermsN, SizeN}, MonitorCount} = + ?line {Elapsed, {_TermsN, SizeN}, MonitorCount} = receive {sendersender, BigRes} -> BigRes end, @@ -227,7 +244,7 @@ sendersender3(To, _Bin, 0, SendDone, MonitorCount) -> ok end, receive - {monitor, _Pid, _Type, _Info} = M -> + {monitor, _Pid, _Type, _Info} -> sendersender3(To, _Bin, 0, SendDone, MonitorCount + 1) after 0 -> if SendDone -> @@ -255,17 +272,14 @@ receiver(Terms, Size) -> end. -local_send(suite) -> - [local_send_small, local_send_big, local_send_legal]; -local_send(doc) -> - ["Tests sending small and big messages to a non-existing ", - "local registered process."]. local_send_big(doc) -> ["Sends several big message to an non-registered process on ", "the local node."]; local_send_big(Config) when is_list(Config) -> - Data0=local_send_big(doc)++local_send(doc), + Data0=local_send_big(doc)++ + ["Tests sending small and big messages to a non-existing ", + "local registered process."], Data1=[Data0,[Data0, Data0, [Data0], Data0],Data0], Data2=Data0++lists:flatten(Data1)++ list_to_binary(lists:flatten(Data1)), @@ -522,7 +536,7 @@ sink1() -> lost_exit(doc) -> "Test that EXIT and DOWN messages send to another node are not lost if " - "if the distribution port is busy."; + "the distribution port is busy."; lost_exit(Config) when is_list(Config) -> ?line {ok, Node} = start_node(lost_exit), @@ -751,9 +765,6 @@ stop_dist(Config) when is_list(Config) -> ok. -trap_bif(doc) -> - ["Verifies that BIFs which are traps to Erlang work (OTP-2680)."]; -trap_bif(suite) -> [trap_bif_1, trap_bif_2, trap_bif_3]. trap_bif_1(doc) -> [""]; @@ -790,10 +801,6 @@ tr3() -> -dist_auto_connect(doc) -> - ["Tests the kernel parameter 'dist_auto_connect'."]; -dist_auto_connect(suite) -> - [dist_auto_connect_never, dist_auto_connect_once]. % This has to be done by nodes with differrent cookies, otherwise global % will connect nodes, which is correct, but makes it hard to test. @@ -1143,8 +1150,7 @@ contended_atom_cache_entry(Config) when is_list(Config) -> ?line {ok, SNode} = start_node(Config), ?line {ok, RNode} = start_node(Config), ?line Success = make_ref(), - ?line Mstr - = spawn_link( + ?line spawn_link( SNode, fun () -> erts_debug:set_internal_state(available_internal_state, @@ -1201,13 +1207,13 @@ contended_atom_cache_entry(Config) when is_list(Config) -> ?line stop_node(RNode), ?line ok. -send_ref_atom(To, Ref, Atom, 0) -> +send_ref_atom(_To, _Ref, _Atom, 0) -> ok; send_ref_atom(To, Ref, Atom, N) -> To ! {Ref, Atom}, send_ref_atom(To, Ref, Atom, N-1). -receive_ref_atom(Ref, Atom, 0) -> +receive_ref_atom(_Ref, _Atom, 0) -> ok; receive_ref_atom(Ref, Atom, N) -> receive @@ -1242,7 +1248,7 @@ unwanted_cixs() -> nodes()). -get_conflicting_atoms(CIX, 0) -> +get_conflicting_atoms(_CIX, 0) -> []; get_conflicting_atoms(CIX, N) -> {A, B, C} = now(), @@ -1256,13 +1262,187 @@ get_conflicting_atoms(CIX, N) -> get_conflicting_atoms(CIX, N) end. +-define(COOKIE, ''). +-define(DOP_LINK, 1). +-define(DOP_SEND, 2). +-define(DOP_EXIT, 3). +-define(DOP_UNLINK, 4). +-define(DOP_REG_SEND, 6). +-define(DOP_GROUP_LEADER, 7). +-define(DOP_EXIT2, 8). + +-define(DOP_SEND_TT, 12). +-define(DOP_EXIT_TT, 13). +-define(DOP_REG_SEND_TT, 16). +-define(DOP_EXIT2_TT, 18). + +-define(DOP_MONITOR_P, 19). +-define(DOP_DEMONITOR_P, 20). +-define(DOP_MONITOR_P_EXIT, 21). + +start_monitor(Offender,P) -> + ?line Parent = self(), + ?line Q = spawn(Offender, + fun () -> + Ref = erlang:monitor(process,P), + Parent ! {self(),ref,Ref}, + receive + just_stay_alive -> ok + end + end), + ?line Ref = receive + {Q,ref,R} -> + R + after 5000 -> + error + end, + io:format("Ref is ~p~n",[Ref]), + ok. +start_link(Offender,P) -> + ?line Parent = self(), + ?line Q = spawn(Offender, + fun () -> + process_flag(trap_exit,true), + link(P), + Parent ! {self(),ref,P}, + receive + just_stay_alive -> ok + end + end), + ?line Ref = receive + {Q,ref,R} -> + R + after 5000 -> + error + end, + io:format("Ref is ~p~n",[Ref]), + ok. + +bad_dist_structure(suite) -> + []; +bad_dist_structure(doc) -> + ["Test dist messages with valid structure (binary to term ok) but malformed" + "control content"]; +bad_dist_structure(Config) when is_list(Config) -> + %process_flag(trap_exit,true), + ODog = ?config(watchdog, Config), + ?t:timetrap_cancel(ODog), + Dog = ?t:timetrap(?t:seconds(15)), + + ?line {ok, Offender} = start_node(bad_dist_structure_offender), + ?line {ok, Victim} = start_node(bad_dist_structure_victim), + ?line start_node_monitors([Offender,Victim]), + ?line Parent = self(), + ?line P = spawn(Victim, + fun () -> + process_flag(trap_exit,true), + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_struct_check_msgs([one, + two]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + ?line receive {P, started} -> ok end, + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line verify_up(Offender, Victim), + ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + ?line start_monitor(Offender,P), + ?line P ! one, + ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_LINK},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_link(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line start_monitor(Offender,P), + ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}), + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line P ! two, + ?line P ! check_msgs, + ?line receive + {P, messages_checked} -> ok + after 5000 -> + exit(victim_is_dead) + end, + + ?line {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line unlink(P), + ?line P ! done, + ?line stop_node(Offender), + ?line stop_node(Victim), + ?t:timetrap_cancel(Dog), + ok. -bad_dist_ext(doc) -> []; -bad_dist_ext(suite) -> - [bad_dist_ext_receive, - bad_dist_ext_process_info, - bad_dist_ext_control, - bad_dist_ext_connection_id]. bad_dist_ext_receive(Config) when is_list(Config) -> @@ -1483,6 +1663,22 @@ bad_dist_ext_connection_id(Config) when is_list(Config) -> ?line stop_node(Victim). +bad_dist_struct_check_msgs([]) -> + receive + Msg -> + exit({unexpected_message, Msg}) + after 0 -> + ok + end; +bad_dist_struct_check_msgs([M|Ms]) -> + receive + {'EXIT',_,_} = EM -> + io:format("Ignoring exit message: ~p~n",[EM]), + bad_dist_struct_check_msgs([M|Ms]); + Msg -> + M = Msg, + bad_dist_struct_check_msgs(Ms) + end. bad_dist_ext_check_msgs([]) -> receive Msg -> @@ -1497,24 +1693,6 @@ bad_dist_ext_check_msgs([M|Ms]) -> bad_dist_ext_check_msgs(Ms) end. --define(COOKIE, ''). --define(DOP_LINK, 1). --define(DOP_SEND, 2). --define(DOP_EXIT, 3). --define(DOP_UNLINK, 4). --define(DOP_NODE_LINK, 5). --define(DOP_REG_SEND, 6). --define(DOP_GROUP_LEADER, 7). --define(DOP_EXIT2, 8). - --define(DOP_SEND_TT, 12). --define(DOP_EXIT_TT, 13). --define(DOP_REG_SEND_TT, 16). --define(DOP_EXIT2_TT, 18). - --define(DOP_MONITOR_P, 19). --define(DOP_DEMONITOR_P, 20). --define(DOP_MONITOR_P_EXIT, 21). dport_reg_send(Node, Name, Msg) -> DPrt = case dport(Node) of @@ -1546,6 +1724,39 @@ dport_send(To, Msg) -> ?COOKIE, To}), dmsg_ext(Msg)]). +send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) -> + send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,[]). +send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) -> + Parent = self(), + Done = make_ref(), + spawn(Offender, + fun () -> + Node = node(Victim), + pong = net_adm:ping(Node), + DPrt = dport(Node), + Bad1 = case WhereToPutSelf of + 0 -> + Bad; + N when N > 0 -> + setelement(N,Bad,self()) + end, + DData = [dmsg_hdr(), + dmsg_ext(Bad1)] ++ + case PayLoad of + [] -> []; + _Other -> [dmsg_ext(PayLoad)] + end, + port_command(DPrt, DData), + Parent ! {DData,Done} + end), + receive + {WhatSent,Done} -> + io:format("Offender sent ~p~n",[WhatSent]), + ok + after 5000 -> + exit(unable_to_send) + end. + %% send_bad_msgs(): %% Send a valid distribution header and control message @@ -1629,10 +1840,10 @@ dmsg_bad_hdr() -> 255]. % 255 atom references -dmsg_fake_hdr1() -> - A = <<"fake header atom 1">>, - [131, % Version Magic - $D, 1, 16#8, 0, size(A), A]. % Fake header +%% dmsg_fake_hdr1() -> +%% A = <<"fake header atom 1">>, +%% [131, % Version Magic +%% $D, 1, 16#8, 0, size(A), A]. % Fake header dmsg_fake_hdr2() -> A1 = <<"fake header atom 1">>, @@ -1817,7 +2028,7 @@ flush_node_changes() -> node_monitor_loop(Master) -> receive - {nodeup, Node, InfoList} = Msg -> + {nodeup, Node, _InfoList} = Msg -> Master ! {nodeup, node(), Node}, ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Msg]), node_monitor_loop(Master); @@ -1854,9 +2065,9 @@ verify_no_down(A, B) -> ok end. -verify_down(A, B) -> - receive {nodedown, A, B, _} -> ok end, - receive {nodedown, B, A, _} -> ok end. +%% verify_down(A, B) -> +%% receive {nodedown, A, B, _} -> ok end, +%% receive {nodedown, B, A, _} -> ok end. verify_down(A, ReasonA, B, ReasonB) -> receive @@ -1876,11 +2087,11 @@ from(H, [H | T]) -> T; from(H, [_ | T]) -> from(H, T); from(_, []) -> []. -fun_spawn(Fun) -> - fun_spawn(Fun, []). +%% fun_spawn(Fun) -> +%% fun_spawn(Fun, []). -fun_spawn(Fun, Args) -> - spawn_link(erlang, apply, [Fun, Args]). +%% fun_spawn(Fun, Args) -> +%% spawn_link(erlang, apply, [Fun, Args]). long_or_short() -> diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 39b2ed395f..7600a44988 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -27,12 +27,12 @@ %%% - queueing -module(driver_SUITE). --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, + end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2, - fin_per_testcase/2, - end_per_suite/1, + end_per_testcase/2, outputv_echo/1, - timer/1, + timer_measure/1, timer_cancel/1, timer_change/1, @@ -51,7 +51,7 @@ 'driver_system_info_ver1.1'/1, driver_system_info_current_ver/1, driver_monitor/1, - ioq_exit/1, + ioq_exit_ready_input/1, ioq_exit_ready_output/1, ioq_exit_timeout/1, @@ -78,7 +78,7 @@ -export([bin_prefix/2]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). % First byte in communication with the timer driver @@ -120,49 +120,51 @@ init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> ?line 0 = erts_debug:get_internal_state(check_io_debug), [{watchdog, Dog},{testcase, Case}|Config]. -fin_per_testcase(Case, Config) -> +end_per_testcase(Case, Config) -> Dog = ?config(watchdog, Config), - erlang:display({fin_per_testcase, Case}), + erlang:display({end_per_testcase, Case}), ?line 0 = erts_debug:get_internal_state(check_io_debug), ?t:timetrap_cancel(Dog). +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [fun_to_port, outputv_echo, queue_echo, {group, timer}, + driver_unloaded, io_ready_exit, use_fallback_pollset, + bad_fd_in_pollset, driver_event, fd_change, + steal_control, otp_6602, 'driver_system_info_ver1.0', + 'driver_system_info_ver1.1', + driver_system_info_current_ver, driver_monitor, + {group, ioq_exit}, zero_extended_marker_garb_drv, + invalid_extended_marker_drv, larger_major_vsn_drv, + larger_minor_vsn_drv, smaller_major_vsn_drv, + smaller_minor_vsn_drv, peek_non_existing_queue, + otp_6879, caller, many_events, missing_callbacks, + smp_select, driver_select_use, + thread_mseg_alloc_cache_clean]. + +groups() -> + [{timer, [], + [timer_measure, timer_cancel, timer_delay, + timer_change]}, + {ioq_exit, [], + [ioq_exit_ready_input, ioq_exit_ready_output, + ioq_exit_timeout, ioq_exit_ready_async, ioq_exit_event, + ioq_exit_ready_input_async, ioq_exit_ready_output_async, + ioq_exit_timeout_async, ioq_exit_event_async]}]. + +init_per_suite(Config) -> + Config. + end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false). -all(suite) -> - [ - fun_to_port, - outputv_echo, - queue_echo, - timer, - driver_unloaded, - io_ready_exit, - use_fallback_pollset, - bad_fd_in_pollset, - driver_event, - fd_change, - steal_control, - otp_6602, - 'driver_system_info_ver1.0', - 'driver_system_info_ver1.1', - driver_system_info_current_ver, - driver_monitor, - ioq_exit, - zero_extended_marker_garb_drv, - invalid_extended_marker_drv, - larger_major_vsn_drv, - larger_minor_vsn_drv, - smaller_major_vsn_drv, - smaller_minor_vsn_drv, - peek_non_existing_queue, - otp_6879, - caller, - many_events, - missing_callbacks, - smp_select, - driver_select_use, - thread_mseg_alloc_cache_clean - ]. +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + fun_to_port(doc) -> "Test sending a fun to port with an outputv-capable driver."; fun_to_port(Config) when is_list(Config) -> @@ -308,7 +310,6 @@ compare(Got, Expected) -> %% Driver timer test suites %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -timer(suite) -> [timer_measure,timer_cancel,timer_delay,timer_change]. timer_measure(doc) -> ["Check that timers time out in good time."]; timer_measure(Config) when is_list(Config) -> @@ -1299,17 +1300,6 @@ driver_monitor(Config) when is_list(Config) -> ?line stop_driver(Port, Name), ?line ok. -ioq_exit(doc) -> []; -ioq_exit(suite) -> - [ioq_exit_ready_input, - ioq_exit_ready_output, - ioq_exit_timeout, - ioq_exit_ready_async, - ioq_exit_event, - ioq_exit_ready_input_async, - ioq_exit_ready_output_async, - ioq_exit_timeout_async, - ioq_exit_event_async]. -define(IOQ_EXIT_READY_INPUT, 1). -define(IOQ_EXIT_READY_OUTPUT, 2). @@ -1682,7 +1672,7 @@ smp_select0(Config) -> ProcFun = fun()-> io:format("Worker ~p starting\n",[self()]), ?line Port = open_port({spawn, DrvName}, []), smp_select_loop(Port, 100000), - sleep(500), % wait for driver to handle pending events + sleep(1000), % wait for driver to handle pending events ?line true = erlang:port_close(Port), Master ! {ok,self()}, io:format("Worker ~p finished\n",[self()]) @@ -1790,8 +1780,8 @@ mseg_alloc_ccc() -> mseg_alloc_ccc(erlang:system_info({allocator,mseg_alloc})). mseg_alloc_ccc(MsegAllocInfo) -> - ?line {value,{calls, CL}} - = lists:keysearch(calls, 1, MsegAllocInfo), + ?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo), + ?line {value,{calls, CL}} = lists:keysearch(calls, 1, MKL), ?line {value,{mseg_check_cache, GigaCCC, CCC}} = lists:keysearch(mseg_check_cache, 1, CL), ?line GigaCCC*1000000000 + CCC. @@ -1800,12 +1790,28 @@ mseg_alloc_cached_segments() -> mseg_alloc_cached_segments(erlang:system_info({allocator,mseg_alloc})). mseg_alloc_cached_segments(MsegAllocInfo) -> + MemName = case is_halfword_vm() of + true -> "high memory"; + false -> "all memory" + end, + ?line [{memkind,DrvMem}] + = lists:filter(fun(E) -> case E of + {memkind, [{name, MemName} | _]} -> true; + _ -> false + end end, MsegAllocInfo), ?line {value,{status, SL}} - = lists:keysearch(status, 1, MsegAllocInfo), + = lists:keysearch(status, 1, DrvMem), ?line {value,{cached_segments, CS}} = lists:keysearch(cached_segments, 1, SL), ?line CS. +is_halfword_vm() -> + case {erlang:system_info({wordsize, internal}), + erlang:system_info({wordsize, external})} of + {4, 8} -> true; + {WS, WS} -> false + end. + driver_alloc_sbct() -> {_, _, _, As} = erlang:system_info(allocator), case lists:keysearch(driver_alloc, 1, As) of diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c index b571cb30e6..bbdb09cfcb 100644 --- a/erts/emulator/test/driver_SUITE_data/chkio_drv.c +++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c @@ -102,6 +102,7 @@ typedef struct chkio_smp_select { int write_fd; int next_read; int next_write; + int first_write; enum {Closed, Opened, Selected, Waiting} state; int wasSelected; unsigned rand_state; @@ -577,9 +578,16 @@ chkio_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event) inPipe = (pip->next_write - pip->next_read); if (inPipe == 0) { bytes = read(pip->read_fd, &word, sizeof(word)); - printf("Unexpected empty pipe, expected %u -> %u, bytes=%d, word=%d\n", - pip->next_read, pip->next_write-1, bytes, word); - abort(); + printf("Unexpected empty pipe, expected %u -> %u, bytes=%d, word=%d, written=%d\n", + pip->next_read, pip->next_write-1, bytes, word, + (pip->next_write - pip->first_write)); + /*abort(); + Allow unexpected events as it's been seen to be triggered by epoll + on Linux. Most of the time the unwanted events are filtered by + the erl_check_io layer. But when fd's are reused the events may + slip up to the driver. + */ + break; } n = rand_r(&pip->rand_state) % (inPipe*4); @@ -1252,6 +1260,7 @@ chkio_drv_control(ErlDrvData drv_data, pip->state = Opened; pip->wasSelected = 0; pip->next_write = pip->next_read = rand_r(&pip->rand_state) % 1024; + pip->first_write = pip->next_write; if (op & 1) break; op >>= 1; }/*fall through*/ diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl index 1d66b6ef70..9ac004200e 100644 --- a/erts/emulator/test/efile_SUITE.erl +++ b/erts/emulator/test/efile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -17,12 +17,32 @@ %% %CopyrightEnd% -module(efile_SUITE). --export([all/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). -export([iter_max_files/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [iter_max_files]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> [iter_max_files]. %% %% Open as many files as possible. Do this several times and check diff --git a/erts/emulator/test/emulator.spec b/erts/emulator/test/emulator.spec index ed5bd48e84..1ea751cc3b 100644 --- a/erts/emulator/test/emulator.spec +++ b/erts/emulator/test/emulator.spec @@ -1 +1 @@ -{topcase, {dir, "../emulator_test"}}. +{suites,"../emulator_test",all}. diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl index ea618e9feb..84a82cced0 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE.erl +++ b/erts/emulator/test/erl_drv_thread_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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 @@ -19,18 +19,36 @@ -module(erl_drv_thread_SUITE). -author('[email protected]'). --export([all/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). -export([basic/1, rwlock/1, tsd/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -define(DEFAULT_TIMETRAP_SECS, 240). -all(doc) -> []; -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [basic, rwlock, tsd]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% %% Testcases %% diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl index 542c8dffbe..435c0872e6 100644 --- a/erts/emulator/test/erl_link_SUITE.erl +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. 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 @@ -28,9 +28,10 @@ -author('[email protected]'). %-define(line_trace, 1). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). % Test cases -export([links/1, @@ -46,7 +47,7 @@ otp_5772_dist_monitor/1, otp_7946/1]). --export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). % Internal exports -export([test_proc/0]). @@ -77,11 +78,29 @@ -all(suite) -> [links, dist_links, monitor_nodes, process_monitors, - dist_process_monitors, busy_dist_port_monitor, - busy_dist_port_link, otp_5772_link, otp_5772_dist_link, - otp_5772_monitor, otp_5772_dist_monitor, - otp_7946]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [links, dist_links, monitor_nodes, process_monitors, + dist_process_monitors, busy_dist_port_monitor, + busy_dist_port_link, otp_5772_link, otp_5772_dist_link, + otp_5772_monitor, otp_5772_dist_monitor, otp_7946]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + catch erts_debug:set_internal_state(available_internal_state, false). + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + links(doc) -> ["Tests node local links"]; links(suite) -> []; @@ -678,13 +697,10 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> end, ?line [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> ?line Dog = ?config(watchdog, Config), ?line ?t:timetrap_cancel(Dog). -end_per_suite(_Config) -> - catch erts_debug:set_internal_state(available_internal_state, false). - tp_call(Tp, Fun) -> ?line R = make_ref(), ?line Tp ! {call, self(), R, Fun}, @@ -1050,7 +1066,6 @@ stop_node(Node) -> -define(DOP_SEND, 2). -define(DOP_EXIT, 3). -define(DOP_UNLINK, 4). --define(DOP_NODE_LINK, 5). -define(DOP_REG_SEND, 6). -define(DOP_GROUP_LEADER, 7). -define(DOP_EXIT2, 8). diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index e60a999df1..4dc2fbaae2 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. 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 @@ -18,19 +18,40 @@ %% -module(erts_debug_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2, - flat_size/1,flat_size_big/1,df/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, + flat_size/1,flat_size_big/1,df/1, + instructions/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [flat_size, flat_size_big, df, instructions]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [flat_size,flat_size_big,df]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(2)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). @@ -70,3 +91,8 @@ df(Config) when is_list(Config) -> pps() -> {erlang:ports()}. + +instructions(Config) when is_list(Config) -> + ?line Is = erts_debug:instructions(), + ?line _ = [list_to_atom(I) || I <- Is], + ok. diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl index 7fb92faf0d..2ba9375a41 100644 --- a/erts/emulator/test/estone_SUITE.erl +++ b/erts/emulator/test/estone_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. 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 @@ -18,8 +18,9 @@ -module(estone_SUITE). %% Test functions --export([all/1,estone/1]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2,estone/1]). +-export([init_per_testcase/2, end_per_testcase/2]). %% Internal exports for EStone tests -export([lists/1, @@ -44,7 +45,7 @@ run_micro/3,p1/1,ppp/3,macro/2,micros/0]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %% Test suite defines -define(default_timeout, ?t:minutes(10)). @@ -68,12 +69,31 @@ init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. -all(suite) -> [estone]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [estone]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + estone(suite) -> []; diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl index a8288584f4..f982b9d4ff 100644 --- a/erts/emulator/test/evil_SUITE.erl +++ b/erts/emulator/test/evil_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. 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 @@ -18,7 +18,9 @@ -module(evil_SUITE). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, heap_frag/1, encode_decode_ext/1, decode_integer_ext/1, @@ -30,26 +32,37 @@ decode_pos_neg_zero/1 ]). --include("test_server.hrl"). - -all(suite) -> - [ - heap_frag, - encode_decode_ext, - decode_integer_ext, - decode_small_big_ext, - decode_large_big_ext, - decode_small_big_ext_neg, - decode_large_big_ext_neg, - decode_too_small, - decode_pos_neg_zero - ]. +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [heap_frag, encode_decode_ext, decode_integer_ext, + decode_small_big_ext, decode_large_big_ext, + decode_small_big_ext_neg, decode_large_big_ext_neg, + decode_too_small, decode_pos_neg_zero]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(_Case, Config) -> ?line Dog = test_server:timetrap(?t:minutes(0.5)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index f1e6e004ad..9d6fc9521d 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -19,20 +19,40 @@ -module(exception_SUITE). --export([all/1, badmatch/1, pending_errors/1, nil_arith/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + badmatch/1, pending_errors/1, nil_arith/1, stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1, exception_with_heap_frag/1]). -export([bad_guy/2]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -import(lists, [foreach/2]). -all(suite) -> - [badmatch, pending_errors, nil_arith, - stacktrace, nested_stacktrace, raise, gunilla, per, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [badmatch, pending_errors, nil_arith, stacktrace, + nested_stacktrace, raise, gunilla, per, exception_with_heap_frag]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + -define(try_match(E), catch ?MODULE:bar(), {'EXIT', {{badmatch, nomatch}, _}} = (catch E = id(nomatch))). @@ -255,7 +275,16 @@ stacktrace(Conf) when is_list(Conf) -> ?line [{?MODULE,stacktrace_1,3}|_] = erase(stacktrace1), ?line St4 = erase(stacktrace2), ?line St4 = erlang:get_stacktrace(), - ok. + + try + ?line stacktrace_2() + catch + error:{badmatch,_} -> + [{?MODULE,stacktrace_2,0}, + {?MODULE,stacktrace,1}|_] = + erlang:get_stacktrace(), + ok + end. stacktrace_1(X, C1, Y) -> erase(stacktrace1), @@ -275,6 +304,9 @@ stacktrace_1(X, C1, Y) -> put(stacktrace2, erlang:get_stacktrace()) end. +stacktrace_2() -> + ok = erlang:process_info(self(), current_function), + ok. nested_stacktrace(Conf) when is_list(Conf) -> diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 99e9457985..736510339f 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -19,9 +19,11 @@ -module(float_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, bad_float_unpack/1]). -export([otp_7178/1]). @@ -31,18 +33,31 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(3)), [{watchdog, Dog},{testcase,Func}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog). -all(suite) -> - [fpe, - fp_drv, - fp_drv_thread, - otp_7178, - denormalized, - match, - bad_float_unpack]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized, + match, bad_float_unpack]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + %% %% OTP-7178, list_to_float on very small numbers should give 0.0 diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index a7889dfe90..7795efe57e 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -22,7 +22,9 @@ -define(default_timeout, ?t:minutes(1)). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, bad_apply/1,bad_fun_call/1,badarity/1,ext_badarity/1, equality/1,ordering/1, fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1, @@ -32,19 +34,37 @@ -export([nothing/0]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [bad_apply, bad_fun_call, badarity, ext_badarity, + equality, ordering, fun_to_port, t_hash, t_phash, + t_phash2, md5, refc, refc_ets, refc_dist, + const_propagation, t_arity, t_is_function2, t_fun_info]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [bad_apply,bad_fun_call,badarity,ext_badarity,equality,ordering, - fun_to_port,t_hash,t_phash,t_phash2,md5, - refc,refc_ets,refc_dist,const_propagation, - t_arity,t_is_function2,t_fun_info]. init_per_testcase(_Case, Config) -> ?line Dog = test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. diff --git a/erts/emulator/test/fun_r12_SUITE.erl b/erts/emulator/test/fun_r12_SUITE.erl index 9262731dcb..3b1dfc9825 100644 --- a/erts/emulator/test/fun_r12_SUITE.erl +++ b/erts/emulator/test/fun_r12_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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 @@ -20,18 +20,39 @@ -module(fun_r12_SUITE). -compile(r12). --export([all/1,init_per_testcase/2,fin_per_testcase/2,dist_old_release/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2,dist_old_release/1]). -define(default_timeout, ?t:minutes(1)). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [dist_old_release]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> [dist_old_release]. init_per_testcase(_Case, Config) -> ?line Dog = test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl index 066aa215b2..771d2c9a7a 100644 --- a/erts/emulator/test/gc_SUITE.erl +++ b/erts/emulator/test/gc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -21,15 +21,34 @@ -module(gc_SUITE). --include("test_server.hrl"). --export([all/1]). +-include_lib("test_server/include/test_server.hrl"). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). -define(default_timeout, ?t:minutes(10)). -export([grow_heap/1, grow_stack/1, grow_stack_heap/1]). -all(suite) -> - [grow_heap,grow_stack, grow_stack_heap]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [grow_heap, grow_stack, grow_stack_heap]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + grow_heap(doc) -> ["Produce a growing list of elements, ", "for X calls, then drop one item per call", diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl index 8fef36dfaf..f41324c2cc 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -19,16 +19,37 @@ -module(guard_SUITE). --export([all/1, bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, bad_arith/1, bad_tuple/1, + test_heap_guards/1, guard_bifs/1, type_tests/1,guard_bif_binary_part/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -export([init/3]). -import(lists, [member/2]). -all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, - type_tests, guard_bif_binary_part]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [bad_arith, bad_tuple, test_heap_guards, guard_bifs, + type_tests, guard_bif_binary_part]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly."; bad_arith(Config) when is_list(Config) -> diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index f5d1871bfb..830ed91da9 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2011. 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 @@ -49,7 +49,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -endif. -ifdef(debug). @@ -69,22 +69,40 @@ config(priv_dir,_) -> ".". -else. %% When run in test server. --export([all/1,test_basic/1,test_cmp/1,test_range/1,test_spread/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + test_basic/1,test_cmp/1,test_range/1,test_spread/1, test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1, - fin_per_testcase/2,init_per_testcase/2]). + end_per_testcase/2,init_per_testcase/2]). init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(test_server:minutes(10)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. -all(doc) -> - ["Test erlang:phash"]; -all(suite) -> - [test_basic, test_cmp, test_range, test_spread, test_phash2, otp_5292, - bit_level_binaries, otp_7127]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [test_basic, test_cmp, test_range, test_spread, + test_phash2, otp_5292, bit_level_binaries, otp_7127]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + test_basic(suite) -> []; diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl index 4d36076d12..203fa6b48e 100644 --- a/erts/emulator/test/hibernate_SUITE.erl +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2011. 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 @@ -19,23 +19,44 @@ -module(hibernate_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2, - basic/1,min_heap_size/1,bad_args/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, + basic/1,dynamic_call/1,min_heap_size/1,bad_args/1, messages_in_queue/1,undefined_mfa/1, no_heap/1]). %% Used by test cases. --export([basic_hibernator/1,messages_in_queue_restart/2, no_heap_loop/0]). +-export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, no_heap_loop/0]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [basic, dynamic_call, min_heap_size, bad_args, messages_in_queue, + undefined_mfa, no_heap]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [basic,min_heap_size,bad_args,messages_in_queue,undefined_mfa,no_heap]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(3)), [{watchdog,Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). @@ -138,10 +159,47 @@ whats_up_calc(A1, A2, A3, A4, A5, A6, A7, A8, A9, Acc) -> whats_up_calc(A1-1, A2+1, A3+2, A4+3, A5+4, A6+5, A7+6, A8+7, A9+8, [A1,A2|Acc]). %%% +%%% Testing a call to erlang:hibernate/3 that the compiler and loader do not +%%% translate to an instruction. +%%% + +dynamic_call(Config) when is_list(Config) -> + Ref = make_ref(), + Info = {self(),Ref}, + ExpectedHeapSz = case erlang:system_info(heap_type) of + private -> erts_debug:size([Info]); + hybrid -> erts_debug:size([a|b]) + end, + ?line Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end), + ?line hibernate_wake_up(100, ExpectedHeapSz, Child), + ?line Child ! please_quit_now, + ok. + +dynamic_call_hibernator(Info, Function) -> + {catchlevel,0} = process_info(self(), catchlevel), + receive + Any -> + dynamic_call_hibernator_msg(Any, Function, Info), + dynamic_call_hibernator(Info, Function) + end. + +dynamic_call_hibernator_msg({hibernate,_}, Function, Info) -> + catch apply(erlang, Function, [?MODULE, basic_hibernator, [Info]]), + exit(hibernate_returned); +dynamic_call_hibernator_msg(Msg, _Function, Info) -> + basic_hibernator_msg(Msg, Info). + +%%% %%% Testing setting the minimum heap size. %%% min_heap_size(Config) when is_list(Config) -> + case test_server:is_native(?MODULE) of + true -> {skip, "Test case relies on trace which is not available in HiPE"}; + false -> min_heap_size_1(Config) + end. + +min_heap_size_1(Config) when is_list(Config) -> ?line erlang:trace(new, true, [call]), MFA = {?MODULE,min_hibernator,1}, ?line 1 = erlang:trace_pattern(MFA, true, [local]), diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl index 1d738cbafd..8b1ac0fe6c 120000..100644 --- a/erts/emulator/test/ignore_cores.erl +++ b/erts/emulator/test/ignore_cores.erl @@ -1 +1,158 @@ -../../test/ignore_cores.erl
\ No newline at end of file +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2010. 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% +%% + +%%%------------------------------------------------------------------- +%%% File : ignore_cores.erl +%%% Author : Rickard Green <[email protected]> +%%% Description : +%%% +%%% Created : 11 Feb 2008 by Rickard Green <[email protected]> +%%%------------------------------------------------------------------- + +-module(ignore_cores). + +-include_lib("test_server/include/test_server.hrl"). + +-export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). + +-record(ignore_cores, {org_cwd, + org_path, + org_pwd_env, + ign_dir = false, + cores_dir = false}). + +%% +%% Takes a testcase config +%% + +init(Config) -> + {ok, OrgCWD} = file:get_cwd(), + [{ignore_cores, + #ignore_cores{org_cwd = OrgCWD, + org_path = code:get_path(), + org_pwd_env = os:getenv("PWD")}} + | lists:keydelete(ignore_cores, 1, Config)]. + +fini(Config) -> + #ignore_cores{org_cwd = OrgCWD, + org_path = OrgPath, + org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + ok = file:set_cwd(OrgCWD), + true = code:set_path(OrgPath), + case OrgPWD of + false -> ok; + _ -> true = os:putenv("PWD", OrgPWD) + end, + lists:keydelete(ignore_cores, 1, Config). + +setup(Suite, Testcase, Config) -> + setup(Suite, Testcase, Config, false). + +setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), + is_atom(Testcase), + is_list(Config) -> + #ignore_cores{org_cwd = OrgCWD, + org_path = OrgPath, + org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + Path = lists:map(fun (".") -> OrgCWD; (Dir) -> Dir end, OrgPath), + true = code:set_path(Path), + PrivDir = ?config(priv_dir, Config), + IgnDir = filename:join([PrivDir, + atom_to_list(Suite) + ++ "_" + ++ atom_to_list(Testcase) + ++ "_wd"]), + ok = file:make_dir(IgnDir), + case SetCwd of + false -> + ok; + _ -> + ok = file:set_cwd(IgnDir), + OrgPWD = case os:getenv("PWD") of + false -> false; + PWD -> + os:putenv("PWD", IgnDir), + PWD + end + end, + ok = file:write_file(filename:join([IgnDir, "ignore_core_files"]), <<>>), + %% cores are dumped in /cores on MacOS X + CoresDir = case {?t:os_type(), filelib:is_dir("/cores")} of + {{unix,darwin}, true} -> + filelib:fold_files("/cores", + "^core.*$", + false, + fun (C,Cs) -> [C|Cs] end, + []); + _ -> + false + end, + lists:keyreplace(ignore_cores, + 1, + Config, + {ignore_cores, + #ignore_cores{org_cwd = OrgCWD, + org_path = OrgPath, + org_pwd_env = OrgPWD, + ign_dir = IgnDir, + cores_dir = CoresDir}}). + +restore(Config) -> + #ignore_cores{org_cwd = OrgCWD, + org_path = OrgPath, + org_pwd_env = OrgPWD, + ign_dir = IgnDir, + cores_dir = CoresDir} = ?config(ignore_cores, Config), + try + case CoresDir of + false -> + ok; + _ -> + %% Move cores dumped by these testcases in /cores + %% to cwd. + lists:foreach(fun (C) -> + case lists:member(C, CoresDir) of + true -> ok; + _ -> + Dst = filename:join( + [IgnDir, + filename:basename(C)]), + {ok, _} = file:copy(C, Dst), + file:delete(C) + end + end, + filelib:fold_files("/cores", + "^core.*$", + false, + fun (C,Cs) -> [C|Cs] end, + [])) + end + after + catch file:set_cwd(OrgCWD), + catch code:set_path(OrgPath), + case OrgPWD of + false -> ok; + _ -> catch os:putenv("PWD", OrgPWD) + end + end. + + +dir(Config) -> + #ignore_cores{ign_dir = Dir} = ?config(ignore_cores, Config), + Dir. diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl index 65ea88eb2f..45a44d8b43 100644 --- a/erts/emulator/test/list_bif_SUITE.erl +++ b/erts/emulator/test/list_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -18,21 +18,42 @@ %% -module(list_bif_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2]). -export([hd_test/1,tl_test/1,t_length/1,t_list_to_pid/1, t_list_to_float/1,t_list_to_integer/1]). -all(suite) -> - [hd_test,tl_test,t_length,t_list_to_pid,t_list_to_float,t_list_to_integer]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [hd_test, tl_test, t_length, t_list_to_pid, + t_list_to_float, t_list_to_integer]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(_Case, Config) -> ?line Dog = test_server:timetrap(test_server:seconds(60)), [{watchdog,Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. diff --git a/erts/emulator/test/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl index 28626d26fb..28a4fba9f6 100644 --- a/erts/emulator/test/long_timers_test.erl +++ b/erts/emulator/test/long_timers_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2010. 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 diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 69c89f5d2d..2b21fa58f4 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -19,7 +19,8 @@ -module(match_spec_SUITE). --export([all/1, not_run/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, not_run/1]). -export([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/1, trace_control_word/1, silent/1, silent_no_ms/1, ms_trace2/1, ms_trace3/1, boxed_and_small/1, @@ -34,29 +35,48 @@ % This test suite assumes that tracing in general works. What we test is % the match spec functionality. --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([init_per_testcase/2, end_per_testcase/2]). init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:seconds(10)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). -all(suite) -> - case test_server:is_native(?MODULE) of - false -> [test_1, test_2, test_3, bad_match_spec_bin, - trace_control_word, silent, silent_no_ms, - ms_trace2, ms_trace3, boxed_and_small, - destructive_in_test_bif, guard_exceptions, - unary_plus, unary_minus, fpe, moving_labels]; - true -> [not_run] +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + case test_server:is_native(match_spec_SUITE) of + false -> + [test_1, test_2, test_3, bad_match_spec_bin, + trace_control_word, silent, silent_no_ms, ms_trace2, + ms_trace3, boxed_and_small, destructive_in_test_bif, + guard_exceptions, unary_plus, unary_minus, fpe, + moving_labels]; + true -> [not_run] end. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + not_run(Config) when is_list(Config) -> {skipped, "Native Code"}. @@ -345,15 +365,15 @@ silent_no_ms(Config) when is_list(Config) -> fun () -> ?MODULE:f1(a), ?MODULE:f2(b, c), - erlang:integer_to_list(id(1)), + _ = erlang:integer_to_list(id(1)), ?MODULE:f3(d, e), ?MODULE:f1(start), ?MODULE:f2(f, g), - erlang:integer_to_list(id(2)), + _ = erlang:integer_to_list(id(2)), ?MODULE:f3(h, i), ?MODULE:f1(stop), ?MODULE:f2(j, k), - erlang:integer_to_list(id(3)), + _ = erlang:integer_to_list(id(3)), ?MODULE:f3(l, m) end, fun (Tracee) -> @@ -393,15 +413,15 @@ silent_no_ms(Config) when is_list(Config) -> fun () -> ?MODULE:f1(a), ?MODULE:f2(b, c), - erlang:integer_to_list(id(1)), + _ = erlang:integer_to_list(id(1)), ?MODULE:f3(d, e), ?MODULE:f1(start), ?MODULE:f2(f, g), - erlang:integer_to_list(id(2)), + _ = erlang:integer_to_list(id(2)), ?MODULE:f3(h, i), ?MODULE:f1(stop), ?MODULE:f2(j, k), - erlang:integer_to_list(id(3)), + _ = erlang:integer_to_list(id(3)), ?MODULE:f3(l, m) end, fun (Tracee) -> @@ -455,18 +475,18 @@ ms_trace2(Config) when is_list(Config) -> fun () -> ?MODULE:f1(a), ?MODULE:f2(b, c), - erlang:integer_to_list(id(1)), + _ = erlang:integer_to_list(id(1)), ?MODULE:f3(d, e), fn([all], [call,return_to,{tracer,Tracer}]), ?MODULE:f1(f), f2(g, h), f1(i), - erlang:integer_to_list(id(2)), + _ = erlang:integer_to_list(id(2)), ?MODULE:f3(j, k), fn([call,return_to], []), ?MODULE:f1(l), ?MODULE:f2(m, n), - erlang:integer_to_list(id(3)), + _ = erlang:integer_to_list(id(3)), ?MODULE:f3(o, p) end, fun (Tracee) -> @@ -551,26 +571,26 @@ ms_trace3(Config) when is_list(Config) -> register(TraceeName, self()), ?MODULE:f1(a), ?MODULE:f2(b, c), - erlang:integer_to_list(id(1)), + _ = erlang:integer_to_list(id(1)), ?MODULE:f3(d, e), Controller ! {self(),Tag,start}, receive {Controller,Tag,started} -> ok end, ?MODULE:f1(f), f2(g, h), f1(i), - erlang:integer_to_list(id(2)), + _ = erlang:integer_to_list(id(2)), ?MODULE:f3(j, k), Controller ! {self(),Tag,stop_1}, receive {Controller,Tag,stopped_1} -> ok end, ?MODULE:f1(l), ?MODULE:f2(m, n), - erlang:integer_to_list(id(3)), + _ = erlang:integer_to_list(id(3)), ?MODULE:f3(o, p), Controller ! {self(),Tag,stop_2}, receive {Controller,Tag,stopped_2} -> ok end, ?MODULE:f1(q), ?MODULE:f2(r, s), - erlang:integer_to_list(id(4)), + _ = erlang:integer_to_list(id(4)), ?MODULE:f3(t, u) end, diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl index f34a2b496c..8a63d9fe3e 100644 --- a/erts/emulator/test/module_info_SUITE.erl +++ b/erts/emulator/test/module_info_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. 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 @@ -19,9 +19,11 @@ -module(module_info_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,end_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, exports/1,functions/1,native/1]). %%-compile(native). @@ -29,8 +31,29 @@ %% Helper. -export([native_proj/1,native_filter/1]). -all(suite) -> - [exports,functions,native]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + modules(). + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +modules() -> + [exports, functions, native]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(3)), @@ -42,14 +65,18 @@ end_per_testcase(_Func, Config) -> %% Should return all functions exported from this module. (local) all_exported() -> - All = add_arity(all(suite)), - lists:sort([{all,1},{init_per_testcase,2},{end_per_testcase,2}, + All = add_arity(modules()), + lists:sort([{all,0},{suite,0},{groups,0}, + {init_per_suite,1},{end_per_suite,1}, + {init_per_group,2},{end_per_group,2}, + {init_per_testcase,2},{end_per_testcase,2}, {module_info,0},{module_info,1},{native_proj,1}, {native_filter,1}|All]). %% Should return all functions in this module. (local) all_functions() -> - Locals = [{add_arity,1},{add_arity,2},{all_exported,0},{all_functions,0}], + Locals = [{add_arity,1},{add_arity,2},{all_exported,0},{all_functions,0}, + {modules,0}], lists:sort(Locals++all_exported()). %% Test that the list of exported functions from this module is correct. diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl index 68e378dfec..aec59867d8 100644 --- a/erts/emulator/test/monitor_SUITE.erl +++ b/erts/emulator/test/monitor_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -19,29 +19,49 @@ -module(monitor_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, case_1/1, case_1a/1, case_2/1, case_2a/1, mon_e_1/1, demon_e_1/1, demon_1/1, - demon_2/1, demon_3/1, demonitor_flush/1, remove_monitor/1, + demon_2/1, demon_3/1, demonitor_flush/1, local_remove_monitor/1, remote_remove_monitor/1, mon_1/1, mon_2/1, large_exit/1, list_cleanup/1, mixer/1, named_down/1, otp_5827/1]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([init_per_testcase/2, end_per_testcase/2]). -export([y2/1, g/1, g0/0, g1/0, large_exit_sub/1]). -all(suite) -> - [case_1, case_1a, case_2, case_2a, mon_e_1, demon_e_1, demon_1, mon_1, - mon_2, demon_2, demon_3, demonitor_flush, remove_monitor, - large_exit, list_cleanup, mixer, named_down, - otp_5827]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [case_1, case_1a, case_2, case_2a, mon_e_1, demon_e_1, + demon_1, mon_1, mon_2, demon_2, demon_3, + demonitor_flush, {group, remove_monitor}, large_exit, + list_cleanup, mixer, named_down, otp_5827]. + +groups() -> + [{remove_monitor, [], + [local_remove_monitor, remote_remove_monitor]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(15)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). @@ -315,8 +335,6 @@ demonitor_flush_test(Node) -> -define(RM_MON_GROUPS, 100). -define(RM_MON_GPROCS, 100). -remove_monitor(suite) -> - [local_remove_monitor, remote_remove_monitor]. local_remove_monitor(Config) when is_list(Config) -> Gs = generate(fun () -> start_remove_monitor_group(node()) end, diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl index ae77fe4d89..e0a7878bd8 100644 --- a/erts/emulator/test/mtx_SUITE.erl +++ b/erts/emulator/test/mtx_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2010-2011. 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 @@ -26,9 +26,11 @@ %%-define(line_trace,true). --include("test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/1, init_per_suite/1, end_per_suite/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0,suite/0,groups/0, + init_per_group/2,end_per_group/2, init_per_suite/1, + end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). -export([long_rwlock/1, hammer_ets_rwlock/1, @@ -66,19 +68,16 @@ init_per_testcase(_Case, Config) -> Dog = ?t:timetrap(?t:minutes(15)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog). -all(suite) -> - [ - long_rwlock, - hammer_rwlock_check, - hammer_rwlock, - hammer_tryrwlock_check, - hammer_tryrwlock, - hammer_ets_rwlock, - hammer_sched_long_rwlock_check, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [long_rwlock, hammer_rwlock_check, hammer_rwlock, + hammer_tryrwlock_check, hammer_tryrwlock, + hammer_ets_rwlock, hammer_sched_long_rwlock_check, hammer_sched_long_rwlock, hammer_sched_long_freqread_rwlock_check, hammer_sched_long_freqread_rwlock, @@ -86,15 +85,22 @@ all(suite) -> hammer_sched_long_tryrwlock, hammer_sched_long_freqread_tryrwlock_check, hammer_sched_long_freqread_tryrwlock, - hammer_sched_rwlock_check, - hammer_sched_rwlock, + hammer_sched_rwlock_check, hammer_sched_rwlock, hammer_sched_freqread_rwlock_check, hammer_sched_freqread_rwlock, - hammer_sched_tryrwlock_check, - hammer_sched_tryrwlock, + hammer_sched_tryrwlock_check, hammer_sched_tryrwlock, hammer_sched_freqread_tryrwlock_check, - hammer_sched_freqread_tryrwlock - ]. + hammer_sched_freqread_tryrwlock]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + long_rwlock(Config) when is_list(Config) -> statistics(runtime), diff --git a/erts/emulator/test/nested_SUITE.erl b/erts/emulator/test/nested_SUITE.erl index 310892424e..2cd67ebaae 100644 --- a/erts/emulator/test/nested_SUITE.erl +++ b/erts/emulator/test/nested_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -19,11 +19,33 @@ -module(nested_SUITE). --export([all/1, case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [case_in_case, case_in_after, catch_in_catch, + bif_in_bif]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> [case_in_case, case_in_after, catch_in_catch, bif_in_bif]. case_in_case(suite) -> []; case_in_case(Config) when is_list(Config) -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 42947aa6be..b79c30d8d9 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2010. All Rights Reserved. +%% Copyright Ericsson AB 2010-2011. 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 @@ -23,14 +23,18 @@ -define(CHECK(Exp,Got), check(Exp,Got,?LINE)). %%-define(CHECK(Exp,Got), ?line Exp = Got). --include("test_server.hrl"). - --export([all/1, - %%init_per_testcase/2, - fin_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1, - types/1, many_args/1, binaries/1, get_string/1, get_atom/1, api_macros/1, - from_array/1, iolist_as_binary/1, resource/1, resource_binary/1, resource_takeover/1, - threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, is_checks/1, +-include_lib("test_server/include/test_server.hrl"). + +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, + end_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1, + types/1, many_args/1, binaries/1, get_string/1, get_atom/1, + api_macros/1, + from_array/1, iolist_as_binary/1, resource/1, resource_binary/1, + resource_takeover/1, + threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, + is_checks/1, get_length/1, make_atom/1, make_string/1]). -export([many_args_100/100]). @@ -40,7 +44,7 @@ %% list_seq/1,type_test/0,tuple_2_list/1,is_identical/2,compare/2, %% clone_bin/1,make_sub_bin/3,string_to_bin/2,atom_to_bin/2,macros/1, %% tuple_2_list_and_tuple/1,iolist_2_bin/1,get_resource_type/1,alloc_resource/2, -%% make_resource/1,get_resource/2,release_resource/1,last_resource_dtor_call/0, +%% make_resource/1,get_resource/2,release_resource/1,last_resource_dtor_call/0, suite/0, %% make_new_resource/2,make_new_resource_binary/1,send_list_seq/2,send_new_blob/2, %% alloc_msgenv/0,clear_msgenv/1,grow_blob/2,send_blob/2,send_blob_thread/3, %% join_send_thread/1]). @@ -48,17 +52,37 @@ -define(nif_stub,nif_stub_error(?LINE)). -all(suite) -> - [basic, reload, upgrade, heap_frag, types, many_args, binaries, get_string, - get_atom, api_macros, from_array, iolist_as_binary, resource, resource_binary, - resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, - get_length, make_atom, make_string]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [basic, reload, upgrade, heap_frag, types, many_args, + binaries, get_string, get_atom, api_macros, from_array, + iolist_as_binary, resource, resource_binary, + resource_takeover, threading, send, send2, send3, + send_threaded, neg, is_checks, get_length, make_atom, + make_string]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + -%%init_per_testcase(_Case, Config) -> -%% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)), -%% [{watchdog, Dog}|Config]. +init_per_testcase(_Case, Config) -> +% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)), + Config. -fin_per_testcase(_Func, _Config) -> +end_per_testcase(_Func, _Config) -> %%Dog = ?config(watchdog, Config), %%?t:timetrap_cancel(Dog), P1 = code:purge(nif_mod), diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.erl b/erts/emulator/test/nif_SUITE_data/nif_mod.erl index 7888a589e7..6634624698 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.erl +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. 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 @@ -19,7 +19,7 @@ -module(nif_mod). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -export([load_nif_lib/2, load_nif_lib/3, start/0, lib_version/0, call_history/0, get_priv_data_ptr/0, make_new_resource/2, get_resource/2]). diff --git a/erts/emulator/test/nif_SUITE_data/tester.erl b/erts/emulator/test/nif_SUITE_data/tester.erl index 9df2158200..b393e29b82 100644 --- a/erts/emulator/test/nif_SUITE_data/tester.erl +++ b/erts/emulator/test/nif_SUITE_data/tester.erl @@ -1,6 +1,6 @@ -module(tester). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -export([load_nif_lib/2, run/0]). diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index f3d9eb783b..aa83459ef8 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. 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 @@ -29,10 +29,12 @@ %-define(line_trace, 1). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %-compile(export_all). --export([all/1, init_per_testcase/2, fin_per_testcase/2, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, init_per_testcase/2, + end_per_testcase/2, node_container_refc_check/1]). -export([term_to_binary_to_term_eq/1, @@ -55,25 +57,30 @@ -define(DEFAULT_TIMEOUT, ?t:minutes(10)). -all(doc) -> []; -all(suite) -> - [term_to_binary_to_term_eq, - round_trip_eq, - cmp, - ref_eq, - node_table_gc, - dist_link_refc, - dist_monitor_refc, - node_controller_refc, - ets_refc, - match_spec_refc, - timer_refc, - otp_4715, - pid_wrap, - port_wrap, - bad_nc, - unique_pid, - iter_max_procs]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [term_to_binary_to_term_eq, round_trip_eq, cmp, ref_eq, + node_table_gc, dist_link_refc, dist_monitor_refc, + node_controller_refc, ets_refc, match_spec_refc, + timer_refc, otp_4715, pid_wrap, port_wrap, bad_nc, + unique_pid, iter_max_procs]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + available_internal_state(false). + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + available_internal_state(Bool) when Bool == true; Bool == false -> case {Bool, @@ -95,14 +102,11 @@ init_per_testcase(_Case, Config) when is_list(Config) -> available_internal_state(true), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) when is_list(Config) -> +end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. -end_per_suite(_Config) -> - available_internal_state(false). - %%% %%% The test cases ------------------------------------------------------------- %%% diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl index ece55f433c..6b6ac28e2e 100644 --- a/erts/emulator/test/nofrag_SUITE.erl +++ b/erts/emulator/test/nofrag_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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 @@ -19,9 +19,11 @@ -module(nofrag_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,end_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, error_handler/1,error_handler_apply/1, error_handler_fixed_apply/1,error_handler_fun/1, error_handler_tuple_fun/1, @@ -30,9 +32,28 @@ %% Exported functions for an error_handler module. -export([undefined_function/3,undefined_lambda/3,breakpoint/3]). -all(suite) -> - [error_handler,error_handler_apply,error_handler_fixed_apply, - error_handler_fun,error_handler_tuple_fun,debug_breakpoint]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [error_handler, error_handler_apply, + error_handler_fixed_apply, error_handler_fun, + error_handler_tuple_fun, debug_breakpoint]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(3)), diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index d009994e2d..4459732257 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -19,7 +19,7 @@ -module(num_bif_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %% Tests the BIFs: %% abs/1 @@ -31,15 +31,36 @@ %% round/1 %% trunc/1 --export([all/1, t_abs/1, t_float/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, t_abs/1, t_float/1, t_float_to_list/1, t_integer_to_list/1, t_list_to_integer/1, - t_list_to_float/1, t_list_to_float_safe/1, t_list_to_float_risky/1, + t_list_to_float_safe/1, t_list_to_float_risky/1, t_round/1, t_trunc/1]). -all(suite) -> [t_abs, t_float, t_float_to_list, t_integer_to_list, - t_list_to_float, t_list_to_integer, - t_round, t_trunc]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [t_abs, t_float, t_float_to_list, t_integer_to_list, + {group, t_list_to_float}, t_list_to_integer, t_round, + t_trunc]. + +groups() -> + [{t_list_to_float, [], + [t_list_to_float_safe, t_list_to_float_risky]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + t_abs(Config) when is_list(Config) -> %% Floats. @@ -140,7 +161,6 @@ t_integer_to_list(Config) when is_list(Config) -> %% Tests list_to_float/1. -t_list_to_float(suite) -> [t_list_to_float_safe, t_list_to_float_risky]. t_list_to_float_safe(Config) when is_list(Config) -> ?line 0.0 = list_to_float(id("0.0")), diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl index 6c47ba6f8f..124842390a 100644 --- a/erts/emulator/test/old_mod.erl +++ b/erts/emulator/test/old_mod.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2010. 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 diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl index 70348f64db..262536a068 100644 --- a/erts/emulator/test/old_scheduler_SUITE.erl +++ b/erts/emulator/test/old_scheduler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2011. 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 @@ -19,24 +19,44 @@ -module(old_scheduler_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2]). -export([equal/1, many_low/1, few_low/1, max/1, high/1]). -define(default_timeout, ?t:minutes(11)). -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> case catch erlang:system_info(modified_timing_level) of Level when is_integer(Level) -> {skipped, - "Modified timing (level " ++ integer_to_list(Level) - ++ ") is enabled. Testcases gets messed up by modfied " - "timing."}; - _ -> - [equal, many_low, few_low, max, high] + "Modified timing (level " ++ + integer_to_list(Level) ++ + ") is enabled. Testcases gets messed " + "up by modfied timing."}; + _ -> [equal, many_low, few_low, max, high] end. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + %%----------------------------------------------------------------------------------- %% TEST SUITE DESCRIPTION %% @@ -63,7 +83,7 @@ init_per_testcase(_Case, Config) -> ?line MS = erlang:system_flag(multi_scheduling, block), [{prio,Prio},{watchdog,Dog},{multi_scheduling, MS}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> erlang:system_flag(multi_scheduling, unblock), Dog=?config(watchdog, Config), Prio=?config(prio, Config), diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl index 55d8d9ab0f..ef4689b850 100644 --- a/erts/emulator/test/op_SUITE.erl +++ b/erts/emulator/test/op_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -19,22 +19,43 @@ -module(op_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]). -export([]). -import(lists, [foldl/3,flatmap/2]). -all(suite) -> - [bsl_bsr,logical,t_not,relop_simple,relop,complex_relop]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [bsl_bsr, logical, t_not, relop_simple, relop, + complex_relop]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> Dog=?t:timetrap(?t:minutes(3)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 7fe532abd0..eac56a867d 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -73,18 +73,19 @@ %% --export([all/1, init_per_testcase/2, fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2, init_per_suite/1, end_per_suite/1, - stream/1, stream_small/1, stream_big/1, + stream_small/1, stream_big/1, basic_ping/1, slow_writes/1, bad_packet/1, bad_port_messages/1, - multiple_packets/1, mul_basic/1, mul_slow_writes/1, + mul_basic/1, mul_slow_writes/1, dying_port/1, port_program_with_path/1, open_input_file_port/1, open_output_file_port/1, iter_max_ports/1, eof/1, input_only/1, output_only/1, name1/1, - t_binary/1, options/1, parallell/1, t_exit/1, + t_binary/1, parallell/1, t_exit/1, env/1, bad_env/1, cd/1, exit_status/1, - tps/1, tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1, + tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1, otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1, mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1, exit_status_multi_scheduling_block/1, ports/1, @@ -98,31 +99,42 @@ -export([otp_3906_forker/5, otp_3906_start_forker_starter/4]). -export([env_slave_main/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -include_lib("kernel/include/file.hrl"). -all(suite) -> - [ - otp_6224, stream, basic_ping, slow_writes, bad_packet, - bad_port_messages, options, multiple_packets, parallell, - dying_port, port_program_with_path, - open_input_file_port, open_output_file_port, - name1, - env, bad_env, cd, exit_status, - iter_max_ports, t_exit, tps, line, stderr_to_stdout, - otp_3906, otp_4389, win_massive, mix_up_ports, - otp_5112, otp_5119, - exit_status_multi_scheduling_block, - ports, spawn_driver, spawn_executable, close_deaf_port, - unregister_name - ]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [otp_6224, {group, stream}, basic_ping, slow_writes, + bad_packet, bad_port_messages, {group, options}, + {group, multiple_packets}, parallell, dying_port, + port_program_with_path, open_input_file_port, + open_output_file_port, name1, env, bad_env, cd, + exit_status, iter_max_ports, t_exit, {group, tps}, line, + stderr_to_stdout, otp_3906, otp_4389, win_massive, + mix_up_ports, otp_5112, otp_5119, + exit_status_multi_scheduling_block, ports, spawn_driver, + spawn_executable, close_deaf_port, unregister_name]. + +groups() -> + [{stream, [], [stream_small, stream_big]}, + {options, [], [t_binary, eof, input_only, output_only]}, + {multiple_packets, [], [mul_basic, mul_slow_writes]}, + {tps, [], [tps_16_bytes, tps_1K]}]. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + -define(DEFAULT_TIMEOUT, ?t:minutes(5)). init_per_testcase(Case, Config) -> [{testcase, Case} |Config]. -fin_per_testcase(_Case, _Config) -> +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> @@ -191,7 +203,6 @@ win_massive_loop(P,N) -> -stream(suite) -> [stream_small, stream_big]. %% Test that we can send a stream of bytes and get it back. %% We will send only a small amount of data, to avoid deadlock. @@ -304,7 +315,6 @@ bad_message(PortTest, Message) -> %% Tests various options (stream and {packet, Number} are implicitly %% tested in other test cases). -options(suite) -> [t_binary, eof, input_only, output_only]. %% Tests the 'binary' option for a port. @@ -416,7 +426,6 @@ output_and_verify(Config, Filename, Options, Data) -> %% Test that receiving several packages written in the same %% write operation works. -multiple_packets(suite) -> [mul_basic, mul_slow_writes]. %% Basic test of receiving multiple packages, written in %% one operation by the other end. @@ -740,7 +749,6 @@ suicide_port(Config) when is_list(Config) -> ?line exit(Port, die), ?line receive after infinity -> ok end. -tps(suite) -> [tps_16_bytes, tps_1K]. tps_16_bytes(doc) -> ""; tps_16_bytes(suite) -> []; @@ -1049,8 +1057,10 @@ otp_3906(Config) when is_list(Config) -> -define(OTP_3906_MAX_CONC_OSP, 50). otp_3906(Config, OSName) -> - ?line TSDir = filename:dirname(code:which(test_server)), - ?line {ok, Variables} = file:consult(filename:join(TSDir, "variables")), + ?line DataDir = filename:dirname(proplists:get_value(data_dir,Config)), + ?line {ok, Variables} = file:consult( + filename:join([DataDir,"..","..", + "test_server","variables"])), case lists:keysearch('CC', 1, Variables) of {value,{'CC', CC}} -> SuiteDir = filename:dirname(code:which(?MODULE)), diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl index f4e0bb9fa8..d9c82aba0e 100644 --- a/erts/emulator/test/port_bif_SUITE.erl +++ b/erts/emulator/test/port_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -20,25 +20,47 @@ -module(port_bif_SUITE). --export([all/1, command/1, command_e/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, command/1, command_e_1/1, command_e_2/1, command_e_3/1, command_e_4/1, - port_info/1, port_info1/1, port_info2/1, + port_info1/1, port_info2/1, connect/1, control/1, echo_to_busy/1]). -export([do_command_e_1/1, do_command_e_2/1, do_command_e_4/1]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([init_per_testcase/2, end_per_testcase/2]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [command, {group, port_info}, connect, control, + echo_to_busy]. + +groups() -> + [{command_e, [], + [command_e_1, command_e_2, command_e_3, command_e_4]}, + {port_info, [], [port_info1, port_info2]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [command, port_info, connect, control, echo_to_busy]. init_per_testcase(_Func, Config) when is_list(Config) -> Dog=test_server:timetrap(test_server:minutes(10)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) when is_list(Config) -> +end_per_testcase(_Func, Config) when is_list(Config) -> Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog). @@ -69,11 +91,6 @@ do_command(P, Data) -> end. -command_e(suite) -> [command_e_1, - command_e_2, - command_e_3, - command_e_4]; -command_e(doc) -> "Tests port_command/2 with errors". %% port_command/2: badarg 1st arg command_e_1(Config) when is_list(Config) -> @@ -161,7 +178,6 @@ do_command_e_4(Program) -> ?line erlang:port_command(P, Data), exit(survived). -port_info(suite) -> [port_info1, port_info2]. %% Tests the port_info/1 BIF port_info1(Config) when is_list(Config) -> diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 77f850d0fb..a731f09e4c 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -25,12 +25,13 @@ %% process_info/1,2 %% register/2 (partially) --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -define(heap_binary_size, 64). --export([all/1, spawn_with_binaries/1, - t_exit_1/1, t_exit_2/1, t_exit_2_other/1, t_exit_2_other_normal/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, spawn_with_binaries/1, + t_exit_1/1, t_exit_2_other/1, t_exit_2_other_normal/1, self_exit/1, normal_suicide_exit/1, abnormal_suicide_exit/1, t_exit_2_catch/1, trap_exit_badarg/1, trap_exit_badarg_in_bif/1, exit_and_timeout/1, exit_twice/1, @@ -46,39 +47,67 @@ processes_large_tab/1, processes_default_tab/1, processes_small_tab/1, processes_this_tab/1, processes_apply_trap/1, processes_last_call_trap/1, processes_gc_trap/1, - processes_term_proc_list/1, processes_bif/1, - otp_7738/1, otp_7738_waiting/1, otp_7738_suspended/1, + processes_term_proc_list/1, + otp_7738_waiting/1, otp_7738_suspended/1, otp_7738_resume/1]). -export([prio_server/2, prio_client/2]). --export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). -export([hangaround/2, processes_bif_test/0, do_processes/1, processes_term_proc_list_test/1]). -all(suite) -> - [spawn_with_binaries, t_exit_1, t_exit_2, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [spawn_with_binaries, t_exit_1, {group, t_exit_2}, trap_exit_badarg, trap_exit_badarg_in_bif, - t_process_info, process_info_other_msg, process_info_other_dist_msg, - process_info_2_list, - process_info_lock_reschedule, process_info_lock_reschedule2, - process_status_exiting, - bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, - garbage_collect, process_info_messages, process_flag_badarg, process_flag_heap_size, - spawn_opt_heap_size, otp_6237, processes_bif, otp_7738]. + t_process_info, process_info_other_msg, + process_info_other_dist_msg, process_info_2_list, + process_info_lock_reschedule, + process_info_lock_reschedule2, process_status_exiting, + bump_reductions, low_prio, yield, yield2, otp_4725, + bad_register, garbage_collect, process_info_messages, + process_flag_badarg, process_flag_heap_size, + spawn_opt_heap_size, otp_6237, {group, processes_bif}, + {group, otp_7738}]. + +groups() -> + [{t_exit_2, [], + [t_exit_2_other, t_exit_2_other_normal, self_exit, + normal_suicide_exit, abnormal_suicide_exit, + t_exit_2_catch, exit_and_timeout, exit_twice]}, + {processes_bif, [], + [processes_large_tab, processes_default_tab, + processes_small_tab, processes_this_tab, + processes_last_call_trap, processes_apply_trap, + processes_gc_trap, processes_term_proc_list]}, + {otp_7738, [], + [otp_7738_waiting, otp_7738_suspended, + otp_7738_resume]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), + Config. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(10)), [{watchdog, Dog},{testcase, Func}|Config]. -fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> +end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). -end_per_suite(Config) -> - catch erts_debug:set_internal_state(available_internal_state, false), - Config. - fun_spawn(Fun) -> spawn_link(erlang, apply, [Fun, []]). @@ -117,10 +146,6 @@ t_exit_1() -> {'EXIT', Pid, Garbage} -> ok end. -t_exit_2(suite) -> [t_exit_2_other, t_exit_2_other_normal, - self_exit, normal_suicide_exit, - abnormal_suicide_exit, t_exit_2_catch, - exit_and_timeout, exit_twice]. %% Tests exit/2 with a lot of data in the exit message. t_exit_2_other(Config) when is_list(Config) -> @@ -1227,17 +1252,6 @@ otp_6237_select_loop() -> otp_6237_select_loop(). -processes_bif(doc) -> - []; -processes_bif(suite) -> - [processes_large_tab, - processes_default_tab, - processes_small_tab, - processes_this_tab, - processes_last_call_trap, - processes_apply_trap, - processes_gc_trap, - processes_term_proc_list]. -define(NoTestProcs, 10000). -record(processes_bif_info, {min_start_reds, @@ -1965,10 +1979,6 @@ processes_term_proc_list_test(MustChk) -> ?line erlang:system_flag(multi_scheduling, unblock), ?line as_expected. -otp_7738(doc) -> - []; -otp_7738(suite) -> - [otp_7738_waiting, otp_7738_suspended, otp_7738_resume]. otp_7738_waiting(doc) -> []; diff --git a/erts/emulator/test/pseudoknot_SUITE.erl b/erts/emulator/test/pseudoknot_SUITE.erl index 907204cf93..5a7cdcecd5 100644 --- a/erts/emulator/test/pseudoknot_SUITE.erl +++ b/erts/emulator/test/pseudoknot_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. 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 @@ -19,9 +19,29 @@ -module(pseudoknot_SUITE). --export([all/1,test/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2,test/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [test]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> [test]. test(Config) when is_list(Config) -> statistics(runtime), @@ -3274,13 +3294,13 @@ most_distant_atom(Sols) -> maximum(map(sol_most_distant_atom, Sols)). maximum([H|T]) -> - max(T,H). + max1(T,H). -max([H|T],M) when is_float(H), is_float(M), H > M -> - max(T,H); -max([_|T],M) -> - max(T,M); -max([],M) -> M. +max1([H|T],M) when is_float(H), is_float(M), H > M -> + max1(T,H); +max1([_|T],M) -> + max1(T,M); +max1([],M) -> M. map(_Func,[]) -> []; map(Func,[H|T]) -> diff --git a/erts/emulator/test/random_iolist.erl b/erts/emulator/test/random_iolist.erl index 4bce347d9a..8f21b5a3b3 100644 --- a/erts/emulator/test/random_iolist.erl +++ b/erts/emulator/test/random_iolist.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2010. 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 diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl index 40ebf2bd21..b070e2b986 100644 --- a/erts/emulator/test/receive_SUITE.erl +++ b/erts/emulator/test/receive_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2010-2011. 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 @@ -21,21 +21,40 @@ %% Tests receive after. --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, call_with_huge_message_queue/1,receive_in_between/1]). --export([init_per_testcase/2,fin_per_testcase/2]). +-export([init_per_testcase/2,end_per_testcase/2]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [call_with_huge_message_queue, receive_in_between]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. -all(suite) -> - [call_with_huge_message_queue,receive_in_between]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(3)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl index fa77095efd..e13dfa1575 100644 --- a/erts/emulator/test/ref_SUITE.erl +++ b/erts/emulator/test/ref_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -19,23 +19,44 @@ -module(ref_SUITE). --export([all/1,init_per_testcase/2,fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2]). -export([wrap_1/1]). -export([loop_ref/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). init_per_testcase(_, Config) -> ?line Dog=test_server:timetrap(test_server:minutes(2)), [{watchdog, Dog}|Config]. -fin_per_testcase(_, Config) -> +end_per_testcase(_, Config) -> Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. -all(suite) -> [wrap_1]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [wrap_1]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + wrap_1(doc) -> "Check that refs don't wrap around easily."; wrap_1(Config) when is_list(Config) -> diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl index c03ee23b2e..9953df3458 100644 --- a/erts/emulator/test/register_SUITE.erl +++ b/erts/emulator/test/register_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009. All Rights Reserved. +%% Copyright Ericsson AB 2010-2011. 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 @@ -22,24 +22,43 @@ %-define(line_trace, 1). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %-compile(export_all). --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2]). -export([otp_8099/1]). -define(DEFAULT_TIMEOUT, ?t:minutes(2)). -all(doc) -> []; -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [otp_8099]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + init_per_testcase(Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?DEFAULT_TIMEOUT), [{watchdog, Dog}, {testcase, Case} | Config]. -fin_per_testcase(_Case, Config) when is_list(Config) -> +end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index b56c4ad0b0..390b49b604 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -19,17 +19,36 @@ -module(save_calls_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). -export([save_calls_1/1,dont_break_reductions/1]). -export([do_bopp/1, do_bipp/0, do_bepp/0]). -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [save_calls_1, dont_break_reductions]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + dont_break_reductions(suite) -> []; dont_break_reductions(doc) -> diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 06442bfad6..f16d0ea429 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -30,10 +30,12 @@ %-define(line_trace, 1). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %-compile(export_all). --export([all/1, init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2, end_per_suite/1]). -export([equal/1, few_low/1, @@ -44,7 +46,7 @@ equal_with_high/1, equal_with_high_max/1, bound_process/1, - scheduler_bind/1, + scheduler_bind_types/1, cpu_topology/1, update_cpu_info/1, @@ -57,21 +59,35 @@ -define(MIN_SCHEDULER_TEST_TIMEOUT, ?t:minutes(1)). -all(doc) -> []; -all(suite) -> - [equal, - few_low, - many_low, - equal_with_part_time_high, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [equal, few_low, many_low, equal_with_part_time_high, equal_with_part_time_max, - equal_and_high_with_part_time_max, - equal_with_high, - equal_with_high_max, - bound_process, - scheduler_bind, - scheduler_suspend, + equal_and_high_with_part_time_max, equal_with_high, + equal_with_high_max, bound_process, + {group, scheduler_bind}, scheduler_suspend, reader_groups]. +groups() -> + [{scheduler_bind, [], + [scheduler_bind_types, cpu_topology, update_cpu_info, + sct_cmd, sbt_cmd]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), + Config. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + init_per_testcase(Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?DEFAULT_TIMEOUT), process_flag(priority, max), @@ -79,15 +95,11 @@ init_per_testcase(Case, Config) when is_list(Config) -> OkRes = ok, [{watchdog, Dog}, {testcase, Case}, {ok_res, OkRes} |Config]. -fin_per_testcase(_Case, Config) when is_list(Config) -> +end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. -end_per_suite(Config) -> - catch erts_debug:set_internal_state(available_internal_state, false), - Config. - -define(ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED, (2000*2000)). -define(DEFAULT_TEST_REDS_PER_SCHED, 200000000). @@ -247,12 +259,6 @@ bound_loop(NS, N, M, Sched) -> Sched = erlang:system_info(scheduler_id), bound_loop(NS, N-1, M, Sched). -scheduler_bind(suite) -> - [scheduler_bind_types, - cpu_topology, - update_cpu_info, - sct_cmd, - sbt_cmd]. -define(TOPOLOGY_A_CMD, "+sct" @@ -856,9 +862,9 @@ get_affinity_mask(Port, Status, Affinity) when Status == unknown; {Port,{exit_status,S}} -> get_affinity_mask(Port, S, Affinity) end; -get_affinity_mask(Port, Status, bad) -> +get_affinity_mask(_Port, _Status, bad) -> unknown; -get_affinity_mask(Port, Status, Affinity) -> +get_affinity_mask(_Port, _Status, Affinity) -> Affinity. get_affinity_mask() -> @@ -1383,67 +1389,6 @@ reader_groups_map(CPUT, Groups) -> %% Utils %% -tilera_cpu_topology() -> - [{processor,[{node,[{core,{logical,0}}, - {core,{logical,1}}, - {core,{logical,2}}, - {core,{logical,8}}, - {core,{logical,9}}, - {core,{logical,10}}, - {core,{logical,11}}, - {core,{logical,16}}, - {core,{logical,17}}, - {core,{logical,18}}, - {core,{logical,19}}, - {core,{logical,24}}, - {core,{logical,25}}, - {core,{logical,27}}, - {core,{logical,29}}]}, - {node,[{core,{logical,3}}, - {core,{logical,4}}, - {core,{logical,5}}, - {core,{logical,6}}, - {core,{logical,7}}, - {core,{logical,12}}, - {core,{logical,13}}, - {core,{logical,14}}, - {core,{logical,15}}, - {core,{logical,20}}, - {core,{logical,21}}, - {core,{logical,22}}, - {core,{logical,23}}, - {core,{logical,28}}, - {core,{logical,30}}]}, - {node,[{core,{logical,31}}, - {core,{logical,36}}, - {core,{logical,37}}, - {core,{logical,38}}, - {core,{logical,44}}, - {core,{logical,45}}, - {core,{logical,46}}, - {core,{logical,47}}, - {core,{logical,51}}, - {core,{logical,52}}, - {core,{logical,53}}, - {core,{logical,54}}, - {core,{logical,55}}, - {core,{logical,60}}, - {core,{logical,61}}]}, - {node,[{core,{logical,26}}, - {core,{logical,32}}, - {core,{logical,33}}, - {core,{logical,34}}, - {core,{logical,35}}, - {core,{logical,39}}, - {core,{logical,40}}, - {core,{logical,41}}, - {core,{logical,42}}, - {core,{logical,43}}, - {core,{logical,48}}, - {core,{logical,49}}, - {core,{logical,50}}, - {core,{logical,58}}]}]}]. - l(Id) -> {logical, Id}. diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl index 819aa34886..6615873392 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. 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 @@ -19,24 +19,43 @@ -module(send_term_SUITE). --export([all/1,basic/1]). --export([init_per_testcase/2,fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2,basic/1]). +-export([init_per_testcase/2,end_per_testcase/2]). -export([generate_external_terms_files/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(3)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [basic]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + basic(Config) when is_list(Config) -> Drv = "send_term_drv", ?line P = start_driver(Config, Drv), diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl index 458275af81..634df367ca 100644 --- a/erts/emulator/test/sensitive_SUITE.erl +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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 @@ -19,9 +19,11 @@ -module(sensitive_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, stickiness/1,send_trace/1,recv_trace/1,proc_trace/1,call_trace/1, meta_trace/1,running_trace/1,gc_trace/1,seq_trace/1, t_process_info/1,t_process_display/1,save_calls/1]). @@ -34,14 +36,33 @@ init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(5)), [{watchdog,Dog}|Config]. -fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> +end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog). -all(suite) -> - [stickiness,send_trace,recv_trace,proc_trace,call_trace, - meta_trace,running_trace,gc_trace,seq_trace, - t_process_info,t_process_display,save_calls]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [stickiness, send_trace, recv_trace, proc_trace, + call_trace, meta_trace, running_trace, gc_trace, + seq_trace, t_process_info, t_process_display, + save_calls]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + stickiness(Config) when is_list(Config) -> ?line {Tracer,Mref} = spawn_monitor(fun() -> diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl index e9103ca3c1..736dfe5b56 100644 --- a/erts/emulator/test/signal_SUITE.erl +++ b/erts/emulator/test/signal_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2011. 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 @@ -30,8 +30,9 @@ -define(DEFAULT_TIMEOUT_SECONDS, 120). %-define(line_trace, 1). --include("test_server.hrl"). --export([all/1]). +-include_lib("test_server/include/test_server.hrl"). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). % Test cases -export([xm_sig_order/1, @@ -49,38 +50,48 @@ pending_exit_group_leader/1, exit_before_pending_exit/1]). --export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> ?line Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMEOUT_SECONDS)), available_internal_state(true), ?line [{testcase, Func},{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> ?line Dog = ?config(watchdog, Config), ?line ?t:timetrap_cancel(Dog). +init_per_suite(Config) -> + Config. + end_per_suite(_Config) -> available_internal_state(true), - erts_debug:set_internal_state(not_running_optimization, true), + catch erts_debug:set_internal_state(not_running_optimization, true), available_internal_state(false). -all(suite) -> - [xm_sig_order, - pending_exit_unlink_process, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [xm_sig_order, pending_exit_unlink_process, pending_exit_unlink_dist_process, - pending_exit_unlink_port, - pending_exit_trap_exit, - pending_exit_receive, - pending_exit_trap_exit, - pending_exit_gc, - pending_exit_is_process_alive, + pending_exit_unlink_port, pending_exit_trap_exit, + pending_exit_receive, pending_exit_trap_exit, + pending_exit_gc, pending_exit_is_process_alive, pending_exit_process_display, pending_exit_process_info_1, - pending_exit_process_info_2, - pending_exit_group_leader, + pending_exit_process_info_2, pending_exit_group_leader, exit_before_pending_exit]. +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + xm_sig_order(doc) -> ["Test that exit signals and messages are received " "in correct order"]; xm_sig_order(suite) -> []; diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index 898908c40f..0392312a6f 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -21,13 +21,14 @@ %% Tests the statistics/1 bif. --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, init_per_testcase/2, - fin_per_testcase/2, - wall_clock/1, wall_clock_zero_diff/1, wall_clock_update/1, - runtime/1, runtime_zero_diff/1, + end_per_testcase/2, + wall_clock_zero_diff/1, wall_clock_update/1, + runtime_zero_diff/1, runtime_update/1, runtime_diff/1, - run_queue/1, run_queue_one/1, + run_queue_one/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, badarg/1]). @@ -35,24 +36,47 @@ -export([hog/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). init_per_testcase(_, Config) -> ?line Dog = test_server:timetrap(test_server:seconds(300)), [{watchdog, Dog}|Config]. -fin_per_testcase(_, Config) -> +end_per_testcase(_, Config) -> Dog = ?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. -all(suite) -> [wall_clock, runtime, reductions, reductions_big, run_queue, - garbage_collection, io, badarg]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group, wall_clock}, {group, runtime}, reductions, + reductions_big, {group, run_queue}, garbage_collection, + io, badarg]. + +groups() -> + [{wall_clock, [], + [wall_clock_zero_diff, wall_clock_update]}, + {runtime, [], + [runtime_zero_diff, runtime_update, runtime_diff]}, + {run_queue, [], [run_queue_one]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + %%% Testing statistics(wall_clock). -wall_clock(suite) -> [wall_clock_zero_diff, wall_clock_update]. wall_clock_zero_diff(doc) -> @@ -99,7 +123,6 @@ wall_clock_update1(0) -> %%% Test statistics(runtime). -runtime(suite) -> [runtime_zero_diff, runtime_update, runtime_diff]. runtime_zero_diff(doc) -> "Tests that the difference between the times returned from two consectuitive " @@ -225,7 +248,6 @@ reductions_big_loop() -> %%% Tests of statistics(run_queue). -run_queue(suite) -> [run_queue_one]. run_queue_one(doc) -> "Tests that statistics(run_queue) returns 1 if we start a " diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl index cd940f3ddf..9b782b35a2 100644 --- a/erts/emulator/test/system_info_SUITE.erl +++ b/erts/emulator/test/system_info_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. 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 @@ -30,23 +30,44 @@ %-define(line_trace, 1). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %-compile(export_all). --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2]). -export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1]). -define(DEFAULT_TIMEOUT, ?t:minutes(2)). -all(doc) -> []; -all(suite) -> [process_count, system_version, misc_smoke_tests, heap_size, wordsize]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [process_count, system_version, misc_smoke_tests, + heap_size, wordsize]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?DEFAULT_TIMEOUT), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) when is_list(Config) -> +end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index 7b0d6d19fe..32089e8872 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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 @@ -22,35 +22,52 @@ -module(system_profile_SUITE). --export([all/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, system_profile_on_and_off/1, runnable_procs/1, runnable_ports/1, scheduler/1 ]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([init_per_testcase/2, end_per_testcase/2]). --export([profiler_process/1, ring_loop/1, port_echo_start/0, list_load/0, run_load/2]). +-export([profiler_process/1, ring_loop/1, port_echo_start/0, + list_load/0, run_load/2]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -define(default_timeout, ?t:minutes(1)). init_per_testcase(_Case, Config) -> ?line Dog=?t:timetrap(?default_timeout), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. -all(suite) -> - %% Test specification on test suite level - [system_profile_on_and_off, - runnable_procs, - runnable_ports, - scheduler]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [system_profile_on_and_off, runnable_procs, + runnable_ports, scheduler]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + %% No specification clause needed for an init function in a conf case!!! diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 095e9dd1af..bd48a0a7db 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -29,14 +29,15 @@ %% now/0 %% --export([all/1, univ_to_local/1, local_to_univ/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, univ_to_local/1, local_to_univ/1, bad_univ_to_local/1, bad_local_to_univ/1, consistency/1, - now/1, now_unique/1, now_update/1, timestamp/1]). + now_unique/1, now_update/1, timestamp/1]). -export([local_to_univ_utc/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -export([linear_time/1]). @@ -54,10 +55,28 @@ -define(dst_timezone, 2). -all(suite) -> [univ_to_local, local_to_univ, - local_to_univ_utc, - bad_univ_to_local, bad_local_to_univ, - consistency, now, timestamp]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [univ_to_local, local_to_univ, local_to_univ_utc, + bad_univ_to_local, bad_local_to_univ, consistency, + {group, now}, timestamp]. + +groups() -> + [{now, [], [now_unique, now_update]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + local_to_univ_utc(suite) -> []; @@ -283,7 +302,6 @@ repeating_timestamp_check(N) -> %% Test now/0. -now(suite) -> [now_unique, now_update]. %% Tests that successive calls to now/0 returns different values. %% Also returns a comment string with the median difference between diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index 9ac5afcc45..7ff7449ff5 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. 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 @@ -19,7 +19,9 @@ -module(timer_bif_SUITE). --export([all/1,init_per_testcase/2,fin_per_testcase/2,end_per_suite/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2]). -export([start_timer_1/1, send_after_1/1, send_after_2/1, send_after_3/1, cancel_timer_1/1, start_timer_big/1, send_after_big/1, @@ -27,7 +29,7 @@ read_timer_trivial/1, read_timer/1, cleanup/1, evil_timers/1, registered_process/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(test_server:seconds(30)), @@ -37,19 +39,35 @@ init_per_testcase(_Case, Config) -> end, [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. +init_per_suite(Config) -> + Config. + end_per_suite(_Config) -> catch erts_debug:set_internal_state(available_internal_state, false). -all(suite) -> - [start_timer_1, send_after_1, send_after_2, cancel_timer_1, - start_timer_e, send_after_e, cancel_timer_e, - start_timer_big, send_after_big, read_timer_trivial, read_timer, - cleanup, evil_timers, registered_process]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [start_timer_1, send_after_1, send_after_2, + cancel_timer_1, start_timer_e, send_after_e, + cancel_timer_e, start_timer_big, send_after_big, + read_timer_trivial, read_timer, cleanup, evil_timers, + registered_process]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + start_timer_1(doc) -> ["Basic start_timer/3 functionality"]; start_timer_1(Config) when is_list(Config) -> diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index e9713fcf0f..221b65309a 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -23,7 +23,8 @@ %%% Tests the trace BIF. %%% --export([all/1, receive_trace/1, self_send/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, receive_trace/1, self_send/1, timeout_trace/1, send_trace/1, procs_trace/1, dist_procs_trace/1, suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1, @@ -35,22 +36,39 @@ system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, bad_flag/1, trace_delivered/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %%% Internal exports -export([process/1]). -all(suite) -> - [cpu_timestamp, receive_trace, self_send, timeout_trace, send_trace, - procs_trace, dist_procs_trace, - suspend, mutual_suspend, suspend_exit, suspender_exit, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [cpu_timestamp, receive_trace, self_send, timeout_trace, + send_trace, procs_trace, dist_procs_trace, suspend, + mutual_suspend, suspend_exit, suspender_exit, suspend_system_limit, suspend_opts, suspend_waiting, - new_clear, existing_clear, - set_on_spawn, set_on_first_spawn, - system_monitor_args, more_system_monitor_args, - system_monitor_long_gc_1, system_monitor_long_gc_2, - system_monitor_large_heap_1, system_monitor_large_heap_2, - bad_flag, trace_delivered]. + new_clear, existing_clear, set_on_spawn, + set_on_first_spawn, system_monitor_args, + more_system_monitor_args, system_monitor_long_gc_1, + system_monitor_long_gc_2, system_monitor_large_heap_1, + system_monitor_large_heap_2, bad_flag, trace_delivered]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + %% No longer testing anything, just reporting whether cpu_timestamp diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index 3f91f8dc08..2c78aa394f 100644 --- a/erts/emulator/test/trace_bif_SUITE.erl +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. 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 @@ -19,24 +19,44 @@ -module(trace_bif_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1]). --export([trace_bif/1, trace_bif_timestamp/1, trace_on_and_off/1, trace_bif_local/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). +-export([trace_bif/1, trace_bif_timestamp/1, trace_on_and_off/1, + trace_bif_local/1, trace_bif_timestamp_local/1, trace_bif_return/1, not_run/1, trace_info_old_code/1]). -export([bif_process/0]). -all(suite) -> - case test_server:is_native(?MODULE) of +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + case test_server:is_native(trace_bif_SUITE) of true -> [not_run]; false -> [trace_bif, trace_bif_timestamp, trace_on_and_off, - trace_bif_local, trace_bif_timestamp_local, + trace_bif_local, trace_bif_timestamp_local, trace_bif_return, trace_info_old_code] end. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + not_run(Config) when is_list(Config) -> {skipped,"Native code"}. diff --git a/erts/emulator/test/trace_call_count_SUITE.erl b/erts/emulator/test/trace_call_count_SUITE.erl index 07aa7c8d8d..2ac58493ff 100644 --- a/erts/emulator/test/trace_call_count_SUITE.erl +++ b/erts/emulator/test/trace_call_count_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. 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 @@ -42,7 +42,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -endif. -ifdef(debug). @@ -62,7 +62,9 @@ config(priv_dir,_) -> ".". -else. %% When run in test server. --export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2, not_run/1]). -export([basic/1, on_and_off/1, info/1, pause_and_restart/1, combo/1]). @@ -70,7 +72,7 @@ init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(test_server:seconds(30)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]), erlang:trace_pattern(on_load, false, [local,meta,call_count]), erlang:trace(all, false, [all]), @@ -78,15 +80,31 @@ fin_per_testcase(_Case, Config) -> test_server:timetrap_cancel(Dog), ok. -all(doc) -> - ["Test call count tracing of local function calls."]; -all(suite) -> - case test_server:is_native(?MODULE) of +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + case test_server:is_native(trace_call_count_SUITE) of true -> [not_run]; - false -> [basic, on_and_off, info, - pause_and_restart, combo] + false -> + [basic, on_and_off, info, pause_and_restart, combo] end. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + not_run(Config) when is_list(Config) -> {skipped,"Native code"}. diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl index 7bc91addde..5dfa87bbee 100644 --- a/erts/emulator/test/trace_call_time_SUITE.erl +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2011. 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 @@ -57,12 +57,15 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %% When run in test server. --export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2, not_run/1]). -export([basic/1, on_and_off/1, info/1, - pause_and_restart/1, scheduling/1, called_function/1, combo/1, bif/1, nif/1]). + pause_and_restart/1, scheduling/1, called_function/1, combo/1, + bif/1, nif/1]). init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(test_server:seconds(400)), @@ -71,7 +74,7 @@ init_per_testcase(_Case, Config) -> timer:now_diff(now(),now()), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]), erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]), erlang:trace(all, false, [all]), @@ -79,15 +82,32 @@ fin_per_testcase(_Case, Config) -> test_server:timetrap_cancel(Dog), ok. -all(doc) -> - ["Test call count tracing of local function calls."]; -all(suite) -> - case test_server:is_native(?MODULE) of +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + case test_server:is_native(trace_call_time_SUITE) of true -> [not_run]; - false -> [basic, on_and_off, info, - pause_and_restart, scheduling, combo, bif, nif, called_function] + false -> + [basic, on_and_off, info, pause_and_restart, scheduling, + combo, bif, nif, called_function] end. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + not_run(Config) when is_list(Config) -> {skipped,"Native code"}. @@ -407,7 +427,7 @@ nif(Config) when is_list(Config) -> ?line 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]), ?line 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]), ?line Pid = setup(), - ?line {L, T1} = execute(Pid, fun() -> with_nif(M) end), + ?line {_, T1} = execute(Pid, fun() -> with_nif(M) end), % the nif is called M - 1 times, the last time the function with 'with_nif' % returns ok and does not call the nif. @@ -486,7 +506,7 @@ with_nif(N) -> with_nif(?MODULE:nif_dec(N)). -nif_dec(N) -> 0. +nif_dec(_) -> 0. dec(N) -> loaded(10000), diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index 24005774ba..091e960610 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2011. 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 @@ -45,7 +45,7 @@ -export([config/2]). -define(DEFAULT_RECEIVE_TIMEOUT, 1000). -else. --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -define(DEFAULT_RECEIVE_TIMEOUT, infinity). -endif. @@ -68,7 +68,8 @@ config(priv_dir,_) -> %%% When run in test server %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([all/1, basic/1, bit_syntax/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, basic/1, bit_syntax/1, return/1, on_and_off/1, stack_grow/1,info/1, delete/1, exception/1, exception_apply/1, exception_function/1, exception_apply_function/1, @@ -79,34 +80,51 @@ config(priv_dir,_) -> exception_meta_nocatch/1, exception_meta_nocatch_apply/1, exception_meta_nocatch_function/1, exception_meta_nocatch_apply_function/1, - init_per_testcase/2, fin_per_testcase/2]). + init_per_testcase/2, end_per_testcase/2]). init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(test_server:minutes(2)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> shutdown(), Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. -all(doc) -> - ["Test tracing of local function calls and return traces."]; -all(suite) -> - case test_server:is_native(?MODULE) of +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + case test_server:is_native(trace_local_SUITE) of true -> [not_run]; - false -> [basic, bit_syntax, return, on_and_off, stack_grow, info, delete, - exception, exception_apply, - exception_function, exception_apply_function, - exception_nocatch, exception_nocatch_apply, - exception_nocatch_function, - exception_nocatch_apply_function, - exception_meta, exception_meta_apply, - exception_meta_function, exception_meta_apply_function, - exception_meta_nocatch, exception_meta_nocatch_apply, - exception_meta_nocatch_function, - exception_meta_nocatch_apply_function] + false -> + [basic, bit_syntax, return, on_and_off, stack_grow, + info, delete, exception, exception_apply, + exception_function, exception_apply_function, + exception_nocatch, exception_nocatch_apply, + exception_nocatch_function, + exception_nocatch_apply_function, exception_meta, + exception_meta_apply, exception_meta_function, + exception_meta_apply_function, exception_meta_nocatch, + exception_meta_nocatch_apply, + exception_meta_nocatch_function, + exception_meta_nocatch_apply_function] end. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + not_run(Config) when is_list(Config) -> {skipped,"Native code"}. @@ -796,9 +814,6 @@ loop(D1,D2,D3,0) -> loop(D1,D2,D3,N) -> max(N,loop(D1,D2,D3,N-1)). -max(A, B) when A > B -> A; -max(_, B) -> B. - exported_wrap(Val) -> exported(Val). diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl index d84cb3cdf2..45987cc319 100644 --- a/erts/emulator/test/trace_meta_SUITE.erl +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. 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 @@ -45,7 +45,7 @@ -define(config(A,B),config(A,B)). -export([config/2]). -else. --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -endif. -ifdef(debug). @@ -65,7 +65,9 @@ config(priv_dir,_) -> ".". -else. %% When run in test server. --export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2, not_run/1]). -export([basic/1, return/1, on_and_off/1, stack_grow/1, info/1, tracer/1, combo/1, nosilent/1]). @@ -73,19 +75,36 @@ init_per_testcase(_Case, Config) -> ?line Dog=test_server:timetrap(test_server:minutes(5)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> shutdown(), Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), ok. -all(doc) -> - ["Test meta tracing of local function calls and return trace."]; -all(suite) -> - case test_server:is_native(?MODULE) of - true -> [not_run]; - false -> [basic, return, on_and_off, stack_grow, - info, tracer, combo, nosilent] - end. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> +case test_server:is_native(trace_meta_SUITE) of + true -> [not_run]; + false -> + [basic, return, on_and_off, stack_grow, info, tracer, + combo, nosilent] +end. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + not_run(Config) when is_list(Config) -> {skipped,"Native code"}. @@ -594,11 +613,6 @@ loop(D1,D2,D3,0) -> loop(D1,D2,D3,N) -> max(N,loop(D1,D2,D3,N-1)). -max(A,B) when A > B -> - A; -max(_A,B) -> - B. - id(X) -> X. diff --git a/erts/emulator/test/trace_nif_SUITE.erl b/erts/emulator/test/trace_nif_SUITE.erl index 587cc08979..a7484a22fd 100644 --- a/erts/emulator/test/trace_nif_SUITE.erl +++ b/erts/emulator/test/trace_nif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009. All Rights Reserved. +%% Copyright Ericsson AB 2010-2011. 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 @@ -19,9 +19,10 @@ -module(trace_nif_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). --export([all/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). -export([trace_nif/1, trace_nif_timestamp/1, trace_nif_local/1, @@ -32,19 +33,33 @@ -export([nif_process/0, nif/0, nif/1]). -all(suite) -> - case test_server:is_native(?MODULE) of +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + case test_server:is_native(trace_nif_SUITE) of true -> [not_run]; false -> - [trace_nif, - trace_nif_timestamp, - trace_nif_local, - trace_nif_meta, - trace_nif_timestamp_local, - trace_nif_return - ] + [trace_nif, trace_nif_timestamp, trace_nif_local, + trace_nif_meta, trace_nif_timestamp_local, + trace_nif_return] end. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + not_run(Config) when is_list(Config) -> {skipped,"Native code"}. diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl index 5febe177f9..0026da4979 100644 --- a/erts/emulator/test/trace_port_SUITE.erl +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. 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 @@ -20,7 +20,9 @@ -module(trace_port_SUITE). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, call_trace/1, return_trace/1, send/1, @@ -34,29 +36,42 @@ gc/1, default_tracer/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -test_cases() -> - [call_trace, - return_trace, - send, - receive_trace, - process_events, - schedule, - fake_schedule, +test_cases() -> + [call_trace, return_trace, send, receive_trace, + process_events, schedule, fake_schedule, fake_schedule_after_register, fake_schedule_after_getting_linked, - fake_schedule_after_getting_unlinked, - gc, + fake_schedule_after_getting_unlinked, gc, default_tracer]. -all(suite) -> test_cases(). +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_cases(). + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:seconds(30)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog). diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl index c4edb16d68..bfc3910742 100644 --- a/erts/emulator/test/tuple_SUITE.erl +++ b/erts/emulator/test/tuple_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -17,11 +17,13 @@ %% %CopyrightEnd% %% -module(tuple_SUITE). --export([all/1, t_size/1, t_tuple_size/1, t_element/1, t_setelement/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + t_size/1, t_tuple_size/1, t_element/1, t_setelement/1, t_list_to_tuple/1, t_tuple_to_list/1, t_make_tuple_2/1, t_make_tuple_3/1, t_append_element/1, build_and_match/1, tuple_with_case/1, tuple_in_guard/1]). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %% Tests tuples and the BIFs: %% @@ -33,13 +35,30 @@ %% make_tuple/2 %% -all(suite) -> - [build_and_match, t_size, t_tuple_size, - t_list_to_tuple, t_tuple_to_list, - t_element, t_setelement, t_make_tuple_2, - t_make_tuple_3, t_append_element, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [build_and_match, t_size, t_tuple_size, t_list_to_tuple, + t_tuple_to_list, t_element, t_setelement, + t_make_tuple_2, t_make_tuple_3, t_append_element, tuple_with_case, tuple_in_guard]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + build_and_match(Config) when is_list(Config) -> ?line {} = id({}), ?line {1} = id({1}), @@ -80,7 +99,7 @@ t_tuple_size(Config) when is_list(Config) -> ludicrous_tuple_size(T) when tuple_size(T) =:= 16#7777777777777777777777777777777777 -> ok; -ludicrous_tuple_size(T) -> error. +ludicrous_tuple_size(_) -> error. %% Tests element/2. diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index 67d2b288a2..4b3075a164 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2011. 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 @@ -29,10 +29,12 @@ %-define(line_trace, 1). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). %-compile(export_all). --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, init_per_testcase/2, + end_per_testcase/2]). -export([schedulers_alive/1, node_container_refc_check/1, long_timers/1, pollset_size/1, @@ -40,19 +42,33 @@ -define(DEFAULT_TIMEOUT, ?t:minutes(5)). -all(doc) -> []; -all(suite) -> - [schedulers_alive, - node_container_refc_check, - long_timers, - pollset_size, - check_io_debug]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [schedulers_alive, node_container_refc_check, + long_timers, pollset_size, check_io_debug]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?DEFAULT_TIMEOUT), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) when is_list(Config) -> +end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index de19a2e35b..e7c57142c0 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -27,6 +27,7 @@ my $outdir = "."; # Directory for output files. my $verbose = 0; my $hot = 1; my $num_file_opcodes = 0; +my $wordsize = 32; # This is shift counts and mask for the packer. my $WHOLE_WORD = ''; @@ -36,12 +37,20 @@ my @pack_mask; $pack_instr[2] = ['6', 'i']; $pack_instr[3] = ['0', '0', 'i']; +$pack_instr[4] = ['6', '6', '6', 'i']; # Only for 64 bit wordsize $pack_shift[2] = ['0', 'BEAM_LOOSE_SHIFT']; $pack_shift[3] = ['0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)']; +$pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize + '(2*BEAM_LOOSE_SHIFT)', + '(3*BEAM_LOOSE_SHIFT)']; $pack_mask[2] = ['BEAM_LOOSE_MASK', $WHOLE_WORD]; $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK']; +$pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize + 'BEAM_LOOSE_MASK', + 'BEAM_LOOSE_MASK', + $WHOLE_WORD]; # There are two types of instructions: generic and specific. # The generic instructions are those generated by the Beam compiler. @@ -80,6 +89,8 @@ my %cold_code; my @unnumbered_generic; my %unnumbered; +my %is_transformed; + # # Code transformations. # @@ -118,7 +129,8 @@ my %arg_size = ('r' => 0, # x(0) - x register zero 't' => 1, # untagged integer -- can be packed 'b' => 1, # pointer to bif 'A' => 1, # arity value - 'P' => 1, # byte offset into tuple + 'P' => 1, # byte offset into tuple or stack + 'Q' => 1, # like 'P', but packable 'h' => 1, # character 'l' => 1, # float reg 'q' => 1, # literal term @@ -157,6 +169,7 @@ my @tag_type; $type_bit{'U'} = $type_bit{'u'}; $type_bit{'e'} = $type_bit{'u'}; $type_bit{'P'} = $type_bit{'u'}; + $type_bit{'Q'} = $type_bit{'u'}; } # @@ -169,6 +182,7 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) { ($target = \&emulator_output), next if /^emulator/; ($target = \&compiler_output), next if /^compiler/; ($outdir = shift), next if /^outdir/; + ($wordsize = shift), next if /^wordsize/; ($verbose = 1), next if /^v/; die "$0: Bad option: -$_\n"; } @@ -474,8 +488,9 @@ sub emulator_output { $gen_transform_offset{$key} : -1; my($spec_op) = $gen_to_spec{$key}; my($num_specific) = $num_specific{$key}; - defined $spec_op or $tr != -1 or + defined $spec_op or $obsolete[$gen_opnum{$name,$arity}] or + $is_transformed{$name,$arity} or error("instruction $key has no specific instruction"); $spec_op = -1 unless defined $spec_op; &init_item($name, $arity, $spec_op, $num_specific, $tr, $min_window{$key}); @@ -498,12 +513,14 @@ sub emulator_output { print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n"; print "\n"; print "#ifdef ARCH_64\n"; + print "# define BEAM_WIDE_MASK 0xFFFFUL\n"; print "# define BEAM_LOOSE_MASK 0x1FFFUL\n"; print "#if HALFWORD_HEAP\n"; print "# define BEAM_TIGHT_MASK 0x1FFCUL\n"; print "#else\n"; print "# define BEAM_TIGHT_MASK 0x1FF8UL\n"; print "#endif\n"; + print "# define BEAM_WIDE_SHIFT 32\n"; print "# define BEAM_LOOSE_SHIFT 16\n"; print "# define BEAM_TIGHT_SHIFT 16\n"; print "#else\n"; @@ -796,6 +813,7 @@ sub basic_generator { 'I' => 1, 't' => 1, 'P' => 1, + 'Q' => 1, ); # Pick up the macro to use and its flags (if any). @@ -916,7 +934,18 @@ sub basic_generator { $var_decls .= "BeamInstr tmp_packed2;" if $macro_code =~ /tmp_packed2/; if ($flags =~ /-nonext/) { - $code = "$macro_code\n"; + $code = join("\n", + "{ $var_decls", + $macro_code, + "}"); + } elsif ($flags =~ /-goto:(\S*)/) { + my $goto = $1; + $code = join("\n", + "{ $var_decls", + $macro_code, + "I += $size + 1;", + "goto $goto;", + "}"); } else { $code = join("\n", "{ $var_decls", @@ -935,18 +964,31 @@ sub basic_generator { sub do_pack { my(@args) = @_; - my($i); my($packable_args) = 0; + my @is_packable; # Packability (boolean) for each argument. + my $wide_packing = 0; # # Count the number of packable arguments. If we encounter any 's' or 'd' # arguments, packing is not possible. # - for ($i = 0; $i < @args; $i++) { - if ($args[$i] =~ /[xyt]/) { + my $packable_types = "xytQ"; + foreach my $arg (@args) { + if ($arg =~ /^[$packable_types]/) { $packable_args++; - } elsif ($args[$i] =~ /[sd]/) { + push @is_packable, 1; + } elsif ($arg =~ /^I/ and $wordsize == 64 and $packable_args < 2) { + $wide_packing = 1; + push @is_packable, 1; + if (++$packable_args == 2) { + # We can only pack two arguments. Turn off packing + # for the rest of the arguments. + $packable_types = "\xFF"; + } + } elsif ($arg =~ /^[sd]/) { return ('', '', @args); + } else { + push @is_packable, 0; } } @@ -962,10 +1004,27 @@ sub do_pack { # beginning). my($up) = ''; # Pack commands (storing back while # moving forward). - my($args_per_word) = $packable_args < 4 ? $packable_args : 2; - my(@shift) = @{$pack_shift[$args_per_word]}; - my(@mask) = @{$pack_mask[$args_per_word]}; - my(@pack_instr) = @{$pack_instr[$args_per_word]}; + my $args_per_word; + if ($packable_args < 4 or $wordsize == 64) { + $args_per_word = $packable_args; + } else { + # 4 packable argument, 32 bit wordsize. Need 2 words. + $args_per_word = 2; + } + + my @shift; + my @mask; + my @instr; + + if ($wide_packing) { + @shift = ('0', 'BEAM_WIDE_SHIFT'); + @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD); + @instr = ('w', 'i'); + } else { + @shift = @{$pack_shift[$args_per_word]}; + @mask = @{$pack_mask[$args_per_word]}; + @instr = @{$pack_instr[$args_per_word]}; + } # # Now generate the packing instructions. One complication is that @@ -979,10 +1038,10 @@ sub do_pack { my($ap) = 0; # Argument number within word. my($tmpnum) = 1; # Number of temporary variable. my($expr) = ''; - for ($i = 0; $i < @args; $i++) { + for (my $i = 0; $i < @args; $i++) { my($reg) = $args[$i]; my($this_size) = $arg_size{$reg}; - if ($reg =~ /[xyt]/) { + if ($is_packable[$i]) { $this_size = 0; $did_some_packing = 1; @@ -993,7 +1052,7 @@ sub do_pack { $this_size = 1; } - $down = "$pack_instr[$ap]$down"; + $down = "$instr[$ap]$down"; my($unpack) = &make_unpack($tmpnum, $shift[$ap], $mask[$ap]); $args[$i] = "pack:$this_size:$reg" . "b($unpack)"; @@ -1103,6 +1162,10 @@ sub compile_transform { if ($obsolete[$gen_opnum{$name,$arity}]) { error("obsolete function must not be used in transformations"); } + + if ($src) { + $is_transformed{$name,$arity} = 1; + } [$name,$arity,@ops]; } @@ -1291,13 +1354,28 @@ sub tr_gen_from { my($var, $type, $type_val, $cond, $val) = @$op; if ($type ne '' && $type ne '*') { - my($types) = ''; - my($type_mask) = 0; - foreach (split('', $type)) { - $types .= "$_ "; - $type_mask |= $type_bit{$_}; + # + # The is_bif, is_not_bif, and is_func instructions have + # their own built-in type test and don't need to + # be guarded with a type test instruction. + # + unless ($cond eq 'is_bif' or + $cond eq 'is_not_bif' or + $cond eq 'is_func') { + my($types) = ''; + my($type_mask) = 0; + foreach (split('', $type)) { + $types .= "$_ "; + $type_mask |= $type_bit{$_}; + } + if ($cond ne 'is_eq') { + push(@code, &make_op($types, 'is_type', $type_mask)); + } else { + $cond = ''; + push(@code, &make_op($types, 'is_type_eq', + $type_mask, $val)); + } } - push(@code, &make_op($types, 'is_type', $type_mask)); } if ($cond eq 'is_func') { diff --git a/erts/emulator/utils/count b/erts/emulator/utils/count new file mode 100755 index 0000000000..617f5c25e8 --- /dev/null +++ b/erts/emulator/utils/count @@ -0,0 +1,127 @@ +%% -*- erlang -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2010. 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% +%% + +-mode(compile). + +main(_) -> + DisDir = "./dis", + ok = filelib:ensure_dir(filename:join(DisDir, "dummy")), + io:format("Dissambling to ~s\n", [DisDir]), + ok = file:set_cwd(DisDir), + Path = code:get_path() -- ["."], + Beams0 = [filelib:wildcard(filename:join(Dir, "*.beam")) || + Dir <- Path], + Beams = lists:append(Beams0), + Mods0 = [list_to_atom(filename:rootname(filename:basename(F))) || + F <- Beams], + Mods = lists:usort(Mods0), + start_sem(), + Ps = [begin + {_,Ref} = spawn_monitor(fun() -> count(M) end), + Ref + end || M <- Mods], + [put(list_to_atom(I), 0) || I <- erts_debug:instructions()], + Res = wait_for_all(Ps, 1), + OutFile = "count", + {ok,Out} = file:open(OutFile, [write]), + [io:format(Out, "~s ~p\n", [I,C]) || {I,C} <- Res], + ok = file:close(Out), + io:format("\nResult written to ~s\n", + [filename:join(DisDir, OutFile)]), + ok. + +wait_for_all([], _) -> + lists:reverse(lists:keysort(2, get())); +wait_for_all([_|_]=Ps, I) -> + receive + {'DOWN',Ref,process,_,Result} -> + io:format("\r~p", [I]), + [increment(Key, Count) || {Key,Count} <- Result], + wait_for_all(Ps -- [Ref], I+1) + end. + +count(M) -> + down(), + erts_debug:df(M), + {ok,Fd} = file:open(atom_to_list(M) ++ ".dis", [read,raw]), + count_is(Fd), + ok = file:close(Fd), + exit(get()). + +count_is(Fd) -> + case file:read_line(Fd) of + {ok,Line} -> + count_instr(Line), + count_is(Fd); + eof -> + ok + end. + +count_instr([$\s|T]) -> + count_instr_1(T, []); +count_instr([_|T]) -> + count_instr(T); +count_instr([]) -> + %% Empty line. + ok. + +count_instr_1([$\s|_], Acc) -> + Instr = list_to_atom(lists:reverse(Acc)), + increment(Instr, 1); +count_instr_1([H|T], Acc) -> + count_instr_1(T, [H|Acc]). + +increment(Key, Inc) -> + case get(Key) of + undefined -> + put(Key, Inc); + Count -> + put(Key, Count+Inc) + end. + +%%% +%%% Counting sempahore to limit the number of processes that +%%% can run concurrently. +%%% + +down() -> + sem ! {down,self()}, + receive + sem_taken -> ok + end. + +start_sem() -> + spawn(fun() -> + register(sem, self()), + process_flag(trap_exit, true), + do_sem(erlang:system_info(schedulers)+1) end). + +do_sem(0) -> + receive + {'EXIT',_,_} -> + do_sem(1) + end; +do_sem(C) -> + receive + {down,Pid} -> + link(Pid), + Pid ! sem_taken, + do_sem(C-1) + end. diff --git a/erts/emulator/utils/loaded b/erts/emulator/utils/loaded new file mode 100644 index 0000000000..d124a64a78 --- /dev/null +++ b/erts/emulator/utils/loaded @@ -0,0 +1,44 @@ +%% -*- erlang -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2011. 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% +%% + +%% Run like: +%% $ERL_TOP/bin/escript erts/emulator/utils/loaded + +-mode(compile). + +main(_) -> + LibDir = code:lib_dir(), + io:format("Library root is ~s\n", [LibDir]), + Wc = filename:join(LibDir, "*/ebin/*.beam"), + Beams = filelib:wildcard(Wc), + BeamFileSize = lists:sum([filelib:file_size(Beam) || Beam <- Beams]), + io:format("~w BEAM files containing ~w bytes\n", + [length(Beams),BeamFileSize]), + Ms = [list_to_atom(filename:rootname(filename:basename(Beam))) || + Beam <- Beams], + [{module,_} = code:ensure_loaded(M) || M <- Ms], + <<"Current code: ",T/binary>> = erlang:system_info(loaded), + Digits = grab_digits(T), + io:format("~w modules comprising ~s words when loaded\n", + [length(Ms),Digits]). + +grab_digits(<<H,T/binary>>) when $0 =< H, H =< $9 -> + [H|grab_digits(T)]; +grab_digits(<<$\n,_/binary>>) -> []. diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 65ff0cd6b2..e94533f0ba 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -433,7 +433,7 @@ static void usage(EpmdVars *g) fprintf(stderr, " List names registered with the currently " "running epmd\n"); fprintf(stderr, " -kill\n"); - fprintf(stderr, " Kill the currently runniing epmd\n"); + fprintf(stderr, " Kill the currently running epmd\n"); fprintf(stderr, " (only allowed if -names show empty database or\n"); fprintf(stderr, " -relaxed_command_check was given when epmd was started).\n"); fprintf(stderr, " -stop Name\n"); diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index ef471a473a..3499ab2934 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -2,7 +2,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2010. All Rights Reserved. + * Copyright Ericsson AB 1998-2011. 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 @@ -157,8 +157,10 @@ void run(EpmdVars *g) dbg_printf(g,2,"starting"); - listen(listensock, SOMAXCONN); - + if(listen(listensock, SOMAXCONN) < 0) { + dbg_perror(g,"failed to listen on socket"); + epmd_cleanup_exit(g,1); + } FD_ZERO(&g->orig_read_mask); FD_SET(listensock,&g->orig_read_mask); diff --git a/erts/epmd/test/Makefile b/erts/epmd/test/Makefile index 13dad09ae3..54688fd90b 100644 --- a/erts/epmd/test/Makefile +++ b/erts/epmd/test/Makefile @@ -74,7 +74,7 @@ release_tests_spec: opt $(INSTALL_DIR) $(RELEPMDDIR) $(INSTALL_DATA) epmd.spec epmd.spec.vxworks $(ERL_FILES) \ $(EMAKEFILE) $(RELEPMDDIR) - chmod -f -R u+w $(RELEPMDDIR) + chmod -R u+w $(RELEPMDDIR) release_docs_spec: diff --git a/erts/epmd/test/epmd.spec b/erts/epmd/test/epmd.spec index 0e2496bc72..e72272cf94 100644 --- a/erts/epmd/test/epmd.spec +++ b/erts/epmd/test/epmd.spec @@ -1 +1 @@ -{topcase, {dir, "../epmd_test"}}. +{suites,"../epmd_test",all}. diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl index da69412e12..72c890503d 100644 --- a/erts/epmd/test/epmd_SUITE.erl +++ b/erts/epmd/test/epmd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. 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 @@ -17,7 +17,7 @@ %% %CopyrightEnd% %% -module(epmd_SUITE). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -include_lib("kernel/include/file.hrl"). @@ -35,7 +35,9 @@ -record(node_info, {port, node_type, prot, lvsn, hvsn, node_name, extra}). % Test server specific exports --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2]). -export( [ @@ -64,7 +66,7 @@ returns_valid_empty_extra/1, returns_valid_populated_extra_with_nulls/1, - buffer_overrun/1, + buffer_overrun_1/1, buffer_overrun_2/1, no_nonlocal_register/1, @@ -101,42 +103,37 @@ %% all/1 %% -all(suite) -> - [ - register_name, - register_names_1, - register_names_2, - register_duplicate_name, - get_port_nr, - slow_get_port_nr, - unregister_others_name_1, - unregister_others_name_2, - register_overflow, - name_with_null_inside, - name_null_terminated, - stupid_names_req, - - no_data, - one_byte, - two_bytes, - partial_packet, - zero_length, - too_large, - alive_req_too_small_1, - alive_req_too_small_2, - alive_req_too_large, - - returns_valid_empty_extra, +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [register_name, register_names_1, register_names_2, + register_duplicate_name, get_port_nr, slow_get_port_nr, + unregister_others_name_1, unregister_others_name_2, + register_overflow, name_with_null_inside, + name_null_terminated, stupid_names_req, no_data, + one_byte, two_bytes, partial_packet, zero_length, + too_large, alive_req_too_small_1, alive_req_too_small_2, + alive_req_too_large, returns_valid_empty_extra, returns_valid_populated_extra_with_nulls, + {group, buffer_overrun}, no_nonlocal_register, + no_nonlocal_kill, no_live_killing]. + +groups() -> + [{buffer_overrun, [], + [buffer_overrun_1, buffer_overrun_2]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. - buffer_overrun, - %buffer_overrun_1, - %buffer_overrun_2, +end_per_group(_GroupName, Config) -> + Config. - no_nonlocal_register, - no_nonlocal_kill, - no_live_killing - ]. %% %% Run before and after each test case @@ -147,7 +144,7 @@ init_per_testcase(_Func, Config) -> cleanup(), [{watchdog, Dog} | Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> cleanup(), Dog = ?config(watchdog, Config), catch test_server:timetrap_cancel(Dog), % We may have canceled already @@ -725,8 +722,6 @@ returns_valid_populated_extra_with_nulls(Config) when is_list(Config) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -buffer_overrun(suite) -> - [buffer_overrun_1,buffer_overrun_2]. buffer_overrun_1(suite) -> []; diff --git a/erts/etc/common/dialyzer.c b/erts/etc/common/dialyzer.c index 4453e63f1c..04e9199ef3 100644 --- a/erts/etc/common/dialyzer.c +++ b/erts/etc/common/dialyzer.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2011. 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 diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c index cd137435d1..35c360a99d 100644 --- a/erts/etc/common/erlc.c +++ b/erts/etc/common/erlc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2010. All Rights Reserved. + * Copyright Ericsson AB 1997-2011. 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 @@ -28,6 +28,7 @@ #include <winbase.h> /* FIXE ME config_win32.h? */ #define HAVE_STRERROR 1 +#define snprintf _snprintf #endif #include <ctype.h> @@ -260,6 +261,95 @@ main(int argc, char** argv) case 'I': PUSH2("@i", process_opt(&argc, &argv, 0)); break; + case 'M': + { + char *buf, *key, *val; + size_t buf_len; + + if (argv[1][2] == '\0') { /* -M */ + /* Push the following options: + * o 'makedep' + * o {makedep_output, standard_io} + */ + buf = strsave("makedep"); + PUSH2("@option", buf); + + key = "makedep_output"; + val = "standard_io"; + buf_len = 1 + strlen(key) + 1 + strlen(val) + 1 + 1; + buf = emalloc(buf_len); + snprintf(buf, buf_len, "{%s,%s}", key, val); + PUSH2("@option", buf); + } else if (argv[1][3] == '\0') { + switch(argv[1][2]) { + case 'D': /* -MD */ + /* Push the following options: + * o 'makedep' + */ + buf = strsave("makedep"); + PUSH2("@option", buf); + break; + case 'F': /* -MF <file> */ + /* Push the following options: + * o 'makedep' + * o {makedep_output, <file>} + */ + buf = strsave("makedep"); + PUSH2("@option", buf); + + key = "makedep_output"; + val = process_opt(&argc, &argv, 1); + buf_len = 1 + strlen(key) + 2 + strlen(val) + 2 + 1; + buf = emalloc(buf_len); + snprintf(buf, buf_len, "{%s,\"%s\"}", key, val); + PUSH2("@option", buf); + break; + case 'T': /* -MT <target> */ + /* Push the following options: + * o {makedep_target, <target>} + */ + key = "makedep_target"; + val = process_opt(&argc, &argv, 1); + buf_len = 1 + strlen(key) + 2 + strlen(val) + 2 + 1; + buf = emalloc(buf_len); + snprintf(buf, buf_len, "{%s,\"%s\"}", key, val); + PUSH2("@option", buf); + break; + case 'Q': /* -MQ <target> */ + /* Push the following options: + * o {makedep_target, <target>} + * o makedep_quote_target + */ + key = "makedep_target"; + val = process_opt(&argc, &argv, 1); + buf_len = 1 + strlen(key) + 2 + strlen(val) + 2 + 1; + buf = emalloc(buf_len); + snprintf(buf, buf_len, "{%s,\"%s\"}", key, val); + PUSH2("@option", buf); + + buf = strsave("makedep_quote_target"); + PUSH2("@option", buf); + break; + case 'G': /* -MG */ + /* Push the following options: + * o makedep_add_missing + */ + buf = strsave("makedep_add_missing"); + PUSH2("@option", buf); + break; + case 'P': /* -MP */ + /* Push the following options: + * o makedep_phony + */ + buf = strsave("makedep_add_missing"); + PUSH2("@option", buf); + break; + default: + goto error; + } + } + } + break; case 'o': PUSH2("@outdir", process_opt(&argc, &argv, 0)); break; @@ -561,6 +651,15 @@ usage(void) {"-hybrid", "compile using hybrid-heap emulator"}, {"-help", "shows this help text"}, {"-I path", "where to search for include files"}, + {"-M", "generate a rule for make(1) describing the dependencies"}, + {"-MF file", "write the dependencies to 'file'"}, + {"-MT target", "change the target of the rule emitted by dependency " + "generation"}, + {"-MQ target", "same as -MT but quote characters special to make(1)"}, + {"-MG", "consider missing headers as generated files and add them to " + "the dependencies"}, + {"-MP", "add a phony target for each dependency"}, + {"-MD", "same as -M -MT file (with default 'file')"}, {"-o name", "name output directory or file"}, {"-pa path", "add path to the front of Erlang's code path"}, {"-pz path", "add path to the end of Erlang's code path"}, diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c index 3e19e5f386..778b3569c7 100644 --- a/erts/etc/common/heart.c +++ b/erts/etc/common/heart.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. 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 diff --git a/erts/etc/common/typer.c b/erts/etc/common/typer.c index de48daf002..c95959d52d 100644 --- a/erts/etc/common/typer.c +++ b/erts/etc/common/typer.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * Copyright Ericsson AB 2006-2011. 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 diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 73b1bafbe0..0355f2629f 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2010. All Rights Reserved. +# Copyright Ericsson AB 2003-2011. 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 @@ -228,17 +228,30 @@ if [ $run_valgrind != yes ]; then fi if [ "x$GDB" = "x" ]; then if [ $run_valgrind = yes ]; then + valversion=`valgrind --version` + valmajor=`echo $valversion | sed 's,[a-z]*\-\([0-9]*\).*,\1,'` + valminor=`echo $valversion | sed 's,[a-z]*\-[0-9]*.\([0-9]*\).*,\1,'` emu_xargs=`echo $xargs | sed "s|+|-|g"` - if [ "x$VALGRIND_LOG_DIR" = "x" ]; then - valgrind_log= - else - valgrind_log="--log-file=$VALGRIND_LOG_DIR/$VALGRIND_LOGFILE_PREFIX$VALGRIND_LOGFILE_INFIX$EMU.log" - fi if [ "x$VALGRIND_LOG_XML" = "x" ]; then valgrind_xml= + log_file_prefix="--log-file=" else export VALGRIND_LOG_XML valgrind_xml="--xml=yes" + if [ $valmajor -gt 2 -a $valminor -gt 4 ]; then + log_file_prefix="--xml-file=" + else + log_file_prefix="--log-file=" + fi + fi + if [ "x$VALGRIND_LOG_DIR" = "x" ]; then + valgrind_log= + else + if [ $valmajor -gt 2 -a $valminor -gt 4 ]; then + valgrind_log="$log_file_prefix$VALGRIND_LOG_DIR/$VALGRIND_LOGFILE_PREFIX$VALGRIND_LOGFILE_INFIX$EMU.log.$$" + else + valgrind_log="$log_file_prefix$VALGRIND_LOG_DIR/$VALGRIND_LOGFILE_PREFIX$VALGRIND_LOGFILE_INFIX$EMU.log" + fi fi if [ "x$VALGRIND_MISC_FLAGS" = "x" ]; then valgrind_misc_flags= diff --git a/erts/etc/win32/erlsrv/erlsrv_service.c b/erts/etc/win32/erlsrv/erlsrv_service.c index a58ee862c5..8891379643 100644 --- a/erts/etc/win32/erlsrv/erlsrv_service.c +++ b/erts/etc/win32/erlsrv/erlsrv_service.c @@ -523,7 +523,7 @@ static BOOL start_a_service(ServerInfo *srvi){ srvi->keys[WorkDir].data.bytes : NULL, &start, &(srvi->info))){ - sprintf(errbuff,"Could not start erlang service" + sprintf(errbuff,"Could not start erlang service " "with commandline \"%s\".", service_name, execbuff @@ -924,7 +924,7 @@ static VOID WINAPI service_main_loop(DWORD argc, char **argv){ } else { DWORD ecode = NO_ERROR; if(success_wait == NO_SUCCESS_WAIT){ - log_warning("Erlang machine volountarily stopped. " + log_warning("Erlang machine voluntarily stopped. " "The service is not restarted as OnFail " "is set to ignore."); } else { diff --git a/erts/etc/win32/nsis/Makefile b/erts/etc/win32/nsis/Makefile index 981a232c69..ae2343b420 100644 --- a/erts/etc/win32/nsis/Makefile +++ b/erts/etc/win32/nsis/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# Copyright Ericsson AB 2003-2011. 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 diff --git a/erts/etc/win32/nsis/dll_version_helper.sh b/erts/etc/win32/nsis/dll_version_helper.sh index 571ee3e39e..eecd4a72b5 100755 --- a/erts/etc/win32/nsis/dll_version_helper.sh +++ b/erts/etc/win32/nsis/dll_version_helper.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2007-2010. All Rights Reserved. +# Copyright Ericsson AB 2007-2011. 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 @@ -26,6 +26,7 @@ # exit 0 cat > hello.c <<EOF +#include <windows.h> #include <stdio.h> int main(void) @@ -35,14 +36,74 @@ int main(void) } EOF -cl /MD hello.c > /dev/null 2>&1 +cl /MD hello.c > /dev/null 2>&1 if [ '!' -f hello.exe.manifest ]; then - echo "This compiler does not generate manifest files - OK if using mingw" >&2 - exit 0 + # Gah - VC 2010 changes the way it handles DLL's and manifests... Again... + # need another way of getting the version + DLLNAME=`dumpbin.exe /imports hello.exe | egrep MSVCR.*dll` + DLLNAME=`echo $DLLNAME` + cat > helper.c <<EOF +#include <windows.h> +#include <stdio.h> + +#define REQ_MODULE "$DLLNAME" + +int main(void) +{ + DWORD dummy; + DWORD versize; + int i,n; + unsigned char *versinfo; + char buff[100]; + + char *vs_verinfo; + unsigned int vs_ver_size; + + struct LANGANDCODEPAGE { + WORD language; + WORD codepage; + } *translate; + + unsigned int tr_size; + + if (!(versize = GetFileVersionInfoSize(REQ_MODULE,&dummy))) { + fprintf(stderr,"No version info size in %s!\n",REQ_MODULE); + exit(1); + } + versinfo=malloc(versize); + if (!GetFileVersionInfo(REQ_MODULE,dummy,versize,versinfo)) { + fprintf(stderr,"No version info in %s!\n",REQ_MODULE); + exit(2); + } + if (!VerQueryValue(versinfo,"\\\\VarFileInfo\\\\Translation",&translate,&tr_size)) { + fprintf(stderr,"No translation info in %s!\n",REQ_MODULE); + exit(3); + } + n = tr_size/sizeof(translate); + for(i=0; i < n; ++i) { + sprintf(buff,"\\\\StringFileInfo\\\\%04x%04x\\\\FileVersion", + translate[i].language,translate[i].codepage); + if (VerQueryValue(versinfo,buff,&vs_verinfo,&vs_ver_size)) { + printf("%s\n",(char *) vs_verinfo); + return 0; + } + } + fprintf(stderr,"Failed to find file version of %s\n",REQ_MODULE); + return 0; +} +EOF + cl /MD helper.c version.lib > /dev/null 2>&1 + if [ '!' -f helper.exe ]; then + echo "Failed to build helper program." >&2 + exit 1 + fi + NAME=$DLLNAME + VERSION=`./helper` +else + VERSION=`grep '<assemblyIdentity' hello.exe.manifest | sed 's,.*version=.\([0-9\.]*\).*,\1,g' | grep -v '<'` + NAME=`grep '<assemblyIdentity' hello.exe.manifest | sed 's,.*name=.[A-Za-z\.]*\([0-9]*\).*,msvcr\1.dll,g' | grep -v '<'` fi -VERSION=`grep '<assemblyIdentity' hello.exe.manifest | sed 's,.*version=.\([0-9\.]*\).*,\1,g' | grep -v '<'` -NAME=`grep '<assemblyIdentity' hello.exe.manifest | sed 's,.*name=.[A-Za-z\.]*\([0-9]*\).*,msvcr\1.dll,g' | grep -v '<'` -rm -f hello.c hello.obj hello.exe hello.exe.manifest +#rm -f hello.c hello.obj hello.exe hello.exe.manifest helper.c helper.obj helper.exe helper.exe.manifest if [ "$1" = "-n" ]; then ASKEDFOR=$NAME else diff --git a/erts/etc/win32/nsis/find_redist.sh b/erts/etc/win32/nsis/find_redist.sh index 153977ded5..328811a0d7 100755 --- a/erts/etc/win32/nsis/find_redist.sh +++ b/erts/etc/win32/nsis/find_redist.sh @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2007-2010. All Rights Reserved. +# Copyright Ericsson AB 2007-2011. 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 @@ -114,13 +114,18 @@ RCPATH=`lookup_prog_in_path rc` fail=false if [ '!' -z "$RCPATH" ]; then BPATH=$RCPATH - for x in rc bin v6.0A ; do - NBPATH=`remove_path_element $x "$BPATH"` - if [ "$NBPATH" = "$BPATH" ]; then - fail=true - break; + allow_fail=false + for x in rc bin @ANY v6.0A v7.0A v7.1; do + if [ $x = @ANY ]; then + allow_fail=true + else + NBPATH=`remove_path_element $x "$BPATH"` + if [ $allow_fail = false -a "$NBPATH" = "$BPATH" ]; then + fail=true + break; + fi + BPATH="$NBPATH" fi - BPATH="$NBPATH" done if [ $fail = false ]; then BPATH_LIST="$BPATH_LIST $BPATH" @@ -129,23 +134,32 @@ fi # Frantic search through two roots with different # version directories. We want to be very specific about the -# directory structures as we woildnt want to find the wrong +# directory structures as we wouldnt want to find the wrong # redistributables... -#echo $BPATH +#echo $BPATH_LIST for BP in $BPATH_LIST; do - for verdir in "sdk v2.0" "sdk v3.5" "v6.0A"; do + #echo "BP=$BP" + for verdir in "sdk v2.0" "sdk v3.5" "v6.0A" "v7.0A" "v7.1"; do BPATH=$BP fail=false - for x in $verdir bootstrapper packages vcredist_x86 vcredist_x86.exe; do + allow_fail=false + for x in $verdir @ANY bootstrapper packages vcredist_x86 Redist VC @ALL vcredist_x86.exe; do #echo "x=$x" #echo "BPATH=$BPATH" - NBPATH=`add_path_element $x "$BPATH"` - if [ "$NBPATH" = "$BPATH" ]; then - fail=true - break; + #echo "allow_fail=$allow_fail" + if [ $x = @ANY ]; then + allow_fail=true + elif [ $x = @ALL ]; then + allow_fail=false + else + NBPATH=`add_path_element $x "$BPATH"` + if [ $allow_fail = false -a "$NBPATH" = "$BPATH" ]; then + fail=true + break; + fi + BPATH="$NBPATH" fi - BPATH="$NBPATH" done if [ $fail = false ]; then break; diff --git a/erts/example/next_perm.cc b/erts/example/next_perm.cc index ee81cb0404..1427cd3979 100644 --- a/erts/example/next_perm.cc +++ b/erts/example/next_perm.cc @@ -120,7 +120,7 @@ static void ready_async(ErlDrvData drv_data, ErlDrvThreadData async_data) ErlDrvPort port = reinterpret_cast<ErlDrvPort>(drv_data); our_async_data* d = reinterpret_cast<our_async_data*>(async_data); int n = d->data.size(), result_n = n*2 + 5; - ErlDrvTermData* result = new ErlDrvTermData[result_n], * rp = result; + ErlDrvTermData *result = new ErlDrvTermData[result_n], *rp = result; *rp++ = ERL_DRV_PORT; *rp++ = driver_mk_port(port); for (vector<int>::iterator i = d->data.begin(); diff --git a/erts/include/internal/ppc32/ethread.h b/erts/include/internal/ppc32/ethread.h index 12efc1b653..3b619e9d01 100644 --- a/erts/include/internal/ppc32/ethread.h +++ b/erts/include/internal/ppc32/ethread.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2011. 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 diff --git a/erts/include/internal/pthread/ethr_event.h b/erts/include/internal/pthread/ethr_event.h index 93da8a0429..4c29b28536 100644 --- a/erts/include/internal/pthread/ethr_event.h +++ b/erts/include/internal/pthread/ethr_event.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * Copyright Ericsson AB 2009-2011. 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 @@ -62,7 +62,7 @@ static void ETHR_INLINE ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e) { ethr_sint32_t val; - ETHR_WRITE_MEMORY_BARRIER; + ETHR_MEMORY_BARRIER; val = ethr_atomic32_xchg(&e->futex, ETHR_EVENT_ON__); if (val == ETHR_EVENT_OFF_WAITER__) { int res = ETHR_FUTEX__(&e->futex, ETHR_FUTEX_WAKE__, 1); @@ -99,7 +99,7 @@ static void ETHR_INLINE ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e) { ethr_sint32_t val; - ETHR_WRITE_MEMORY_BARRIER; + ETHR_MEMORY_BARRIER; val = ethr_atomic32_xchg(&e->state, ETHR_EVENT_ON__); if (val == ETHR_EVENT_OFF_WAITER__) { int res = pthread_mutex_lock(&e->mtx); diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 87ff5119fd..bff3f7f9de 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 6b0d96ff8e..5d2f187435 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 8a7a9a1314..7e492057da 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 5d544ff4aa..c443866671 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 3ed02ecd44..4a75e43e73 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 79a8d22366..30bbfb0943 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 3cc8c6b8be..6681466767 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 3f9e867542..593bb8dbed 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 935c2de253..4679a916c7 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -427,17 +427,11 @@ delay_trap(Result, Timeout) -> receive after Timeout -> Result end. %% have to reflect that, which we cannot forsee. %% set_cookie(Node, C) when Node =/= nonode@nohost, is_atom(Node) -> - Res = case C of - _ when is_atom(C) -> - auth:set_cookie(Node, C); - {CI,CO} when is_atom(CI), is_atom(CO) -> - auth:set_cookie(Node, {CI, CO}); - _ -> - error - end, - case Res of - error -> exit(badarg); - Other -> Other + case is_atom(C) of + true -> + auth:set_cookie(Node, C); + false -> + error(badarg) end. -spec get_cookie() -> atom(). diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index 446656e45f..8f2e845b4f 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% Copyright Ericsson AB 2000-2011. 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 @@ -1518,7 +1518,7 @@ enc_value_2(addr, {IP,Port}) when tuple_size(IP) =:= 4 -> [?INET_AF_INET,?int16(Port)|ip4_to_bytes(IP)]; enc_value_2(addr, {IP,Port}) when tuple_size(IP) =:= 8 -> [?INET_AF_INET6,?int16(Port)|ip6_to_bytes(IP)]; -enc_value_2(ether, [X1,X2,X3,X4,X5,X6]) -> [X1,X2,X3,X4,X5,X6]; +enc_value_2(ether, [_,_,_,_,_,_]=Xs) -> Xs; enc_value_2(sockaddr, any) -> [?INET_AF_ANY]; enc_value_2(sockaddr, loopback) -> @@ -1572,7 +1572,7 @@ dec_value(time, [X3,X2,X1,X0|T]) -> Val -> {Val, T} end; dec_value(ip, [A,B,C,D|T]) -> {{A,B,C,D}, T}; -dec_value(ether,[X1,X2,X3,X4,X5,X6|T]) -> {[X1,X2,X3,X4,X5,X6],T}; +%% dec_value(ether, [X1,X2,X3,X4,X5,X6|T]) -> {[X1,X2,X3,X4,X5,X6],T}; dec_value(sockaddr, [X|T]) -> get_ip(X, T); dec_value(linkaddr, [X1,X0|T]) -> diff --git a/erts/test/Makefile b/erts/test/Makefile index 94458da019..68be3f2178 100644 --- a/erts/test/Makefile +++ b/erts/test/Makefile @@ -89,7 +89,7 @@ release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) system.spec system.dynspec system.spec.vxworks \ $(ERL_FILES) $(TARGET_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) tar cf - *_SUITE_data utils | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/erts/test/autoimport_SUITE.erl b/erts/test/autoimport_SUITE.erl index 2430dac78d..0e4708e046 100644 --- a/erts/test/autoimport_SUITE.erl +++ b/erts/test/autoimport_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. 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 @@ -20,16 +20,38 @@ -module(autoimport_SUITE). -include_lib("test_server/include/test_server.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2,autoimports/1]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, + autoimports/1]). -define(TEST_TIMEOUT, ?t:seconds(180)). -all(suite) -> [autoimports]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [autoimports]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(?TEST_TIMEOUT), [{watchdog, Dog} | Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), catch test_server:timetrap_cancel(Dog), ok. diff --git a/erts/test/erl_print_SUITE.erl b/erts/test/erl_print_SUITE.erl index 3bb7d4d016..ee1a200530 100644 --- a/erts/test/erl_print_SUITE.erl +++ b/erts/test/erl_print_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. 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 @@ -32,14 +32,35 @@ -define(DEFAULT_TIMEOUT, ?t:minutes(10)). --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, fin_per_testcase/2]). --export([erlang_display/1, integer/1, float/1, string/1, character/1, snprintf/1, quote/1]). +-export([erlang_display/1, integer/1, float/1, + string/1, character/1, snprintf/1, quote/1]). -include_lib("test_server/include/test_server.hrl"). - -all(doc) -> []; -all(suite) -> test_cases(). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_cases(). + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + %% %% @@ -47,14 +68,9 @@ all(suite) -> test_cases(). %% %% -test_cases() -> - [erlang_display, - integer, - float, - string, - character, - snprintf, - quote]. +test_cases() -> + [erlang_display, integer, float, string, character, + snprintf, quote]. erlang_display(doc) -> []; erlang_display(suite) -> []; diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index 4797f78be2..62e0e6813d 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -20,15 +20,34 @@ %% Tests the erlc command by compiling various types of files. --export([all/1, compile_erl/1, compile_yecc/1, compile_script/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, compile_erl/1, + compile_yecc/1, compile_script/1, compile_mib/1, good_citizen/1, deep_cwd/1, arg_overflow/1]). -include_lib("test_server/include/test_server.hrl"). -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [compile_erl, compile_yecc, compile_script, compile_mib, good_citizen, deep_cwd, arg_overflow]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + %% Copy from erlc_SUITE_data/include/erl_test.hrl. -record(person, {name, shoe_size}). diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl index 6adb865f6d..0dfe6c2e5f 100644 --- a/erts/test/erlexec_SUITE.erl +++ b/erts/test/erlexec_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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 @@ -31,7 +31,9 @@ -define(DEFAULT_TIMEOUT, ?t:minutes(1)). --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2]). -export([args_file/1, evil_args_file/1, env/1, args_file_env/1, otp_7461/1, otp_7461_remote/1, otp_8209/1, zdbbl_dist_buf_busy_limit/1]). @@ -43,7 +45,7 @@ init_per_testcase(Case, Config) -> SavedEnv = save_env(), [{testcase, Case}, {watchdog, Dog}, {erl_flags_env, SavedEnv} |Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), SavedEnv = ?config(erl_flags_env, Config), restore_env(SavedEnv), @@ -51,11 +53,26 @@ fin_per_testcase(_Case, Config) -> ?t:timetrap_cancel(Dog), ok. -all(doc) -> []; -all(suite) -> - [args_file, evil_args_file, env, args_file_env, otp_7461, otp_8209, - zdbbl_dist_buf_busy_limit]. +suite() -> [{ct_hooks,[ts_install_cth]}]. +all() -> + [args_file, evil_args_file, env, args_file_env, + otp_7461, otp_8209, zdbbl_dist_buf_busy_limit]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. otp_8209(doc) -> ["Test that plain first argument does not " diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl index 69e5af802f..71d8c1c679 100644 --- a/erts/test/ethread_SUITE.erl +++ b/erts/test/ethread_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-2011. 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 @@ -31,7 +31,9 @@ -define(DEFAULT_TIMEOUT, ?t:minutes(10)). --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, fin_per_testcase/2]). -export([create_join_thread/1, equal_tids/1, @@ -49,24 +51,30 @@ -include_lib("test_server/include/test_server.hrl"). -tests() -> - [create_join_thread, - equal_tids, - mutex, - try_lock_mutex, - cond_wait, - broadcast, - detached_thread, - max_threads, - tsd, - spinlock, - rwspinlock, - rwmutex, - atomic]. - -all(doc) -> []; -all(suite) -> tests(). +tests() -> + [create_join_thread, equal_tids, mutex, try_lock_mutex, + cond_wait, broadcast, detached_thread, + max_threads, tsd, spinlock, rwspinlock, rwmutex, atomic]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + tests(). + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. %% %% diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl index e14790bc1b..214031a6fe 100644 --- a/erts/test/install_SUITE.erl +++ b/erts/test/install_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2010-2011. 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 @@ -29,8 +29,9 @@ %-define(line_trace, 1). --export([all/1, init_per_suite/1, end_per_suite/1, - init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([bin_default/1, bin_default_dirty/1, @@ -64,27 +65,32 @@ erlang_bindir = "", bindir_symlinks = ""}). -need_symlink_cases() -> - [bin_unreachable_absolute, - bin_unreachable_relative, - bin_same_dir, - bin_ok_symlink, - bin_dirname_fail, +need_symlink_cases() -> + [bin_unreachable_absolute, bin_unreachable_relative, + bin_same_dir, bin_ok_symlink, bin_dirname_fail, bin_no_use_dirname_fail]. -dont_need_symlink_cases() -> - [bin_default, - bin_default_dirty, - bin_outside_eprfx, - bin_outside_eprfx_dirty, - bin_not_abs, - bin_unreasonable_path, - 'bin white space', +dont_need_symlink_cases() -> + [bin_default, bin_default_dirty, bin_outside_eprfx, + bin_outside_eprfx_dirty, bin_not_abs, + bin_unreasonable_path, 'bin white space', bin_no_srcfile]. -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> dont_need_symlink_cases() ++ need_symlink_cases(). +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + %% %% The test cases %% @@ -585,7 +591,7 @@ init_per_testcase_aux(true, _OsType, Case, Config) -> {test_dir, make_dirs(?config(priv_dir, Config), atom_to_list(Case))} | Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl index 530fb55270..7d6da28ad6 100644 --- a/erts/test/nt_SUITE.erl +++ b/erts/test/nt_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. 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 @@ -22,7 +22,9 @@ -include_lib("test_server/include/test_server.hrl"). -include_lib("kernel/include/file.hrl"). --export([all/1,init_per_testcase/2,fin_per_testcase/2,nt/1,handle_eventlog/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2,init_per_testcase/2, + end_per_testcase/2,nt/1,handle_eventlog/2, middleman/1,service_basic/1, service_env/1, user_env/1, synced/1, service_prio/1, logout/1, debug/1, restart/1, restart_always/1,stopaction/1, @@ -31,20 +33,38 @@ -define(TEST_SERVICES, [1,2,3,4,5,6,7,8,9,10,11]). -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> case os:type() of - {win32,nt} -> - [nt, service_basic, service_env, user_env, synced, service_prio, - logout, debug, - restart, restart_always, stopaction]; - _ -> [nt] %%% Just to give a little hint why they are skipped... + {win32, nt} -> + [nt, service_basic, service_env, user_env, synced, + service_prio, logout, debug, restart, restart_always, + stopaction]; + _ -> [nt] end. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(?TEST_TIMEOUT), [{watchdog, Dog} | Config]. -fin_per_testcase(_Func, Config) -> +end_per_testcase(_Func, Config) -> lists:foreach(fun(X) -> catch remove_service("test_service_" ++ integer_to_list(X)) end, diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 425ad31782..d61fbbddcf 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% Copyright Ericsson AB 2000-2011. 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 @@ -19,7 +19,8 @@ -module(otp_SUITE). --export([all/1,init_per_suite/1,end_per_suite/1]). +-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, + init_per_suite/1,end_per_suite/1]). -export([undefined_functions/1,deprecated_not_in_obsolete/1, obsolete_but_not_deprecated/1,call_to_deprecated/1, call_to_size_1/1,strong_components/1]). @@ -28,10 +29,22 @@ -import(lists, [filter/2,foldl/3,foreach/2]). -all(suite) -> - [undefined_functions,deprecated_not_in_obsolete, - obsolete_but_not_deprecated,call_to_deprecated, - call_to_size_1,strong_components]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [undefined_functions, deprecated_not_in_obsolete, + obsolete_but_not_deprecated, call_to_deprecated, + call_to_size_1, strong_components]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + init_per_suite(Config) -> Dog = test_server:timetrap(?t:minutes(10)), diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl index efeafbad8c..6350dc47dd 100644 --- a/erts/test/run_erl_SUITE.erl +++ b/erts/test/run_erl_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. 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 @@ -19,7 +19,9 @@ -module(run_erl_SUITE). --export([all/1,init_per_testcase/2,fin_per_testcase/2, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, basic/1,heavy/1,heavier/1,defunct/1]). -export([ping_me_back/1]). @@ -29,13 +31,31 @@ init_per_testcase(_Case, Config) -> Dog = ?t:timetrap(?t:minutes(2)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. -all(suite) -> - [basic,heavy,heavier,defunct]. +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [basic, heavy, heavier, defunct]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + basic(Config) when is_list(Config) -> case os:type() of diff --git a/erts/test/system.spec b/erts/test/system.spec index 9bfe2dbcf8..e0561ba0b2 100644 --- a/erts/test/system.spec +++ b/erts/test/system.spec @@ -1 +1 @@ -{topcase, {dir, "../system_test"}}. +{suites,"../system_test",all}. diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl index 9f13a7083d..8fceab32a6 100644 --- a/erts/test/z_SUITE.erl +++ b/erts/test/z_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. 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 @@ -35,26 +35,45 @@ -define(DEFAULT_TIMEOUT, ?t:minutes(5)). --export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2, end_per_testcase/2]). -export([search_for_core_files/1, core_files/1]). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). init_per_testcase(Case, Config) -> Dog = ?t:timetrap(?DEFAULT_TIMEOUT), [{testcase, Case}, {watchdog, Dog} |Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. -all(doc) -> []; -all(suite) -> +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [core_files]. +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + core_files(doc) -> []; diff --git a/erts/vsn.mk b/erts/vsn.mk index 8a1590e74c..193a914a70 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# Copyright Ericsson AB 1997-2011. 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 @@ -17,8 +17,8 @@ # %CopyrightEnd% # -VSN = 5.8.3 -SYSTEM_VSN = R14B02 +VSN = 5.8.4 +SYSTEM_VSN = R14B03 # Port number 4365 in 4.2 # Port number 4366 in 4.3 |