~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to erts/emulator/beam/beam_emu.c

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
20
20
#  include "config.h"
21
21
#endif
22
22
 
 
23
#include <stddef.h> /* offsetof() */
23
24
#include "sys.h"
24
25
#include "erl_vm.h"
25
26
#include "global.h"
26
27
#include "erl_process.h"
 
28
#include "erl_nmgc.h"
27
29
#include "error.h"
28
30
#include "bif.h"
29
31
#include "big.h"
30
32
#include "beam_load.h"
31
33
#include "erl_binary.h"
32
34
#include "erl_bits.h"
 
35
#include "dist.h"
33
36
#include "beam_bp.h"
34
37
#include "beam_catches.h"
35
38
#ifdef HIPE
53
56
#  define OpCode(OpCode)  (&&lb_##OpCode)
54
57
#endif
55
58
 
 
59
#ifdef ERTS_ENABLE_LOCK_CHECK
 
60
#  ifdef ERTS_SMP
 
61
#    define PROCESS_MAIN_CHK_LOCKS(P) \
 
62
do { if ((P)) erts_proc_lc_chk_only_proc_main((P)); } while (0)
 
63
#  else
 
64
#    define PROCESS_MAIN_CHK_LOCKS(P) erts_lc_check_exact(NULL, 0)
 
65
#  endif
 
66
#else
 
67
#  define PROCESS_MAIN_CHK_LOCKS(P)
 
68
#endif
 
69
 
 
70
#ifdef ERTS_SMP
 
71
 
 
72
#if defined(HEAP_FRAG_ELIM_TEST) /* Shallow copy to heap if possible;
 
73
                                    otherwise, move to heap via garbage
 
74
                                    collection. */
 
75
 
 
76
#define MV_MSG_MBUF_INTO_PROC(M)                                        \
 
77
do {                                                                    \
 
78
    if ((M)->bp) {                                                      \
 
79
        Uint need = (M)->bp->size;                                      \
 
80
        if (E - HTOP >= need) {                                         \
 
81
            Uint *htop = HTOP;                                          \
 
82
            erts_move_msg_mbuf_to_heap(&htop, &MSO(c_p), (M));          \
 
83
            ASSERT(htop - HTOP == need);                                \
 
84
            HTOP = htop;                                                \
 
85
        }                                                               \
 
86
        else {                                                          \
 
87
            SWAPOUT;                                                    \
 
88
            reg[0] = r(0);                                              \
 
89
            PROCESS_MAIN_CHK_LOCKS(c_p);                                \
 
90
            FCALLS -= erts_garbage_collect(c_p, 0, NULL, 0);            \
 
91
            PROCESS_MAIN_CHK_LOCKS(c_p);                                \
 
92
            r(0) = reg[0];                                              \
 
93
            SWAPIN;                                                     \
 
94
            ASSERT(!(M)->bp);                                           \
 
95
        }                                                               \
 
96
    }                                                                   \
 
97
    ASSERT(!(M)->bp);                                                   \
 
98
} while (0)
 
99
 
 
100
#elif 0 /* Shallow copy to heap if possible; otherwise,
 
101
           move to proc mbuf list. */
 
102
 
 
103
#define MV_MSG_MBUF_INTO_PROC(M)                                        \
 
104
do {                                                                    \
 
105
    if ((M)->bp) {                                                      \
 
106
        Uint need = (M)->bp->size;                                      \
 
107
        if (E - HTOP < need)                                            \
 
108
            erts_move_msg_mbuf_to_proc_mbufs(c_p, (M));                 \
 
109
        else {                                                          \
 
110
            Uint *htop = HTOP;                                          \
 
111
            erts_move_msg_mbuf_to_heap(&htop, &MSO(c_p), (M));          \
 
112
            ASSERT(htop - HTOP == need);                                \
 
113
            HTOP = htop;                                                \
 
114
        }                                                               \
 
115
    }                                                                   \
 
116
    ASSERT(!(M)->bp);                                                   \
 
117
} while (0)
 
118
 
 
119
#else /* Move to proc mbuf list. */
 
120
 
 
121
#define MV_MSG_MBUF_INTO_PROC(M)                                        \
 
122
do {                                                                    \
 
123
    if ((M)->bp) erts_move_msg_mbuf_to_proc_mbufs(c_p, (M));            \
 
124
    ASSERT(!(M)->bp);                                                   \
 
125
} while (0)
 
126
 
 
127
#endif
 
128
 
 
129
#else 
 
130
#define MV_MSG_MBUF_INTO_PROC(M)
 
131
#endif
 
132
 
56
133
/*
57
134
 * Allocate memory on secondary arithmetic heap.
58
135
 * We need our special version because the heap top is in the
59
136
 * HTOP variable and not in the process structure.
60
137
 */
 
138
#if !defined(HEAP_FRAG_ELIM_TEST)
 
139
 
61
140
#if defined(DEBUG)
62
 
#  define BeamArithAlloc(p, need) \
63
 
   (ASSERT_EXPR((need) >= 0), \
64
 
    ((ARITH_AVAIL(p) < (need)) ? \
65
 
     erts_arith_alloc((p), HTOP, (need)) : \
66
 
     ((ARITH_HEAP(p) += (need)), (ARITH_AVAIL(p) -= (need)), \
67
 
      (ARITH_CHECK_ME(p) = ARITH_HEAP(p)), \
 
141
#  define BeamArithAlloc(p, need)                               \
 
142
   (ASSERT_EXPR((need) >= 0),                                   \
 
143
    ((ARITH_AVAIL(p) < (need)) ?                                \
 
144
     erts_heap_alloc((p), (need)) :                             \
 
145
     ((ARITH_HEAP(p) += (need)), (ARITH_AVAIL(p) -= (need)),    \
 
146
      (ARITH_CHECK_ME(p) = ARITH_HEAP(p)),                      \
68
147
      (ARITH_HEAP(p) - (need)))))
69
148
#else
70
 
#  define BeamArithAlloc(p, need) \
71
 
    ((ARITH_AVAIL(p) < (need)) ? \
72
 
     erts_arith_alloc((p), HTOP, (need)) : \
73
 
     ((ARITH_HEAP(p) += (need)), \
74
 
      (ARITH_AVAIL(p) -= (need)), \
 
149
#  define BeamArithAlloc(p, need)               \
 
150
    ((ARITH_AVAIL(p) < (need)) ?                \
 
151
     erts_heap_alloc((p), (need)) :             \
 
152
     ((ARITH_HEAP(p) += (need)),                \
 
153
      (ARITH_AVAIL(p) -= (need)),               \
75
154
      (ARITH_HEAP(p) - (need))))
76
155
#endif
77
156
 
 
157
#endif
 
158
 
78
159
/*
79
160
 * Define macros for deep checking of terms.
80
161
 */
83
164
 
84
165
#  define CHECK_TERM(T) size_object(T)
85
166
 
86
 
#  define CHECK_ARGS(PC) \
87
 
do { \
88
 
  int i_; \
89
 
  int Arity_ = PC[-1]; \
90
 
  if (Arity_ > 0) { \
91
 
        CHECK_TERM(r(0)); \
92
 
  } \
93
 
  for (i_ = 1; i_ < Arity_; i_++) { \
94
 
        CHECK_TERM(x(i_)); \
95
 
  } \
 
167
#  define CHECK_ARGS(PC)                 \
 
168
do {                                     \
 
169
  int i_;                                \
 
170
  int Arity_ = PC[-1];                   \
 
171
  if (Arity_ > 0) {                      \
 
172
        CHECK_TERM(r(0));                \
 
173
  }                                      \
 
174
  for (i_ = 1; i_ < Arity_; i_++) {      \
 
175
        CHECK_TERM(x(i_));               \
 
176
  }                                      \
96
177
} while (0)
97
178
    
98
179
#else
106
187
 
107
188
#define GET_BIF_ADDRESS(p) ((BifFunction) (((Export *) p)->code[4]))
108
189
 
 
190
 
109
191
/*
110
192
 * We reuse some of fields in the save area in the process structure.
111
193
 * This is safe to do, since this space is only activly used when
129
211
    (Sint)(IP) < (Sint)LabelAddr(end_emulator_loop))
130
212
#endif /* NO_JUMP_TABLE */
131
213
 
132
 
#define SET_CP(p, ip) \
133
 
   ASSERT(VALID_INSTR(*(ip))); \
 
214
#define SET_CP(p, ip)           \
 
215
   ASSERT(VALID_INSTR(*(ip)));  \
134
216
   (p)->cp = (ip)
135
217
 
136
218
#define SET_I(ip) \
143
225
 * Store a result into a register given a destination descriptor.
144
226
 */
145
227
 
146
 
#define StoreResult(Result, DestDesc) \
147
 
  do { \
148
 
    Eterm stb_reg; \
149
 
    stb_reg = (DestDesc); \
150
 
    CHECK_TERM(Result); \
151
 
    switch (beam_reg_tag(stb_reg)) { \
152
 
    case R_REG_DEF: \
153
 
      r(0) = (Result); break; \
154
 
    case X_REG_DEF: \
155
 
      xb(x_reg_offset(stb_reg)) = (Result); break; \
156
 
    default: \
157
 
      yb(y_reg_offset(stb_reg)) = (Result); break; \
158
 
    } \
 
228
#define StoreResult(Result, DestDesc)               \
 
229
  do {                                              \
 
230
    Eterm stb_reg;                                  \
 
231
    stb_reg = (DestDesc);                           \
 
232
    CHECK_TERM(Result);                             \
 
233
    switch (beam_reg_tag(stb_reg)) {                \
 
234
    case R_REG_DEF:                                 \
 
235
      r(0) = (Result); break;                       \
 
236
    case X_REG_DEF:                                 \
 
237
      xb(x_reg_offset(stb_reg)) = (Result); break;  \
 
238
    default:                                        \
 
239
      yb(y_reg_offset(stb_reg)) = (Result); break;  \
 
240
    }                                               \
159
241
  } while (0)
160
242
 
161
243
#define StoreSimpleDest(Src, Dest) Dest = (Src)
166
248
 * be just before the next instruction.
167
249
 */
168
250
 
169
 
#define StoreBifResult(Dst, Result) \
170
 
  do { \
171
 
    Eterm* stb_next; \
172
 
    Eterm stb_reg; \
173
 
    stb_reg = Arg(Dst); \
174
 
    I += (Dst) + 2; \
175
 
    stb_next = (Eterm *) *I; \
176
 
    CHECK_TERM(Result); \
177
 
    switch (beam_reg_tag(stb_reg)) { \
178
 
    case R_REG_DEF: \
179
 
      r(0) = (Result); Goto(stb_next); \
180
 
    case X_REG_DEF: \
181
 
      xb(x_reg_offset(stb_reg)) = (Result); Goto(stb_next); \
182
 
    default: \
183
 
      yb(y_reg_offset(stb_reg)) = (Result); Goto(stb_next); \
184
 
    } \
 
251
#define StoreBifResult(Dst, Result)                          \
 
252
  do {                                                       \
 
253
    Eterm* stb_next;                                         \
 
254
    Eterm stb_reg;                                           \
 
255
    stb_reg = Arg(Dst);                                      \
 
256
    I += (Dst) + 2;                                          \
 
257
    stb_next = (Eterm *) *I;                                 \
 
258
    CHECK_TERM(Result);                                      \
 
259
    switch (beam_reg_tag(stb_reg)) {                         \
 
260
    case R_REG_DEF:                                          \
 
261
      r(0) = (Result); Goto(stb_next);                       \
 
262
    case X_REG_DEF:                                          \
 
263
      xb(x_reg_offset(stb_reg)) = (Result); Goto(stb_next);  \
 
264
    default:                                                 \
 
265
      yb(y_reg_offset(stb_reg)) = (Result); Goto(stb_next);  \
 
266
    }                                                        \
185
267
  } while (0)
186
268
 
187
269
#define ClauseFail() goto lb_jump_f
188
270
 
189
 
#define Badmatch(Term) { \
190
 
    c_p->fvalue = (Term); \
191
 
    goto badmatch; \
192
 
}
193
 
 
194
271
#define SAVE_CP(X)              *(X) = make_cp(c_p->cp)
195
272
#define RESTORE_CP(X)           SET_CP(c_p, cp_val(*(X)))
196
273
 
202
279
 
203
280
Eterm beam_apply[2];
204
281
Eterm beam_exit[1];
205
 
Eterm beam_debug_apply[12];
206
 
int beam_debug_apply_size = sizeof(beam_debug_apply)/sizeof(beam_debug_apply[0]);
207
282
 
208
283
Eterm* em_call_error_handler;
209
284
Eterm* em_apply_bif;
210
285
Eterm* em_call_traced_function;
211
286
 
 
287
 
 
288
/* NOTE These should be the only variables containing trace instructions.
 
289
**      Sometimes tests are form the instruction value, and sometimes
 
290
**      for the refering variable (one of these), and rouge references
 
291
**      will most likely cause chaos.
 
292
*/
 
293
Eterm beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */
 
294
Eterm beam_return_trace[1];    /* OpCode(i_return_trace) */
 
295
Eterm beam_exception_trace[1]; /* UGLY also OpCode(i_return_trace) */
 
296
 
212
297
/*
213
298
 * All Beam instructions in numerical order.
214
299
 */
217
302
void** beam_ops;
218
303
#endif
219
304
 
 
305
#ifndef ERTS_SMP /* Not supported with smp emulator */
220
306
extern int count_instructions;
221
 
 
222
 
#ifdef SHARED_HEAP
223
 
#define SWAPIN \
224
 
    HTOP = HEAP_TOP(c_p); \
225
 
    HeapLimit = HEAP_END(c_p); \
226
 
    StackLimit = STACK_END(c_p); \
227
 
    E = c_p->stop
228
 
 
229
 
#define SWAPOUT \
230
 
    HEAP_TOP(c_p) = HTOP; \
231
 
    HEAP_END(c_p) = HeapLimit; \
232
 
    STACK_END(c_p) = StackLimit; \
233
 
    c_p->stop = E
234
 
#else
235
 
#define SWAPIN \
236
 
    HTOP = HEAP_TOP(c_p); \
237
 
    E = c_p->stop
238
 
 
239
 
#define SWAPOUT \
240
 
    HEAP_TOP(c_p) = HTOP; \
241
 
    c_p->stop = E
 
307
#endif
 
308
 
 
309
#if defined(HYBRID)
 
310
#define SWAPIN             \
 
311
    g_htop = global_htop;  \
 
312
    g_hend = global_hend;  \
 
313
    HTOP = HEAP_TOP(c_p);  \
 
314
    E = c_p->stop
 
315
 
 
316
#define SWAPOUT            \
 
317
    global_htop = g_htop;  \
 
318
    global_hend = g_hend;  \
 
319
    HEAP_TOP(c_p) = HTOP;  \
 
320
    c_p->stop = E
 
321
 
 
322
#else
 
323
#define SWAPIN             \
 
324
    HTOP = HEAP_TOP(c_p);  \
 
325
    E = c_p->stop
 
326
 
 
327
#define SWAPOUT            \
 
328
    HEAP_TOP(c_p) = HTOP;  \
 
329
    c_p->stop = E
 
330
#endif
 
331
 
 
332
#if defined(HEAP_FRAG_ELIM_TEST)
 
333
#  if defined(HYBRID)
 
334
#    define POST_BIF_GC_SWAPIN(_p, _res)                \
 
335
     if ((_p)->mbuf) {                                  \
 
336
       _res = erts_gc_after_bif_call((_p), (_res));     \
 
337
     }                                                  \
 
338
     SWAPIN
 
339
#  else
 
340
#    define POST_BIF_GC_SWAPIN(_p, _res)                \
 
341
     if ((_p)->mbuf) {                                  \
 
342
       _res = erts_gc_after_bif_call((_p), (_res));     \
 
343
       E = (_p)->stop;                                  \
 
344
     }                                                  \
 
345
     HTOP = HEAP_TOP((_p))
 
346
#  endif
 
347
#else
 
348
#  if defined(HYBRID)
 
349
#    define POST_BIF_GC_SWAPIN(_p, _res)                \
 
350
     SWAPIN
 
351
#  else
 
352
#    define POST_BIF_GC_SWAPIN(_p, _res)                \
 
353
     HTOP = HEAP_TOP((_p))
 
354
#  endif
242
355
#endif
243
356
 
244
357
#define SAVE_HTOP HEAP_TOP(c_p) = HTOP
252
365
#define y(N) E[N]
253
366
#define r(N) x##N
254
367
 
255
 
#ifdef SHARED_HEAP
256
 
 
257
 
#ifdef DEBUG
258
 
#define DEBUG_MEMSET sys_memset(c_p->send, 0xff, c_p->stack_sz*sizeof(Eterm))
259
 
#else
260
 
#define DEBUG_MEMSET
261
 
#endif
262
 
 
263
 
#define AllocateStack(StackNeed)                                        \
264
 
  do {                                                                  \
265
 
    ASSERT(c_p->send <= E && E <= c_p->stack);                          \
266
 
    if (E - c_p->send < (StackNeed)) {                                  \
267
 
      int used_stack = c_p->stack - E;                                  \
268
 
      int new_sz = erts_next_heap_size(c_p->stack_sz + (StackNeed), 0); \
269
 
      Eterm *new_stack =                                                \
270
 
        (Eterm*) ERTS_STACK_ALLOC(sizeof(Eterm) * new_sz);              \
271
 
      sys_memmove((new_stack + new_sz) - used_stack, E,                 \
272
 
                  used_stack * sizeof(Eterm));                          \
273
 
      DEBUG_MEMSET;                                                     \
274
 
      ERTS_STACK_FREE((void *) c_p->send, c_p->stack_sz*sizeof(Eterm)); \
275
 
      c_p->stack_sz = new_sz;                                           \
276
 
      c_p->send = new_stack;                                            \
277
 
      c_p->stop = new_stack + new_sz - used_stack;                      \
278
 
      c_p->stack = new_stack + new_sz;                                  \
279
 
      E = c_p->stop;                                                    \
280
 
    }                                                                   \
281
 
    E -= (StackNeed);                                                   \
282
 
    ASSERT(c_p->send <= E && E <= c_p->stack);                          \
283
 
  } while(0)
284
 
 
285
 
/*
286
 
 * Makes sure that there are StackNeed and HeapNeed + 1 words available
287
 
 * on the stack and heap respectively, then allocates StackNeed + 1
288
 
 * words on the stack and saves CP.
289
 
 *
290
 
 * M is number of live registers to preserve during garbage collection
291
 
 */
292
 
 
293
 
#define AH(StackNeed, HeapNeed, M)                                       \
294
 
  do {                                                                   \
295
 
     int needed;                                                         \
296
 
     ASSERT(StackLimit <= E && E <= c_p->stack);                         \
297
 
     ASSERT(HEAP_START(c_p) <= HTOP && HTOP <= HeapLimit);               \
298
 
     needed = (StackNeed) + CP_SIZE;                                     \
299
 
     if (E - StackLimit < needed) {                                      \
300
 
       int used_stack = c_p->stack - E;                                  \
301
 
       int new_sz = erts_next_heap_size(c_p->stack_sz + needed, 0);      \
302
 
       Eterm *new_stack = (Eterm *)                                      \
303
 
           ERTS_STACK_ALLOC(sizeof(Eterm)*new_sz);                       \
304
 
       sys_memcpy((new_stack + new_sz) - used_stack,                     \
305
 
                   E,                                                    \
306
 
                   used_stack * sizeof(Eterm));                          \
307
 
       DEBUG_MEMSET;                                                     \
308
 
       ERTS_STACK_FREE((void *) StackLimit, c_p->stack_sz*sizeof(Eterm));\
309
 
       c_p->stack_sz = new_sz;                                           \
310
 
       StackLimit = c_p->send = new_stack;                               \
311
 
       c_p->stop = new_stack + new_sz - used_stack;                      \
312
 
       c_p->stack = new_stack + new_sz;                                  \
313
 
       E = c_p->stop;                                                    \
314
 
     }                                                                   \
315
 
     if ((HeapNeed) > HeapLimit - HTOP) {                                \
316
 
           SWAPOUT;                                                      \
317
 
           reg[0] = r(0);                                                \
318
 
           FCALLS -= erts_garbage_collect(c_p, (HeapNeed), reg, (M));    \
319
 
           r(0) = reg[0];                                                \
320
 
           SWAPIN;                                                       \
321
 
     }                                                                   \
322
 
     E -= needed;                                                        \
323
 
     SAVE_CP(E);                                                         \
324
 
     ASSERT(c_p->send <= E && E <= c_p->stack);                          \
325
 
     ASSERT(HEAP_START(c_p) <= HTOP && HTOP <= HeapLimit);               \
326
 
  } while (0)
327
 
#else
328
368
/*
329
369
 * Makes sure that there are StackNeed + HeapNeed + 1 words available
330
370
 * on the combined heap/stack segment, then allocates StackNeed + 1
336
376
#define AH(StackNeed, HeapNeed, M) \
337
377
  do { \
338
378
     int needed; \
339
 
     needed = (StackNeed) + CP_SIZE; \
 
379
     needed = (StackNeed) + 1; \
340
380
     if (E - HTOP < (needed + (HeapNeed))) { \
341
381
           SWAPOUT; \
342
382
           reg[0] = r(0); \
 
383
           PROCESS_MAIN_CHK_LOCKS(c_p); \
343
384
           FCALLS -= erts_garbage_collect(c_p, needed + (HeapNeed), reg, (M)); \
 
385
           PROCESS_MAIN_CHK_LOCKS(c_p); \
344
386
           r(0) = reg[0]; \
345
387
           SWAPIN; \
346
388
     } \
347
389
     E -= needed; \
348
390
     SAVE_CP(E); \
349
391
  } while (0)
350
 
#endif
351
392
 
352
393
#define Allocate(Ns, Live) AH(Ns, 0, Live)
353
394
 
354
 
#define AllocateZero(Ns, Live) \
355
 
 do { Eterm* ptr; \
356
 
      int i = (Ns); \
357
 
      AH(i, 0, Live); \
358
 
      for (ptr = E + i; ptr > E; ptr--) { \
359
 
         make_blank(*ptr); \
360
 
     } \
 
395
#define AllocateZero(Ns, Live)             \
 
396
 do { Eterm* ptr;                          \
 
397
      int i = (Ns);                        \
 
398
      AH(i, 0, Live);                      \
 
399
      for (ptr = E + i; ptr > E; ptr--) {  \
 
400
         make_blank(*ptr);                 \
 
401
     }                                     \
361
402
  } while (0)
362
403
 
363
404
#define AllocateHeap(Ns, Nh, Live) AH(Ns, Nh, Live)
364
405
 
365
 
#define PutString(Len, Ptr, Dst) \
366
 
  do { \
367
 
      int len = (Len); \
368
 
      unsigned char* s = (unsigned char *) (Ptr); \
369
 
      Eterm result = NIL; \
370
 
      for (s = (unsigned char *) Arg(1); len > 0; s--, len--) { \
371
 
          PutList(make_small(*s), result, result, StoreSimpleDest); \
372
 
      } \
373
 
      StoreResult(result, Dst); \
 
406
#define PutString(Len, Ptr, Dst)                                     \
 
407
  do {                                                               \
 
408
      int len = (Len);                                               \
 
409
      unsigned char* s = (unsigned char *) (Ptr);                    \
 
410
      Eterm result = NIL;                                            \
 
411
      for (s = (unsigned char *) Arg(1); len > 0; s--, len--) {      \
 
412
          PutList(make_small(*s), result, result, StoreSimpleDest);  \
 
413
      }                                                              \
 
414
      StoreResult(result, Dst);                                      \
374
415
  } while (0)
375
416
 
376
 
#define AllocateHeapZero(Ns, Nh, Live) \
377
 
 do { Eterm* ptr; \
378
 
      int i = (Ns); \
379
 
      AH(i, Nh, Live); \
380
 
      for (ptr = E + i; ptr > E; ptr--) { \
381
 
         make_blank(*ptr); \
382
 
     } \
 
417
#define AllocateHeapZero(Ns, Nh, Live)     \
 
418
 do { Eterm* ptr;                          \
 
419
      int i = (Ns);                        \
 
420
      AH(i, Nh, Live);                     \
 
421
      for (ptr = E + i; ptr > E; ptr--) {  \
 
422
         make_blank(*ptr);                 \
 
423
     }                                     \
383
424
  } while (0)
384
425
 
385
426
#define AllocateInit(Ns, Live, Y) \
391
432
 
392
433
#define A(StackNeed, M) AH(StackNeed, 0, M)
393
434
 
394
 
#define D(N) \
395
 
     RESTORE_CP(E); \
396
 
     E += (N) + CP_SIZE;
 
435
#define D(N)             \
 
436
     RESTORE_CP(E);      \
 
437
     E += (N) + 1;
397
438
 
398
439
 
399
440
/*
401
442
 * Live is number of active argument registers to be preserved.
402
443
 */
403
444
 
404
 
#ifdef SHARED_HEAP
405
 
#define TestHeap(Nh, Live) \
406
 
  do { \
407
 
    unsigned need = (Nh); \
408
 
    ASSERT(HEAP_START(c_p) <= HTOP && HTOP <= HeapLimit); \
409
 
    if (HeapLimit - HTOP < need) { \
410
 
       SWAPOUT; \
411
 
       reg[0] = r(0); \
412
 
       FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \
413
 
       ASSERT(c_p->active); \
414
 
       r(0) = reg[0]; \
415
 
       SWAPIN; \
416
 
    } \
 
445
#define TestHeap(Nh, Live)                                      \
 
446
  do {                                                          \
 
447
    unsigned need = (Nh);                                       \
 
448
    if (E - HTOP < need) {                                      \
 
449
       SWAPOUT;                                                 \
 
450
       reg[0] = r(0);                                           \
 
451
       PROCESS_MAIN_CHK_LOCKS(c_p);                             \
 
452
       FCALLS -= erts_garbage_collect(c_p, need, reg, (Live));  \
 
453
       PROCESS_MAIN_CHK_LOCKS(c_p);                             \
 
454
       r(0) = reg[0];                                           \
 
455
       SWAPIN;                                                  \
 
456
    }                                                           \
 
457
  } while (0)
 
458
 
 
459
#ifdef HYBRID
 
460
#ifdef INCREMENTAL
 
461
#define TestGlobalHeap(Nh, Live, hp)                                    \
 
462
  do {                                                                  \
 
463
    unsigned need = (Nh);                                               \
 
464
    ASSERT(global_heap <= g_htop && g_htop <= global_hend);             \
 
465
    SWAPOUT;                                                            \
 
466
    reg[0] = r(0);                                                      \
 
467
    FCALLS -= need;                                                     \
 
468
    (hp) = IncAlloc(c_p,need,reg,(Live));                               \
 
469
    r(0) = reg[0];                                                      \
 
470
    SWAPIN;                                                             \
417
471
  } while (0)
418
472
#else
419
 
#define TestHeap(Nh, Live) \
420
 
  do { \
421
 
    unsigned need = (Nh); \
422
 
    if (E - HTOP < need) { \
423
 
       SWAPOUT; \
424
 
       reg[0] = r(0); \
425
 
       FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \
426
 
       r(0) = reg[0]; \
427
 
       SWAPIN; \
428
 
    } \
 
473
#define TestGlobalHeap(Nh, Live, hp)                                    \
 
474
  do {                                                                  \
 
475
    unsigned need = (Nh);                                               \
 
476
    ASSERT(global_heap <= g_htop && g_htop <= global_hend);             \
 
477
    if (g_hend - g_htop < need) {                                       \
 
478
       SWAPOUT;                                                         \
 
479
       reg[0] = r(0);                                                   \
 
480
       FCALLS -= erts_global_garbage_collect(c_p, need, reg, (Live));   \
 
481
       r(0) = reg[0];                                                   \
 
482
       SWAPIN;                                                          \
 
483
    }                                                                   \
 
484
    (hp) = global_htop;                                                 \
429
485
  } while (0)
430
486
#endif
431
 
 
 
487
#endif /* HYBRID */
432
488
 
433
489
#define Init(N) make_blank(yb(N))
434
490
 
450
506
 * the I register.  If we are out of reductions, do a context switch.
451
507
 */
452
508
 
453
 
#define DispatchMacro()                                 \
454
 
  do {                                                  \
455
 
     Eterm* dis_next;                                   \
456
 
     dis_next = (Eterm *) *I;                           \
457
 
     CHECK_ARGS(I);                                     \
458
 
     if (FCALLS > 0                                     \
459
 
         || (c_p->ct != NULL && FCALLS > -o_reds)) {    \
460
 
        FCALLS--;                                       \
461
 
        Goto(dis_next);                                 \
462
 
     } else {                                           \
463
 
        goto context_switch;                            \
464
 
     }                                                  \
465
 
 } while (0)
466
 
 
467
 
#define DispatchMacroFun()                              \
468
 
  do {                                                  \
469
 
     Eterm* dis_next;                                   \
470
 
     dis_next = (Eterm *) *I;                           \
471
 
     CHECK_ARGS(I);                                     \
472
 
     if (FCALLS > 0                                     \
473
 
         || (c_p->ct != NULL && FCALLS > -o_reds)) {    \
474
 
        FCALLS--;                                       \
475
 
        Goto(dis_next);                                 \
476
 
     } else {                                           \
477
 
        goto context_switch_fun;                        \
478
 
     }                                                  \
479
 
 } while (0)
480
 
 
481
 
#define DispatchMacrox()                                \
482
 
  do {                                                  \
483
 
     if (FCALLS > 0) {                                  \
484
 
        Eterm* dis_next;                                \
485
 
        SET_I(((Export *) Arg(0))->address);            \
486
 
        dis_next = (Eterm *) *I;                        \
487
 
        FCALLS--;                                       \
488
 
        CHECK_ARGS(I);                                  \
489
 
        Goto(dis_next);                                 \
490
 
     } else if (c_p->ct != NULL && FCALLS > -o_reds) {  \
491
 
        goto save_calls1;                               \
492
 
     } else {                                           \
493
 
        SET_I(((Export *) Arg(0))->address);            \
494
 
        CHECK_ARGS(I);                                  \
495
 
        goto context_switch;                            \
496
 
     }                                                  \
497
 
 } while (0)
 
509
#define DispatchMacro()                         \
 
510
  do {                                          \
 
511
     Eterm* dis_next;                           \
 
512
     dis_next = (Eterm *) *I;                   \
 
513
     CHECK_ARGS(I);                             \
 
514
     if (FCALLS > 0 || FCALLS > neg_o_reds) {   \
 
515
        FCALLS--;                               \
 
516
        Goto(dis_next);                         \
 
517
     } else {                                   \
 
518
        goto context_switch;                    \
 
519
     }                                          \
 
520
 } while (0)
 
521
 
 
522
#define DispatchMacroFun()                      \
 
523
  do {                                          \
 
524
     Eterm* dis_next;                           \
 
525
     dis_next = (Eterm *) *I;                   \
 
526
     CHECK_ARGS(I);                             \
 
527
     if (FCALLS > 0 || FCALLS > neg_o_reds) {   \
 
528
        FCALLS--;                               \
 
529
        Goto(dis_next);                         \
 
530
     } else {                                   \
 
531
        goto context_switch_fun;                \
 
532
     }                                          \
 
533
 } while (0)
 
534
 
 
535
#define DispatchMacrox()                                        \
 
536
  do {                                                          \
 
537
     if (FCALLS > 0) {                                          \
 
538
        Eterm* dis_next;                                        \
 
539
        SET_I(((Export *) Arg(0))->address);                    \
 
540
        dis_next = (Eterm *) *I;                                \
 
541
        FCALLS--;                                               \
 
542
        CHECK_ARGS(I);                                          \
 
543
        Goto(dis_next);                                         \
 
544
     } else if (c_p->ct != NULL && FCALLS > neg_o_reds) {       \
 
545
        goto save_calls1;                                       \
 
546
     } else {                                                   \
 
547
        SET_I(((Export *) Arg(0))->address);                    \
 
548
        CHECK_ARGS(I);                                          \
 
549
        goto context_switch;                                    \
 
550
     }                                                          \
 
551
 } while (0)
 
552
 
 
553
#if !defined(HEAP_FRAG_ELIM_TEST)
 
554
#define MAYBE_SHRINK(p,hp,res,alloc)                                \
 
555
  do {                                                              \
 
556
      Uint actual;                                                  \
 
557
      if (is_small(res)) {                                          \
 
558
          erts_arith_shrink(p, hp);                                 \
 
559
      } else if ((actual = bignum_header_arity(*hp)+1) < alloc) {   \
 
560
          erts_arith_shrink(p, hp+actual);                          \
 
561
      }                                                             \
 
562
  } while (0)
 
563
#endif
498
564
 
499
565
#ifdef DEBUG
500
566
/*
516
582
#define Node(R) R = erts_this_node->sysname
517
583
 
518
584
#define Arg(N)       I[(N)+1]
519
 
#define Next(N) \
520
 
    I += (N) + 1; \
521
 
    ASSERT(VALID_INSTR(*I)); \
 
585
#define Next(N)                \
 
586
    I += (N) + 1;              \
 
587
    ASSERT(VALID_INSTR(*I));   \
522
588
    Goto(*I)
523
589
 
524
590
#define PreFetch(N, Dst) do { Dst = (Eterm *) *(I + N + 1); } while (0)
525
 
#define NextPF(N, Dst) \
526
 
    I += N + 1; \
527
 
    ASSERT(VALID_INSTR(Dst)); \
 
591
#define NextPF(N, Dst)         \
 
592
    I += N + 1;                \
 
593
    ASSERT(VALID_INSTR(Dst));  \
528
594
    Goto(Dst)
529
595
 
530
596
#define GetR(pos, tr) \
533
599
     switch (beam_reg_tag(tr)) { \
534
600
     case R_REG_DEF: tr = r(0); break; \
535
601
     case X_REG_DEF: tr = xb(x_reg_offset(tr)); break; \
536
 
     case Y_REG_DEF: ASSERT(y_reg_offset(tr) >= CP_SIZE); tr = yb(y_reg_offset(tr)); break; \
 
602
     case Y_REG_DEF: ASSERT(y_reg_offset(tr) >= 1); tr = yb(y_reg_offset(tr)); break; \
537
603
     } \
538
604
     CHECK_TERM(tr); \
539
605
   } while (0)
540
606
 
541
607
#define GetArg1(N, Dst) GetR((N), Dst)
542
608
 
543
 
#define GetArg2(N, Dst1, Dst2) \
544
 
   do { \
545
 
     GetR(N, Dst1); \
546
 
     GetR((N)+1, Dst2); \
 
609
#define GetArg2(N, Dst1, Dst2)     \
 
610
   do {                            \
 
611
     GetR(N, Dst1);                \
 
612
     GetR((N)+1, Dst2);            \
547
613
   } while (0)
548
614
 
549
 
#define PutList(H, T, Dst, Store) \
550
 
  do { \
551
 
   HTOP[0] = (H); HTOP[1] = (T); \
552
 
   Store(make_list(HTOP), Dst); \
553
 
   HTOP += 2; \
 
615
#define PutList(H, T, Dst, Store)  \
 
616
  do {                             \
 
617
   HTOP[0] = (H); HTOP[1] = (T);   \
 
618
   Store(make_list(HTOP), Dst);    \
 
619
   HTOP += 2;                      \
554
620
  } while (0)
555
621
 
556
 
#define Move(Src, Dst, Store) \
557
 
   do { \
558
 
       Eterm term = (Src); \
559
 
       Store(term, Dst); \
 
622
#define Move(Src, Dst, Store)      \
 
623
   do {                            \
 
624
       Eterm term = (Src);         \
 
625
       Store(term, Dst);           \
560
626
   } while (0)
561
627
 
562
628
#define Move2(src1, dst1, src2, dst2) dst1 = (src1); dst2 = (src2)
564
630
#define MoveGenDest(src, dstp) \
565
631
   if ((dstp) == NULL) { r(0) = (src); } else { *(dstp) = src; }
566
632
 
567
 
#define MoveReturn(Src, Dest) \
568
 
    (Dest) = (Src); \
569
 
    I = c_p->cp; \
570
 
    ASSERT(VALID_INSTR(*c_p->cp)); \
571
 
    CHECK_TERM(r(0)); \
 
633
#define MoveReturn(Src, Dest)       \
 
634
    (Dest) = (Src);                 \
 
635
    I = c_p->cp;                    \
 
636
    ASSERT(VALID_INSTR(*c_p->cp));  \
 
637
    CHECK_TERM(r(0));               \
572
638
    Goto(*I)
573
639
 
574
 
#define DeallocateReturn(Deallocate) \
575
 
  do { \
576
 
    int words_to_pop = (Deallocate); \
577
 
    SET_I(cp_val(*E)); \
578
 
    E = ADD_BYTE_OFFSET(E, words_to_pop); \
579
 
    CHECK_TERM(r(0)); \
580
 
    Goto(*I); \
 
640
#define DeallocateReturn(Deallocate)       \
 
641
  do {                                     \
 
642
    int words_to_pop = (Deallocate);       \
 
643
    SET_I(cp_val(*E));                     \
 
644
    E = ADD_BYTE_OFFSET(E, words_to_pop);  \
 
645
    CHECK_TERM(r(0));                      \
 
646
    Goto(*I);                              \
581
647
  } while (0)
582
648
 
583
 
#define MoveDeallocateReturn(Src, Dest, Deallocate) \
584
 
    (Dest) = (Src); \
 
649
#define MoveDeallocateReturn(Src, Dest, Deallocate)  \
 
650
    (Dest) = (Src);                                  \
585
651
    DeallocateReturn(Deallocate)
586
652
 
587
653
#define MoveCall(Src, Dest, CallDest, Size)     \
597
663
    SET_I((Eterm *) CallDest);                          \
598
664
    Dispatch();
599
665
 
 
666
#define MoveCallOnly(Src, Dest, CallDest)       \
 
667
    (Dest) = (Src);                             \
 
668
    SET_I((Eterm *) CallDest);                  \
 
669
    Dispatch();
 
670
 
600
671
#define GetList(Src, H, T) do {                 \
601
672
   Eterm* tmp_ptr = list_val(Src);              \
602
673
   H = CAR(tmp_ptr);                            \
603
674
   T = CDR(tmp_ptr); } while (0)
604
675
 
605
 
#define GetTupleElement(Src, Element, Dest)                                     \
606
 
  do {                                                                          \
607
 
    tmp_arg1 = (Eterm) (((unsigned char *) tuple_val(Src)) + (Element));        \
608
 
    (Dest) = (*(Eterm *)tmp_arg1);                                              \
 
676
#define GetTupleElement(Src, Element, Dest)                               \
 
677
  do {                                                                    \
 
678
    tmp_arg1 = (Eterm) (((unsigned char *) tuple_val(Src)) + (Element));  \
 
679
    (Dest) = (*(Eterm *)tmp_arg1);                                        \
609
680
  } while (0)
610
681
 
611
682
#define ExtractNextElement(Dest)                                \
666
737
 
667
738
#define IsAtom(Src, Fail) if (is_not_atom(Src)) { Fail; }
668
739
 
669
 
#define IsIntegerAllocate(Src, Need, Alive, Fail) \
670
 
    if (is_not_integer(Src)) { Fail; } \
 
740
#define IsIntegerAllocate(Src, Need, Alive, Fail)  \
 
741
    if (is_not_integer(Src)) { Fail; }             \
671
742
    A(Need, Alive)
672
743
 
673
744
#define IsNil(Src, Fail) if (is_not_nil(Src)) { Fail; }
676
747
 
677
748
#define IsNonemptyList(Src, Fail) if (is_not_list(Src)) { Fail; }
678
749
 
679
 
#define IsNonemptyListAllocate(Src, Need, Alive, Fail) \
680
 
    if (is_not_list(Src)) { Fail; } \
 
750
#define IsNonemptyListAllocate(Src, Need, Alive, Fail)  \
 
751
    if (is_not_list(Src)) { Fail; }                     \
681
752
    A(Need, Alive)
682
753
 
683
 
#define IsNonemptyListTestHeap(Src, Need, Alive, Fail) \
684
 
    if (is_not_list(Src)) { Fail; } \
 
754
#define IsNonemptyListTestHeap(Src, Need, Alive, Fail)  \
 
755
    if (is_not_list(Src)) { Fail; }                     \
685
756
    TestHeap(Need, Alive)
686
757
 
687
758
#define IsTuple(X, Action) if (is_not_tuple(X)) Action
689
760
#define IsArity(Pointer, Arity, Fail) \
690
761
    if (*(Eterm *)(tmp_arg1 = (Eterm)tuple_val(Pointer)) != (Arity)) { Fail; }
691
762
 
692
 
#define IsFunction(X, Action) \
693
 
  do { \
694
 
     if ( !(is_fun(X)) ) { \
695
 
          Action; \
696
 
     } \
 
763
#define IsFunction(X, Action)                   \
 
764
  do {                                          \
 
765
     if ( !(is_any_fun(X)) ) {                  \
 
766
          Action;                               \
 
767
     }                                          \
 
768
  } while (0)
 
769
 
 
770
#define IsFunction2(F, A, Action)               \
 
771
  do {                                          \
 
772
     if (is_function_2(c_p, F, A) != am_true ) {\
 
773
          Action;                               \
 
774
     }                                          \
697
775
  } while (0)
698
776
 
699
777
#define IsTupleOfArity(Src, Arity, Fail) \
703
781
    } \
704
782
  } while (0)
705
783
 
 
784
#define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; }
 
785
 
706
786
#define IsBinary(Src, Fail) \
707
787
 if (is_not_binary(Src)) { Fail; }
708
788
 
 
789
#if !defined(HEAP_FRAG_ELIM_TEST)
 
790
 
709
791
#define BsStartMatch(Src, Fail) erts_InitMatchBuf(Src, Fail)
710
792
 
711
 
#define BsGetInteger8(Dst, Store, Fail)                         \
712
 
 do {                                                           \
713
 
    Eterm _result;                                              \
714
 
    if (erts_mb.size - erts_mb.offset < 8) { Fail; }            \
715
 
    _result = make_small(erts_mb.base[erts_mb.offset/8]);       \
716
 
    erts_mb.offset += 8;                                        \
717
 
    Store(_result, Dst);                                        \
718
 
 } while (0)
719
 
 
720
 
#define BsGetInteger16(Dst, Store, Fail)                                \
721
 
 do {                                                                   \
722
 
    Eterm _result;                                                      \
723
 
    if (erts_mb.size - erts_mb.offset < 16) { Fail; }                   \
724
 
    _result = make_small(get_int16(erts_mb.base + erts_mb.offset/8));   \
725
 
    erts_mb.offset += 16;                                               \
726
 
    Store(_result, Dst);                                                \
727
 
 } while (0)
728
 
 
729
 
#define BsGetInteger32(Dst, Store, Fail)                        \
730
 
 do {                                                           \
731
 
    Uint32 _integer;                                            \
732
 
    Eterm _result;                                              \
733
 
    if (erts_mb.size - erts_mb.offset < 32) { Fail; }   \
734
 
    _integer = get_int32(erts_mb.base + erts_mb.offset/8);      \
735
 
    erts_mb.offset += 32;                                       \
736
 
    if (IS_USMALL(0, _integer)) {                               \
737
 
        _result = make_small(_integer);                         \
738
 
    } else {                                                    \
739
 
        Eterm* _hp = BeamArithAlloc(c_p, BIG_NEED_SIZE(2));             \
740
 
        _result = uint_to_big((Uint) _integer, _hp);                    \
741
 
    }                                                           \
742
 
    Store(_result, Dst);                                        \
743
 
 } while (0)
744
 
 
745
 
#define BsGetIntegerImm(Sz, Flags, Dst, Store, Fail)    \
746
 
 do {                                                   \
747
 
    Eterm _result;                                      \
748
 
    SWAPOUT;                                            \
749
 
    _result = erts_bs_get_integer(c_p, (Sz), (Flags));  \
750
 
    HTOP = HEAP_TOP(c_p);                                       \
751
 
    if (is_non_value(_result)) { Fail; }                \
752
 
    else { Store(_result, Dst); }                       \
753
 
 } while (0)
754
 
 
755
793
#define BsGetInteger(Sz, Flags, Dst, Store, Fail)                       \
756
794
 do {                                                                   \
757
 
    Eterm _result; int _size;                                           \
 
795
    Eterm _result; Sint _size;                                          \
758
796
    if (!is_small(Sz) || (_size = signed_val(Sz)) < 0) { Fail; }        \
759
797
    _size *= ((Flags) >> 3);                                            \
760
798
    SWAPOUT;                                                            \
761
799
    _result = erts_bs_get_integer(c_p, _size, (Flags));                 \
762
 
    HTOP = HEAP_TOP(c_p);                                                       \
 
800
    HTOP = HEAP_TOP(c_p);                                               \
763
801
    if (is_non_value(_result)) { Fail; }                                \
764
802
    else { Store(_result, Dst); }                                       \
765
803
 } while (0)
766
804
 
767
805
#define BsGetFloat(Sz, Flags, Dst, Store, Fail)                         \
768
806
 do {                                                                   \
769
 
    Eterm _result; int _size;                                           \
 
807
    Eterm _result; Sint _size;                                          \
770
808
    if (!is_small(Sz) || (_size = signed_val(Sz)) < 0) { Fail; }        \
771
809
    _size *= ((Flags) >> 3);                                            \
772
810
    SWAPOUT;                                                            \
773
811
    _result = erts_bs_get_float(c_p, _size, (Flags));                   \
774
 
    HTOP = HEAP_TOP(c_p);                                                       \
 
812
    HTOP = HEAP_TOP(c_p);                                               \
775
813
    if (is_non_value(_result)) { Fail; }                                \
776
814
    else { Store(_result, Dst); }                                       \
777
815
 } while (0)
781
819
    Eterm _result;                                      \
782
820
    SWAPOUT;                                            \
783
821
    _result = erts_bs_get_binary(c_p, (Sz), (Flags));   \
784
 
    HTOP = HEAP_TOP(c_p);                                       \
 
822
    HTOP = HEAP_TOP(c_p);                               \
785
823
    if (is_non_value(_result)) { Fail; }                \
786
824
    else { Store(_result, Dst); }                       \
787
825
 } while (0)
788
826
 
789
827
#define BsGetBinary(Sz, Flags, Dst, Store, Fail)                        \
790
828
 do {                                                                   \
791
 
    Eterm _result; int _size;                                           \
 
829
    Eterm _result; Sint _size;                                          \
792
830
    if (!is_small(Sz) || (_size = signed_val(Sz)) < 0) { Fail; }        \
793
831
    _size *= ((Flags) >> 3);                                            \
794
832
    SWAPOUT;                                                            \
795
833
    _result = erts_bs_get_binary(c_p, _size, (Flags));                  \
796
 
    HTOP = HEAP_TOP(c_p);                                                       \
 
834
    HTOP = HEAP_TOP(c_p);                                               \
797
835
    if (is_non_value(_result)) { Fail; }                                \
798
836
    else { Store(_result, Dst); }                                       \
799
837
 } while (0)
803
841
    Eterm _result;                              \
804
842
    SWAPOUT;                                    \
805
843
    _result = erts_bs_get_binary_all(c_p);      \
806
 
    HTOP = HEAP_TOP(c_p);                               \
 
844
    HTOP = HEAP_TOP(c_p);                       \
807
845
    if (is_non_value(_result)) { Fail; }        \
808
846
    else { Store(_result, Dst); }               \
809
847
 } while (0)
810
848
 
811
849
#define BsSkipBits(Bits, Unit, Fail)                                    \
812
850
 do {                                                                   \
813
 
    size_t new_offset; int _size;                                       \
 
851
    size_t new_offset; Sint _size;                                      \
814
852
    if (!is_small(Bits) || (_size = signed_val(Bits)) < 0) { Fail; }    \
815
853
    new_offset = erts_mb.offset + _size * (Unit);                       \
816
854
    if (new_offset <= erts_mb.size) { erts_mb.offset = new_offset; }    \
830
868
 
831
869
#define BsSkipBitsImm(Bits, Fail)                                       \
832
870
 do {                                                                   \
833
 
    size_t new_offset = erts_mb.offset + (Bits);                        \
 
871
   size_t new_offset = erts_mb.offset + (Bits);                 \
834
872
    if (new_offset <= erts_mb.size) { erts_mb.offset = new_offset; }    \
835
873
    else { Fail; }                                                      \
836
874
 } while (0)
837
875
 
838
 
 
839
 
#define BsPutIntegerImm(Sz, Flags, Src)                                 \
840
 
 do {                                                                   \
841
 
    if (!erts_bs_put_integer((Src), (Sz), (Flags))) { goto badarg; }    \
842
 
 } while (0)
 
876
#endif
 
877
 
 
878
#define BsStartMatch2(Src, Live, Max, Dst, Store, Fail) \
 
879
 do {                                                   \
 
880
   Eterm _result; Uint _wordsneeded;                    \
 
881
   _wordsneeded = ERL_BIN_MATCHSTATE_SIZE(Max);         \
 
882
   TestHeap(_wordsneeded, Live);                        \
 
883
   SWAPOUT;                                             \
 
884
   _result = erts_bs_start_match_2(c_p, Src, Max);      \
 
885
   HTOP = HEAP_TOP(c_p);                                \
 
886
   if (is_non_value(_result)) { Fail; }                 \
 
887
   else { Store(_result, Dst); }                        \
 
888
 } while(0)  
 
889
 
 
890
#define BsGetInteger2_8(Ms, Dst, Store, Fail)                           \
 
891
 do {                                                           \
 
892
    ErlBinMatchBuffer *_mb;                                     \
 
893
    Eterm _result;                                              \
 
894
    _mb = ms_matchbuffer(Ms);                                   \
 
895
    if (_mb->size - _mb->offset < 8) { Fail; }          \
 
896
    if ((_mb->offset & 7) != 0) {                                       \
 
897
      _result = erts_bs_get_integer_2(c_p, 8, 0, _mb);          \
 
898
    }                                                           \
 
899
    else {                                                      \
 
900
    _result = make_small(_mb->base[_mb->offset/8]);             \
 
901
    _mb->offset += 8;                                           \
 
902
    }                                                           \
 
903
    Store(_result, Dst);                                        \
 
904
 } while (0)
 
905
 
 
906
#define BsGetInteger2_16(Ms, Dst, Store, Fail)                  \
 
907
 do {                                                           \
 
908
    ErlBinMatchBuffer *_mb;                                     \
 
909
    Eterm _result;                                              \
 
910
    _mb = ms_matchbuffer(Ms);                                   \
 
911
   if (_mb->size - _mb->offset < 16) { Fail; }                  \
 
912
   if ((_mb->offset & 7) != 0) {                                        \
 
913
      _result = erts_bs_get_integer_2(c_p, 16, 0, _mb);         \
 
914
    }                                                           \
 
915
   else {                                                       \
 
916
    _result = make_small(get_int16(_mb->base + _mb->offset/8)); \
 
917
    _mb->offset += 16;                                          \
 
918
   }                                                            \
 
919
    Store(_result, Dst);                                        \
 
920
 } while (0)
 
921
 
 
922
#define BsGetInteger2_32(Ms, Live, Dst, Store, Fail)            \
 
923
 do {                                                           \
 
924
    ErlBinMatchBuffer *_mb;                                     \
 
925
   Uint32 _integer;                                             \
 
926
    Eterm _result;                                              \
 
927
    _mb = ms_matchbuffer(Ms);                                   \
 
928
   if (_mb->size - _mb->offset < 32) { Fail; }                  \
 
929
   if ((_mb->offset & 7) != 0) {                                \
 
930
     _result = erts_bs_get_integer_2(c_p, 32, 0, _mb);          \
 
931
   }                                                            \
 
932
   else {                                                       \
 
933
     _integer = get_int32(_mb->base + _mb->offset/8);           \
 
934
     _mb->offset += 32;                                         \
 
935
    if (IS_USMALL(0, _integer)) {                               \
 
936
        _result = make_small(_integer);                         \
 
937
    } else {                                                    \
 
938
        TestHeap(BIG_UINT_HEAP_SIZE, Live);                     \
 
939
        _result = uint_to_big((Uint) _integer, HTOP);           \
 
940
        HTOP += BIG_UINT_HEAP_SIZE;                             \
 
941
    }                                                           \
 
942
   }                                                            \
 
943
    Store(_result, Dst);                                        \
 
944
 } while (0)
 
945
 
 
946
#define BsGetIntegerImm2(Ms, Live, Sz, Flags, Dst, Store, Fail) \
 
947
  do {                                                                  \
 
948
    ErlBinMatchBuffer *_mb;                                             \
 
949
    Eterm _result; unsigned wordneed;                                   \
 
950
    if (Sz > 27) {                                                      \
 
951
      wordneed = 1+WSIZE(NBYTES(Sz));                                   \
 
952
      TestHeap(wordneed, Live);                                         \
 
953
    }                                                                   \
 
954
    _mb = ms_matchbuffer(Ms);                                           \
 
955
    SWAPOUT;                                                            \
 
956
    _result = erts_bs_get_integer_2(c_p, (Sz), (Flags), _mb);           \
 
957
    HTOP = HEAP_TOP(c_p);                                               \
 
958
    if (is_non_value(_result)) { Fail; }                                \
 
959
    else { Store(_result, Dst); }                                       \
 
960
  } while (0)
 
961
    
 
962
#define BsGetInteger2(Ms, Live, Sz, Flags, Dst, Store, Fail)            \
 
963
    do {                                                                \
 
964
        ErlBinMatchBuffer *_mb;                                         \
 
965
      Eterm _result; Sint _size; unsigned wordneed;                     \
 
966
      if (!is_small(Sz) || (_size = signed_val(Sz)) < 0) { Fail; }      \
 
967
      _size *= ((Flags) >> 3);                                          \
 
968
      wordneed = 1+WSIZE(NBYTES(_size));                                \
 
969
      TestHeap(wordneed, Live);                                         \
 
970
      _mb = ms_matchbuffer(Ms);                                         \
 
971
      SWAPOUT;                                                          \
 
972
      _result = erts_bs_get_integer_2(c_p, _size, (Flags), _mb);        \
 
973
      HTOP = HEAP_TOP(c_p);                                             \
 
974
      if (is_non_value(_result)) { Fail; }                              \
 
975
      else { Store(_result, Dst); }                                     \
 
976
    } while (0)
 
977
 
 
978
#define BsGetFloat2(Ms, Live, Sz, Flags, Dst, Store, Fail)      \
 
979
 do {                                                           \
 
980
   ErlBinMatchBuffer *_mb;                                      \
 
981
   Eterm _result; Sint _size;                                   \
 
982
   if (!is_small(Sz) || (_size = signed_val(Sz)) < 0) { Fail; } \
 
983
   _size *= ((Flags) >> 3);                                     \
 
984
   TestHeap(FLOAT_SIZE_OBJECT, Live);                           \
 
985
   _mb = ms_matchbuffer(Ms);                                    \
 
986
   SWAPOUT;                                                     \
 
987
   _result = erts_bs_get_float_2(c_p, _size, (Flags), _mb);     \
 
988
   HTOP = HEAP_TOP(c_p);                                        \
 
989
   if (is_non_value(_result)) { Fail; }                         \
 
990
   else { Store(_result, Dst); }                                \
 
991
 } while (0)
 
992
 
 
993
#define BsGetBinaryImm_2(Ms, Live, Sz, Flags, Dst, Store, Fail)         \
 
994
  do {                                                                  \
 
995
    ErlBinMatchBuffer *_mb;                                             \
 
996
    Eterm _result;                                                      \
 
997
    TestHeap(heap_bin_size(ERL_ONHEAP_BIN_LIMIT), Live);                \
 
998
    _mb = ms_matchbuffer(Ms);                                           \
 
999
    SWAPOUT;                                                            \
 
1000
    _result = erts_bs_get_binary_2(c_p, (Sz), (Flags), _mb);            \
 
1001
    HTOP = HEAP_TOP(c_p);                                               \
 
1002
    if (is_non_value(_result)) { Fail; }                                \
 
1003
    else { Store(_result, Dst); }                                       \
 
1004
  } while (0)
 
1005
 
 
1006
#define BsGetBinary_2(Ms, Live, Sz, Flags, Dst, Store, Fail)            \
 
1007
  do {                                                                  \
 
1008
    ErlBinMatchBuffer *_mb;                                             \
 
1009
    Eterm _result; Sint _size;                                          \
 
1010
    if (!is_small(Sz) || (_size = signed_val(Sz)) < 0) { Fail; }        \
 
1011
    TestHeap(heap_bin_size(ERL_ONHEAP_BIN_LIMIT), Live);                \
 
1012
    _size *= ((Flags) >> 3);                                            \
 
1013
    TestHeap(heap_bin_size(ERL_ONHEAP_BIN_LIMIT), Live);                \
 
1014
    _mb = ms_matchbuffer(Ms);                                           \
 
1015
    SWAPOUT;                                                            \
 
1016
    _result = erts_bs_get_binary_2(c_p, _size, (Flags), _mb);           \
 
1017
    HTOP = HEAP_TOP(c_p);                                               \
 
1018
    if (is_non_value(_result)) { Fail; }                                \
 
1019
    else { Store(_result, Dst); }                                       \
 
1020
  } while (0)
 
1021
 
 
1022
#define BsGetBinaryAll_2(Ms, Live, Unit, Dst, Store, Fail)              \
 
1023
  do {                                                                  \
 
1024
    ErlBinMatchBuffer *_mb;                                             \
 
1025
    Eterm _result;                                                      \
 
1026
    TestHeap(ERL_SUB_BIN_SIZE, Live);                                   \
 
1027
    _mb = ms_matchbuffer(Ms);                                           \
 
1028
    if (((_mb->size - _mb->offset) % Unit) == 0)                        \
 
1029
      {SWAPOUT;                                                         \
 
1030
        _result = erts_bs_get_binary_all_2(c_p, _mb);                   \
 
1031
        HTOP = HEAP_TOP(c_p);                                           \
 
1032
        if (is_non_value(_result)) { Fail; }                            \
 
1033
        else { Store(_result, Dst); }                                   \
 
1034
      }                                                                 \
 
1035
    else { Fail; }                                                      \
 
1036
 } while (0)
 
1037
 
 
1038
#define BsSkipBits2(Ms, Bits, Unit, Fail)                               \
 
1039
 do {                                                                   \
 
1040
   ErlBinMatchBuffer *_mb;                                              \
 
1041
   size_t new_offset; Sint _size;                                       \
 
1042
    _mb = ms_matchbuffer(Ms);                                           \
 
1043
   if (!is_small(Bits) || (_size = signed_val(Bits)) < 0) { Fail; }     \
 
1044
    new_offset = _mb->offset + _size * (Unit);                          \
 
1045
    if (new_offset <= _mb->size) { _mb->offset = new_offset; }          \
 
1046
    else { Fail; }                                                      \
 
1047
 } while (0)
 
1048
 
 
1049
#define BsSkipBitsAll2(Ms, Unit, Fail)          \
 
1050
 do {                                           \
 
1051
    ErlBinMatchBuffer *_mb;                     \
 
1052
   _mb = ms_matchbuffer(Ms);                    \
 
1053
   if (((_mb->size - _mb->offset) % Unit) == 0) {_mb->offset = _mb->size; } \
 
1054
   else { Fail; }                                       \
 
1055
 } while (0)
 
1056
 
 
1057
#define BsSkipBitsImm2(Ms, Bits, Fail)                          \
 
1058
 do {                                                           \
 
1059
   ErlBinMatchBuffer *_mb;                                      \
 
1060
   size_t new_offset;                                           \
 
1061
   _mb = ms_matchbuffer(Ms);                                    \
 
1062
   new_offset = _mb->offset + (Bits);                           \
 
1063
   if (new_offset <= _mb->size) { _mb->offset = new_offset; }   \
 
1064
   else { Fail; }                                               \
 
1065
 } while (0)
 
1066
 
 
1067
#define NewBsPutIntegerImm(Sz, Flags, Src)                                      \
 
1068
 do {                                                                   \
 
1069
    if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), (Sz), (Flags)))) { goto badarg; }       \
 
1070
 } while (0)
 
1071
 
 
1072
#define NewBsPutInteger(Sz, Flags, Src)                                         \
 
1073
 do {                                                                           \
 
1074
    Sint _size = signed_val(Sz) * ((Flags) >> 3);                               \
 
1075
    if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), _size, (Flags)))) { goto badarg; }      \
 
1076
 } while (0)
 
1077
 
 
1078
#define NewBsPutFloatImm(Sz, Flags, Src)                                        \
 
1079
 do {                                                                   \
 
1080
    if (!erts_new_bs_put_float(c_p, (Src), (Sz), (Flags))) { goto badarg; }     \
 
1081
 } while (0)
 
1082
 
 
1083
#define NewBsPutFloat(Sz, Flags, Src)                                   \
 
1084
 do {                                                                   \
 
1085
    Sint _size = signed_val(Sz) * ((Flags) >> 3);                       \
 
1086
    if (!erts_new_bs_put_float(c_p, (Src), _size, (Flags))) { goto badarg; }    \
 
1087
 } while (0)
 
1088
 
 
1089
#define NewBsPutBinary(Sz, Flags, Src)                                  \
 
1090
 do {                                                                   \
 
1091
    Sint _size = signed_val(Sz) * ((Flags) >> 3);                       \
 
1092
    if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), _size))) { goto badarg; }                \
 
1093
 } while (0)
 
1094
 
 
1095
#define NewBsPutBinaryImm(Sz, Src)                                      \
 
1096
 do {                                                           \
 
1097
    if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), (Sz)))) { goto badarg; } \
 
1098
 } while (0)
 
1099
 
 
1100
#define NewBsPutBinaryAll(Src)                                  \
 
1101
 do {                                                           \
 
1102
    if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_1((Src)))) { goto badarg; }   \
 
1103
 } while (0)
 
1104
 
 
1105
/*
 
1106
 * Macros for old instruction set for constructing binaries.
 
1107
 */
 
1108
 
 
1109
#if !defined(HEAP_FRAG_ELIM_TEST)
843
1110
 
844
1111
#define BsPutInteger(Sz, Flags, Src)                                    \
845
1112
 do {                                                                   \
846
 
    int _size;                                                  \
 
1113
    Sint _size;                                                         \
847
1114
    if (!is_small(Sz) || (_size = signed_val(Sz)) < 0) { goto badarg; } \
848
1115
    _size *= ((Flags) >> 3);                                            \
849
 
    if (!erts_bs_put_integer((Src), _size, (Flags))) { goto badarg; }   \
850
 
 } while (0)
851
 
 
852
 
#define BsPutFloatImm(Sz, Flags, Src)                                   \
853
 
 do {                                                                   \
854
 
    if (!erts_bs_put_float((Src), (Sz), (Flags))) { goto badarg; }      \
 
1116
    if (!erts_bs_put_integer(ERL_BITS_ARGS_3((Src), _size, (Flags)))) { goto badarg; }  \
855
1117
 } while (0)
856
1118
 
857
1119
#define BsPutFloat(Sz, Flags, Src)                                      \
858
1120
 do {                                                                   \
859
 
    int _size;                                                  \
 
1121
    Sint _size;                                                         \
860
1122
    if (!is_small(Sz) || (_size = signed_val(Sz)) < 0) { goto badarg; } \
861
1123
    _size *= ((Flags) >> 3);                                            \
862
 
    if (!erts_bs_put_float((Src), _size, (Flags))) { goto badarg; }     \
 
1124
    if (!erts_bs_put_float(c_p, (Src), _size, (Flags))) { goto badarg; }        \
863
1125
 } while (0)
864
1126
 
865
1127
#define BsPutBinary(Sz, Flags, Src)                                     \
866
1128
 do {                                                                   \
867
 
    int _size;                                                  \
 
1129
    Sint _size;                                                         \
868
1130
    if (!is_small(Sz) || (_size = signed_val(Sz)) < 0) { goto badarg; } \
869
1131
    _size *= ((Flags) >> 3);                                            \
870
 
    if (!erts_bs_put_binary((Src), _size)) { goto badarg; }             \
871
 
 } while (0)
872
 
 
873
 
#define BsPutBinaryImm(Sz, Src)                         \
874
 
 do {                                                   \
875
 
    if (!erts_bs_put_binary((Src), (Sz))) { goto badarg; }      \
876
 
 } while (0)
877
 
 
878
 
#define BsPutBinaryAll(Src)                             \
879
 
 do {                                                   \
880
 
    if (!erts_bs_put_binary_all((Src))) { goto badarg; }        \
881
 
 } while (0)
882
 
 
 
1132
    if (!erts_bs_put_binary(ERL_BITS_ARGS_2((Src), _size))) { goto badarg; }            \
 
1133
 } while (0)
 
1134
 
 
1135
#define BsPutBinaryAll(Src)                                     \
 
1136
 do {                                                           \
 
1137
    if (!erts_bs_put_binary_all(ERL_BITS_ARGS_1((Src)))) { goto badarg; }       \
 
1138
 } while (0)
 
1139
 
 
1140
#endif
883
1141
 
884
1142
#define IsPort(Src, Fail) if (is_not_port(Src)) { Fail; }
885
1143
#define IsPid(Src, Fail) if (is_not_pid(Src)) { Fail; }
886
1144
#define IsRef(Src, Fail) if (is_not_ref(Src)) { Fail; }
887
1145
 
 
1146
#if defined(HEAP_FRAG_ELIM_TEST)
 
1147
static BifFunction translate_gc_bif(void* gcf);
 
1148
#endif
888
1149
static Eterm* handle_error(Process* c_p, Eterm* pc, Eterm* reg, BifFunction bf);
 
1150
static Eterm* next_catch(Process* c_p, Eterm *reg);
 
1151
static void terminate_proc(Process* c_p, Eterm Value);
 
1152
static Eterm add_stacktrace(Process* c_p, Eterm Value, Eterm exc);
 
1153
static void save_stacktrace(Process* c_p, Eterm* pc, Eterm* reg,
 
1154
                             BifFunction bf, Eterm args);
 
1155
static struct StackTrace * get_trace_from_exc(Eterm exc);
 
1156
static Eterm make_arglist(Process* c_p, Eterm* reg, int a);
889
1157
static Eterm call_error_handler(Process* p, Eterm* ip, Eterm* reg);
890
1158
static Eterm call_breakpoint_handler(Process* p, Eterm* fi, Eterm* reg);
 
1159
static Uint* fixed_apply(Process* p, Eterm* reg, Uint arity);
891
1160
static Eterm* apply(Process* p, Eterm module, Eterm function,
892
1161
                     Eterm args, Eterm* reg);
893
1162
static int hibernate(Process* c_p, Eterm module, Eterm function,
914
1183
 * in registers.
915
1184
 */
916
1185
 
917
 
#if defined(__GNUC__) && defined(sparc) && !defined(DEBUG)
918
 
#  define REG_x0 asm("%l0")
919
 
#  define REG_xregs asm("%l1")
920
 
#  define REG_htop asm("%l2")
921
 
#  define REG_stop asm("%l3")
922
 
#  define REG_I asm("%l4")
923
 
#  define REG_fcalls asm("%l5")
924
 
#  define REG_tmp_arg1 asm("%l6")
925
 
#  define REG_tmp_arg2 asm("%l7")
926
 
#else
927
1186
#  define REG_x0
928
1187
#  define REG_xregs
929
1188
#  define REG_htop
932
1191
#  define REG_fcalls
933
1192
#  define REG_tmp_arg1
934
1193
#  define REG_tmp_arg2
935
 
#endif
936
1194
 
937
1195
/*
938
1196
 * process_main() is called twice:
963
1221
     */
964
1222
    register Eterm* HTOP REG_htop = NULL;
965
1223
 
966
 
#ifdef SHARED_HEAP
967
 
    /* Heap limit and Stack limit. If possible, the c compiler might
968
 
     * choose to place this variable in to a register.  In any case a
969
 
     * local variable is faster than accessing the PCB.
970
 
     */
971
 
     Eterm *HeapLimit;
972
 
     Eterm *StackLimit;
 
1224
 
 
1225
#ifdef HYBRID
 
1226
     Eterm *g_htop;
 
1227
     Eterm *g_hend;
973
1228
#endif
974
1229
 
975
1230
    /* Stack pointer.  Grows downwards; points
995
1250
    register Eterm tmp_arg2 REG_tmp_arg2 = NIL;
996
1251
    Eterm tmp_big[2];           /* Temporary buffer for small bignums. */
997
1252
 
998
 
    static Eterm save_reg[MAX_REG];     
 
1253
#ifndef ERTS_SMP
 
1254
    static Eterm save_reg[ERTS_X_REGS_ALLOCATED];
999
1255
    /* X registers -- not used directly, but
1000
1256
     * through 'reg', because using it directly
1001
1257
     * needs two instructions on a SPARC,
1007
1263
     * Floating point registers.
1008
1264
     */
1009
1265
    static FloatDef freg[MAX_REG];
1010
 
 
1011
 
    /*
1012
 
     * For keeping the old value of 'reds' when call saving is active.
1013
 
     */
1014
 
    int o_reds = 0;
1015
 
 
1016
 
    /*
1017
 
     * Value to use when bumping all reductions.
1018
 
     */
1019
 
    int bumper;
 
1266
#else
 
1267
    /* X regisers and floating point registers are located in
 
1268
     * scheduler specific data.
 
1269
     */
 
1270
    register FloatDef *freg;
 
1271
#endif
 
1272
 
 
1273
    /*
 
1274
     * For keeping the negative old value of 'reds' when call saving is active.
 
1275
     */
 
1276
    int neg_o_reds = 0;
 
1277
 
 
1278
#if defined(HEAP_FRAG_ELIM_TEST)
 
1279
    Eterm (*arith_func)(Process* p, Eterm* reg, Uint live);
 
1280
#else
 
1281
    Eterm (*arith_func)(Process* p, Eterm arg1, Eterm arg2);
 
1282
#endif
1020
1283
 
1021
1284
#ifndef NO_JUMP_TABLE
1022
1285
    static void* opcodes[] = { DEFINE_OPCODES };
 
1286
#ifndef ERTS_SMP /* Not supported with smp emulator */
1023
1287
    static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES };
 
1288
#endif
1024
1289
#else
1025
1290
    int Go;
1026
1291
#endif
1027
1292
 
 
1293
    ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */
 
1294
 
 
1295
 
1028
1296
    /*
1029
1297
     * Note: In this function, we attempt to place rarely executed code towards
1030
1298
     * the end of the function, in the hope that the cache hit rate will be better.
1031
1299
     * The initialization code is only run once, so it is at the very end.
1032
1300
     *
1033
1301
     * Note: c_p->arity must be set to reflect the number of useful terms in
1034
 
     * c_p->arg_reg before *returning* from this function.  *Inside* this function,
1035
 
     * there is no need to set it.
 
1302
     * c_p->arg_reg before calling the scheduler.
1036
1303
     */
1037
1304
 
1038
1305
    if (!init_done) {
1039
1306
        init_done = 1;
1040
1307
        goto init_emulator;
1041
1308
    }
 
1309
#ifndef ERTS_SMP
1042
1310
    reg = save_reg;     /* XXX: probably wastes a register on x86 */
 
1311
#endif
1043
1312
    c_p = NULL;
1044
1313
    reds_used = 0;
1045
1314
    goto do_schedule1;
1047
1316
 do_schedule:
1048
1317
    reds_used = REDS_IN(c_p) - FCALLS;
1049
1318
 do_schedule1:
 
1319
    PROCESS_MAIN_CHK_LOCKS(c_p);
1050
1320
    c_p = schedule(c_p, reds_used);
1051
 
    ASSERT(SAVED_HEAP_TOP(c_p) == NULL);
 
1321
#ifdef ERTS_SMP
 
1322
    PROCESS_MAIN_CHK_LOCKS(c_p);
 
1323
    reg = c_p->scheduler_data->save_reg;
 
1324
    freg = c_p->scheduler_data->freg;
 
1325
#endif
 
1326
    ERL_BITS_RELOAD_STATEP(c_p);
1052
1327
    {
1053
1328
        int reds;
1054
1329
        Eterm* argp;
1071
1346
 
1072
1347
        reds = c_p->fcalls;
1073
1348
        if (c_p->ct != NULL) {
1074
 
            bumper = -CONTEXT_REDS;
1075
 
            o_reds = reds;
 
1349
            neg_o_reds = -reds;
1076
1350
            FCALLS = REDS_IN(c_p) = 0;
1077
1351
        } else {
1078
 
            bumper = 0;
1079
 
            o_reds = 0;
 
1352
            neg_o_reds = 0;
1080
1353
            FCALLS = REDS_IN(c_p) = reds;
1081
1354
        }
1082
1355
 
1101
1374
#endif
1102
1375
#include "beam_hot.h"
1103
1376
 
 
1377
#if defined(HEAP_FRAG_ELIM_TEST)
 
1378
#  define STORE_ARITH_RESULT(res) StoreBifResult(2, (res));
 
1379
#  define ARITH_FUNC(name) erts_gc_##name
 
1380
#else
 
1381
#  define STORE_ARITH_RESULT(r) StoreBifResult(1, (r));
 
1382
#  define ARITH_FUNC(name) erts_##name
 
1383
#endif
 
1384
 
 
1385
#if defined(HEAP_FRAG_ELIM_TEST)
 
1386
 OpCase(i_plus_jId):
 
1387
#else
1104
1388
 OpCase(i_plus_jd):
 
1389
#endif
1105
1390
 {
1106
1391
     Eterm result;
1107
1392
 
1108
1393
     if (is_both_small(tmp_arg1, tmp_arg2)) {
1109
 
         int i = signed_val(tmp_arg1) + signed_val(tmp_arg2);
 
1394
         Sint i = signed_val(tmp_arg1) + signed_val(tmp_arg2);
1110
1395
         ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
1111
1396
         if (MY_IS_SSMALL(i)) {
1112
1397
             result = make_small(i);
1113
 
             StoreBifResult(1, result);
 
1398
             STORE_ARITH_RESULT(result);
1114
1399
         }
1115
1400
     
1116
1401
     }
1117
 
     SAVE_HTOP;
1118
 
     result = erts_mixed_plus(c_p, tmp_arg1, tmp_arg2);
1119
 
     if (is_value(result)) {
1120
 
         StoreBifResult(1, result);
1121
 
     }
1122
 
     goto lb_Cl_error;
 
1402
     arith_func = ARITH_FUNC(mixed_plus);
 
1403
     goto do_big_arith2;
1123
1404
 }
1124
1405
 
 
1406
#if defined(HEAP_FRAG_ELIM_TEST)
 
1407
 OpCase(i_minus_jId):
 
1408
#else
1125
1409
 OpCase(i_minus_jd):
 
1410
#endif
1126
1411
 {
1127
1412
     Eterm result;
1128
1413
 
1129
1414
     if (is_both_small(tmp_arg1, tmp_arg2)) {
1130
 
         int i = signed_val(tmp_arg1) - signed_val(tmp_arg2);
 
1415
         Sint i = signed_val(tmp_arg1) - signed_val(tmp_arg2);
1131
1416
         ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
1132
1417
         if (MY_IS_SSMALL(i)) {
1133
1418
             result = make_small(i);
1134
 
             StoreBifResult(1, result);
 
1419
             STORE_ARITH_RESULT(result);
1135
1420
         }
1136
1421
     }
1137
 
     SAVE_HTOP;
1138
 
     result = erts_mixed_minus(c_p, tmp_arg1, tmp_arg2);
1139
 
     if (is_value(result)) {
1140
 
         StoreBifResult(1, result);
1141
 
     }
1142
 
     goto lb_Cl_error;
 
1422
     arith_func = ARITH_FUNC(mixed_minus);
 
1423
     goto do_big_arith2;
1143
1424
 }
1144
1425
 
1145
1426
 OpCase(i_is_lt_f):
1172
1453
    }
1173
1454
    Next(1);
1174
1455
 
 
1456
 OpCase(i_move_call_only_fcr): {
 
1457
     r(0) = Arg(1);
 
1458
 }
 
1459
 /* FALL THROUGH */
1175
1460
 OpCase(i_call_only_f): {
1176
1461
     SET_I((Eterm *) Arg(0));
1177
1462
     Dispatch();
1178
1463
 }
1179
1464
 
 
1465
 OpCase(i_move_call_last_fPcr): {
 
1466
     r(0) = Arg(2);
 
1467
 }
 
1468
 /* FALL THROUGH */
1180
1469
 OpCase(i_call_last_fP): {
1181
1470
     RESTORE_CP(E);
1182
1471
     E = ADD_BYTE_OFFSET(E, Arg(1));
1184
1473
     Dispatch();
1185
1474
 }
1186
1475
 
 
1476
 OpCase(i_move_call_crf): {
 
1477
     r(0) = Arg(0);
 
1478
     I++;
 
1479
 }
 
1480
 /* FALL THROUGH */
1187
1481
 OpCase(i_call_f): {
1188
1482
     SET_CP(c_p, I+2);
1189
1483
     SET_I((Eterm *) Arg(0));
1190
1484
     Dispatch();
1191
1485
 }
1192
1486
 
 
1487
 OpCase(i_move_call_ext_last_ePcr): {
 
1488
     r(0) = Arg(2);
 
1489
 }
 
1490
 /* FALL THROUGH */
1193
1491
 OpCase(i_call_ext_last_eP):
1194
1492
    RESTORE_CP(E);
1195
1493
    E = ADD_BYTE_OFFSET(E, Arg(1));
1201
1499
     */
1202
1500
    Dispatchx();
1203
1501
 
 
1502
 OpCase(i_move_call_ext_cre): {
 
1503
     r(0) = Arg(0);
 
1504
     I++;
 
1505
 }
 
1506
 /* FALL THROUGH */
1204
1507
 OpCase(i_call_ext_e):
1205
1508
    SET_CP(c_p, I+2);
1206
1509
    Dispatchx();
1207
1510
 
 
1511
 OpCase(i_move_call_ext_only_ecr): {
 
1512
     r(0) = Arg(1);
 
1513
 }
 
1514
 /* FALL THROUGH */
1208
1515
 OpCase(i_call_ext_only_e):
1209
1516
    Dispatchx();
1210
1517
 
1257
1564
 
1258
1565
     SWAPOUT;
1259
1566
     c_p->fcalls = FCALLS - 1;
 
1567
     PROCESS_MAIN_CHK_LOCKS(c_p);
1260
1568
     result = send_2(c_p, r(0), x(1));
 
1569
     PROCESS_MAIN_CHK_LOCKS(c_p);
1261
1570
     PreFetch(0, next);
 
1571
     POST_BIF_GC_SWAPIN(c_p, result);
1262
1572
     FCALLS = c_p->fcalls;
1263
 
     HTOP = HEAP_TOP(c_p);
1264
1573
     if (is_value(result)) {
1265
1574
         r(0) = result;
1266
1575
         CHECK_TERM(r(0));
1267
 
#ifdef HEAP_FRAG_ELIM_TEST
1268
 
         if (MBUF(c_p) != NULL) {
1269
 
             reg[0] = r(0);
1270
 
             FCALLS -= erts_garbage_collect(c_p, 0, reg, 1);
1271
 
             SWAPIN;
1272
 
             r(0) = reg[0];
1273
 
         }
1274
 
         CHECK_TERM(r(0));
1275
 
#endif
1276
1576
         NextPF(0, next);
1277
1577
     } else if (c_p->freason == RESCHEDULE) {
1278
1578
         Eterm* argp;
1290
1590
         SWAPOUT;
1291
1591
         c_p->i = I;
1292
1592
         c_p->current = NULL;
1293
 
#ifdef HEAP_FRAG_ELIM_TEST
1294
 
         if (MBUF(c_p) != NULL) {
1295
 
             FCALLS -= erts_garbage_collect(c_p, 0, argp, 2);
1296
 
         }
1297
 
#endif
1298
1593
         goto do_schedule;
1299
1594
     } else if (c_p->freason == TRAP) {
1300
1595
         SET_CP(c_p, I+1);
1301
 
         SET_I(((Export *)(c_p->def_arg_reg[0]))->address);
1302
 
#ifdef HEAP_FRAG_ELIM_TEST
1303
 
         if (MBUF(c_p) != NULL) {
1304
 
             FCALLS -= erts_garbage_collect(c_p, 0, c_p->def_arg_reg+1, 2);
1305
 
         }
1306
 
#endif
 
1596
         SET_I(((Export *)(c_p->def_arg_reg[3]))->address);
1307
1597
         SWAPIN;
1308
 
         r(0) = c_p->def_arg_reg[1];
1309
 
         x(1) = c_p->def_arg_reg[2];
 
1598
         r(0) = c_p->def_arg_reg[0];
 
1599
         x(1) = c_p->def_arg_reg[1];
1310
1600
         Dispatch();
1311
1601
     }
1312
1602
     goto find_func_info;
1358
1648
 }
1359
1649
 
1360
1650
 OpCase(catch_yf):
1361
 
    c_p->catches++;
1362
 
    yb(Arg(0)) = Arg(1);
1363
 
    Next(2);
 
1651
     c_p->catches++;
 
1652
     yb(Arg(0)) = Arg(1);
 
1653
     Next(2);
1364
1654
 
1365
1655
 OpCase(catch_end_y): {
1366
1656
     c_p->catches--;
1369
1659
         if (x(1) == am_throw) {
1370
1660
             r(0) = x(2);
1371
1661
         } else {
1372
 
#ifdef SHARED_HEAP
1373
 
             if (HeapLimit - HTOP < 3) {
1374
 
                 SWAPOUT;
1375
 
                 FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1);
1376
 
                 SWAPIN;
1377
 
             }
1378
 
#else
1379
 
             if (E - HTOP < 3) {
1380
 
                 SWAPOUT;
1381
 
                 FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1);
1382
 
                 SWAPIN;
1383
 
             }
 
1662
             if (x(1) == am_error) {
 
1663
                 SWAPOUT;
 
1664
                 x(2) = add_stacktrace(c_p, x(2), x(3));
 
1665
                 SWAPIN;
 
1666
             }
 
1667
             /* only x(2) is included in the rootset here */
 
1668
             if (E - HTOP < 3
 
1669
#if defined(HEAP_FRAG_ELIM_TEST)
 
1670
                 || c_p->mbuf   /* Force GC in case add_stacktrace()
 
1671
                                 * created heap fragments */
1384
1672
#endif
 
1673
                 ) {
 
1674
                 SWAPOUT;
 
1675
                 PROCESS_MAIN_CHK_LOCKS(c_p);
 
1676
                 FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1);
 
1677
                 PROCESS_MAIN_CHK_LOCKS(c_p);
 
1678
                 SWAPIN;
 
1679
             }
1385
1680
             r(0) = TUPLE2(HTOP, am_EXIT, x(2));
1386
1681
             HTOP += 3;
1387
1682
         }
1396
1691
     if (is_non_value(r(0))) {
1397
1692
         r(0) = x(1);
1398
1693
         x(1) = x(2);
 
1694
         x(2) = x(3);
1399
1695
     }
1400
1696
     Next(1);
1401
1697
 }
1421
1717
  *
1422
1718
  */
1423
1719
 
1424
 
 
1425
 
    /*
1426
 
     * Pick up the next message and place it in a x register (not r(0)).
1427
 
     * If no message, jump to a wait or wait_timeout instruction.
1428
 
     */
1429
 
 OpCase(loop_rec_fx):
1430
 
 {
1431
 
     Eterm* next;
1432
 
     ErlMessage* msgp = PEEK_MESSAGE(c_p);
1433
 
 
1434
 
     if (msgp == NULL) {
1435
 
         SET_I((Eterm *) Arg(0));
1436
 
         Goto(*I);              /* Jump to a wait or wait_timeout instruction */
1437
 
     }
1438
 
     PreFetch(2, next);
1439
 
     xb(Arg(1)) = ERL_MESSAGE_TERM(msgp);
1440
 
     NextPF(2, next);
1441
 
 }
1442
 
 
1443
1720
    /*
1444
1721
     * Pick up the next message and place it in x(0).
1445
1722
     * If no message, jump to a wait or wait_timeout instruction.
1446
1723
     */
1447
 
 OpCase(loop_rec_fr):
 
1724
 OpCase(i_loop_rec_fr):
1448
1725
 {
1449
1726
     Eterm* next;
1450
 
     ErlMessage* msgp = PEEK_MESSAGE(c_p);
1451
 
 
1452
 
     if (msgp == NULL) {
1453
 
         SET_I((Eterm *) Arg(0));
1454
 
         Goto(*I);              /* Jump to a wait or wait_timeout instruction */
 
1727
     ErlMessage* msgp;
 
1728
 
 
1729
 loop_rec__:
 
1730
 
 
1731
     PROCESS_MAIN_CHK_LOCKS(c_p);
 
1732
 
 
1733
     msgp = PEEK_MESSAGE(c_p);
 
1734
 
 
1735
     if (!msgp) {
 
1736
#ifdef ERTS_SMP
 
1737
         erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
 
1738
         /* Make sure messages wont pass exit signals... */
 
1739
         if (ERTS_PROC_PENDING_EXIT(c_p)) {
 
1740
             erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
 
1741
             goto do_schedule; /* Will be rescheduled for exit */
 
1742
         }
 
1743
         ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
 
1744
         msgp = PEEK_MESSAGE(c_p);
 
1745
         if (msgp)
 
1746
             erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
 
1747
         else {
 
1748
#endif
 
1749
             SET_I((Eterm *) Arg(0));
 
1750
             Goto(*I);          /* Jump to a wait or wait_timeout instruction */
 
1751
#ifdef ERTS_SMP
 
1752
         }
 
1753
#endif
1455
1754
     }
 
1755
     MV_MSG_MBUF_INTO_PROC(msgp);
1456
1756
     PreFetch(1, next);
1457
1757
     r(0) = ERL_MESSAGE_TERM(msgp);
1458
1758
     NextPF(1, next);
1465
1765
     Eterm* next;
1466
1766
     ErlMessage* msgp;
1467
1767
 
 
1768
     PROCESS_MAIN_CHK_LOCKS(c_p);
 
1769
 
1468
1770
     PreFetch(0, next);
1469
1771
     msgp = PEEK_MESSAGE(c_p);
 
1772
 
1470
1773
     if (c_p->ct != NULL) {
1471
1774
         save_calls(c_p, &exp_receive);
1472
1775
     }
1493
1796
     JOIN_MESSAGE(c_p);
1494
1797
     CANCEL_TIMER(c_p);
1495
1798
     free_message(msgp);
 
1799
 
 
1800
     PROCESS_MAIN_CHK_LOCKS(c_p);
 
1801
 
1496
1802
     NextPF(0, next);
1497
1803
 }
1498
1804
 
1503
1809
 OpCase(loop_rec_end_f): {
1504
1810
     SET_I((Eterm *) Arg(0));
1505
1811
     SAVE_MESSAGE(c_p);
1506
 
     Goto(*I);          /* To loop_rec */
 
1812
     goto loop_rec__;
1507
1813
 }
1508
1814
    /*
1509
1815
     * Prepare to wait for a message or a timeout, whichever occurs first.
 
1816
     *
 
1817
     * Note: In order to keep the compatibility between 32 and 64 bits
 
1818
     * emulators, only timeout values that can be represented in 32 bits
 
1819
     * (unsigned) or less are allowed.
1510
1820
     */
1511
 
 OpCase(wait_timeout_fs): {
 
1821
 
 
1822
 
 
1823
 OpCase(i_wait_timeout_fs): {
 
1824
     erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
 
1825
 
 
1826
     /* Fall through */
 
1827
 }
 
1828
 OpCase(i_wait_timeout_locked_fs): {
1512
1829
     Eterm timeout_value;
1513
1830
 
1514
1831
     /*
1520
1837
     }
1521
1838
     GetArg1(1, timeout_value);
1522
1839
     if (timeout_value != make_small(0)) {
 
1840
#if !defined(ARCH_64)
1523
1841
         Uint time_val;
 
1842
#endif
1524
1843
 
1525
 
         if (is_small(timeout_value) && signed_val(timeout_value) > 0) {
 
1844
         if (is_small(timeout_value) && signed_val(timeout_value) > 0 &&
 
1845
#if defined(ARCH_64)
 
1846
             ((unsigned_val(timeout_value) >> 32) == 0)
 
1847
#else
 
1848
             1
 
1849
#endif
 
1850
             ) {
1526
1851
             /*
1527
1852
              * The timer routiner will set c_p->i to the value in
1528
1853
              * c_p->def_arg_reg[0].  Note that it is safe to use this
1533
1858
             set_timer(c_p, unsigned_val(timeout_value));
1534
1859
         } else if (timeout_value == am_infinity) {
1535
1860
             c_p->flags |= F_TIMO;
 
1861
#if !defined(ARCH_64)
1536
1862
         } else if (term_to_Uint(timeout_value, &time_val)) {
1537
1863
             c_p->def_arg_reg[0] = (Eterm) (I+3);
1538
1864
             set_timer(c_p, time_val);
 
1865
#endif
1539
1866
         } else {               /* Wrong time */
1540
 
             OpCase(i_wait_error):
1541
 
             c_p->freason = EXC_TIMEOUT_VALUE;
1542
 
             goto find_func_info;
 
1867
             OpCase(i_wait_error_locked): {
 
1868
                 erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
 
1869
                 /* Fall through */
 
1870
             }
 
1871
             OpCase(i_wait_error): {
 
1872
                 c_p->freason = EXC_TIMEOUT_VALUE;
 
1873
                 goto find_func_info;
 
1874
             }
1543
1875
         }
1544
1876
 
1545
1877
         /*
1552
1884
          * instruction following the wait_timeout instruction.
1553
1885
          */
1554
1886
 
 
1887
         OpCase(wait_locked_f):
1555
1888
         OpCase(wait_f):
1556
1889
 
1557
1890
         wait2: {
 
1891
             ASSERT(!ERTS_PROC_IS_EXITING(c_p));
1558
1892
             c_p->i = (Eterm *) Arg(0); /* L1 */
1559
1893
             SWAPOUT;
1560
1894
             c_p->arity = 0;
1561
1895
             c_p->status = P_WAITING;
 
1896
             erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
1562
1897
             c_p->current = NULL;
1563
1898
             goto do_schedule;
1564
1899
         }
 
1900
         OpCase(wait_unlocked_f): {
 
1901
             erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
 
1902
             goto wait2;
 
1903
         }
1565
1904
     }
 
1905
     erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
1566
1906
     Next(2);
1567
1907
 }
1568
1908
 
1569
 
 OpCase(wait_timeout_fI):
 
1909
 OpCase(i_wait_timeout_fI): {
 
1910
     erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
 
1911
 }
 
1912
 
 
1913
 OpCase(i_wait_timeout_locked_fI):
1570
1914
 {
1571
1915
     /*
1572
1916
      * If we have already set the timer, we must NOT set it again.  Therefore,
1583
1927
     * A timeout has occurred.  Reset the save pointer so that the next
1584
1928
     * receive statement will examine the first message first.
1585
1929
     */
 
1930
 OpCase(timeout_locked): {
 
1931
     erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
 
1932
 }
 
1933
 
1586
1934
 OpCase(timeout): {
1587
1935
     Eterm* next;
1588
1936
 
1590
1938
     if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) {
1591
1939
         trace_receive(c_p, am_timeout);
1592
1940
     }
1593
 
     if (c_p->ct != NULL)
1594
 
        save_calls(c_p, &exp_timeout);
 
1941
     if (c_p->ct != NULL) {
 
1942
         save_calls(c_p, &exp_timeout);
 
1943
     }
1595
1944
     c_p->flags &= ~F_TIMO;
1596
1945
     JOIN_MESSAGE(c_p);
1597
1946
     NextPF(0, next);
1649
1998
 
1650
1999
     GetArg1(0, index);
1651
2000
     if (is_small(index)) {
1652
 
         index = (unsigned) (signed_val(index) - Arg(3));
 
2001
         index = (Uint) (signed_val(index) - Arg(3));
1653
2002
         if (index < Arg(2)) {
1654
2003
             SET_I((Eterm *) (&Arg(4))[index]);
1655
2004
             Goto(*I);
1683
2032
        bf = (BifFunction) Arg(1);
1684
2033
        SAVE_HTOP;
1685
2034
        c_p->fcalls = FCALLS;
 
2035
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2036
        ASSERT(!ERTS_PROC_IS_EXITING(c_p));
1686
2037
        result = (*bf)(c_p, arg);
 
2038
        ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
 
2039
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2040
        ERTS_HOLE_CHECK(c_p);
1687
2041
        FCALLS = c_p->fcalls;
1688
2042
        if (is_value(result)) {
1689
2043
            StoreBifResult(3, result);
1707
2061
        bf = (BifFunction) Arg(0);
1708
2062
        SAVE_HTOP;
1709
2063
        c_p->fcalls = FCALLS;
 
2064
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2065
        ASSERT(!ERTS_PROC_IS_EXITING(c_p));
1710
2066
        result = (*bf)(c_p, arg);
 
2067
        ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
 
2068
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2069
        ERTS_HOLE_CHECK(c_p);
1711
2070
        FCALLS = c_p->fcalls;
1712
2071
        if (is_value(result)) {
1713
2072
            StoreBifResult(2, result);
1714
2073
        }
1715
2074
        reg[0] = arg;
1716
2075
        SWAPOUT;
1717
 
        c_p->cp = NULL;
1718
2076
        I = handle_error(c_p, I, reg, bf);
1719
2077
        goto post_error_handling;
1720
2078
    }
1721
2079
 
 
2080
#if defined(HEAP_FRAG_ELIM_TEST)
 
2081
 OpCase(i_gc_bif1_jIsId):
 
2082
    {
 
2083
        typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
 
2084
        GcBifFunction bf;
 
2085
        Eterm arg;
 
2086
        Eterm result;
 
2087
        Uint live = Arg(3);
 
2088
 
 
2089
        GetArg1(2, arg);
 
2090
        reg[0] = r(0);
 
2091
        reg[live] = arg;
 
2092
        bf = (GcBifFunction) Arg(1);
 
2093
        c_p->fcalls = FCALLS;
 
2094
        SWAPOUT;
 
2095
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2096
        result = (*bf)(c_p, reg, live);
 
2097
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2098
        SWAPIN;
 
2099
        r(0) = reg[0];
 
2100
        ERTS_HOLE_CHECK(c_p);
 
2101
        FCALLS = c_p->fcalls;
 
2102
        if (is_value(result)) {
 
2103
            StoreBifResult(4, result);
 
2104
        }
 
2105
        if (Arg(0) != 0) {
 
2106
            SET_I((Eterm *) Arg(0));
 
2107
            Goto(*I);
 
2108
        }
 
2109
        reg[0] = arg;
 
2110
        I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
 
2111
        goto post_error_handling;
 
2112
    }
 
2113
#endif
 
2114
 
1722
2115
 /*
1723
2116
  * Guards bifs and, or, xor in guards.
1724
2117
  */
1730
2123
        bf = (BifFunction) Arg(1);
1731
2124
        SAVE_HTOP;
1732
2125
        c_p->fcalls = FCALLS;
 
2126
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2127
        ASSERT(!ERTS_PROC_IS_EXITING(c_p));
1733
2128
        result = (*bf)(c_p, tmp_arg1, tmp_arg2);
 
2129
        ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
 
2130
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2131
        ERTS_HOLE_CHECK(c_p);
1734
2132
        FCALLS = c_p->fcalls;
1735
2133
        if (is_value(result)) {
1736
2134
            StoreBifResult(2, result);
1749
2147
 
1750
2148
        bf = (BifFunction) Arg(0);
1751
2149
        SAVE_HTOP;
 
2150
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2151
        ASSERT(!ERTS_PROC_IS_EXITING(c_p));
1752
2152
        result = (*bf)(c_p, tmp_arg1, tmp_arg2);
 
2153
        ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
 
2154
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2155
        ERTS_HOLE_CHECK(c_p);
1753
2156
        if (is_value(result)) {
1754
2157
            ASSERT(!is_CP(result));
1755
2158
            StoreBifResult(1, result);
1757
2160
        reg[0] = tmp_arg1;
1758
2161
        reg[1] = tmp_arg2;
1759
2162
        SWAPOUT;
1760
 
        c_p->cp = NULL;
1761
2163
        I = handle_error(c_p, I, reg, bf);
1762
2164
        goto post_error_handling;
1763
2165
    }
1779
2181
        /*
1780
2182
         * A BIF with no arguments cannot fail (especially not with badarg).
1781
2183
         */
 
2184
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2185
        ASSERT(!ERTS_PROC_IS_EXITING(c_p));
1782
2186
        r(0) = (*bf)(c_p, I);
 
2187
        ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(r(0)));
 
2188
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2189
        ERTS_HOLE_CHECK(c_p);
 
2190
        POST_BIF_GC_SWAPIN(c_p, r(0));
1783
2191
        FCALLS = c_p->fcalls;
1784
 
        HTOP = HEAP_TOP(c_p);
1785
2192
        CHECK_TERM(r(0));
1786
2193
        Next(1);
1787
2194
    }
1792
2199
        Eterm result;
1793
2200
        Eterm* next;
1794
2201
 
1795
 
        SWAPOUT;
1796
2202
        c_p->fcalls = FCALLS - 1;
1797
2203
        if (FCALLS <= 0) {
1798
 
           save_calls(c_p, (Export *) Arg(0));
 
2204
            save_calls(c_p, (Export *) Arg(0));
1799
2205
        }
1800
2206
        PreFetch(1, next);
 
2207
        SWAPOUT;
 
2208
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2209
        ASSERT(!ERTS_PROC_IS_EXITING(c_p));
1801
2210
        result = (*bf)(c_p, r(0), I);
 
2211
        ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
 
2212
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2213
        ERTS_HOLE_CHECK(c_p);
 
2214
        POST_BIF_GC_SWAPIN(c_p, result);
1802
2215
        FCALLS = c_p->fcalls;
1803
 
        HTOP = HEAP_TOP(c_p);
1804
 
        if (is_value(result)) {
 
2216
        if (is_value(result)) {
1805
2217
            r(0) = result;
1806
2218
            CHECK_TERM(r(0));
1807
2219
            NextPF(1, next);
1817
2229
         */
1818
2230
        ASSERT(c_p->stop == E);
1819
2231
        reg[0] = r(0);
1820
 
        c_p->cp = NULL;
1821
2232
        I = handle_error(c_p, I, reg, bf);
1822
2233
        goto post_error_handling;
1823
2234
    }
1836
2247
        PreFetch(1, next);
1837
2248
        CHECK_TERM(r(0));
1838
2249
        CHECK_TERM(x(1));
 
2250
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2251
        ASSERT(!ERTS_PROC_IS_EXITING(c_p));
1839
2252
        result = (*bf)(c_p, r(0), x(1), I);
 
2253
        ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
 
2254
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2255
        ERTS_HOLE_CHECK(c_p);
 
2256
        POST_BIF_GC_SWAPIN(c_p, result);
1840
2257
        FCALLS = c_p->fcalls;
1841
 
        HTOP = HEAP_TOP(c_p);
1842
2258
        if (is_value(result)) {
1843
2259
            r(0) = result;
1844
2260
            CHECK_TERM(r(0));
1855
2271
         */
1856
2272
        ASSERT(c_p->stop == E);
1857
2273
        reg[0] = r(0);
1858
 
        c_p->cp = NULL;
1859
2274
        I = handle_error(c_p, I, reg, bf);
1860
2275
        goto post_error_handling;
1861
2276
    }
1872
2287
           save_calls(c_p, (Export *) Arg(0));
1873
2288
        }
1874
2289
        PreFetch(1, next);
 
2290
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2291
        ASSERT(!ERTS_PROC_IS_EXITING(c_p));
1875
2292
        result = (*bf)(c_p, r(0), x(1), x(2), I);
 
2293
        ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
 
2294
        PROCESS_MAIN_CHK_LOCKS(c_p);
 
2295
        ERTS_HOLE_CHECK(c_p);
 
2296
        POST_BIF_GC_SWAPIN(c_p, result);
1876
2297
        FCALLS = c_p->fcalls;
1877
 
        HTOP = HEAP_TOP(c_p);
1878
2298
        if (is_value(result)) {
1879
2299
            r(0) = result;
1880
2300
            CHECK_TERM(r(0));
1885
2305
        } else if (c_p->freason == TRAP) {
1886
2306
        call_bif_trap3:
1887
2307
            SET_CP(c_p, I+2);
1888
 
            SET_I(((Export *)(c_p->def_arg_reg[0]))->address);
 
2308
            SET_I(((Export *)(c_p->def_arg_reg[3]))->address);
1889
2309
            SWAPIN;
1890
 
            r(0) = c_p->def_arg_reg[1];
1891
 
            x(1) = c_p->def_arg_reg[2];
1892
 
            x(2) = c_p->def_arg_reg[3];
 
2310
            r(0) = c_p->def_arg_reg[0];
 
2311
            x(1) = c_p->def_arg_reg[1];
 
2312
            x(2) = c_p->def_arg_reg[2];
1893
2313
            Dispatch();
1894
2314
        }
1895
2315
 
1898
2318
         */
1899
2319
        ASSERT(c_p->stop == E);
1900
2320
        reg[0] = r(0);
1901
 
        c_p->cp = NULL;
1902
2321
        I = handle_error(c_p, I, reg, bf);
1903
2322
        goto post_error_handling;
1904
2323
    }
1907
2326
  * Arithmetic operations.
1908
2327
  */
1909
2328
 
 
2329
#if defined(HEAP_FRAG_ELIM_TEST)
 
2330
 OpCase(i_times_jId):
 
2331
#else
1910
2332
 OpCase(i_times_jd):
1911
 
 {
1912
 
     Eterm result;
1913
 
 
 
2333
#endif
 
2334
 {
 
2335
     arith_func = ARITH_FUNC(mixed_times);
 
2336
     goto do_big_arith2;
 
2337
 }
 
2338
 
 
2339
#if defined(HEAP_FRAG_ELIM_TEST)
 
2340
 OpCase(i_m_div_jId):
 
2341
#else
 
2342
 OpCase(i_m_div_jd):
 
2343
#endif
 
2344
 {
 
2345
     arith_func = ARITH_FUNC(mixed_div);
 
2346
     goto do_big_arith2;
 
2347
 }
 
2348
 
 
2349
#if defined(HEAP_FRAG_ELIM_TEST)
 
2350
 OpCase(i_int_div_jId):
 
2351
#else
 
2352
 OpCase(i_int_div_jd):
 
2353
#endif
 
2354
 {
 
2355
     Eterm result;
 
2356
 
 
2357
     if (tmp_arg2 == SMALL_ZERO) {
 
2358
         goto badarith;
 
2359
     } else if (is_both_small(tmp_arg1, tmp_arg2)) {
 
2360
         Sint ires = signed_val(tmp_arg1) / signed_val(tmp_arg2);
 
2361
         if (MY_IS_SSMALL(ires)) {
 
2362
             result = make_small(ires);
 
2363
             STORE_ARITH_RESULT(result);
 
2364
         }
 
2365
     }
 
2366
     arith_func = ARITH_FUNC(int_div);
 
2367
     goto do_big_arith2;
 
2368
 }
 
2369
 
 
2370
#if defined(HEAP_FRAG_ELIM_TEST)
 
2371
 OpCase(i_rem_jId):
 
2372
#else
 
2373
 OpCase(i_rem_jd):
 
2374
#endif
 
2375
 {
 
2376
     Eterm result;
 
2377
 
 
2378
     if (tmp_arg2 == SMALL_ZERO) {
 
2379
         goto badarith;
 
2380
     } else if (is_both_small(tmp_arg1, tmp_arg2)) {
 
2381
         result = make_small(signed_val(tmp_arg1) % signed_val(tmp_arg2));
 
2382
         STORE_ARITH_RESULT(result);
 
2383
     } else {
 
2384
         arith_func = ARITH_FUNC(int_rem);
 
2385
         goto do_big_arith2;
 
2386
     }
 
2387
 }
 
2388
 
 
2389
#if defined(HEAP_FRAG_ELIM_TEST)
 
2390
 OpCase(i_band_jId):
 
2391
#else
 
2392
 OpCase(i_band_jd):
 
2393
#endif
 
2394
 {
 
2395
     Eterm result;
 
2396
 
 
2397
     if (is_both_small(tmp_arg1, tmp_arg2)) {
 
2398
         /*
 
2399
          * No need to untag -- TAG & TAG == TAG.
 
2400
          */
 
2401
         result = tmp_arg1 & tmp_arg2;
 
2402
         STORE_ARITH_RESULT(result);
 
2403
     }
 
2404
     arith_func = ARITH_FUNC(band);
 
2405
     goto do_big_arith2;
 
2406
 }
 
2407
 
 
2408
 do_big_arith2:
 
2409
 {
 
2410
     Eterm result;
 
2411
#if defined(HEAP_FRAG_ELIM_TEST)
 
2412
     Uint live = Arg(1);
 
2413
 
 
2414
     SWAPOUT;
 
2415
     reg[0] = r(0);
 
2416
     reg[live] = tmp_arg1;
 
2417
     reg[live+1] = tmp_arg2;
 
2418
     result = arith_func(c_p, reg, live);
 
2419
     r(0) = reg[0];
 
2420
     SWAPIN;
 
2421
     ERTS_HOLE_CHECK(c_p);
 
2422
     if (is_value(result)) {
 
2423
         STORE_ARITH_RESULT(result);
 
2424
     }
 
2425
     goto lb_Cl_error;
 
2426
#else
1914
2427
     SAVE_HTOP;
1915
 
     result = erts_mixed_times(c_p, tmp_arg1, tmp_arg2);
 
2428
     result = arith_func(c_p, tmp_arg1, tmp_arg2);
1916
2429
     if (is_value(result)) {
1917
 
         StoreBifResult(1, result);
 
2430
         STORE_ARITH_RESULT(result);
1918
2431
     }
 
2432
     goto lb_Cl_error;
 
2433
#endif
1919
2434
 }
1920
 
    /* Fall through into lb_Cl_error. */
1921
2435
 
1922
2436
 /*
1923
2437
  * An error occured in an arithmetic operation or test that could
1936
2450
     goto find_func_info;
1937
2451
 }
1938
2452
 
1939
 
 OpCase(i_m_div_jd):
1940
 
 {
1941
 
     Eterm result;
1942
 
 
1943
 
     SAVE_HTOP;
1944
 
     result = erts_mixed_div(c_p, tmp_arg1, tmp_arg2);
1945
 
     if (is_value(result)) {
1946
 
         StoreBifResult(1, result);
1947
 
     }
1948
 
     goto lb_Cl_error;
1949
 
 }
1950
 
 
1951
 
 OpCase(i_int_div_jd):
1952
 
 {
1953
 
     Eterm result;
1954
 
 
1955
 
     if (tmp_arg2 == SMALL_ZERO) {
1956
 
         goto badarith;
1957
 
     } else if (is_both_small(tmp_arg1, tmp_arg2)) {
1958
 
         result = make_small(signed_val(tmp_arg1) / signed_val(tmp_arg2));
1959
 
         StoreBifResult(1, result);
1960
 
     }
1961
 
     SAVE_HTOP;
1962
 
     result = erts_int_div(c_p, tmp_arg1, tmp_arg2);
1963
 
     if (is_value(result)) {
1964
 
         StoreBifResult(1, result);
1965
 
     }
1966
 
     goto lb_Cl_error;
1967
 
 }
1968
 
 
1969
 
 OpCase(i_rem_jd):
1970
 
 {
1971
 
     Eterm result;
1972
 
 
1973
 
     if (tmp_arg2 == SMALL_ZERO) {
1974
 
         goto badarith;
1975
 
     } else if (is_both_small(tmp_arg1, tmp_arg2)) {
1976
 
         result = make_small(signed_val(tmp_arg1) % signed_val(tmp_arg2));
1977
 
     } else {
1978
 
         SAVE_HTOP;
1979
 
         result = erts_int_rem(c_p, tmp_arg1, tmp_arg2);
1980
 
     }
1981
 
     if (is_value(result)) {
1982
 
         StoreBifResult(1, result);
1983
 
     }
1984
 
     goto lb_Cl_error;
1985
 
 }
1986
 
 
1987
 
 OpCase(i_band_jd):
1988
 
 {
1989
 
     Eterm result;
1990
 
 
1991
 
     if (is_both_small(tmp_arg1, tmp_arg2)) {
1992
 
         /*
1993
 
          * No need to untag -- TAG & TAG == TAG.
1994
 
          */
1995
 
         result = tmp_arg1 & tmp_arg2;
1996
 
         StoreBifResult(1, result);
1997
 
     }
1998
 
     SAVE_HTOP;
1999
 
     result = erts_band(c_p, tmp_arg1, tmp_arg2);
2000
 
     if (is_value(result)) {
2001
 
         StoreBifResult(1, result);
2002
 
     }
2003
 
     goto lb_Cl_error;
2004
 
 }
2005
 
 
 
2453
#if defined(HEAP_FRAG_ELIM_TEST)
 
2454
 OpCase(i_bor_jId):
 
2455
#else
2006
2456
 OpCase(i_bor_jd):
 
2457
#endif
2007
2458
 {
2008
2459
     Eterm result;
2009
2460
 
2012
2463
          * No need to untag -- TAG | TAG == TAG.
2013
2464
          */
2014
2465
         result = tmp_arg1 | tmp_arg2;
2015
 
         StoreBifResult(1, result);
2016
 
     }
2017
 
     SAVE_HTOP;
2018
 
     result = erts_bor(c_p, tmp_arg1, tmp_arg2);
2019
 
     if (is_value(result)) {
2020
 
         StoreBifResult(1, result);
2021
 
     }
2022
 
     goto lb_Cl_error;
 
2466
         STORE_ARITH_RESULT(result);
 
2467
     }
 
2468
     arith_func = ARITH_FUNC(bor);
 
2469
     goto do_big_arith2;
2023
2470
 }
2024
2471
 
 
2472
#if defined(HEAP_FRAG_ELIM_TEST)
 
2473
 OpCase(i_bxor_jId):
 
2474
#else
2025
2475
 OpCase(i_bxor_jd):
 
2476
#endif
2026
2477
 {
2027
2478
     Eterm result;
2028
2479
 
2032
2483
          * could mean a shift.  Therefore, play it safe here.
2033
2484
          */
2034
2485
         result = make_small(signed_val(tmp_arg1) ^ signed_val(tmp_arg2));
2035
 
         StoreBifResult(1, result);
2036
 
     }
2037
 
     SAVE_HTOP;
2038
 
     result = erts_bxor(c_p, tmp_arg1, tmp_arg2);
2039
 
     if (is_value(result)) {
2040
 
         StoreBifResult(1, result);
2041
 
     }
2042
 
     goto lb_Cl_error;
2043
 
 }
2044
 
 
2045
 
 {
2046
 
     int i;
2047
 
     int ires;
 
2486
         STORE_ARITH_RESULT(result);
 
2487
     }
 
2488
     arith_func = ARITH_FUNC(bxor);
 
2489
     goto do_big_arith2;
 
2490
 }
 
2491
 
 
2492
#if defined(HEAP_FRAG_ELIM_TEST)
 
2493
 {
 
2494
     Sint i;
 
2495
     Sint ires;
 
2496
     Eterm* bigp;
 
2497
 
 
2498
     OpCase(i_bsr_jId):
 
2499
         if (is_small(tmp_arg2)) {
 
2500
             i = -signed_val(tmp_arg2);
 
2501
             if (is_small(tmp_arg1)) {
 
2502
                 goto small_shift;
 
2503
             } else if (is_big(tmp_arg1)) {
 
2504
                 if (i == 0) {
 
2505
                     StoreBifResult(2, tmp_arg1);
 
2506
                 }
 
2507
                 goto big_shift;
 
2508
             }
 
2509
         }
 
2510
     goto badarith;
 
2511
     
 
2512
     OpCase(i_bsl_jId):
 
2513
         if (is_small(tmp_arg2)) {
 
2514
             i = signed_val(tmp_arg2);
 
2515
 
 
2516
             if (is_small(tmp_arg1)) {
 
2517
             small_shift:
 
2518
                 ires = signed_val(tmp_arg1);
 
2519
             
 
2520
                 if (i == 0 || ires == 0) {
 
2521
                     StoreBifResult(2, tmp_arg1);
 
2522
                 } else if (i < 0)  { /* Right shift */
 
2523
                     i = -i;
 
2524
                     if (i >= SMALL_BITS-1) {
 
2525
                         tmp_arg1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
 
2526
                     } else {
 
2527
                         tmp_arg1 = make_small(ires >> i);
 
2528
                     }
 
2529
                     StoreBifResult(2, tmp_arg1);
 
2530
                 } else if (i < SMALL_BITS-1) { /* Left shift */
 
2531
                     if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) ||
 
2532
                         ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) {
 
2533
                         tmp_arg1 = make_small(ires << i);
 
2534
                         StoreBifResult(2, tmp_arg1);
 
2535
                     }
 
2536
                 }
 
2537
                 tmp_arg1 = small_to_big(ires, tmp_big);
 
2538
 
 
2539
             big_shift:
 
2540
                 if (i > 0) {   /* Left shift. */
 
2541
                     ires = big_size(tmp_arg1) + (i / D_EXP);
 
2542
                 } else {       /* Right shift. */
 
2543
                     ires = big_size(tmp_arg1);
 
2544
                     if (ires <= (-i / D_EXP))
 
2545
                         ires = 3; /* ??? */
 
2546
                     else
 
2547
                         ires -= (-i / D_EXP);
 
2548
                 }
 
2549
                 {
 
2550
                     Uint live = Arg(1);
 
2551
                     ires = BIG_NEED_SIZE(ires+1);
 
2552
                     SWAPOUT;
 
2553
                     reg[0] = r(0);
 
2554
                     reg[live] = tmp_arg1;
 
2555
                     
 
2556
                     PROCESS_MAIN_CHK_LOCKS(c_p);
 
2557
                     FCALLS -= erts_garbage_collect(c_p, ires, reg, live+1);
 
2558
                     PROCESS_MAIN_CHK_LOCKS(c_p);
 
2559
                     r(0) = reg[0];
 
2560
                     SWAPIN;
 
2561
                     bigp = HTOP;
 
2562
                     tmp_arg1 = big_lshift(reg[live], i, bigp);
 
2563
                     if (is_big(tmp_arg1)) {
 
2564
                         HTOP += bignum_header_arity(*HTOP) + 1;
 
2565
                     }
 
2566
                     if (is_nil(tmp_arg1)) {
 
2567
                         c_p->freason = SYSTEM_LIMIT;
 
2568
                         goto lb_Cl_error;
 
2569
                     }
 
2570
                     ERTS_HOLE_CHECK(c_p);
 
2571
                     StoreBifResult(2, tmp_arg1);
 
2572
                 }
 
2573
             } else if (is_big(tmp_arg1)) {
 
2574
                 if (i == 0) {
 
2575
                     StoreBifResult(2, tmp_arg1);
 
2576
                 }
 
2577
                 goto big_shift;
 
2578
             }
 
2579
         }
 
2580
     goto badarith;
 
2581
 }
 
2582
#else
 
2583
 {
 
2584
     Sint i;
 
2585
     Sint ires;
2048
2586
     Eterm* bigp;
2049
2587
 
2050
2588
     OpCase(i_bsr_jd):
2080
2618
                     }
2081
2619
                     StoreBifResult(1, tmp_arg1);
2082
2620
                 } else if (i < SMALL_BITS-1) { /* Left shift */
2083
 
                     if ((ires > 0 && ((-1 << ((SMALL_BITS-1)-i)) & ires) == 0) ||
2084
 
                         ((-1 << ((SMALL_BITS-1)-i)) & ~ires) == 0) {
 
2621
                     if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) ||
 
2622
                         ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) {
2085
2623
                         tmp_arg1 = make_small(ires << i);
2086
2624
                         StoreBifResult(1, tmp_arg1);
2087
2625
                     }
2094
2632
                 } else {       /* Right shift. */
2095
2633
                     ires = big_size(tmp_arg1);
2096
2634
                     if (ires <= (-i / D_EXP))
2097
 
                         ires = 3;
 
2635
                         ires = 3; /* ??? */
2098
2636
                     else
2099
2637
                         ires -= (-i / D_EXP);
2100
2638
                 }
2101
2639
                 bigp = BeamArithAlloc(c_p, BIG_NEED_SIZE(ires+1));
2102
2640
 
2103
2641
                 tmp_arg1 = big_lshift(tmp_arg1, i, bigp);
2104
 
                 ArithCheck(c_p);
2105
2642
                 if (is_nil(tmp_arg1)) {
2106
 
                 system_limit:
 
2643
                     erts_arith_shrink(c_p, bigp);
2107
2644
                     c_p->freason = SYSTEM_LIMIT;
2108
2645
                     goto lb_Cl_error;
2109
2646
                 }
 
2647
                 MAYBE_SHRINK(c_p,bigp,tmp_arg1,BIG_NEED_SIZE(ires+1));
 
2648
                 ArithCheck(c_p);
2110
2649
                 StoreBifResult(1, tmp_arg1);
2111
2650
             } else if (is_big(tmp_arg1)) {
2112
2651
                 if (i == 0) {
2115
2654
                 goto big_shift;
2116
2655
             }
2117
2656
         }
 
2657
     goto badarith;
 
2658
 }
 
2659
#endif
 
2660
 
 
2661
#if defined(HEAP_FRAG_ELIM_TEST)
 
2662
 OpCase(i_int_bnot_jsId):
 
2663
#else
 
2664
 OpCase(i_int_bnot_jsd):
 
2665
#endif
 
2666
 {
 
2667
     GetArg1(1, tmp_arg1);
 
2668
     if (is_small(tmp_arg1)) {
 
2669
         tmp_arg1 = make_small(~signed_val(tmp_arg1));
 
2670
     } else {
 
2671
#if !defined(HEAP_FRAG_ELIM_TEST)
 
2672
         tmp_arg1 = erts_bnot(c_p, tmp_arg1);
 
2673
#else
 
2674
         Uint live = Arg(2);
 
2675
         SWAPOUT;
 
2676
         reg[0] = r(0);
 
2677
         reg[live] = tmp_arg1;
 
2678
         tmp_arg1 = erts_gc_bnot(c_p, reg, live);
 
2679
         r(0) = reg[0];
 
2680
         SWAPIN;
 
2681
         ERTS_HOLE_CHECK(c_p);
 
2682
#endif
 
2683
         if (is_nil(tmp_arg1)) {
 
2684
             goto lb_Cl_error;
 
2685
         }
 
2686
     }
 
2687
#if defined(HEAP_FRAG_ELIM_TEST)
 
2688
 StoreBifResult(3, tmp_arg1);
 
2689
#else
 
2690
 StoreBifResult(2, tmp_arg1);
 
2691
#endif
2118
2692
 }
2119
2693
 
2120
2694
 badarith:
2123
2697
 
2124
2698
 OpCase(i_apply): {
2125
2699
     Eterm* next;
2126
 
 
2127
2700
     if ((next = apply(c_p, r(0), x(1), x(2), reg)) != NULL) {
2128
2701
         r(0) = reg[0];
2129
2702
         SET_CP(c_p, I+1);
2163
2736
     goto post_error_handling;
2164
2737
 }
2165
2738
 
 
2739
 OpCase(apply_I): {
 
2740
     Eterm* next;
 
2741
 
 
2742
     reg[0] = r(0);
 
2743
     SWAPOUT;
 
2744
     next = fixed_apply(c_p, reg, Arg(0));
 
2745
     HTOP = HEAP_TOP(c_p);
 
2746
     if (next != NULL) {
 
2747
         r(0) = reg[0];
 
2748
         SET_CP(c_p, I+2);
 
2749
         SET_I(next);
 
2750
         Dispatch();
 
2751
     }
 
2752
     I = handle_error(c_p, I, reg, apply_3);
 
2753
     goto post_error_handling;
 
2754
 }
 
2755
 
 
2756
 OpCase(apply_last_IP): {
 
2757
     Eterm* next;
 
2758
 
 
2759
     reg[0] = r(0);
 
2760
     SWAPOUT;
 
2761
     next = fixed_apply(c_p, reg, Arg(0));
 
2762
     HTOP = HEAP_TOP(c_p);
 
2763
     if (next != NULL) {
 
2764
         r(0) = reg[0];
 
2765
         SET_CP(c_p, (Eterm *) E[0]);
 
2766
         E = ADD_BYTE_OFFSET(E, Arg(1));
 
2767
         SET_I(next);
 
2768
         Dispatch();
 
2769
     }
 
2770
     I = handle_error(c_p, I, reg, apply_3);
 
2771
     goto post_error_handling;
 
2772
 }
 
2773
 
2166
2774
 OpCase(i_apply_fun): {
2167
2775
     Eterm* next;
2168
2776
 
2326
2934
     c_p->arg_reg[0] = r(0);
2327
2935
     SWAPOUT;
2328
2936
     c_p->i = I;
 
2937
     erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
2329
2938
     add_to_schedule_q(c_p);
 
2939
     erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
2330
2940
     goto do_schedule1;
2331
2941
 }
2332
2942
 
2351
2961
#else
2352
2962
 OpCase(i_put_float_od):
2353
2963
 {
2354
 
     Eterm* hp = BeamArithAlloc(c_p, 3);
 
2964
     Eterm* hp = BeamArithAlloc(c_p, FLOAT_SIZE_OBJECT);
2355
2965
     Eterm f = make_float(hp);
2356
2966
 
2357
 
     hp[0] = HEADER_FLONUM;     /* Arg(0) == HEADER_FLONUM */
2358
 
     hp[1] = Arg(1);
2359
 
     hp[2] = Arg(2);
 
2967
     PUT_DOUBLE(*(FloatDef*)&Arg(1), hp);
2360
2968
     StoreBifResult(3, f);
2361
2969
 }
2362
2970
 
2363
2971
 OpCase(i_fetch_float1_o):
2364
2972
 {
2365
 
     Eterm* hp = BeamArithAlloc(c_p, 3);
 
2973
     Eterm* hp = BeamArithAlloc(c_p, FLOAT_SIZE_OBJECT);
2366
2974
     tmp_arg1 = make_float(hp);
2367
2975
 
2368
 
     hp[0] = HEADER_FLONUM;     /* Arg(0) == HEADER_FLONUM */
2369
 
     hp[1] = Arg(1);
2370
 
     hp[2] = Arg(2);
 
2976
     PUT_DOUBLE(*(FloatDef*)&Arg(1), hp);
2371
2977
     Next(3);
2372
2978
 }
2373
2979
 
2374
2980
 OpCase(i_fetch_float2_o):
2375
2981
 {
2376
 
     Eterm* hp = BeamArithAlloc(c_p, 3);
 
2982
     Eterm* hp = BeamArithAlloc(c_p, FLOAT_SIZE_OBJECT);
2377
2983
     tmp_arg2 = make_float(hp);
2378
2984
 
2379
 
     hp[0] = HEADER_FLONUM;     /* Arg(0) == HEADER_FLONUM */
2380
 
     hp[1] = Arg(1);
2381
 
     hp[2] = Arg(2);
 
2985
     PUT_DOUBLE(*(FloatDef*)&Arg(1), hp);
2382
2986
     Next(3);
2383
2987
 }
2384
2988
#endif
2492
3096
            given_arity = given[0];
2493
3097
            given_size = thing_arityval(given_arity);
2494
3098
            bigp = &Arg(2);
2495
 
            while ((arity = bigp[0]) >= given_arity) {
2496
 
                if (arity == given_arity &&
2497
 
                    memcmp(bigp+1, given+1, sizeof(Eterm)*given_size) == 0) {
 
3099
            while ((arity = bigp[0]) > given_arity) {
 
3100
                bigp += thing_arityval(arity) + 2;
 
3101
            }
 
3102
            while (bigp[0] == given_arity) {
 
3103
                if (memcmp(bigp+1, given+1, sizeof(Eterm)*given_size) == 0) {
2498
3104
                    SET_I((Eterm *) bigp[given_size+1]);
2499
3105
                    Goto(*I);
2500
3106
                }
2510
3116
        Goto(*I);
2511
3117
    }
2512
3118
 
 
3119
#ifdef ARCH_64
 
3120
 OpCase(i_select_float_sfI):
 
3121
 {
 
3122
     Uint f;
 
3123
     int n;
 
3124
     struct ValLabel {
 
3125
         Uint f;
 
3126
         Eterm* addr;
 
3127
     };
 
3128
     struct ValLabel* ptr;
 
3129
 
 
3130
     GetArg1(0, tmp_arg1);
 
3131
     ASSERT(is_float(tmp_arg1));
 
3132
     f = float_val(tmp_arg1)[1];
 
3133
     n = Arg(2);
 
3134
     ptr = (struct ValLabel *) &Arg(3);
 
3135
     while (n-- > 0) {
 
3136
         if (ptr->f == f) {
 
3137
             SET_I(ptr->addr);
 
3138
             Goto(*I);
 
3139
         }
 
3140
         ptr++;
 
3141
     }
 
3142
     SET_I((Eterm *) Arg(1));
 
3143
     Goto(*I);
 
3144
 }
 
3145
#else
2513
3146
 OpCase(i_select_float_sfI):
2514
3147
 {
2515
3148
     Uint fpart1;
2539
3172
     SET_I((Eterm *) Arg(1));
2540
3173
     Goto(*I);
2541
3174
 }
 
3175
#endif
2542
3176
 
2543
3177
 OpCase(set_tuple_element_sdP): {
2544
3178
     Eterm element;
2554
3188
     NextPF(3, next);
2555
3189
 }
2556
3190
 
2557
 
 OpCase(int_bnot_jsd):
2558
 
    GetArg1(1, tmp_arg1);
2559
 
    if (is_small(tmp_arg1)) {
2560
 
        tmp_arg1 = make_small(~signed_val(tmp_arg1));
2561
 
    } else if (is_big(tmp_arg1)) {
2562
 
        Eterm* bigp = BeamArithAlloc(c_p, BIG_NEED_SIZE(big_size(tmp_arg1)+1));
2563
 
        tmp_arg1 = big_bnot(tmp_arg1, bigp);
2564
 
        ArithCheck(c_p);
2565
 
        if (is_nil(tmp_arg1)) {
2566
 
            goto system_limit;
2567
 
        }
2568
 
    } else {
2569
 
        goto badarith;
2570
 
    }
2571
 
    StoreBifResult(2, tmp_arg1);
2572
 
 
2573
3191
 OpCase(i_is_ne_exact_f):
2574
3192
    if (EQ(tmp_arg1, tmp_arg2)) {
2575
3193
        ClauseFail();
2580
3198
     SWAPOUT;
2581
3199
     c_p->freason = EXC_NORMAL;
2582
3200
     c_p->arity = 0;            /* In case this process will ever be garbed again. */
2583
 
     do_exit(c_p, am_normal);
 
3201
     erts_do_exit_process(c_p, am_normal);
2584
3202
     goto do_schedule;
2585
3203
 }
2586
3204
 
2599
3217
 }
2600
3218
 
2601
3219
 OpCase(raise_ss): {
2602
 
     GetArg1(0, tmp_arg1);
 
3220
     /* This was not done very well in R10-0; then, we passed the tag in
 
3221
        the first argument and hoped that the existing c_p->ftrace was
 
3222
        still correct. But the ftrace-object already includes the tag
 
3223
        (or rather, the freason). Now, we pass the original ftrace in
 
3224
        the first argument. We also handle atom tags in the first
 
3225
        argument for backwards compatibility.
 
3226
     */
 
3227
     GetArg2(0, tmp_arg1, tmp_arg2);
 
3228
     c_p->fvalue = tmp_arg2;
 
3229
     if (c_p->freason == EXC_NULL) {
 
3230
       /* a safety check for the R10-0 case; should not happen */
 
3231
       c_p->ftrace = NIL;
 
3232
       c_p->freason = EXC_ERROR;
 
3233
     }
 
3234
     /* for R10-0 code, keep existing c_p->ftrace and hope it's correct */
2603
3235
     switch (tmp_arg1) {
2604
3236
     case am_throw:
2605
 
         c_p->freason = EXC_THROWN;
2606
 
         break;
2607
 
     case am_ERROR:
2608
 
         c_p->freason = EXC_FAULT;
2609
 
         break;
2610
 
     case am_EXIT:
2611
 
         c_p->freason = EXC_EXIT;
2612
 
         break;
 
3237
       c_p->freason = EXC_THROWN & ~EXF_SAVETRACE;
 
3238
       break;
 
3239
     case am_error:
 
3240
       c_p->freason = EXC_ERROR & ~EXF_SAVETRACE;
 
3241
       break;
 
3242
     case am_exit:
 
3243
       c_p->freason = EXC_EXIT & ~EXF_SAVETRACE;
 
3244
       break;
2613
3245
     default:
2614
 
         c_p->freason = EXC_INTERNAL_ERROR;
2615
 
         break;
 
3246
       {/* R10-1 and later
 
3247
           XXX note: should do sanity check on given trace if it can be
 
3248
           passed from a user! Currently only expecting generated calls.
 
3249
        */
 
3250
         struct StackTrace *s;
 
3251
         c_p->ftrace = tmp_arg1;
 
3252
         s = get_trace_from_exc(tmp_arg1);
 
3253
         if (s == NULL) {
 
3254
           c_p->freason = EXC_ERROR;
 
3255
         } else {
 
3256
           c_p->freason = PRIMARY_EXCEPTION(s->freason);
 
3257
         }
 
3258
       }
2616
3259
     }
2617
 
     GetArg1(1, tmp_arg1);
2618
 
     c_p->fvalue = tmp_arg1;
2619
3260
     goto find_func_info;
2620
3261
 }
2621
3262
 
2622
3263
 OpCase(badmatch_s): {
2623
3264
     GetArg1(0, tmp_arg1);
2624
3265
     c_p->fvalue = tmp_arg1;
2625
 
 }
2626
 
 
2627
 
 badmatch: {
2628
3266
     c_p->freason = BADMATCH;
2629
3267
 }
 
3268
 /* Fall through here */
2630
3269
 
2631
3270
 find_func_info: {
2632
3271
     reg[0] = r(0);
2667
3306
         goto do_schedule;
2668
3307
     } else {
2669
3308
         r(0) = reg[0];
 
3309
#if defined(HEAP_FRAG_ELIM_TEST)
 
3310
         ASSERT(!is_value(r(0)));
 
3311
         if (c_p->mbuf) {
 
3312
             erts_garbage_collect(c_p, 0, reg+1, 3);
 
3313
         }
 
3314
#endif
2670
3315
         SWAPIN;
2671
3316
         Goto(*I);
2672
3317
     }
2696
3341
        c_p->fcalls = FCALLS - 1;
2697
3342
        vbf = (BifFunction) Arg(0);
2698
3343
        ASSERT(I[-1] <= 3);
 
3344
        PROCESS_MAIN_CHK_LOCKS(c_p);
2699
3345
        switch (I[-1]) {
2700
3346
        case 3:
2701
3347
            {
2702
3348
                Eterm (*bf)(Process*, Eterm, Eterm, Eterm, Uint*) = vbf;
 
3349
                ASSERT(!ERTS_PROC_IS_EXITING(c_p));
2703
3350
                tmp_arg1 = (*bf)(c_p, r(0), x(1), x(2), I);
 
3351
                ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1));
 
3352
                PROCESS_MAIN_CHK_LOCKS(c_p);
2704
3353
            }
2705
3354
            break;
2706
3355
        case 2:
2707
3356
            {
2708
3357
                Eterm (*bf)(Process*, Eterm, Eterm, Uint*) = vbf;
 
3358
                ASSERT(!ERTS_PROC_IS_EXITING(c_p));
2709
3359
                tmp_arg1 = (*bf)(c_p, r(0), x(1), I);
 
3360
                ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1));
 
3361
                PROCESS_MAIN_CHK_LOCKS(c_p);
2710
3362
            }
2711
3363
            break;
2712
3364
        case 1:
2713
3365
            {
2714
3366
                Eterm (*bf)(Process*, Eterm, Uint*) = vbf;
 
3367
                ASSERT(!ERTS_PROC_IS_EXITING(c_p));
2715
3368
                tmp_arg1 = (*bf)(c_p, r(0), I);
 
3369
                ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1));
 
3370
                PROCESS_MAIN_CHK_LOCKS(c_p);
2716
3371
            }
2717
3372
            break;
2718
3373
        case 0:
2719
3374
            {
2720
3375
                Eterm (*bf)(Process*, Uint*) = vbf;
 
3376
                ASSERT(!ERTS_PROC_IS_EXITING(c_p));
2721
3377
                tmp_arg1 = (*bf)(c_p, I);
 
3378
                ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1));
 
3379
                PROCESS_MAIN_CHK_LOCKS(c_p);
2722
3380
                break;
2723
3381
            }
2724
3382
        }
2725
 
        FCALLS = c_p->fcalls;
 
3383
        ERTS_HOLE_CHECK(c_p);
 
3384
#ifdef HEAP_FRAG_ELIM_TEST
 
3385
        if (c_p->mbuf) {
 
3386
            tmp_arg1 = erts_gc_after_bif_call(c_p, tmp_arg1);
 
3387
        }
 
3388
#endif
2726
3389
        SWAPIN;                 /* There might have been a garbage collection. */
 
3390
        FCALLS = c_p->fcalls;
2727
3391
        if (is_value(tmp_arg1)) {
2728
3392
            r(0) = tmp_arg1;
2729
 
#ifdef HEAP_FRAG_ELIM_TEST
2730
 
            TestHeap(1, 1);
2731
 
#endif
2732
3393
            CHECK_TERM(r(0));
2733
3394
            SET_I(c_p->cp);
2734
3395
            Goto(*I);
2742
3403
            SWAPOUT;
2743
3404
            c_p->i = I;
2744
3405
            c_p->current = NULL;
2745
 
#ifdef HEAP_FRAG_ELIM_TEST
2746
 
            if (MBUF(c_p) != NULL) {
2747
 
                erts_garbage_collect(c_p, 0, argp, c_p->arity);
2748
 
            }
2749
 
#endif
2750
3406
            goto do_schedule;
2751
3407
        } else if (c_p->freason == TRAP) {
2752
 
            SET_I(((Export *)(c_p->def_arg_reg[0]))->address);
2753
 
#ifdef HEAP_FRAG_ELIM_TEST
2754
 
            if (MBUF(c_p) != NULL) {
2755
 
                /* SWAPOUT done above */
2756
 
                FCALLS -= erts_garbage_collect(c_p, 0, c_p->def_arg_reg+1, I[-1]);
2757
 
                SWAPIN;
2758
 
            }
2759
 
#endif
2760
 
            r(0) = c_p->def_arg_reg[1];
2761
 
            x(1) = c_p->def_arg_reg[2];
2762
 
            x(2) = c_p->def_arg_reg[3];
 
3408
            SET_I(((Export *)(c_p->def_arg_reg[3]))->address);
 
3409
            r(0) = c_p->def_arg_reg[0];
 
3410
            x(1) = c_p->def_arg_reg[1];
 
3411
            x(2) = c_p->def_arg_reg[2];
2763
3412
            Dispatch();
2764
3413
        }
2765
3414
        reg[0] = r(0);
2767
3416
        goto post_error_handling;
2768
3417
    }
2769
3418
 
 
3419
 OpCase(i_get_sd):
 
3420
    {
 
3421
        Eterm arg;
 
3422
        Eterm result;
 
3423
 
 
3424
        GetArg1(0, arg);
 
3425
        result = erts_pd_hash_get(c_p, arg);
 
3426
        StoreBifResult(1, result);
 
3427
    }
 
3428
 
2770
3429
 OpCase(i_put_tuple_only_Ad): {
2771
3430
     tmp_arg1 = make_tuple(HTOP);
2772
3431
     *HTOP++ = Arg(0);
2796
3455
    goto find_func_info;
2797
3456
 
2798
3457
 /*
2799
 
  * Construction of binaries.
 
3458
  * Construction of binaries using new instructions.
2800
3459
  */
2801
3460
 
2802
 
 OpCase(i_bs_init): {
2803
 
     Eterm *next;
2804
 
     PreFetch(0, next);
2805
 
     erts_bin_offset = 0;
2806
 
     NextPF(0, next);
2807
 
 }
2808
 
 
2809
 
 OpCase(i_bs_final_jd): {
2810
 
     Eterm *next;
2811
 
     Eterm b;
2812
 
 
2813
 
     if (erts_bin_offset % 8 != 0) {
2814
 
         goto badarg;
2815
 
     }
2816
 
     PreFetch(2, next);
2817
 
     SAVE_HTOP;
2818
 
     c_p->fcalls = FCALLS;
2819
 
     b = new_binary_arith(c_p, erts_bin_buf, erts_bin_offset / 8);
2820
 
     FCALLS = c_p->fcalls;
2821
 
     StoreResult(b, Arg(1));
2822
 
     NextPF(2, next);
2823
 
 }
2824
 
 
2825
 
 OpCase(i_bs_final_heap_d): {
2826
 
     Eterm *next;
2827
 
     ErlHeapBin* hb;
2828
 
     Eterm b;
2829
 
     unsigned len;
2830
 
 
2831
 
     PreFetch(1, next);
2832
 
     len = erts_bin_offset / 8;
2833
 
     hb = (ErlHeapBin *) BeamArithAlloc(c_p, heap_bin_size(len));
2834
 
     hb->thing_word = header_heap_bin(len);
2835
 
     hb->size = len;
2836
 
     sys_memcpy(hb->data, erts_bin_buf, len);
2837
 
     b = make_binary(hb);
2838
 
     StoreResult(b, Arg(0));
2839
 
     NextPF(1, next);
2840
 
 }
2841
 
 
2842
 
 OpCase(bs_put_string_II):
 
3461
 {
 
3462
     OpCase(i_bs_init_fail_heap_IjId): {
 
3463
         /* tmp_arg1 was fetched by an i_fetch instruction */
 
3464
         tmp_arg2 = Arg(0);
 
3465
         I++;
 
3466
         goto do_bs_init;
 
3467
     }
 
3468
 
 
3469
     OpCase(i_bs_init_fail_rjId): {
 
3470
         tmp_arg1 = r(0);
 
3471
         tmp_arg2 = 0;
 
3472
         goto do_bs_init;
 
3473
     }
 
3474
 
 
3475
     OpCase(i_bs_init_fail_yjId): {
 
3476
         tmp_arg1 = yb(Arg(0));
 
3477
         tmp_arg2 = 0;
 
3478
         I++;
 
3479
         goto do_bs_init;
 
3480
     }
 
3481
 
 
3482
     OpCase(i_bs_init_fail_xjId): {
 
3483
         tmp_arg1 = xb(Arg(0));
 
3484
         tmp_arg2 = 0;
 
3485
         I++;
 
3486
     }
 
3487
         /* FALL THROUGH */
 
3488
     do_bs_init:
 
3489
         if (is_not_small(tmp_arg1)) {
 
3490
             goto badarg;
 
3491
         } else {
 
3492
             Sint size = signed_val(tmp_arg1);
 
3493
 
 
3494
             if (size < 0) {
 
3495
                 goto badarg;
 
3496
             }
 
3497
             tmp_arg1 = (Eterm) size;
 
3498
         }
 
3499
 
 
3500
         if (tmp_arg1 <= ERL_ONHEAP_BIN_LIMIT) {
 
3501
             goto do_heap_bin_alloc;
 
3502
         } else {
 
3503
             goto do_proc_bin_alloc;
 
3504
         }
 
3505
 
 
3506
 
 
3507
     OpCase(i_bs_init_heap_IIId): {
 
3508
         tmp_arg1 = Arg(0);
 
3509
         tmp_arg2 = Arg(1);
 
3510
         I++;
 
3511
         goto do_proc_bin_alloc;
 
3512
     }
 
3513
 
 
3514
     OpCase(i_bs_init_IId): {
 
3515
         tmp_arg1 = Arg(0);
 
3516
         tmp_arg2 = 0;
 
3517
     }
 
3518
     /* FALL THROUGH */
 
3519
     do_proc_bin_alloc: {
 
3520
         Binary* bptr;
 
3521
         ProcBin* pb;
 
3522
 
 
3523
         erts_bin_offset = 0;
 
3524
         TestHeap(tmp_arg2 + PROC_BIN_SIZE, Arg(1));
 
3525
 
 
3526
         /*
 
3527
          * Allocate the binary struct itself.
 
3528
          */
 
3529
         bptr = erts_bin_nrml_alloc(tmp_arg1);
 
3530
         bptr->flags = 0;
 
3531
         bptr->orig_size = tmp_arg1;
 
3532
         erts_refc_init(&bptr->refc, 1);
 
3533
         erts_current_bin = (byte *) bptr->orig_bytes;
 
3534
 
 
3535
         /*
 
3536
          * Now allocate the ProcBin on the heap.
 
3537
          */
 
3538
         pb = (ProcBin *) HTOP;
 
3539
         HTOP += PROC_BIN_SIZE;
 
3540
         pb->thing_word = HEADER_PROC_BIN;
 
3541
         pb->size = tmp_arg1;
 
3542
         pb->next = MSO(c_p).mso;
 
3543
         MSO(c_p).mso = pb;
 
3544
         pb->val = bptr;
 
3545
         pb->bytes = (byte*) bptr->orig_bytes;
 
3546
 
 
3547
         MSO(c_p).overhead += pb->size / BINARY_OVERHEAD_FACTOR / sizeof(Eterm);
 
3548
         StoreBifResult(2, make_binary(pb));
 
3549
     }
 
3550
 
 
3551
     OpCase(i_bs_init_heap_bin_heap_IIId): {
 
3552
         tmp_arg1 = Arg(0);
 
3553
         tmp_arg2 = Arg(1);
 
3554
         I++;
 
3555
         goto do_heap_bin_alloc;
 
3556
     }
 
3557
 
 
3558
     OpCase(i_bs_init_heap_bin_IId): {
 
3559
         tmp_arg1 = Arg(0);
 
3560
         tmp_arg2 = 0;
 
3561
     }
 
3562
     /* Fall through */
 
3563
     do_heap_bin_alloc:
 
3564
         {
 
3565
             ErlHeapBin* hb;
 
3566
             Uint bin_need;
 
3567
 
 
3568
             bin_need = heap_bin_size(tmp_arg1);
 
3569
             erts_bin_offset = 0;
 
3570
             TestHeap(bin_need+tmp_arg2, Arg(1));
 
3571
             hb = (ErlHeapBin *) HTOP;
 
3572
             HTOP += bin_need;
 
3573
             hb->thing_word = header_heap_bin(tmp_arg1);
 
3574
             hb->size = tmp_arg1;
 
3575
             erts_current_bin = (byte *) hb->data;
 
3576
             tmp_arg1 = make_binary(hb);
 
3577
             StoreBifResult(2, tmp_arg1);
 
3578
         }
 
3579
 }
 
3580
 
 
3581
 OpCase(i_bs_bits_to_bytes_rjd): {
 
3582
     tmp_arg1 = r(0);
 
3583
     goto do_bits_to_bytes;
 
3584
 }
 
3585
 
 
3586
 OpCase(i_bs_bits_to_bytes_yjd): {
 
3587
     tmp_arg1 = yb(Arg(0));
 
3588
     I++;
 
3589
     goto do_bits_to_bytes;
 
3590
 
 
3591
 OpCase(i_bs_bits_to_bytes_xjd): {
 
3592
     tmp_arg1 = xb(Arg(0));
 
3593
     I++;
 
3594
 }
 
3595
 
 
3596
 do_bits_to_bytes:
 
3597
     {
 
3598
         if (is_not_valid_bit_size(tmp_arg1)) {
 
3599
             goto badarg;
 
3600
         }
 
3601
         tmp_arg1 = make_small(unsigned_val(tmp_arg1) >> 3);
 
3602
         StoreBifResult(1, tmp_arg1);
 
3603
     }
 
3604
 }
 
3605
 
 
3606
 OpCase(i_bs_bits_to_bytes2_rd): {
 
3607
     tmp_arg1 = r(0);
 
3608
     goto do_bits_to_bytes2;
 
3609
 }
 
3610
 
 
3611
 OpCase(i_bs_bits_to_bytes2_yd): {
 
3612
     tmp_arg1 = yb(Arg(0));
 
3613
     I++;
 
3614
     goto do_bits_to_bytes2;
 
3615
 
 
3616
 OpCase(i_bs_bits_to_bytes2_xd): {
 
3617
     tmp_arg1 = xb(Arg(0));
 
3618
     I++;
 
3619
 }
 
3620
 
 
3621
 do_bits_to_bytes2:
 
3622
     {
 
3623
       tmp_arg1 = make_small((unsigned_val(tmp_arg1)+7) >> 3);   
 
3624
       StoreBifResult(0, tmp_arg1);
 
3625
     }
 
3626
 }
 
3627
   
 
3628
 OpCase(i_bs_final2_rd): {
 
3629
   tmp_arg1 = r(0);
 
3630
   goto do_bs_final2;
 
3631
 }  
 
3632
 OpCase(i_bs_final2_yd): {
 
3633
   tmp_arg1 = yb(Arg(0));
 
3634
   I++;
 
3635
   goto do_bs_final2;
 
3636
       
 
3637
 OpCase(i_bs_final2_xd): {
 
3638
   tmp_arg1 = xb(Arg(0));
 
3639
   I++;
 
3640
 }
 
3641
 
 
3642
 do_bs_final2:
 
3643
     { 
 
3644
       tmp_arg1 = erts_bs_final2(c_p, tmp_arg1);
 
3645
       StoreBifResult(0, tmp_arg1);
 
3646
     }
 
3647
 }
 
3648
 
 
3649
 OpCase(i_bs_add_jId): {
 
3650
     if (is_both_small(tmp_arg1, tmp_arg2)) {
 
3651
         Uint Unit = Arg(1);
 
3652
         Sint Arg1 = signed_val(tmp_arg1);
 
3653
         Sint Arg2 = signed_val(tmp_arg2);
 
3654
 
 
3655
         if (Arg1 >= 0 && Arg2 >= 0) {
 
3656
             Sint res = Arg1 + Unit*Arg2;
 
3657
 
 
3658
             if (MY_IS_SSMALL(res)) {
 
3659
                 Eterm result = make_small(res);
 
3660
                 StoreBifResult(2, result);
 
3661
             }
 
3662
         }
 
3663
     }
 
3664
 
 
3665
     /*
 
3666
      * Fall through to here if there were any errors in the arguments.
 
3667
      */
 
3668
     goto badarg;
 
3669
 }
 
3670
 
 
3671
 OpCase(i_new_bs_put_string_II):
2843
3672
    {
2844
 
        erts_bs_put_string((byte *) Arg(1), Arg(0));
2845
 
        Next(2);
 
3673
        Eterm* next;
 
3674
        PreFetch(2, next);
 
3675
        erts_new_bs_put_string(ERL_BITS_ARGS_2((byte *) Arg(1), Arg(0)));
 
3676
        NextPF(2, next);
2846
3677
    }
2847
3678
 
2848
3679
 /*
2849
3680
  * Matching of binaries.
2850
3681
  */
2851
3682
 
 
3683
#if !defined(HEAP_FRAG_ELIM_TEST)
 
3684
 
2852
3685
 OpCase(bs_test_zero_tail_f): {
2853
3686
     Eterm* next;
2854
3687
 
2885
3718
     NextPF(1, next);
2886
3719
 }
2887
3720
 
 
3721
#endif
 
3722
 
 
3723
 OpCase(bs_test_zero_tail2_fr): {
 
3724
     Eterm* next;
 
3725
     ErlBinMatchBuffer *_mb;
 
3726
     
 
3727
     PreFetch(1, next);
 
3728
     _mb = (ErlBinMatchBuffer*) ms_matchbuffer(r(0));
 
3729
     if (_mb->size != _mb->offset) {
 
3730
         ClauseFail();
 
3731
     }
 
3732
     NextPF(1, next);
 
3733
 }
 
3734
 
 
3735
 OpCase(bs_test_zero_tail2_fx): {
 
3736
     Eterm* next;
 
3737
     ErlBinMatchBuffer *_mb;
 
3738
     
 
3739
     PreFetch(2, next);
 
3740
     _mb = (ErlBinMatchBuffer*) ms_matchbuffer(xb(Arg(1)));
 
3741
     if (_mb->size != _mb->offset) {
 
3742
         ClauseFail();
 
3743
     }
 
3744
     NextPF(2, next);
 
3745
 }
 
3746
 
 
3747
 OpCase(bs_test_tail_imm2_frI): {
 
3748
     Eterm* next;
 
3749
     ErlBinMatchBuffer *_mb;
 
3750
     PreFetch(2, next);
 
3751
     _mb = ms_matchbuffer(r(0));
 
3752
     if (_mb->size - _mb->offset != Arg(1)) {
 
3753
         ClauseFail();
 
3754
     }
 
3755
     NextPF(2, next);
 
3756
 }
 
3757
 OpCase(bs_test_tail_imm2_fxI): {
 
3758
     Eterm* next;
 
3759
     ErlBinMatchBuffer *_mb;
 
3760
     PreFetch(3, next);
 
3761
     _mb = ms_matchbuffer(xb(Arg(1)));
 
3762
     if (_mb->size - _mb->offset != Arg(2)) {
 
3763
         ClauseFail();
 
3764
     }
 
3765
     NextPF(3, next);
 
3766
 }
 
3767
 
 
3768
 OpCase(bs_save2_rI): {
 
3769
     Eterm* next;
 
3770
     ErlBinMatchState *_ms;
 
3771
     PreFetch(1, next);
 
3772
     _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0));
 
3773
     erts_bs_save_2(Arg(0), _ms);
 
3774
     NextPF(1, next);
 
3775
 }
 
3776
 OpCase(bs_save2_xI): {
 
3777
     Eterm* next;
 
3778
     ErlBinMatchState *_ms;
 
3779
     PreFetch(2, next);
 
3780
     _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0)));
 
3781
     erts_bs_save_2(Arg(1), _ms);
 
3782
     NextPF(2, next);
 
3783
 }
 
3784
 
 
3785
 OpCase(bs_restore2_rI): {
 
3786
     Eterm* next;
 
3787
     ErlBinMatchState *_ms;
 
3788
     PreFetch(1, next);
 
3789
     _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0));
 
3790
     erts_bs_restore_2(Arg(0), _ms);
 
3791
     NextPF(1, next);
 
3792
 }
 
3793
 OpCase(bs_restore2_xI): {
 
3794
     Eterm* next;
 
3795
     ErlBinMatchState *_ms;
 
3796
     PreFetch(2, next);
 
3797
     _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0)));
 
3798
     erts_bs_restore_2(Arg(1), _ms);
 
3799
     NextPF(2, next);
 
3800
 }
 
3801
 
2888
3802
#include "beam_cold.h"
2889
3803
 
2890
 
 OpCase(is_eq_exact_body): {
2891
 
     Eterm* next;
2892
 
 
2893
 
     PreFetch(0, next);
2894
 
     if (EQ(tmp_arg1, tmp_arg2)) {
2895
 
         NextPF(0, next);
2896
 
     }
2897
 
     Badmatch(tmp_arg1);
2898
 
 }
2899
 
 
2900
3804
 /*
2901
3805
  * This instruction is probably never used (because it is combined with a
2902
3806
  * a return). However, a future compiler might for some reason emit a
2932
3836
 
2933
3837
         SWAPOUT;
2934
3838
         reg[0] = r(0);
 
3839
         PROCESS_MAIN_CHK_LOCKS(c_p);
2935
3840
         flags = erts_call_trace(c_p, ep->code, ep->match_prog_set, reg,
2936
3841
                                 0, &c_p->tracer_proc);
 
3842
         PROCESS_MAIN_CHK_LOCKS(c_p);
 
3843
         ASSERT(!ERTS_PROC_IS_EXITING(c_p));
2937
3844
         SWAPIN;
2938
3845
         
2939
 
         if (flags & MATCH_SET_RETURN_TRACE) {
2940
 
             static void* return_trace[1] = {OpCode(return_trace)};
2941
 
 
2942
 
#ifdef SHARED_HEAP
2943
 
             AllocateStack(3);
2944
 
#else
 
3846
         if (flags & MATCH_SET_RX_TRACE) {
2945
3847
             ASSERT(c_p->htop <= E && E <= c_p->hend);
2946
3848
             if (E - 3 < HTOP) {
2947
3849
                 /* SWAPOUT, SWAPIN was done and r(0) was saved above */
 
3850
                 PROCESS_MAIN_CHK_LOCKS(c_p);
2948
3851
                 FCALLS -= erts_garbage_collect(c_p, 3, reg, ep->code[2]);
 
3852
                 PROCESS_MAIN_CHK_LOCKS(c_p);
2949
3853
                 r(0) = reg[0];
2950
3854
                 SWAPIN;
2951
3855
             }
2952
3856
             E -= 3;
2953
3857
             ASSERT(c_p->htop <= E && E <= c_p->hend);
2954
 
#endif
2955
3858
             ASSERT(is_CP((Eterm)(ep->code)));
2956
3859
             ASSERT(is_internal_pid(c_p->tracer_proc) || 
2957
3860
                    is_internal_port(c_p->tracer_proc));
2958
3861
             E[2] = make_cp(c_p->cp);
2959
3862
             E[1] = am_true; /* Process tracer */
2960
3863
             E[0] = make_cp(ep->code);
2961
 
             c_p->cp = (Eterm *) make_cp((Uint*)return_trace);
 
3864
             c_p->cp = (Eterm*)
 
3865
                 make_cp(flags & MATCH_SET_EXCEPTION_TRACE
 
3866
                         ? beam_exception_trace : beam_return_trace);
 
3867
             erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
 
3868
             c_p->trace_flags |= F_EXCEPTION_TRACE;
 
3869
             erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
2962
3870
         }
2963
3871
     }
2964
3872
     SET_I((Uint *) Arg(0));
2967
3875
 
2968
3876
 OpCase(return_trace): {
2969
3877
     Uint* code = (Uint *) E[0];
2970
 
     Eterm tracer_pid = E[1];
2971
3878
     
2972
3879
     SWAPOUT;           /* Needed for shared heap */
2973
 
     erts_trace_return(c_p, code, r(0), &tracer_pid);
 
3880
     erts_trace_return(c_p, code, r(0), E+1/*Process tracer*/);
2974
3881
     SWAPIN;
 
3882
     c_p->cp = NULL;
2975
3883
     SET_I((Eterm *) E[2]);
2976
3884
     E += 3;
2977
3885
     Goto(*I);
2998
3906
     Uint32 flags;
2999
3907
     Eterm tracer_pid;
3000
3908
     Uint *cpp;
 
3909
     int return_to_trace = 0, need = 0;
3001
3910
     flags = 0;
3002
3911
     SWAPOUT;
3003
3912
     reg[0] = r(0);
3004
3913
 
3005
3914
     if (*cp_val((Eterm)c_p->cp) 
3006
3915
         == (Uint) OpCode(return_trace)) {
3007
 
         cpp = &((Uint) E[2]);
 
3916
         cpp = (Uint*)&E[2];
3008
3917
     } else if (*cp_val((Eterm)c_p->cp) 
3009
3918
                == (Uint) OpCode(i_return_to_trace)) {
3010
 
         cpp = &((Uint) E[0]);
 
3919
         return_to_trace = !0;
 
3920
         cpp = (Uint*)&E[0];
3011
3921
     } else {
3012
3922
         cpp = NULL;
3013
3923
     }
3014
3924
     if (cpp) {
 
3925
         /* This _IS_ a tail recursive call, if there are
 
3926
          * return_trace and/or i_return_to_trace stackframes
 
3927
          * on the stack, they are not intermixed with y registers
 
3928
          */
3015
3929
         Eterm *cp_save = c_p->cp;
3016
3930
         for (;;) {
3017
3931
             ASSERT(is_CP(*cpp));
3018
3932
             if (*cp_val(*cpp) == (Uint) OpCode(return_trace)) {
3019
3933
                 cpp += 3;
3020
3934
             } else if (*cp_val(*cpp) == (Uint) OpCode(i_return_to_trace)) {
 
3935
                 return_to_trace = !0;
3021
3936
                 cpp += 1;
3022
3937
             } else
3023
3938
                 break;
3032
3947
         SWAPIN;                /* Needed by shared heap. */
3033
3948
     }
3034
3949
 
3035
 
     if ((flags & MATCH_SET_RETURN_TO_TRACE)) {
3036
 
         static void* return_to_trace[1] = {OpCode(i_return_to_trace)};
3037
 
         if ((Uint) c_p->cp != make_cp((Uint*)return_to_trace)) {
3038
 
             /* Look down the stack for other return_to frames */
3039
 
             int do_insert = 1;
3040
 
             if (*cp_val((Eterm)c_p->cp) == (Uint) OpCode(return_trace)) {
3041
 
                 cpp = &((Uint) E[2]);
3042
 
                 for(;;) {
3043
 
                     ASSERT(is_CP(*cpp));
3044
 
                     if (*cp_val(*cpp) == 
3045
 
                         (Uint) OpCode(return_trace)) {
3046
 
                         cpp += 3;
3047
 
                     } else {
3048
 
                         break;
3049
 
                     }
3050
 
                 }
3051
 
                 if (*cp_val(*cpp) == 
3052
 
                     (Uint) OpCode(i_return_to_trace)) {
3053
 
                     do_insert = 0;
3054
 
                 }
3055
 
             } 
3056
 
             if (do_insert) {
3057
 
#ifdef SHARED_HEAP
3058
 
                 AllocateStack(1);
3059
 
#else
3060
 
                 ASSERT(c_p->htop <= E && E <= c_p->hend);
3061
 
                 if (E - 1 < HTOP) {
3062
 
                     /* SWAPOUT was done and r(0) was saved above */
3063
 
                     FCALLS -= erts_garbage_collect(c_p, 1, reg, I[-1]);
3064
 
                     r(0) = reg[0];
3065
 
                     SWAPIN;
3066
 
                 }
3067
 
                 E -= 1;
3068
 
                 ASSERT(c_p->htop <= E && E <= c_p->hend);
3069
 
#endif
3070
 
                 E[0] = make_cp(c_p->cp);
3071
 
                 c_p->cp = (Eterm *) make_cp((Uint*)return_to_trace);
3072
 
             }
3073
 
         }  
3074
 
     }
3075
 
     if (flags & MATCH_SET_RETURN_TRACE) {
3076
 
         static void* return_trace[1] = {OpCode(return_trace)};
 
3950
     ASSERT(!ERTS_PROC_IS_EXITING(c_p));
3077
3951
 
3078
 
#ifdef SHARED_HEAP
3079
 
         AllocateStack(3);
3080
 
#else
 
3952
     if ((flags & MATCH_SET_RETURN_TO_TRACE) && !return_to_trace) {
 
3953
         need += 1;
 
3954
     }
 
3955
     if (flags & MATCH_SET_RX_TRACE) {
 
3956
         need += 3;
 
3957
     }
 
3958
     if (need) {
3081
3959
         ASSERT(c_p->htop <= E && E <= c_p->hend);
3082
 
         if (E - 3 < HTOP) {
3083
 
             /* Stack pointer may have been changed by 
3084
 
                return_to trace above */
3085
 
             SWAPOUT; 
3086
 
             FCALLS -= erts_garbage_collect(c_p, 3, reg, I[-1]);
 
3960
         if (E - need < HTOP) {
 
3961
             /* SWAPOUT was done and r(0) was saved above */
 
3962
             PROCESS_MAIN_CHK_LOCKS(c_p);
 
3963
             FCALLS -= erts_garbage_collect(c_p, need, reg, I[-1]);
 
3964
             PROCESS_MAIN_CHK_LOCKS(c_p);
3087
3965
             r(0) = reg[0];
3088
3966
             SWAPIN;
3089
3967
         }
 
3968
     }
 
3969
     if ((flags & MATCH_SET_RETURN_TO_TRACE) && !return_to_trace) {
 
3970
         E -= 1;
 
3971
         ASSERT(c_p->htop <= E && E <= c_p->hend);
 
3972
         E[0] = make_cp(c_p->cp);
 
3973
         c_p->cp = (Eterm *) make_cp(beam_return_to_trace);
 
3974
     }
 
3975
     if (flags & MATCH_SET_RX_TRACE) {
3090
3976
         E -= 3;
3091
3977
         ASSERT(c_p->htop <= E && E <= c_p->hend);
3092
 
#endif
3093
3978
         ASSERT(is_CP((Eterm) (I - 3)));
3094
3979
         ASSERT(am_true == tracer_pid || 
3095
3980
                is_internal_pid(tracer_pid) || is_internal_port(tracer_pid));
3098
3983
         E[0] = make_cp(I - 3); /* We ARE at the beginning of an 
3099
3984
                                   instruction,
3100
3985
                                   the funcinfo is above i. */
3101
 
         c_p->cp = (Eterm *) make_cp((Uint*)return_trace);
 
3986
         c_p->cp = (Eterm*)
 
3987
             make_cp(flags & MATCH_SET_EXCEPTION_TRACE
 
3988
                     ? beam_exception_trace : beam_return_trace);
 
3989
         erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
 
3990
         c_p->trace_flags |= F_EXCEPTION_TRACE;
 
3991
         erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
3102
3992
     }
3103
3993
     Goto(real_I);
3104
3994
 }
3105
3995
 
3106
3996
 OpCase(i_return_to_trace): {
3107
 
     Uint *cpp = &((Uint) E[0]);
3108
 
     for(;;) {
3109
 
         ASSERT(is_CP(*cpp));
3110
 
         if (*cp_val(*cpp) == (Uint) OpCode(return_trace)) {
3111
 
             cpp += 3;
3112
 
         } else {
3113
 
             break;
3114
 
         }
3115
 
     }
3116
3997
     if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO)) {
 
3998
         Uint *cpp = (Uint*) E;
 
3999
         for(;;) {
 
4000
             ASSERT(is_CP(*cpp));
 
4001
             if (*cp_val(*cpp) == (Uint) OpCode(return_trace)) {
 
4002
                 do ++cpp; while(is_not_CP(*cpp));
 
4003
                 cpp += 2;
 
4004
             } else if (*cp_val(*cpp) == (Uint) OpCode(i_return_to_trace)) {
 
4005
                 do ++cpp; while(is_not_CP(*cpp));
 
4006
             } else break;
 
4007
         }
3117
4008
         SWAPOUT;               /* Needed for shared heap */
3118
4009
         erts_trace_return_to(c_p, cp_val(*cpp));
3119
4010
         SWAPIN;
3120
4011
     }
 
4012
     c_p->cp = NULL;
3121
4013
     SET_I((Eterm *) E[0]);
3122
4014
     E += 1;
3123
4015
     Goto(*I);
3152
4044
 }
3153
4045
 
3154
4046
 /*
 
4047
  * Instructions for allocating on the message area.
 
4048
  */
 
4049
 
 
4050
 OpCase(i_global_cons):
 
4051
 {
 
4052
     Eterm *next;
 
4053
#ifdef HYBRID
 
4054
     Eterm *hp;
 
4055
 
 
4056
     PreFetch(0,next);
 
4057
     TestGlobalHeap(2,2,hp);
 
4058
     hp[0] = r(0);
 
4059
     hp[1] = x(1);
 
4060
     r(0) = make_list(hp);
 
4061
#ifndef INCREMENTAL
 
4062
     global_htop += 2;
 
4063
#endif
 
4064
     NextPF(0,next);
 
4065
#else
 
4066
     PreFetch(0,next);
 
4067
     c_p->freason = EXC_INTERNAL_ERROR;
 
4068
     goto find_func_info;
 
4069
#endif
 
4070
 }
 
4071
 
 
4072
 OpCase(i_global_tuple):
 
4073
 {
 
4074
     Eterm *next;
 
4075
     int len;
 
4076
#ifdef HYBRID
 
4077
     Eterm list;
 
4078
     Eterm *hp;
 
4079
#endif
 
4080
 
 
4081
     if ((len = list_length(r(0))) < 0) {
 
4082
         goto badarg;
 
4083
     }
 
4084
 
 
4085
     PreFetch(0,next);
 
4086
#ifdef HYBRID
 
4087
     TestGlobalHeap(len + 1,1,hp);
 
4088
     list = r(0);
 
4089
     r(0) = make_tuple(hp);
 
4090
     *hp++ = make_arityval(len);
 
4091
     while(is_list(list))
 
4092
     {
 
4093
         Eterm* cons = list_val(list);
 
4094
         *hp++ = CAR(cons);
 
4095
         list = CDR(cons);
 
4096
     }
 
4097
#ifndef INCREMENTAL
 
4098
     global_htop += len + 1;
 
4099
#endif
 
4100
     NextPF(0,next);
 
4101
#else
 
4102
     c_p->freason = EXC_INTERNAL_ERROR;
 
4103
     goto find_func_info;
 
4104
#endif
 
4105
 }
 
4106
 
 
4107
 OpCase(i_global_copy):
 
4108
 {
 
4109
     Eterm *next;
 
4110
     PreFetch(0,next);
 
4111
#ifdef HYBRID
 
4112
     if (!IS_CONST(r(0)))
 
4113
     {
 
4114
         BM_SWAP_TIMER(system,copy);
 
4115
         SWAPOUT;
 
4116
         reg[0] = r(0);
 
4117
         reg[1] = NIL;
 
4118
         r(0) = copy_struct_lazy(c_p,r(0),0);
 
4119
         ASSERT(ma_src_top == 0);
 
4120
         ASSERT(ma_dst_top == 0);
 
4121
         ASSERT(ma_offset_top == 0);
 
4122
         SWAPIN;
 
4123
         BM_SWAP_TIMER(copy,system);
 
4124
     }
 
4125
     NextPF(0,next);
 
4126
#else
 
4127
     c_p->freason = EXC_INTERNAL_ERROR;
 
4128
     goto find_func_info;
 
4129
#endif
 
4130
 }
 
4131
 
 
4132
 /*
3155
4133
  * New floating point instructions.
3156
4134
  */
3157
4135
 
3160
4138
     Eterm* next;
3161
4139
 
3162
4140
     PreFetch(4, next);
3163
 
     *ADD_BYTE_OFFSET(freg[0].fw, fr) = Arg(1);
3164
 
     *ADD_BYTE_OFFSET(freg[0].fw, fr+sizeof(Eterm)) = Arg(2);
 
4141
     GET_DOUBLE_DATA(&Arg(1), *(FloatDef*)ADD_BYTE_OFFSET(freg, fr));
3165
4142
     NextPF(4, next);
3166
4143
 }
3167
4144
 OpCase(fmove_dl): {
3172
4149
     PreFetch(2, next);
3173
4150
     GetR(0, targ1);
3174
4151
     /* Arg(0) == HEADER_FLONUM */
3175
 
     *ADD_BYTE_OFFSET(freg[0].fw, fr) = *(float_val(targ1)+1);
3176
 
     *ADD_BYTE_OFFSET(freg[0].fw, fr+sizeof(Eterm)) = *(float_val(targ1)+2);
 
4152
     GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr));
3177
4153
     NextPF(2, next);
3178
4154
 }
3179
 
 OpCase(fmove_ld): {
3180
 
     Eterm* hp = BeamArithAlloc(c_p, 3);
3181
 
     Eterm dest = make_float(hp);
 
4155
 
 
4156
 OpCase(fmove_new_ld): {
3182
4157
     Eterm fr = Arg(0);
3183
 
     Eterm* next;
 
4158
     Eterm dest = make_float(HTOP);
3184
4159
 
3185
 
     ArithCheck(c_p);
3186
 
     PreFetch(2, next);
3187
 
     hp[0] = HEADER_FLONUM;
3188
 
     hp[1] = *ADD_BYTE_OFFSET(freg[0].fw, fr);
3189
 
     hp[2] = *ADD_BYTE_OFFSET(freg[0].fw, fr+sizeof(Eterm));
3190
 
     StoreResult(dest, Arg(1));
3191
 
     NextPF(2, next);
 
4160
     PUT_DOUBLE(*(FloatDef*)ADD_BYTE_OFFSET(freg, fr), HTOP);
 
4161
     HTOP += FLOAT_SIZE_OBJECT;
 
4162
     StoreBifResult(1, dest);
3192
4163
 }
3193
4164
 
3194
4165
 OpCase(fconv_dl): {
3205
4176
             goto fbadarith;
3206
4177
         }
3207
4178
     } else if (is_float(targ1)) {
3208
 
         *ADD_BYTE_OFFSET(freg[0].fw, fr) = *(float_val(targ1)+1);
3209
 
         *ADD_BYTE_OFFSET(freg[0].fw, fr+sizeof(Eterm)) = *(float_val(targ1)+2);
 
4179
         GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr));
3210
4180
     } else {
3211
4181
         goto fbadarith;
3212
4182
     }
3213
4183
     NextPF(2, next);
3214
4184
 }
3215
4185
 
 
4186
 /*
 
4187
  * Old allocating fmove.
 
4188
  */
 
4189
 
 
4190
#if !defined(HEAP_FRAG_ELIM_TEST)
 
4191
 OpCase(fmove_old_ld): {
 
4192
     Eterm* hp = BeamArithAlloc(c_p, FLOAT_SIZE_OBJECT);
 
4193
     Eterm dest = make_float(hp);
 
4194
     Eterm fr = Arg(0);
 
4195
     Eterm* next;
 
4196
 
 
4197
     ArithCheck(c_p);
 
4198
     PreFetch(2, next);
 
4199
     PUT_DOUBLE(*(FloatDef*)ADD_BYTE_OFFSET(freg, fr), hp);
 
4200
     StoreResult(dest, Arg(1));
 
4201
     NextPF(2, next);
 
4202
 }
 
4203
#endif
 
4204
 
3216
4205
#ifdef NO_FPE_SIGNALS
3217
4206
     OpCase(fclearerror):
3218
4207
     OpCase(i_fcheckerror):
3222
4211
         Eterm* next;
3223
4212
 
3224
4213
         PreFetch(0, next);
3225
 
         ERTS_FP_CHECK_INIT();
 
4214
         ERTS_FP_CHECK_INIT(c_p);
3226
4215
         NextPF(0, next);
3227
4216
     }
3228
4217
 
3230
4219
         Eterm* next;
3231
4220
 
3232
4221
         PreFetch(0, next);
3233
 
         ERTS_FP_ERROR(freg[0].fd, goto fbadarith);
 
4222
         ERTS_FP_ERROR(c_p, freg[0].fd, goto fbadarith);
3234
4223
         NextPF(0, next);
3235
4224
     }
3236
4225
#  undef ERTS_FP_CHECK_INIT
3237
4226
#  undef ERTS_FP_ERROR
3238
 
#  define ERTS_FP_CHECK_INIT()
3239
 
#  define ERTS_FP_ERROR(a, b)
 
4227
#  define ERTS_FP_CHECK_INIT(p)
 
4228
#  define ERTS_FP_ERROR(p, a, b)
3240
4229
#endif
3241
4230
 
3242
4231
 
3244
4233
     Eterm* next;
3245
4234
 
3246
4235
     PreFetch(3, next);
3247
 
     ERTS_FP_CHECK_INIT();
 
4236
     ERTS_FP_CHECK_INIT(c_p);
3248
4237
     fb(Arg(2)) = fb(Arg(0)) + fb(Arg(1));
3249
 
     ERTS_FP_ERROR(fb(Arg(2)), goto fbadarith);
 
4238
     ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
3250
4239
     NextPF(3, next);
3251
4240
 }
3252
4241
 OpCase(i_fsub_lll): {
3253
4242
     Eterm* next;
3254
4243
 
3255
4244
     PreFetch(3, next);
3256
 
     ERTS_FP_CHECK_INIT();
 
4245
     ERTS_FP_CHECK_INIT(c_p);
3257
4246
     fb(Arg(2)) = fb(Arg(0)) - fb(Arg(1));
3258
 
     ERTS_FP_ERROR(fb(Arg(2)), goto fbadarith);
 
4247
     ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
3259
4248
     NextPF(3, next);
3260
4249
 }
3261
4250
 OpCase(i_fmul_lll): {
3262
4251
     Eterm* next;
3263
4252
 
3264
4253
     PreFetch(3, next);
3265
 
     ERTS_FP_CHECK_INIT();
 
4254
     ERTS_FP_CHECK_INIT(c_p);
3266
4255
     fb(Arg(2)) = fb(Arg(0)) * fb(Arg(1));
3267
 
     ERTS_FP_ERROR(fb(Arg(2)), goto fbadarith);
 
4256
     ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
3268
4257
     NextPF(3, next);
3269
4258
 }
3270
4259
 OpCase(i_fdiv_lll): {
3271
4260
     Eterm* next;
3272
4261
 
3273
4262
     PreFetch(3, next);
3274
 
     ERTS_FP_CHECK_INIT();
 
4263
     ERTS_FP_CHECK_INIT(c_p);
3275
4264
     fb(Arg(2)) = fb(Arg(0)) / fb(Arg(1));
3276
 
     ERTS_FP_ERROR(fb(Arg(2)), goto fbadarith);
 
4265
     ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
3277
4266
     NextPF(3, next);
3278
4267
 }
3279
4268
 OpCase(i_fnegate_ll): {
3280
4269
     Eterm* next;
3281
4270
 
3282
4271
     PreFetch(2, next);
3283
 
     ERTS_FP_CHECK_INIT();
 
4272
     ERTS_FP_CHECK_INIT(c_p);
3284
4273
     fb(Arg(1)) = -fb(Arg(0));
3285
 
     ERTS_FP_ERROR(fb(Arg(1)), goto fbadarith);
 
4274
     ERTS_FP_ERROR(c_p, fb(Arg(1)), goto fbadarith);
3286
4275
     NextPF(2, next);
3287
4276
 
3288
4277
 fbadarith:
3307
4296
         ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
3308
4297
         c_p->hipe.ncallee = (void(*)(void)) I[-4];
3309
4298
         cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8);
 
4299
         ++hipe_trap_count;
3310
4300
         goto L_hipe_mode_switch;
3311
4301
     }
3312
4302
     OpCase(hipe_trap_call_closure): {
3313
4303
       ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
3314
4304
       c_p->hipe.ncallee = (void(*)(void)) I[-4];
3315
4305
       cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8);
 
4306
       ++hipe_trap_count;
3316
4307
       goto L_hipe_mode_switch;
3317
4308
     }
3318
4309
     OpCase(hipe_trap_return): {
3335
4326
     /* XXX: this abuse of def_arg_reg[] is horrid! */
3336
4327
     SWAPOUT;
3337
4328
     c_p->fcalls = FCALLS;
3338
 
     c_p->def_arg_reg[4] = o_reds;
 
4329
     c_p->def_arg_reg[4] = -neg_o_reds;
3339
4330
     reg[0] = r(0);
3340
4331
     c_p = hipe_mode_switch(c_p, cmd, reg);
3341
 
     o_reds = c_p->def_arg_reg[4];
 
4332
#ifdef ERTS_SMP
 
4333
     reg = c_p->scheduler_data->save_reg;
 
4334
     freg = c_p->scheduler_data->freg;
 
4335
#endif
 
4336
     ERL_BITS_RELOAD_STATEP(c_p);
 
4337
     neg_o_reds = -c_p->def_arg_reg[4];
3342
4338
     FCALLS = c_p->fcalls;
3343
4339
     SWAPIN;
3344
4340
     switch( c_p->def_arg_reg[3] ) {
3350
4346
         r(0) = reg[0];
3351
4347
         Dispatch();
3352
4348
       case HIPE_MODE_SWITCH_RES_THROW:
3353
 
         if( c_p->freason == EXC_USER_ERROR ) {
3354
 
             c_p->freason = EXC_ERROR; /* don't build backtrace */
3355
 
         }
3356
4349
         c_p->cp = NULL;
3357
4350
         I = handle_error(c_p, I, reg, NULL);
3358
4351
         goto post_error_handling;
3389
4382
     c_p->arity = 1; /* One living register (the 'true' return value) */
3390
4383
     SWAPOUT;
3391
4384
     c_p->i = I + 1; /* Next instruction */
 
4385
     erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
3392
4386
     add_to_schedule_q(c_p);
 
4387
     erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
3393
4388
     goto do_schedule;
3394
4389
 }
3395
4390
 
3416
4411
     goto no_error_handler;
3417
4412
 }
3418
4413
 
 
4414
 /*
 
4415
  * Construction of binaries using old instructions.
 
4416
  */
 
4417
#if !defined(HEAP_FRAG_ELIM_TEST)
 
4418
 OpCase(i_bs_init_old): {
 
4419
     Eterm *next;
 
4420
     PreFetch(0, next);
 
4421
     erts_bin_offset = 0;
 
4422
     NextPF(0, next);
 
4423
 }
 
4424
 
 
4425
 OpCase(i_bs_final_jd): {
 
4426
     Eterm *next;
 
4427
     Eterm b;
 
4428
 
 
4429
     PreFetch(2, next);
 
4430
     SAVE_HTOP;
 
4431
     c_p->fcalls = FCALLS;
 
4432
     b = erts_bs_final(c_p);
 
4433
     FCALLS = c_p->fcalls;
 
4434
     if (is_non_value(b)) {
 
4435
         goto badarg;
 
4436
     }
 
4437
     StoreResult(b, Arg(1));
 
4438
     NextPF(2, next);
 
4439
 }
 
4440
 
 
4441
 OpCase(i_bs_put_string_II):
 
4442
    {
 
4443
        Eterm* next;
 
4444
        PreFetch(2, next);
 
4445
        erts_bs_put_string(ERL_BITS_ARGS_2((byte *) Arg(1), Arg(0)));
 
4446
        NextPF(2, next);
 
4447
    }
 
4448
#endif
 
4449
 
 
4450
#ifndef ERTS_SMP /* Not supported with smp emulator */
3419
4451
    DEFINE_COUNTING_LABELS;
 
4452
#endif
 
4453
 
3420
4454
#ifndef NO_JUMP_TABLE
3421
4455
#ifdef DEBUG
3422
4456
 end_emulator_loop:
3425
4459
 
3426
4460
 OpCase(int_code_end):
3427
4461
 OpCase(label_L):
 
4462
 OpCase(too_old_compiler):
3428
4463
    erl_exit(1, "meta op\n");
3429
4464
 
3430
4465
    /*
3437
4472
     Export* ep;
3438
4473
 
3439
4474
#ifndef NO_JUMP_TABLE
 
4475
#ifndef ERTS_SMP /* Not supported with smp emulator */     
 
4476
 
3440
4477
     /* Are tables correctly generated by beam_makeops? */
3441
4478
     ASSERT(sizeof(counting_opcodes) == sizeof(opcodes));
3442
 
     
3443
 
     if (!count_instructions) {
3444
 
         beam_ops = opcodes;
3445
 
     } else {
 
4479
 
 
4480
     if (count_instructions) {
3446
4481
#ifdef DEBUG
3447
4482
         counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y);
3448
4483
#endif
3449
4484
         counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI);
3450
4485
         beam_ops = counting_opcodes;
3451
4486
     }
 
4487
     else
 
4488
#endif /* #ifndef ERTS_SMP */
 
4489
     {
 
4490
         beam_ops = opcodes;
 
4491
     }
3452
4492
#endif /* NO_JUMP_TABLE */
3453
4493
     
3454
4494
     em_call_error_handler = OpCode(call_error_handler);
3457
4497
     beam_apply[0] = (Eterm) OpCode(i_apply);
3458
4498
     beam_apply[1] = (Eterm) OpCode(normal_exit);
3459
4499
     beam_exit[0] = (Eterm) OpCode(error_action_code);
 
4500
     beam_return_to_trace[0] = (Eterm) OpCode(i_return_to_trace);
 
4501
     beam_return_trace[0] = (Eterm) OpCode(return_trace);
 
4502
     beam_exception_trace[0] = (Eterm) OpCode(return_trace); /* UGLY */
3460
4503
 
3461
4504
     /*
3462
4505
      * Enter all BIFs into the export table.
3470
4513
         ep->code[4] = (Eterm) bif_table[i].f;
3471
4514
     }
3472
4515
 
3473
 
     /*
3474
 
      * erts_debug:apply(Mod, Func, Args, {M,F,A})
3475
 
      *  Applies Mod:Func with Args in the same way as apply/3.
3476
 
      *  If a BIF is applied and it fails, the normal EXIT code
3477
 
      *  to look as if the error occurred in function {M,F,A}.
3478
 
      *  Also, the normal stack backtrace will suppressed.
3479
 
      */
3480
 
 
3481
 
     ep = erts_export_put(am_erts_debug, am_apply, 4);
3482
 
     ep->address = (Eterm *) (beam_debug_apply+5);
3483
 
 
3484
 
     /* func_info 0 erts_debug apply 4 */
3485
 
     beam_debug_apply[0] = (Eterm) OpCode(i_func_info_IaaI);
3486
 
     beam_debug_apply[1] = 0;
3487
 
     beam_debug_apply[2] = am_erts_debug;
3488
 
     beam_debug_apply[3] = am_apply;
3489
 
     beam_debug_apply[4] = 4;
3490
 
 
3491
 
     /* allocate 1 4 */
3492
 
     beam_debug_apply[5] = (Eterm) OpCode(allocate_tt);
3493
 
     beam_debug_apply[6] = (4 << 16) | 1;
3494
 
 
3495
 
     /* move {x,3} {y,0} */
3496
 
     beam_debug_apply[7] = (Eterm) OpCode(move_xy);
3497
 
     beam_debug_apply[8] = (1 << 18) | (3 << 2);
3498
 
 
3499
 
     /* i_apply */
3500
 
     beam_debug_apply[9] = (Eterm) OpCode(i_apply);
3501
 
 
3502
 
     /* deallocate_return 1 */
3503
 
     beam_debug_apply[10] = (Eterm) OpCode(deallocate_return_P);
3504
 
     beam_debug_apply[11] = (1+1)*4;
3505
 
 
3506
4516
     return;
3507
4517
 }
3508
4518
#ifdef NO_JUMP_TABLE
3526
4536
    }
3527
4537
}
3528
4538
 
 
4539
#if defined(HEAP_FRAG_ELIM_TEST)
 
4540
static BifFunction
 
4541
translate_gc_bif(void* gcf)
 
4542
{
 
4543
    if (gcf == erts_gc_length_1) {
 
4544
        return length_1;
 
4545
    } else if (gcf == erts_gc_size_1) {
 
4546
        return size_1;
 
4547
    } else if (gcf == erts_gc_abs_1) {
 
4548
        return abs_1;
 
4549
    } else if (gcf == erts_gc_float_1) {
 
4550
        return float_1;
 
4551
    } else if (gcf == erts_gc_round_1) {
 
4552
        return round_1;
 
4553
    } else if (gcf == erts_gc_trunc_1) {
 
4554
        return round_1;
 
4555
    } else {
 
4556
        erl_exit(1, "bad gc bif");
 
4557
    }
 
4558
}
 
4559
#endif
 
4560
 
3529
4561
/*
3530
4562
 * Mapping from the error code 'class tag' to atoms.
3531
4563
 */
3532
4564
Eterm exception_tag[NUMBER_EXC_TAGS] = {
3533
 
  am_EXIT,      /* 0 */
3534
 
  am_ERROR,     /* 1 */
 
4565
  am_error,     /* 0 */
 
4566
  am_exit,      /* 1 */
3535
4567
  am_throw,     /* 2 */
3536
4568
};
3537
4569
 
3558
4590
  am_try_clause,        /* 16 */
3559
4591
};
3560
4592
 
 
4593
/*
 
4594
 * To fully understand the error handling, one must keep in mind that
 
4595
 * when an exception is thrown, the search for a handler can jump back
 
4596
 * and forth between Beam and native code. Upon each mode switch, a
 
4597
 * dummy handler is inserted so that if an exception reaches that point,
 
4598
 * the handler is invoked (like any handler) and transfers control so
 
4599
 * that the search for a real handler is continued in the other mode.
 
4600
 * Therefore, c_p->freason and c_p->fvalue must still hold the exception
 
4601
 * info when the handler is executed, but normalized so that creation of
 
4602
 * error terms and saving of the stack trace is only done once, even if
 
4603
 * we pass through the error handling code several times.
 
4604
 *
 
4605
 * When a new exception is raised, the current stack trace information
 
4606
 * is quick-saved in a small structure allocated on the heap. Depending
 
4607
 * on how the exception is eventually caught (perhaps by causing the
 
4608
 * current process to terminate), the saved information may be used to
 
4609
 * create a symbolic (human-readable) representation of the stack trace
 
4610
 * at the point of the original exception.
 
4611
 */
 
4612
 
3561
4613
static Eterm*
3562
4614
handle_error(Process* c_p, Eterm* pc, Eterm* reg, BifFunction bf)
3563
4615
{
3564
 
    Eterm temp_current[3];
3565
 
    Uint needed;
3566
 
    Eterm* heap_start;
3567
4616
    Eterm* hp;
3568
 
    int max_depth = erts_backtrace_depth;
3569
 
 
3570
 
    /*
3571
 
     * For most exceptions, the error reason will look like {Value,Where},
3572
 
     * where Where is a list.
3573
 
     * Where will not be used for exit/1 and throw/1.
3574
 
     */
3575
 
 
3576
 
    Eterm Value;
3577
 
    Eterm Where = NIL;
3578
 
    Eterm* next_p = &Where;     
3579
 
                              /* Where to store the next element of Where. */
3580
 
    Eterm *save_current = c_p->current; 
3581
 
                              /* Needed when bif traps throws exceptions */
3582
 
    c_p->i = pc;              /* In case we call erl_exit(). */
3583
 
 
3584
 
    /*
3585
 
     * First, make sure that we know the {M,F,A} of the current function.
3586
 
     */
3587
 
 
3588
 
    if (pc != NULL && (c_p->current = find_function_from_pc(pc)) == NULL) {
3589
 
        /*
3590
 
         * Default to the initial function (e.g. spawn_link(erlang, abs, [1])).
3591
 
         */
3592
 
        c_p->current = c_p->initial;
3593
 
        if (beam_debug_apply <= pc && pc < beam_debug_apply+beam_debug_apply_size) {
3594
 
            Eterm* y0 = c_p->stop+1;
3595
 
 
3596
 
            if (is_tuple(*y0)) {
3597
 
                Eterm* tp = tuple_val(*y0);
3598
 
 
3599
 
                if (arityval(tp[0]) == 3) {
3600
 
                    Sint arity;
3601
 
 
3602
 
                    temp_current[0] = tp[1];
3603
 
                    temp_current[1] = tp[2];
3604
 
                    if ((arity = list_length(tp[3])) >= 0) {
3605
 
                        temp_current[2] = (Eterm) arity;
3606
 
                        c_p->current = temp_current;
3607
 
                    }
3608
 
                }
3609
 
            }
3610
 
            if (c_p->freason & EXF_ARGLIST) {
3611
 
                c_p->freason -= EXF_ARGLIST;
3612
 
                bf = NULL;
3613
 
            }
3614
 
        }
3615
 
    }
3616
 
 
3617
 
    /*
3618
 
     * We are not allowed to have backwards pointers between heap fragments
3619
 
     * or from a heap fragment to the heap. Therefore, we must allocate all
3620
 
     * storage we need in a single block.
3621
 
     */
3622
 
 
3623
 
    needed = 3+3+6+6+2*3;
3624
 
    if (c_p->current != NULL) {
3625
 
        needed += c_p->current[2]*2;
3626
 
    }
3627
 
    needed += 4+2+6+6*max_depth+3;
3628
 
    heap_start = hp = HAlloc(c_p, needed);
3629
 
 
3630
 
    /*
3631
 
     * Retrieve the atom to use in Value.
3632
 
     */
 
4617
    Eterm Value = c_p->fvalue;
 
4618
    Eterm Args = am_true;
 
4619
    c_p->i = pc;    /* In case we call erl_exit(). */
3633
4620
 
3634
4621
    ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */
3635
4622
    ASSERT(c_p->freason != RESCHEDULE); /* Should have been handled earlier. */
3636
 
    { Uint r = GET_EXC_INDEX(c_p->freason);
3637
 
      ASSERT(r < NUMBER_EXIT_CODES); /* range check */
3638
 
      if (r < NUMBER_EXIT_CODES) {
3639
 
          Value = error_atom[r];
3640
 
      } else {
3641
 
          Value = am_internal_error;
3642
 
          c_p->freason = EXC_INTERNAL_ERROR;
3643
 
      }
3644
 
    }
3645
 
 
3646
 
    /*
3647
 
     * Throws that are not caught are turned into 'nocatch' errors.
3648
 
     */
3649
 
 
 
4623
 
 
4624
    /*
 
4625
     * Check if we have an arglist for the top level call. If so, this
 
4626
     * is encoded in Value, so we have to dig out the real Value as well
 
4627
     * as the Arglist.
 
4628
     */
 
4629
    if (c_p->freason & EXF_ARGLIST) {
 
4630
          Eterm* tp;
 
4631
          ASSERT(is_tuple(Value));
 
4632
          tp = tuple_val(Value);
 
4633
          Value = tp[1];
 
4634
          Args = tp[2];
 
4635
    }
 
4636
 
 
4637
    /*
 
4638
     * Save the stack trace info if the EXF_SAVETRACE flag is set. The
 
4639
     * main reason for doing this separately is to allow throws to later
 
4640
     * become promoted to errors without losing the original stack
 
4641
     * trace, even if they have passed through one or more catch and
 
4642
     * rethrow. It also makes the creation of symbolic stack traces much
 
4643
     * more modular.
 
4644
     */
 
4645
    if (c_p->freason & EXF_SAVETRACE) {
 
4646
        save_stacktrace(c_p, pc, reg, bf, Args);
 
4647
    }
 
4648
 
 
4649
    /*
 
4650
     * Throws that are not caught are turned into 'nocatch' errors
 
4651
     */
3650
4652
    if ((c_p->freason & EXF_THROWN) && (c_p->catches <= 0) ) {
3651
 
        c_p->fvalue = TUPLE2(hp, am_nocatch, c_p->fvalue);
3652
 
        hp += 3;
3653
 
        c_p->freason = EXC_USER_ERROR;   /* force stack trace and log */
3654
 
    }
3655
 
 
 
4653
        hp = HAlloc(c_p, 3);
 
4654
        Value = TUPLE2(hp, am_nocatch, Value);
 
4655
        c_p->freason = EXC_ERROR;
 
4656
    }
 
4657
 
 
4658
    /* Get the fully expanded error term */
 
4659
    Value = expand_error_value(c_p, c_p->freason, Value);
 
4660
 
 
4661
    /* Save final error term and stabilize the exception flags so no
 
4662
       further expansion is done. */
 
4663
    c_p->fvalue = Value;
 
4664
    c_p->freason = PRIMARY_EXCEPTION(c_p->freason);
 
4665
 
 
4666
    /* Find a handler or die */
 
4667
    if ((c_p->catches > 0 || IS_TRACED_FL(c_p, F_EXCEPTION_TRACE))
 
4668
        && !(c_p->freason & EXF_PANIC)) {
 
4669
        Eterm *new_pc;
 
4670
        /* The Beam handler code (catch_end or try_end) checks reg[0]
 
4671
           for THE_NON_VALUE to see if the previous code finished
 
4672
           abnormally. If so, reg[1], reg[2] and reg[3] should hold the
 
4673
           exception class, term and trace, respectively. (If the
 
4674
           handler is just a trap to native code, these registers will
 
4675
           be ignored.) */
 
4676
        reg[0] = THE_NON_VALUE;
 
4677
        reg[1] = exception_tag[GET_EXC_CLASS(c_p->freason)];
 
4678
        reg[2] = Value;
 
4679
        reg[3] = c_p->ftrace;
 
4680
        if ( (new_pc = next_catch(c_p, reg))) return new_pc;
 
4681
        if (c_p->catches > 0) erl_exit(1, "Catch not found");
 
4682
    }
 
4683
    terminate_proc(c_p, Value);
 
4684
    return NULL;
 
4685
}
 
4686
 
 
4687
/*
 
4688
 * Find the nearest catch handler
 
4689
 */
 
4690
static Eterm*
 
4691
next_catch(Process* c_p, Eterm *reg) {
 
4692
    int active_catches = c_p->catches > 0;
 
4693
    int have_return_to_trace = 0;
 
4694
    Eterm *ptr, *prev, *return_to_trace_ptr = NULL;
 
4695
    Uint i_return_trace = beam_return_trace[0];
 
4696
    Uint i_return_to_trace = beam_return_to_trace[0];
 
4697
    ptr = prev = c_p->stop;
 
4698
    ASSERT(is_CP(*ptr));
 
4699
    ASSERT(ptr <= STACK_START(c_p));
 
4700
    if (ptr == STACK_START(c_p)) return NULL;
 
4701
    if ((is_not_CP(*ptr) || (*cp_val(*ptr) != i_return_trace &&
 
4702
                             *cp_val(*ptr) != i_return_to_trace))
 
4703
        && c_p->cp) {
 
4704
        /* Can not follow cp here - code may be unloaded */
 
4705
        Uint *cpp = cp_val((Eterm) c_p->cp);
 
4706
        if (cpp == beam_exception_trace) {
 
4707
            erts_trace_exception(c_p, (Eterm*) ptr[0],
 
4708
                                 reg[1], reg[2], ptr+1);
 
4709
            /* Skip return_trace parameters */
 
4710
            ptr += 2;
 
4711
        } else if (cpp == beam_return_trace) {
 
4712
            /* Skip return_trace parameters */
 
4713
            ptr += 2;
 
4714
        } else if (cpp == beam_return_to_trace) {
 
4715
            have_return_to_trace = !0; /* Record next cp */
 
4716
        }
 
4717
    }
 
4718
    while (ptr < STACK_START(c_p)) {
 
4719
        if (is_catch(*ptr)) {
 
4720
            if (active_catches) goto found_catch;
 
4721
            ptr++;
 
4722
        }
 
4723
        else if (is_CP(*ptr)) {
 
4724
            prev = ptr;
 
4725
            if (*cp_val(*prev) == i_return_trace) {
 
4726
                /* Skip stack frame variables */
 
4727
                while (++ptr, ptr < STACK_START(c_p) && is_not_CP(*ptr)) {
 
4728
                    if (is_catch(*ptr) && active_catches) goto found_catch;
 
4729
                }
 
4730
                if (cp_val(*prev) == beam_exception_trace) {
 
4731
                    erts_trace_exception(c_p, (Eterm*) ptr[0],
 
4732
                                         reg[1], reg[2], ptr+1);
 
4733
                }
 
4734
                /* Skip return_trace parameters */
 
4735
                ptr += 2;
 
4736
            } else if (*cp_val(*prev) == i_return_to_trace) {
 
4737
                /* Skip stack frame variables */
 
4738
                while (++ptr, ptr < STACK_START(c_p) && is_not_CP(*ptr)) {
 
4739
                    if (is_catch(*ptr) && active_catches) goto found_catch;
 
4740
                }
 
4741
                have_return_to_trace = !0; /* Record next cp */
 
4742
                return_to_trace_ptr = NULL;
 
4743
            } else {
 
4744
                if (have_return_to_trace) {
 
4745
                    /* Record this cp as possible return_to trace cp */
 
4746
                    have_return_to_trace = 0;
 
4747
                    return_to_trace_ptr = ptr;
 
4748
                } else return_to_trace_ptr = NULL;
 
4749
                ptr++;
 
4750
            }
 
4751
        } else ptr++;
 
4752
    }
 
4753
    return NULL;
 
4754
    
 
4755
 found_catch:
 
4756
    ASSERT(ptr < STACK_START(c_p));
 
4757
    c_p->stop = prev;
 
4758
    if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO) && return_to_trace_ptr) {
 
4759
        /* The stackframe closest to the catch contained an
 
4760
         * return_to_trace entry, so since the execution now
 
4761
         * continues after the catch, a return_to trace message 
 
4762
         * would be appropriate.
 
4763
         */
 
4764
        erts_trace_return_to(c_p, cp_val(*return_to_trace_ptr));
 
4765
    }
 
4766
    return catch_pc(*ptr);
 
4767
}
 
4768
 
 
4769
/*
 
4770
 * Terminating the process when an exception is not caught
 
4771
 */
 
4772
static void
 
4773
terminate_proc(Process* c_p, Eterm Value)
 
4774
{
 
4775
    /* Add a stacktrace if this is an error. */
 
4776
    if (GET_EXC_CLASS(c_p->freason) == EXTAG_ERROR) {
 
4777
        Value = add_stacktrace(c_p, Value, c_p->ftrace);
 
4778
    }
 
4779
    /* EXF_LOG is a primary exception flag */
 
4780
    if (c_p->freason & EXF_LOG) {
 
4781
        erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
 
4782
        erts_dsprintf(dsbufp, "Error in process %T ", c_p->id);
 
4783
        if (erts_is_alive())
 
4784
            erts_dsprintf(dsbufp, "on node %T ", erts_this_node->sysname);
 
4785
        erts_dsprintf(dsbufp,"with exit value: %0.*T\n", display_items, Value);
 
4786
        erts_send_error_to_logger(c_p->group_leader, dsbufp);
 
4787
    }
3656
4788
    /*
3657
 
     * Make sure we form the correct error value
 
4789
     * If we use a shared heap, the process will be garbage-collected.
 
4790
     * Must zero c_p->arity to indicate that there are no live registers.
3658
4791
     */
3659
 
 
3660
 
    switch (GET_EXC_INDEX(c_p->freason)) {
 
4792
    c_p->arity = 0;
 
4793
    erts_do_exit_process(c_p, Value);
 
4794
}
 
4795
 
 
4796
/*
 
4797
 * Build and add a symbolic stack trace to the error value.
 
4798
 */
 
4799
static Eterm
 
4800
add_stacktrace(Process* c_p, Eterm Value, Eterm exc) {
 
4801
    Eterm Where = build_stacktrace(c_p, exc);
 
4802
    Eterm* hp = HAlloc(c_p, 3);
 
4803
    return TUPLE2(hp, Value, Where);
 
4804
}
 
4805
 
 
4806
/*
 
4807
 * Forming the correct error value from the internal error code.
 
4808
 * This does not update c_p->fvalue or c_p->freason.
 
4809
 */
 
4810
Eterm
 
4811
expand_error_value(Process* c_p, Uint freason, Eterm Value) {
 
4812
    Eterm* hp;
 
4813
    Uint r;
 
4814
 
 
4815
    r = GET_EXC_INDEX(freason);
 
4816
    ASSERT(r < NUMBER_EXIT_CODES); /* range check */
 
4817
    ASSERT(is_value(Value));
 
4818
 
 
4819
    switch (r) {
3661
4820
    case (GET_EXC_INDEX(EXC_PRIMARY)):
3662
 
        /* Primary exceptions use fvalue directly */
3663
 
        ASSERT(is_value(c_p->fvalue));
3664
 
        Value = c_p->fvalue;
3665
 
        break;
 
4821
        /* Primary exceptions use fvalue as it is */
 
4822
        break;
3666
4823
    case (GET_EXC_INDEX(EXC_BADMATCH)):
3667
4824
    case (GET_EXC_INDEX(EXC_CASE_CLAUSE)):
3668
4825
    case (GET_EXC_INDEX(EXC_TRY_CLAUSE)):
3669
4826
    case (GET_EXC_INDEX(EXC_BADFUN)):
3670
 
        ASSERT(is_value(c_p->fvalue));
3671
 
        Value = TUPLE2(hp, Value, c_p->fvalue);
3672
 
        hp += 3;
3673
 
        break;
3674
4827
    case (GET_EXC_INDEX(EXC_BADARITY)):
3675
 
        ASSERT(is_value(c_p->fvalue));
3676
 
        ASSERT(*next_p == NIL);
3677
 
        *next_p = CONS(hp, c_p->fvalue, NIL);
3678
 
        next_p = hp + 1;
3679
 
        hp += 2;
 
4828
        /* Some common exceptions: value -> {atom, value} */
 
4829
        ASSERT(is_value(Value));
 
4830
        hp = HAlloc(c_p, 3);
 
4831
        Value = TUPLE2(hp, error_atom[r], Value);
 
4832
        break;
 
4833
    default:
 
4834
        /* Other exceptions just use an atom as descriptor */
 
4835
        Value = error_atom[r];
3680
4836
        break;
3681
4837
    }
3682
 
    c_p->fvalue = NIL;
3683
4838
#ifdef DEBUG
3684
4839
    ASSERT(Value != am_internal_error);
3685
4840
#endif
 
4841
    return Value;
 
4842
}
 
4843
 
 
4844
/*
 
4845
 * Quick-saving the stack trace in an internal form on the heap. Note
 
4846
 * that c_p->ftrace will point to a cons cell which holds the given args
 
4847
 * and the saved data (encoded as a bignum).
 
4848
 *
 
4849
 * (It would be much better to put the arglist - when it exists - in the
 
4850
 * error value instead of in the actual trace; e.g. '{badarg, Args}'
 
4851
 * instead of using 'badarg' with Args in the trace. The arglist may
 
4852
 * contain very large values, and right now they will be kept alive as
 
4853
 * long as the stack trace is live. Preferably, the stack trace should
 
4854
 * always be small, so that it does not matter if it is long-lived.
 
4855
 * However, it is probably not possible to ever change the format of
 
4856
 * error terms.)
 
4857
 */
 
4858
 
 
4859
static void
 
4860
save_stacktrace(Process* c_p, Eterm* pc, Eterm* reg, BifFunction bf,
 
4861
                Eterm args) {
 
4862
    struct StackTrace* s;
 
4863
    int sz;
 
4864
    int depth = erts_backtrace_depth;    /* max depth (never negative) */
 
4865
    if (depth > 0) {
 
4866
        /* There will always be a current function */
 
4867
        depth --;
 
4868
    }
 
4869
 
 
4870
    /* Create a container for the exception data */
 
4871
    sz = (offsetof(struct StackTrace, trace) + sizeof(Eterm)*depth
 
4872
          + sizeof(Eterm) - 1) / sizeof(Eterm);
 
4873
    s = (struct StackTrace *) HAlloc(c_p, 1 + sz);
 
4874
    /* The following fields are inside the bignum */
 
4875
    s->header = make_pos_bignum_header(sz);
 
4876
    s->freason = c_p->freason;
 
4877
    s->depth = 0;
3686
4878
 
3687
4879
    /*
3688
 
     * Build the Where part of the reason (the backtrace), if the
3689
 
     * EXF_TRACE flag is set.
 
4880
     * If the failure was in a BIF other than 'error', 'exit' or
 
4881
     * 'throw', find the bif-table index and save the argument
 
4882
     * registers by consing up an arglist.
3690
4883
     */
3691
 
 
3692
 
    if (c_p->freason & EXF_TRACE) {
3693
 
        Eterm mfa;
3694
 
        Uint* fi;
3695
 
        Uint* ptr;
3696
 
        Uint* prev = NULL;      /* Pointer to func_info for previous function
3697
 
                                 * put in Where.
3698
 
                                 */
3699
 
 
3700
 
        /*
3701
 
         * Check if we have an arglist term to use instead of the arity
3702
 
         * for the top level call. (If so, this is encoded in Value.)
3703
 
         */
3704
 
 
3705
 
        if (c_p->freason & EXF_ARGLIST) {
3706
 
            Eterm* tp;
3707
 
 
3708
 
            ASSERT(is_tuple(Value));
3709
 
            prev = c_p->current;
3710
 
            ASSERT(prev != NULL);
3711
 
            tp = tuple_val(Value);
3712
 
            Value = tp[1];
3713
 
            mfa = TUPLE3(hp, prev[0], prev[1], tp[2]);
3714
 
            hp += 4;
3715
 
            ASSERT(*next_p == NIL);
3716
 
            *next_p = CONS(hp, mfa, NIL);
3717
 
            next_p = hp + 1;
3718
 
            hp += 2;
3719
 
            bf = NULL;
3720
 
        }
3721
 
 
3722
 
        /*
3723
 
         * If the failure was in a BIF, this is the first element in Where.
3724
 
         * If the failure was caused by 'fault' or 'throw', we won't show it.
3725
 
         */
3726
 
 
3727
 
        if (bf != NULL && bf != fault_1 && bf != fault_2 && bf != throw_1) {
3728
 
            int i;
3729
 
 
3730
 
            for (i = 0; i < BIF_SIZE; i++) {
3731
 
                if (bf == bif_table[i].f || bf == bif_table[i].traced) {
3732
 
                    int arity = bif_table[i].arity;
3733
 
                    Eterm args;
3734
 
 
3735
 
                    args = NIL;
3736
 
                    /* hp += 6+2*arity */
3737
 
                    while (arity > 0) {
3738
 
                        args = CONS(hp, reg[arity-1], args);
3739
 
                        hp += 2;
3740
 
                        arity--;
3741
 
                    }
3742
 
                    mfa = TUPLE3(hp, bif_table[i].module, bif_table[i].name, args);
3743
 
                    hp += 4;
3744
 
                    ASSERT(*next_p == NIL);
3745
 
                    *next_p = CONS(hp, mfa, NIL);
3746
 
                    next_p = hp + 1;
3747
 
                    hp += 2;
3748
 
                    break;
3749
 
                }
3750
 
            }
3751
 
            if (i >= BIF_SIZE) {
3752
 
                /* 
3753
 
                 * The Bif does not really exist (no BIF entry). 
3754
 
                 * It is a TRAP and traps are called through
3755
 
                 * apply_bif, which also sets c_p->current (luckily).
3756
 
                 * We save c_p->current at the beginning of this function
3757
 
                 * so that we can dig out {M,F,Args} from that. 
3758
 
                 */
3759
 
 
3760
 
                int arity = save_current[2];
3761
 
                Eterm args;
3762
 
                ASSERT(is_atom(save_current[0]) && is_atom(save_current[1]) &&
3763
 
                       save_current[2] <= 3);
3764
 
                
3765
 
 
3766
 
                /* hp += 6+2*arity */
3767
 
                args = NIL;
3768
 
                while (arity > 0) {
3769
 
                    args = CONS(hp, reg[arity-1], args);
3770
 
                    hp += 2;
3771
 
                    arity--;
3772
 
                }
3773
 
                mfa = TUPLE3(hp, save_current[0], save_current[1], args);
3774
 
                hp += 4;
3775
 
                ASSERT(*next_p == NIL);
3776
 
                *next_p = CONS(hp, mfa, NIL);
3777
 
                next_p = hp + 1;
3778
 
                hp += 2;
3779
 
            }
3780
 
        }
3781
 
 
3782
 
        /*
3783
 
         * Add the {M,F,A} for the current function,
3784
 
         * where A is arity or arguments.
3785
 
         */
3786
 
 
3787
 
        if (c_p->current != prev) {
3788
 
            Eterm a;            /* Arguments or arity. */
3789
 
            prev = c_p->current;
3790
 
            if (c_p->current == c_p->stop) {
3791
 
                mfa = c_p->stop[1];
3792
 
                max_depth = 0;
3793
 
            } else {
3794
 
                if ( (GET_EXC_INDEX(c_p->freason)) !=
3795
 
                     (GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) ) {
3796
 
                    a = make_small(prev[2]);
 
4884
    if (bf != NULL && bf != error_1 && bf != error_2
 
4885
        && bf != fault_1 && bf != fault_2
 
4886
        && bf != exit_1 && bf != throw_1) {
 
4887
        int i;
 
4888
        int a = 0;
 
4889
        for (i = 0; i < BIF_SIZE; i++) {
 
4890
            if (bf == bif_table[i].f || bf == bif_table[i].traced) {
 
4891
                Export *ep = bif_export[i];
 
4892
                s->current = ep->code;
 
4893
                a = bif_table[i].arity;
 
4894
                break;
 
4895
            }
 
4896
        }
 
4897
        if (i >= BIF_SIZE) {
 
4898
            /* 
 
4899
             * The Bif does not really exist (no BIF entry).  It is a
 
4900
             * TRAP and traps are called through apply_bif, which also
 
4901
             * sets c_p->current (luckily).
 
4902
             */
 
4903
            ASSERT(c_p->current);
 
4904
            s->current = c_p->current;
 
4905
            a = s->current[2];
 
4906
            ASSERT(s->current[2] <= 3);
 
4907
        }
 
4908
        /* Save first stack entry */
 
4909
        ASSERT(pc);
 
4910
        if (depth > 0) {
 
4911
            s->trace[s->depth++] = pc;
 
4912
            depth--;
 
4913
        }
 
4914
        s->pc = NULL;
 
4915
        args = make_arglist(c_p, reg, a); /* Overwrite CAR(c_p->ftrace) */
 
4916
    } else {
 
4917
        s->current = c_p->current;
 
4918
        /* 
 
4919
         * For a function_clause error, the arguments are in the beam
 
4920
         * registers, c_p->cp is valid, and c_p->current is set.
 
4921
         */
 
4922
        if ( (GET_EXC_INDEX(s->freason)) ==
 
4923
             (GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) ) {
 
4924
            int a;
 
4925
            ASSERT(s->current);
 
4926
            a = s->current[2];
 
4927
            args = make_arglist(c_p, reg, a); /* Overwrite CAR(c_p->ftrace) */
 
4928
            /* Save first stack entry */
 
4929
            ASSERT(c_p->cp);
 
4930
            if (depth > 0) {
 
4931
                s->trace[s->depth++] = c_p->cp;
 
4932
                depth--;
 
4933
            }
 
4934
            s->pc = NULL; /* Ignore pc */
 
4935
        } else {
 
4936
            s->pc = pc;
 
4937
        }
 
4938
    }
 
4939
 
 
4940
    /* Package args and stack trace */
 
4941
    {
 
4942
        Eterm *hp;
 
4943
        hp = HAlloc(c_p, 2);
 
4944
        c_p->ftrace = CONS(hp, args, make_big((Eterm *) s));
 
4945
    }
 
4946
 
 
4947
    /* Save the actual stack trace */
 
4948
    if (depth > 0) {
 
4949
        Eterm *ptr, *prev = s->depth ? s->trace[s->depth-1] : NULL;
 
4950
        Uint i_return_trace = beam_return_trace[0];
 
4951
        Uint i_return_to_trace = beam_return_to_trace[0];
 
4952
        /*
 
4953
         * Traverse the stack backwards and add all unique continuation
 
4954
         * pointers to the buffer, up to the maximum stack trace size.
 
4955
         * 
 
4956
         * Skip trace stack frames.
 
4957
         */
 
4958
        ptr = c_p->stop;
 
4959
        if (ptr < STACK_START(c_p) 
 
4960
            && (is_not_CP(*ptr)|| (*cp_val(*ptr) != i_return_trace &&
 
4961
                                   *cp_val(*ptr) != i_return_to_trace))
 
4962
            && c_p->cp) {
 
4963
            /* Can not follow cp here - code may be unloaded */
 
4964
            Uint *cpp = cp_val((Eterm) c_p->cp);
 
4965
            if (cpp == beam_exception_trace || cpp == beam_return_trace) {
 
4966
                /* Skip return_trace parameters */
 
4967
                ptr += 2;
 
4968
            } else if (cpp == beam_return_to_trace) {
 
4969
                /* Skip return_to_trace parameters */
 
4970
                ptr += 1;
 
4971
            }
 
4972
        }
 
4973
        while (ptr < STACK_START(c_p) && depth > 0) {
 
4974
            if (is_CP(*ptr)) {
 
4975
                if (*cp_val(*ptr) == i_return_trace) {
 
4976
                    /* Skip stack frame variables */
 
4977
                    do ++ptr; while (is_not_CP(*ptr));
 
4978
                    /* Skip return_trace parameters */
 
4979
                    ptr += 2;
 
4980
                } else if (*cp_val(*ptr) == i_return_to_trace) {
 
4981
                    /* Skip stack frame variables */
 
4982
                    do ++ptr; while (is_not_CP(*ptr));
3797
4983
                } else {
3798
 
                    int i;
3799
 
 
3800
 
                    /* 2*prev[2] <= 2*c_p->current[2] */
3801
 
                    a = NIL;
3802
 
                    for (i = prev[2]-1; i >= 0; i--) {
3803
 
                        a = CONS(hp, reg[i], a);
3804
 
                        hp += 2;
 
4984
                    Eterm *cp = (Eterm *)(*ptr);
 
4985
                    if (cp != prev) {
 
4986
                        /* Record non-duplicates only */
 
4987
                        prev = cp;
 
4988
                        s->trace[s->depth++] = cp;
 
4989
                        depth--;
3805
4990
                    }
 
4991
                    ptr++;
3806
4992
                }
3807
 
                mfa = TUPLE3(hp, prev[0], prev[1], a);
3808
 
                hp += 4;
3809
 
            }
3810
 
            ASSERT(*next_p == NIL);
3811
 
            *next_p = CONS(hp, mfa, NIL);
3812
 
            next_p = hp + 1;
3813
 
            hp += 2;
3814
 
        }
3815
 
 
3816
 
        /*
3817
 
         * The continuation pointer (c_p->cp) in most cases points to
3818
 
         * a function which we have called and already returned from,
3819
 
         * because the deallocate_return instruction doesn't update c_p->cp.
3820
 
         * Therefore, we will ignore c_p->cp, except for function_clause
3821
 
         * when it *is* accurate.
 
4993
            } else ptr++;
 
4994
        }
 
4995
    }
 
4996
}
 
4997
 
 
4998
/*
 
4999
 * Getting the relevant fields from the term pointed to by ftrace
 
5000
 */
 
5001
 
 
5002
static struct StackTrace *get_trace_from_exc(Eterm exc) {
 
5003
    if (exc == NIL) {
 
5004
        return NULL;
 
5005
    } else {
 
5006
        ASSERT(is_list(exc));
 
5007
        return (struct StackTrace *) big_val(CDR(list_val(exc)));
 
5008
    }
 
5009
}
 
5010
 
 
5011
static Eterm get_args_from_exc(Eterm exc) {
 
5012
    if (exc == NIL) {
 
5013
        return NIL;
 
5014
    } else {
 
5015
        ASSERT(is_list(exc));
 
5016
        return CAR(list_val(exc));
 
5017
    }
 
5018
}
 
5019
 
 
5020
static int is_raised_exc(Eterm exc) {
 
5021
    if (exc == NIL) {
 
5022
        return 0;
 
5023
    } else {
 
5024
        ASSERT(is_list(exc));
 
5025
        return bignum_header_is_neg(*big_val(CDR(list_val(exc))));
 
5026
    }
 
5027
}
 
5028
 
 
5029
/*
 
5030
 * Creating a list with the argument registers
 
5031
 */
 
5032
static Eterm
 
5033
make_arglist(Process* c_p, Eterm* reg, int a) {
 
5034
    Eterm args = NIL;
 
5035
    Eterm* hp = HAlloc(c_p, 2*a);
 
5036
    while (a > 0) {
 
5037
        args = CONS(hp, reg[a-1], args);
 
5038
        hp += 2;
 
5039
        a--;
 
5040
    }
 
5041
    return args;
 
5042
}
 
5043
 
 
5044
/*
 
5045
 * Building a symbolic representation of a saved stack trace. Note that
 
5046
 * the exception object 'exc', unless NIL, points to a cons cell which
 
5047
 * holds the given args and the quick-saved data (encoded as a bignum).
 
5048
 *
 
5049
 * If the bignum is negative, the given args is a complete stacktrace.
 
5050
 */
 
5051
Eterm
 
5052
build_stacktrace(Process* c_p, Eterm exc) {
 
5053
    struct StackTrace* s;
 
5054
    Eterm  args;
 
5055
    int    depth;
 
5056
    Eterm* current;
 
5057
    Eterm  Where = NIL;
 
5058
    Eterm* next_p = &Where;
 
5059
 
 
5060
    if (! (s = get_trace_from_exc(exc))) {
 
5061
        return NIL;
 
5062
    }
 
5063
    if (s->freason & EXF_NATIVE) {
 
5064
      /* Just return a null trace if the exception was in native code.
 
5065
       */
 
5066
      return NIL;
 
5067
    }
 
5068
    if (is_raised_exc(exc)) {
 
5069
        return get_args_from_exc(exc);
 
5070
    }
 
5071
 
 
5072
    /*
 
5073
     * Find the current function. If the saved s->pc is null, then the
 
5074
     * saved s->current should already contain the proper value.
 
5075
     */
 
5076
    if (s->pc != NULL) {
 
5077
        current = find_function_from_pc(s->pc);
 
5078
    } else {
 
5079
        current = s->current;
 
5080
    }
 
5081
    /*
 
5082
     * If current is still NULL, default to the initial function
 
5083
     * (e.g. spawn_link(erlang, abs, [1])).
 
5084
     */
 
5085
    if (current == NULL) {
 
5086
        current = c_p->initial;
 
5087
        args = am_true; /* Just in case */
 
5088
    } else {
 
5089
        args = get_args_from_exc(exc);
 
5090
    }
 
5091
 
 
5092
    depth = s->depth;
 
5093
    
 
5094
    /*
 
5095
     * Add the {M,F,A} for the current function 
 
5096
     * (where A is arity or [Argument]).
 
5097
     */
 
5098
    {
 
5099
        int i;
 
5100
        Eterm mfa;
 
5101
        Uint heap_size = 6*(depth+1);
 
5102
        Eterm* hp = HAlloc(c_p, heap_size);
 
5103
        Eterm* hp_end = hp + heap_size;
 
5104
 
 
5105
        if (args != am_true) {
 
5106
            /* We have an arglist - use it */
 
5107
            mfa = TUPLE3(hp, current[0], current[1], args);
 
5108
        } else {
 
5109
            Eterm arity = make_small(current[2]);
 
5110
            mfa = TUPLE3(hp, current[0], current[1], arity);
 
5111
        }
 
5112
        hp += 4;
 
5113
        ASSERT(*next_p == NIL);
 
5114
        *next_p = CONS(hp, mfa, NIL);
 
5115
        next_p = &CDR(list_val(*next_p));
 
5116
        hp += 2;
 
5117
 
 
5118
        /* 
 
5119
         * Finally, we go through the saved continuation pointers.
3822
5120
         */
3823
 
 
3824
 
        fi = find_function_from_pc(c_p->cp);
3825
 
        if ( (GET_EXC_INDEX(c_p->freason)) ==
3826
 
             (GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) &&
3827
 
             fi != NULL && fi != prev && max_depth > 0) {
3828
 
            prev = fi;
 
5121
        for (i = 0; i < depth; i++) {
 
5122
            Eterm *fi = find_function_from_pc((Eterm *) s->trace[i]);
 
5123
            if (fi == NULL) continue;
3829
5124
            mfa = TUPLE3(hp, fi[0], fi[1], make_small(fi[2]));
3830
5125
            hp += 4;
3831
5126
            ASSERT(*next_p == NIL);
3832
5127
            *next_p = CONS(hp, mfa, NIL);
3833
 
            next_p = hp + 1;
 
5128
            next_p = &CDR(list_val(*next_p));
3834
5129
            hp += 2;
3835
 
            max_depth--;
3836
 
        }
3837
 
 
3838
 
        /*
3839
 
         * Traverse the stack backwards and add all unique functions
3840
 
         * to Where.
3841
 
         */
3842
 
 
3843
 
        if (max_depth != 0) {
3844
 
            /* hp += max_depth*6 */
3845
 
            for (ptr = c_p->stop; ptr < STACK_START(c_p); ptr++) {
3846
 
                if (is_CP(*ptr)) {
3847
 
                    fi = find_function_from_pc(cp_val(*ptr));
3848
 
                    if (fi != NULL && fi != prev) {
3849
 
                        if (max_depth-- <= 1) {
3850
 
                            ASSERT(*next_p == NIL);
3851
 
                            *next_p = am_more;
3852
 
                            break;
3853
 
                        }
3854
 
                        prev = fi;
3855
 
                        mfa = TUPLE3(hp, fi[0], fi[1], make_small(fi[2]));
3856
 
                        hp += 4;
3857
 
                        ASSERT(*next_p == NIL);
3858
 
                        *next_p = CONS(hp, mfa, NIL);
3859
 
                        next_p = hp + 1;
3860
 
                        hp += 2;
3861
 
                    }
3862
 
                }
3863
 
            }
3864
 
        }
3865
 
 
3866
 
        /*
3867
 
         * Build the final error term: {Value,Where}.
3868
 
         */
3869
 
 
3870
 
        Value = TUPLE2(hp, Value, Where);
3871
 
        hp += 2;
3872
 
    }
3873
 
 
3874
 
    if (hp - heap_start > needed) {
3875
 
        erl_exit(1, "%s, line %d: Heap block overrun", __FILE__, __LINE__);
3876
 
    }
3877
 
 
3878
 
 
3879
 
    /*
3880
 
     * Save final error term for use by native code.
3881
 
     */
3882
 
    c_p->fvalue = Value;
3883
 
    
3884
 
    if (c_p->current == temp_current) { /* It will go out of scope soon. */
3885
 
        c_p->current = c_p->initial;
3886
 
    }
3887
 
    
3888
 
    if ((c_p->catches <= 0) || (c_p->freason & EXF_PANIC)) {
3889
 
        /*
3890
 
         * No catch active -- terminate the process.
3891
 
         */
3892
 
        if (c_p->freason & EXF_LOG) {
3893
 
            cerr_pos = 0;
3894
 
            erl_printf(CBUF, "Error in process ");
3895
 
            display(c_p->id, CBUF);
3896
 
            if (erts_this_node->sysname != am_Noname) {
3897
 
                erl_printf(CBUF, " on node ");
3898
 
                print_atom(atom_val(erts_this_node->sysname), CBUF);
3899
 
            }
3900
 
            erl_printf(CBUF, " with exit value: ");
3901
 
            ldisplay(Value, CBUF, display_items);
3902
 
            erl_printf(CBUF, "\n");
3903
 
            send_error_to_logger(c_p->group_leader);
3904
 
        }
3905
 
 
3906
 
        /*
3907
 
         * If we use a shared heap, the process will be garbage-collected.
3908
 
         * Must zero c_p->arity to indicate that there are no live registers.
3909
 
         */
3910
 
        c_p->arity = 0;
3911
 
        do_exit(c_p, Value);
3912
 
    } else {
3913
 
        Eterm* ptr;
3914
 
 
3915
 
        /*
3916
 
         * Make sure the exception is stable, if anybody looks at
3917
 
         * freason/fvalue again after this point.
3918
 
         */
3919
 
 
3920
 
        c_p->freason = PRIMARY_EXCEPTION(c_p->freason);
3921
 
 
3922
 
        /*
3923
 
         * Search for the first catch.
3924
 
         */
3925
 
 
3926
 
        for (ptr = c_p->stop + CP_SIZE; ptr < STACK_START(c_p); ptr++) {
3927
 
            if (is_catch(*ptr)) {
3928
 
                pc = catch_pc(*ptr);
3929
 
                while (is_not_CP(*ptr)) {
3930
 
                    ptr--;
3931
 
                    ASSERT(c_p->stop <= ptr);
3932
 
                }
3933
 
                c_p->stop = ptr;
3934
 
                reg[0] = THE_NON_VALUE;
3935
 
                reg[1] = exception_tag[GET_EXC_CLASS(c_p->freason)];
3936
 
                reg[2] = Value;
3937
 
                return pc;
3938
 
            }
3939
 
        }
3940
 
        erl_exit(1, "Catch not found");
3941
 
    }
3942
 
    return 0;
 
5130
        }
 
5131
        ASSERT(hp <= hp_end);
 
5132
        HRelease(c_p, hp_end, hp);
 
5133
    }
 
5134
    return Where;
3943
5135
}
3944
5136
 
3945
5137
 
4033
5225
{
4034
5226
    int arity;
4035
5227
    Export* ep;
4036
 
    Eterm tmp;
 
5228
    Eterm tmp, this;
4037
5229
 
4038
5230
    /*
4039
5231
     * Check the arguments which should be of the form apply(Module,
4040
 
     * Function, Arguments) where Module and Function are atoms and
 
5232
     * Function, Arguments) where Function is an atom and
4041
5233
     * Arguments is an arity long list of terms.
4042
5234
     */
4043
 
    if (is_not_atom(module) || is_not_atom(function)) {
 
5235
    if (is_not_atom(function)) {
4044
5236
        /*
4045
5237
         * No need to test args here -- done below.
4046
5238
         */
4054
5246
        return 0;
4055
5247
    }
4056
5248
 
 
5249
    /* The module argument may be either an atom or an abstract module
 
5250
     * (currently implemented using tuples, but this might change).
 
5251
     */
 
5252
    this = THE_NON_VALUE;
 
5253
    if (is_not_atom(module)) {
 
5254
        Eterm* tp;
 
5255
 
 
5256
        if (is_not_tuple(module)) goto error;
 
5257
        tp = tuple_val(module);
 
5258
        if (arityval(tp[0]) < 1) goto error;
 
5259
        this = module;
 
5260
        module = tp[1];
 
5261
        if (is_not_atom(module)) goto error;
 
5262
    }
 
5263
    
4057
5264
    /*
4058
5265
     * Walk down the 3rd parameter of apply (the argument list) and copy
4059
 
     * the parameters to the x registers (reg[]).
 
5266
     * the parameters to the x registers (reg[]). If the module argument
 
5267
     * was an abstract module, add 1 to the function arity and put the
 
5268
     * module argument in the n+1st x register as a THIS reference.
4060
5269
     */
4061
5270
 
4062
5271
    tmp = args;
4063
5272
    arity = 0;
4064
5273
    while (is_list(tmp)) {
4065
 
        if (arity < MAX_REG) {
 
5274
        if (arity < (MAX_REG - 1)) {
4066
5275
            reg[arity++] = CAR(list_val(tmp));
4067
5276
            tmp = CDR(list_val(tmp));
4068
5277
        } else {
4073
5282
    if (is_not_nil(tmp)) {      /* Must be well-formed list */
4074
5283
        goto error;
4075
5284
    }
4076
 
 
4077
 
    /*
4078
 
     * Get the index into the export table, or failing that the export
4079
 
     * entry for the error handler module.  Only give up if no error
4080
 
     * handler module.
4081
 
     *
4082
 
     * Note: All BIFs have export entries; thus, no special case is needed.
4083
 
     */
4084
 
 
4085
 
    if ((ep = erts_find_export_entry(module, function, arity)) == NULL) {
4086
 
        if ((ep = erts_find_export_entry(p->error_handler,
4087
 
                                         am_undefined_function, 3)) == NULL) {
4088
 
            goto error;
4089
 
        } else {
 
5285
    if (this != THE_NON_VALUE) {
 
5286
        reg[arity++] = this;
 
5287
    }
 
5288
 
 
5289
    /*
 
5290
     * Get the index into the export table, or failing that the export
 
5291
     * entry for the error handler module.  Only give up if no error
 
5292
     * handler module.
 
5293
     *
 
5294
     * Note: All BIFs have export entries; thus, no special case is needed.
 
5295
     */
 
5296
 
 
5297
    if ((ep = erts_find_export_entry(module, function, arity)) == NULL) {
 
5298
        if ((ep = erts_find_export_entry(p->error_handler,
 
5299
                                         am_undefined_function, 3)) == NULL) {
 
5300
            goto error;
 
5301
        } else {
 
5302
            reg[0] = module;
 
5303
            reg[1] = function;
 
5304
            reg[2] = args;
 
5305
        }
 
5306
    } else if (p->ct != NULL) {
 
5307
        save_calls(p, ep);
 
5308
    }
 
5309
 
 
5310
    return ep->address;
 
5311
}
 
5312
 
 
5313
static Uint*
 
5314
fixed_apply(Process* p, Eterm* reg, Uint arity)
 
5315
{
 
5316
    Export* ep;
 
5317
    Eterm module;
 
5318
    Eterm function;
 
5319
 
 
5320
    module = reg[arity];    /* The THIS pointer already in place */
 
5321
    function = reg[arity+1];
 
5322
 
 
5323
    if (is_not_atom(function)) {
 
5324
    error:
 
5325
        p->freason = BADARG;
 
5326
        reg[0] = module;
 
5327
        reg[1] = function;
 
5328
        reg[2] = NIL;
 
5329
        return 0;
 
5330
    }
 
5331
 
 
5332
    /* The module argument may be either an atom or an abstract module
 
5333
     * (currently implemented using tuples, but this might change).
 
5334
     */
 
5335
    if (is_not_atom(module)) {
 
5336
        Eterm* tp;
 
5337
        if (is_not_tuple(module)) goto error;
 
5338
        tp = tuple_val(module);
 
5339
        if (arityval(tp[0]) < 1) goto error;
 
5340
        module = tp[1];
 
5341
        if (is_not_atom(module)) goto error;
 
5342
        ++arity;
 
5343
    }
 
5344
    
 
5345
    /*
 
5346
     * Get the index into the export table, or failing that the export
 
5347
     * entry for the error handler module.  Only give up if no error
 
5348
     * handler module.
 
5349
     *
 
5350
     * Note: All BIFs have export entries; thus, no special case is needed.
 
5351
     */
 
5352
 
 
5353
    if ((ep = erts_find_export_entry(module, function, arity)) == NULL) {
 
5354
        if ((ep = erts_find_export_entry(p->error_handler,
 
5355
                                         am_undefined_function, 3)) == NULL) {
 
5356
            goto error;
 
5357
        } else {
 
5358
            int i;
 
5359
            Eterm* hp = HAlloc(p, 2*arity);
 
5360
            Eterm args = NIL;
 
5361
            
 
5362
            for (i = arity-1; i >= 0; i--) {
 
5363
                args = CONS(hp, reg[i], args);
 
5364
                hp += 2;
 
5365
            }
4090
5366
            reg[0] = module;
4091
5367
            reg[1] = function;
4092
5368
            reg[2] = args;
4163
5439
     * If there are no waiting messages, garbage collect and
4164
5440
     * shrink the heap. 
4165
5441
     */
 
5442
    erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
 
5443
    ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
4166
5444
    if (c_p->msg.len > 0) {
4167
5445
        add_to_schedule_q(c_p);
4168
5446
    } else {
 
5447
        erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
4169
5448
        FLAGS(c_p) |= F_NEED_FULLSWEEP;
 
5449
        c_p->fvalue = NIL;
 
5450
        PROCESS_MAIN_CHK_LOCKS(c_p);
4170
5451
        erts_garbage_collect(c_p, 0, c_p->arg_reg, c_p->arity);
 
5452
        PROCESS_MAIN_CHK_LOCKS(c_p);
4171
5453
        new_sz = HEAP_TOP(c_p) - HEAP_START(c_p);
 
5454
        if (new_sz == 0) new_sz = 1; /* We want a heap... */
4172
5455
        erts_shrink_new_heap(c_p, new_sz, c_p->arg_reg, c_p->arity);
 
5456
        erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
 
5457
        ASSERT(!ERTS_PROC_IS_EXITING(c_p));
4173
5458
        c_p->status = P_WAITING;
 
5459
#ifdef ERTS_SMP
 
5460
        ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
 
5461
        if (c_p->msg.len > 0)
 
5462
            add_to_schedule_q(c_p);
 
5463
#endif
4174
5464
    }
 
5465
    erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
4175
5466
    c_p->current = bif_export[BIF_hibernate_3]->code;
4176
5467
    return 1;
4177
5468
}
4183
5474
         Eterm args)            /* THE_NON_VALUE or pre-built list of arguments. */
4184
5475
{
4185
5476
    Eterm fun = reg[arity];
 
5477
    Eterm hdr;
4186
5478
    int i;
4187
5479
    Eterm function;
4188
5480
    Eterm* hp;
4189
5481
 
4190
 
    if (is_fun(fun)) {
 
5482
    if (!is_boxed(fun)) {
 
5483
        goto badfun;
 
5484
    }
 
5485
    hdr = *boxed_val(fun);
 
5486
 
 
5487
    if (is_fun_header(hdr)) {
4191
5488
        ErlFunThing* funp = (ErlFunThing *) fun_val(fun);
4192
5489
        ErlFunEntry* fe;
4193
5490
        Eterm* code_ptr;
4199
5496
        num_free = funp->num_free;
4200
5497
        code_ptr = fe->address;
4201
5498
        actual_arity = (int) code_ptr[-1];
4202
 
        var_ptr = funp->env;
4203
5499
 
4204
5500
        if (actual_arity == arity+num_free) {
4205
 
            reg += arity;
4206
 
            for (i = 0; i < num_free; i++) {
4207
 
                reg[i] = var_ptr[i];
 
5501
            if (num_free == 0) {
 
5502
                return code_ptr;
 
5503
            } else {
 
5504
                var_ptr = funp->env;
 
5505
                reg += arity;
 
5506
                i = 0;
 
5507
                do {
 
5508
                    reg[i] = var_ptr[i];
 
5509
                    i++;
 
5510
                } while (i < num_free);
 
5511
                reg[i] = fun;
 
5512
                return code_ptr;
4208
5513
            }
4209
 
            reg[i] = fun;
4210
5514
            return code_ptr;
4211
5515
        } else {
4212
5516
            /*
4269
5573
                return ep->address;
4270
5574
            }
4271
5575
        }
4272
 
    } else if (is_tuple(fun)) {
4273
 
        Eterm* tp = tuple_val(fun);
4274
 
 
4275
 
        if (*tp == make_arityval(2)) {
4276
 
            Export* ep;
4277
 
            Eterm module;
4278
 
 
4279
 
            module = tp[1];
4280
 
            function = tp[2];
4281
 
            if (!is_atom(module) || !is_atom(function)) {
4282
 
                goto badfun;
4283
 
            }
4284
 
            if ((ep = erts_find_export_entry(module, function, arity)) == NULL) {
4285
 
                ep = erts_find_export_entry(p->error_handler, am_undefined_function, 3);
4286
 
                if (ep == NULL) {
4287
 
                    p->freason = EXC_UNDEF;
4288
 
                    return 0;
4289
 
                }
4290
 
                if (is_non_value(args)) {
4291
 
                    hp = HAlloc(p, 2*arity);
4292
 
                    args = NIL;
4293
 
                    while (arity-- > 0) {
4294
 
                        args = CONS(hp, reg[arity], args);
4295
 
                        hp += 2;
4296
 
                    }
4297
 
                }
4298
 
 
4299
 
                reg[0] = module;
4300
 
                reg[1] = function;
4301
 
                reg[2] = args;
4302
 
            }
 
5576
    } else if (is_export_header(hdr)) {
 
5577
        Export* ep = (Export *) (export_val(fun))[1];
 
5578
        int actual_arity = (int) ep->code[2];
 
5579
        if (arity == actual_arity) {
4303
5580
            return ep->address;
4304
 
        }
 
5581
        } else {
 
5582
            /*
 
5583
             * Wrong arity. First build a list of the arguments.
 
5584
             */  
 
5585
 
 
5586
            if (is_non_value(args)) {
 
5587
                args = NIL;
 
5588
                hp = HAlloc(p, arity*2);
 
5589
                for (i = arity-1; i >= 0; i--) {
 
5590
                    args = CONS(hp, reg[i], args);
 
5591
                    hp += 2;
 
5592
                }
 
5593
            }
 
5594
 
 
5595
            hp = HAlloc(p, 3);
 
5596
            p->freason = EXC_BADARITY;
 
5597
            p->fvalue = TUPLE2(hp, fun, args);
 
5598
            return NULL;
 
5599
        }
 
5600
    } else if (hdr == make_arityval(2)) {
 
5601
        Eterm* tp;
 
5602
        Export* ep;
 
5603
        Eterm module;
 
5604
 
 
5605
        tp = tuple_val(fun);
 
5606
        module = tp[1];
 
5607
        function = tp[2];
 
5608
        if (!is_atom(module) || !is_atom(function)) {
 
5609
            goto badfun;
 
5610
        }
 
5611
        if ((ep = erts_find_export_entry(module, function, arity)) == NULL) {
 
5612
            ep = erts_find_export_entry(p->error_handler, am_undefined_function, 3);
 
5613
            if (ep == NULL) {
 
5614
                p->freason = EXC_UNDEF;
 
5615
                return 0;
 
5616
            }
 
5617
            if (is_non_value(args)) {
 
5618
                hp = HAlloc(p, 2*arity);
 
5619
                args = NIL;
 
5620
                while (arity-- > 0) {
 
5621
                    args = CONS(hp, reg[arity], args);
 
5622
                    hp += 2;
 
5623
                }
 
5624
            }
 
5625
 
 
5626
            reg[0] = module;
 
5627
            reg[1] = function;
 
5628
            reg[2] = args;
 
5629
        }
 
5630
        return ep->address;
 
5631
    } else {
 
5632
    badfun:
 
5633
        p->current = NULL;
 
5634
        p->freason = EXC_BADFUN;
 
5635
        p->fvalue = fun;
 
5636
        return NULL;
4305
5637
    }
4306
 
 
4307
 
    /*
4308
 
     * Default error reason if the Fun argument is bad.
4309
 
     */
4310
 
 badfun:
4311
 
    p->current = NULL;
4312
 
    p->freason = EXC_BADFUN;
4313
 
    p->fvalue = fun;
4314
 
    return NULL;
4315
5638
}
4316
5639
 
4317
5640
static Eterm*
4355
5678
    int i;
4356
5679
 
4357
5680
    if (HEAP_LIMIT(p) - HEAP_TOP(p) <= needed) {
 
5681
        PROCESS_MAIN_CHK_LOCKS(p);
4358
5682
        erts_garbage_collect(p, needed, reg, num_free);
 
5683
        PROCESS_MAIN_CHK_LOCKS(p);
4359
5684
    }
4360
5685
    hp = p->htop;
4361
5686
    p->htop = hp + needed;
4362
5687
    funp = (ErlFunThing *) hp;
4363
5688
    hp = funp->env;
4364
 
    fe->refc++;
 
5689
    erts_refc_inc(&fe->refc, 2);
4365
5690
    funp->thing_word = HEADER_FUN;
4366
 
#ifndef SHARED_HEAP
 
5691
#ifndef HYBRID /* FIND ME! */
4367
5692
    funp->next = MSO(p).funs;
4368
5693
    MSO(p).funs = funp;
4369
5694
#endif
4403
5728
    e.code[1] = Name;
4404
5729
    e.code[2] = arity;
4405
5730
 
4406
 
    if ((ep = hash_get(&export_table.htable, (void*) &e)) == NULL) {
 
5731
    if ((ep = export_get(&e)) == NULL) {
4407
5732
        return 0;
4408
5733
    }
4409
5734
    return ep->address == ep->code+3 && (ep->code[3] == (Uint) em_apply_bif);
4426
5751
        return REDS_IN(current) - current->fcalls;
4427
5752
    }
4428
5753
}
 
5754