aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erts/emulator/Makefile.in2
-rw-r--r--erts/emulator/beam/beam_emu.c674
-rw-r--r--erts/emulator/beam/bs_instrs.tab179
-rw-r--r--erts/emulator/beam/instrs.tab594
-rw-r--r--erts/emulator/beam/ops.tab140
-rwxr-xr-xerts/emulator/utils/beam_makeops407
6 files changed, 1055 insertions, 941 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 521fc46b47..015a3a42ed 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -31,7 +31,7 @@ USE_VM_PROBES=@USE_VM_PROBES@
LIBS = @LIBS@
Z_LIB=@Z_LIB@
NO_INLINE_FUNCTIONS=false
-OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab beam/ops.tab
+OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab beam/ops.tab beam/instrs.tab beam/bs_instrs.tab
DEBUG_CFLAGS = @DEBUG_CFLAGS@
CONFIGURE_CFLAGS = @CFLAGS@
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 25e16764ab..a5a462944b 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -296,79 +296,16 @@ void** beam_ops;
PROCESS_MAIN_CHK_LOCKS((P)); \
ERTS_UNREQ_PROC_MAIN_LOCK((P))
-#define db(N) (N)
#define tb(N) (N)
#define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N)))
#define yb(N) (*(Eterm *) (((unsigned char *)E) + (N)))
-#define fb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N)))
+#define lb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N)))
#define Qb(N) (N)
#define Ib(N) (N)
#define x(N) reg[N]
#define y(N) E[N]
#define r(N) x(N)
-/*
- * Makes sure that there are StackNeed + HeapNeed + 1 words available
- * on the combined heap/stack segment, then allocates StackNeed + 1
- * words on the stack and saves CP.
- *
- * M is number of live registers to preserve during garbage collection
- */
-
-#define AH(StackNeed, HeapNeed, M) \
- do { \
- int needed; \
- needed = (StackNeed) + 1; \
- if (E - HTOP < (needed + (HeapNeed))) { \
- SWAPOUT; \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), \
- reg, (M), FCALLS); \
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
- PROCESS_MAIN_CHK_LOCKS(c_p); \
- SWAPIN; \
- } \
- E -= needed; \
- SAVE_CP(E); \
- } while (0)
-
-#define Allocate(Ns, Live) AH(Ns, 0, Live)
-
-#define AllocateZero(Ns, Live) \
- do { Eterm* ptr; \
- int i = (Ns); \
- AH(i, 0, Live); \
- for (ptr = E + i; ptr > E; ptr--) { \
- make_blank(*ptr); \
- } \
- } while (0)
-
-#define AllocateHeap(Ns, Nh, Live) AH(Ns, Nh, Live)
-
-#define AllocateHeapZero(Ns, Nh, Live) \
- do { Eterm* ptr; \
- int i = (Ns); \
- AH(i, Nh, Live); \
- for (ptr = E + i; ptr > E; ptr--) { \
- make_blank(*ptr); \
- } \
- } while (0)
-
-#define AllocateInit(Ns, Live, Y) \
- do { AH(Ns, 0, Live); make_blank(Y); } while (0)
-
-/*
- * Like the AH macro, but allocates no additional heap space.
- */
-
-#define A(StackNeed, M) AH(StackNeed, 0, M)
-
-#define D(N) \
- RESTORE_CP(E); \
- E += (N) + 1;
-
-
-
#define TestBinVHeap(VNh, Nh, Live) \
do { \
unsigned need = (Nh); \
@@ -426,32 +363,6 @@ void** beam_ops;
HEAP_SPACE_VERIFIED(need); \
} while (0)
-#define TestHeapPutList(Need, Reg) \
- do { \
- TestHeap((Need), 1); \
- PutList(Reg, r(0), r(0)); \
- CHECK_TERM(r(0)); \
- } while (0)
-
-#define Init(N) make_blank(yb(N))
-
-#define Init2(Y1, Y2) do { make_blank(Y1); make_blank(Y2); } while (0)
-#define Init3(Y1, Y2, Y3) \
- do { make_blank(Y1); make_blank(Y2); make_blank(Y3); } while (0)
-
-#define MakeFun(FunP, NumFree) \
- do { \
- HEAVY_SWAPOUT; \
- r(0) = new_fun(c_p, reg, (ErlFunEntry *) FunP, NumFree); \
- HEAVY_SWAPIN; \
- } while (0)
-
-#define PutTuple(Dst, Arity) \
- do { \
- Dst = make_tuple(HTOP); \
- pt_arity = (Arity); \
- } while (0)
-
/*
* Check that we haven't used the reductions and jump to function pointed to by
* the I register. If we are out of reductions, do a context switch.
@@ -518,9 +429,6 @@ void** beam_ops;
# define Dispatchfun() DispatchMacroFun()
#endif
-#define Self(R) R = c_p->common.id
-#define Node(R) R = erts_this_node->sysname
-
#define Arg(N) I[(N)+1]
#define Next(N) \
I += (N) + 1; \
@@ -556,90 +464,6 @@ void** beam_ops;
GetR((N)+1, Dst2); \
} while (0)
-#define PutList(H, T, Dst) \
- do { \
- HTOP[0] = (H); HTOP[1] = (T); \
- Dst = make_list(HTOP); \
- HTOP += 2; \
- } while (0)
-
-#define Swap(R1, R2) \
- do { \
- Eterm V = R1; \
- R1 = R2; \
- R2 = V; \
- } while (0)
-
-#define SwapTemp(R1, R2, Tmp) \
- do { \
- Eterm V = R1; \
- R1 = R2; \
- R2 = Tmp = V; \
- } while (0)
-
-#define Move(Src, Dst) Dst = (Src)
-
-#define Move2Par(S1, D1, S2, D2) \
- do { \
- Eterm V1, V2; \
- V1 = (S1); V2 = (S2); D1 = V1; D2 = V2; \
- } while (0)
-
-#define MoveShift(Src, SD, D) \
- do { \
- Eterm V; \
- V = Src; D = SD; SD = V; \
- } while (0)
-
-#define MoveDup(Src, D1, D2) \
- do { \
- D1 = D2 = (Src); \
- } while (0)
-
-#define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3)
-
-#define MoveWindow3(S1, S2, S3, D) \
- do { \
- Eterm xt0, xt1, xt2; \
- Eterm *y = &D; \
- xt0 = S1; \
- xt1 = S2; \
- xt2 = S3; \
- y[0] = xt0; \
- y[1] = xt1; \
- y[2] = xt2; \
- } while (0)
-
-#define MoveWindow4(S1, S2, S3, S4, D) \
- do { \
- Eterm xt0, xt1, xt2, xt3; \
- Eterm *y = &D; \
- xt0 = S1; \
- xt1 = S2; \
- xt2 = S3; \
- xt3 = S4; \
- y[0] = xt0; \
- y[1] = xt1; \
- y[2] = xt2; \
- y[3] = xt3; \
- } while (0)
-
-#define MoveWindow5(S1, S2, S3, S4, S5, D) \
- do { \
- Eterm xt0, xt1, xt2, xt3, xt4; \
- Eterm *y = &D; \
- xt0 = S1; \
- xt1 = S2; \
- xt2 = S3; \
- xt3 = S4; \
- xt4 = S5; \
- y[0] = xt0; \
- y[1] = xt1; \
- y[2] = xt2; \
- y[3] = xt3; \
- y[4] = xt4; \
- } while (0)
-
#define DispatchReturn \
do { \
if (FCALLS > 0 || FCALLS > neg_o_reds) { \
@@ -653,225 +477,14 @@ do { \
} \
} while (0)
-#define MoveReturn(Src) \
- x(0) = (Src); \
- I = c_p->cp; \
- ASSERT(VALID_INSTR(*c_p->cp)); \
- c_p->cp = 0; \
- CHECK_TERM(r(0)); \
- DispatchReturn
-
-#define DeallocateReturn(Deallocate) \
- do { \
- int words_to_pop = (Deallocate); \
- SET_I((BeamInstr *) cp_val(*E)); \
- E = ADD_BYTE_OFFSET(E, words_to_pop); \
- CHECK_TERM(r(0)); \
- DispatchReturn; \
- } while (0)
-
-#define MoveDeallocateReturn(Src, Deallocate) \
- x(0) = (Src); \
- DeallocateReturn(Deallocate)
-
-#define MoveCall(Src, CallDest, Size) \
- x(0) = (Src); \
- SET_CP(c_p, I+Size+1); \
- SET_I((BeamInstr *) CallDest); \
- Dispatch();
-
-#define MoveCallLast(Src, CallDest, Deallocate) \
- x(0) = (Src); \
- RESTORE_CP(E); \
- E = ADD_BYTE_OFFSET(E, (Deallocate)); \
- SET_I((BeamInstr *) CallDest); \
- Dispatch();
-
-#define MoveCallOnly(Src, CallDest) \
- x(0) = (Src); \
- SET_I((BeamInstr *) CallDest); \
- Dispatch();
-
-#define MoveJump(Src) \
- r(0) = (Src); \
- SET_I((BeamInstr *) Arg(0)); \
- Goto(*I);
-
-#define GetList(Src, H, T) \
- do { \
- Eterm* tmp_ptr = list_val(Src); \
- Eterm hd, tl; \
- hd = CAR(tmp_ptr); \
- tl = CDR(tmp_ptr); \
- H = hd; T = tl; \
- } while (0)
-
-#define GetTupleElement(Src, Element, Dest) \
- do { \
- Eterm* src; \
- src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
- (Dest) = *src; \
- } while (0)
-
-#define GetTupleElement2(Src, Element, Dest) \
- do { \
- Eterm* src; \
- Eterm* dst; \
- Eterm E1, E2; \
- src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
- dst = &(Dest); \
- E1 = src[0]; \
- E2 = src[1]; \
- dst[0] = E1; \
- dst[1] = E2; \
- } while (0)
-
-#define GetTupleElement2Y(Src, Element, D1, D2) \
- do { \
- Eterm* src; \
- Eterm E1, E2; \
- src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
- E1 = src[0]; \
- E2 = src[1]; \
- D1 = E1; \
- D2 = E2; \
- } while (0)
-
-#define GetTupleElement3(Src, Element, Dest) \
- do { \
- Eterm* src; \
- Eterm* dst; \
- Eterm E1, E2, E3; \
- src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
- dst = &(Dest); \
- E1 = src[0]; \
- E2 = src[1]; \
- E3 = src[2]; \
- dst[0] = E1; \
- dst[1] = E2; \
- dst[2] = E3; \
- } while (0)
-
-#define EqualImmed(X, Y, Action) if (X != Y) { Action; }
-#define NotEqualImmed(X, Y, Action) if (X == Y) { Action; }
-#define EqualExact(X, Y, Action) if (!EQ(X,Y)) { Action; }
-#define NotEqualExact(X, Y, Action) if (EQ(X,Y)) { Action; }
-#define Equal(X, Y, Action) CMP_EQ_ACTION(X,Y,Action)
-#define NotEqual(X, Y, Action) CMP_NE_ACTION(X,Y,Action)
-#define IsLessThan(X, Y, Action) CMP_LT_ACTION(X,Y,Action)
-#define IsGreaterEqual(X, Y, Action) CMP_GE_ACTION(X,Y,Action)
-
-#define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; }
-
-#define IsInteger(Src, Fail) if (is_not_integer(Src)) { Fail; }
-
-#define IsNumber(X, Fail) if (is_not_integer(X) && is_not_float(X)) { Fail; }
-
-#define IsAtom(Src, Fail) if (is_not_atom(Src)) { Fail; }
-
-#define IsIntegerAllocate(Src, Need, Alive, Fail) \
- if (is_not_integer(Src)) { Fail; } \
- A(Need, Alive)
-
-#define IsNil(Src, Fail) if (is_not_nil(Src)) { Fail; }
-
-#define IsList(Src, Fail) if (is_not_list(Src) && is_not_nil(Src)) { Fail; }
-
-#define IsNonemptyList(Src, Fail) if (is_not_list(Src)) { Fail; }
-
-#define IsNonemptyListAllocate(Src, Need, Alive, Fail) \
- if (is_not_list(Src)) { Fail; } \
- A(Need, Alive)
-
-#define IsNonemptyListTestHeap(Need, Alive, Fail) \
- if (is_not_list(x(0))) { Fail; } \
- TestHeap(Need, Alive)
-
-#define IsNonemptyListGetList(Src, H, T, Fail) \
- if (is_not_list(Src)) { \
- Fail; \
- } else { \
- Eterm* tmp_ptr = list_val(Src); \
- Eterm hd, tl; \
- hd = CAR(tmp_ptr); \
- tl = CDR(tmp_ptr); \
- H = hd; T = tl; \
- }
-
-#define IsTuple(X, Action) if (is_not_tuple(X)) Action
-
-#define IsArity(Pointer, Arity, Fail) \
- if (*tuple_val(Pointer) != (Arity)) { \
- Fail; \
- }
-
-#define IsMap(Src, Fail) if (!is_map(Src)) { Fail; }
-
-#define GetMapElement(Src, Key, Dst, Fail) \
- do { \
- Eterm _res = get_map_element(Src, Key); \
- if (is_non_value(_res)) { \
- Fail; \
- } \
- Dst = _res; \
- } while (0)
-
-#define GetMapElementHash(Src, Key, Hx, Dst, Fail) \
- do { \
- Eterm _res = get_map_element_hash(Src, Key, Hx); \
- if (is_non_value(_res)) { \
- Fail; \
- } \
- Dst = _res; \
- } while (0)
-
-#define IsFunction(X, Action) \
- do { \
- if ( !(is_any_fun(X)) ) { \
- Action; \
- } \
- } while (0)
-
-#define IsFunction2(F, A, Action) \
- do { \
- if (erl_is_function(c_p, F, A) != am_true ) { \
- Action; \
- } \
- } while (0)
-
#ifdef DEBUG
-#define IsTupleOfArity(Src, Arityval, Fail) \
- do { \
- if (!(is_tuple(Src) && *tuple_val(Src) == Arityval)) { \
- Fail; \
- } \
- } while (0)
+/* Better static type testing by the C compiler */
+# define BEAM_IS_TUPLE(Src) is_tuple(Src)
#else
-#define IsTupleOfArity(Src, Arityval, Fail) \
- do { \
- if (!(is_boxed(Src) && *tuple_val(Src) == Arityval)) { \
- Fail; \
- } \
- } while (0)
+/* Better performance */
+# define BEAM_IS_TUPLE(Src) is_boxed(Src)
#endif
-#define IsTaggedTuple(Src,Arityval,Tag,Fail) \
- do { \
- if (!(is_tuple(Src) && \
- (tuple_val(Src))[0] == Arityval && \
- (tuple_val(Src))[1] == Tag)) { \
- Fail; \
- } \
- } while (0)
-
-#define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; }
-
-#define IsBinary(Src, Fail) \
- if (is_not_binary(Src) || binary_bitsize(Src) != 0) { Fail; }
-
-#define IsBitstring(Src, Fail) \
- if (is_not_binary(Src)) { Fail; }
-
#if defined(ARCH_64)
#define BsSafeMul(A, B, Fail, Target) \
do { Uint64 _res = (A) * (B); \
@@ -916,145 +529,6 @@ do { \
Target = _uint_size * Unit; \
} while (0)
-#define BsGetFloat2(Ms, Live, Sz, Flags, Dst, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- Eterm _result; Sint _size; \
- if (!is_small(Sz) || (_size = unsigned_val(Sz)) > 64) { Fail; } \
- _size *= ((Flags) >> 3); \
- TestHeap(FLOAT_SIZE_OBJECT, Live); \
- _mb = ms_matchbuffer(Ms); \
- LIGHT_SWAPOUT; \
- _result = erts_bs_get_float_2(c_p, _size, (Flags), _mb); \
- LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
- if (is_non_value(_result)) { Fail; } \
- else { Dst = _result; } \
- } while (0)
-
-#define BsGetBinaryImm_2(Ms, Live, Sz, Flags, Dst, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- Eterm _result; \
- TestHeap(heap_bin_size(ERL_ONHEAP_BIN_LIMIT), Live); \
- _mb = ms_matchbuffer(Ms); \
- LIGHT_SWAPOUT; \
- _result = erts_bs_get_binary_2(c_p, (Sz), (Flags), _mb); \
- LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
- if (is_non_value(_result)) { Fail; } \
- else { Dst = _result; } \
- } while (0)
-
-#define BsGetBinary_2(Ms, Live, Sz, Flags, Dst, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- Eterm _result; Uint _size; \
- BsGetFieldSize(Sz, ((Flags) >> 3), Fail, _size); \
- TestHeap(ERL_SUB_BIN_SIZE, Live); \
- _mb = ms_matchbuffer(Ms); \
- LIGHT_SWAPOUT; \
- _result = erts_bs_get_binary_2(c_p, _size, (Flags), _mb); \
- LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
- if (is_non_value(_result)) { Fail; } \
- else { Dst = _result; } \
- } while (0)
-
-#define BsGetBinaryAll_2(Ms, Live, Unit, Dst, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- Eterm _result; \
- TestHeap(ERL_SUB_BIN_SIZE, Live); \
- _mb = ms_matchbuffer(Ms); \
- if (((_mb->size - _mb->offset) % Unit) == 0) { \
- LIGHT_SWAPOUT; \
- _result = erts_bs_get_binary_all_2(c_p, _mb); \
- LIGHT_SWAPIN; \
- HEAP_SPACE_VERIFIED(0); \
- ASSERT(is_value(_result)); \
- Dst = _result; \
- } else { \
- HEAP_SPACE_VERIFIED(0); \
- Fail; } \
- } while (0)
-
-#define BsSkipBits2(Ms, Bits, Unit, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- size_t new_offset; \
- Uint _size; \
- _mb = ms_matchbuffer(Ms); \
- BsGetFieldSize(Bits, Unit, Fail, _size); \
- new_offset = _mb->offset + _size; \
- if (new_offset <= _mb->size) { _mb->offset = new_offset; } \
- else { Fail; } \
- } while (0)
-
-#define BsSkipBitsAll2(Ms, Unit, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- _mb = ms_matchbuffer(Ms); \
- if (((_mb->size - _mb->offset) % Unit) == 0) {_mb->offset = _mb->size; } \
- else { Fail; } \
- } while (0)
-
-#define BsSkipBitsImm2(Ms, Bits, Fail) \
- do { \
- ErlBinMatchBuffer *_mb; \
- size_t new_offset; \
- _mb = ms_matchbuffer(Ms); \
- new_offset = _mb->offset + (Bits); \
- if (new_offset <= _mb->size) { _mb->offset = new_offset; } \
- else { Fail; } \
- } while (0)
-
-#define NewBsPutIntegerImm(Sz, Flags, Src) \
- do { \
- if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), (Sz), (Flags)))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutInteger(Sz, Flags, Src) \
- do { \
- Sint _size; \
- BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \
- if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), _size, (Flags)))) \
- { goto badarg; } \
- } while (0)
-
-#define NewBsPutFloatImm(Sz, Flags, Src) \
- do { \
- if (!erts_new_bs_put_float(c_p, (Src), (Sz), (Flags))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutFloat(Sz, Flags, Src) \
- do { \
- Sint _size; \
- BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \
- if (!erts_new_bs_put_float(c_p, (Src), _size, (Flags))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutBinary(Sz, Flags, Src) \
- do { \
- Sint _size; \
- BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \
- if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), _size))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutBinaryImm(Sz, Src) \
- do { \
- if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), (Sz)))) { goto badarg; } \
- } while (0)
-
-#define NewBsPutBinaryAll(Src, Unit) \
- do { \
- if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2((Src), (Unit)))) { goto badarg; } \
- } while (0)
-
-
-#define IsPort(Src, Fail) if (is_not_port(Src)) { Fail; }
-#define IsPid(Src, Fail) if (is_not_pid(Src)) { Fail; }
-#define IsRef(Src, Fail) if (is_not_ref(Src)) { Fail; }
/*
* process_main() is already huge, so we want to avoid inlining
@@ -1603,40 +1077,6 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
Next(3);
}
- OpCase(i_move_call_only_fc): {
- r(0) = Arg(1);
- }
- /* FALL THROUGH */
- OpCase(i_call_only_f): {
- SET_I((BeamInstr *) Arg(0));
- DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
- Dispatch();
- }
-
- OpCase(i_move_call_last_fPc): {
- r(0) = Arg(2);
- }
- /* FALL THROUGH */
- OpCase(i_call_last_fP): {
- RESTORE_CP(E);
- E = ADD_BYTE_OFFSET(E, Arg(1));
- SET_I((BeamInstr *) Arg(0));
- DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
- Dispatch();
- }
-
- OpCase(i_move_call_cf): {
- r(0) = Arg(0);
- I++;
- }
- /* FALL THROUGH */
- OpCase(i_call_f): {
- SET_CP(c_p, I+2);
- SET_I((BeamInstr *) Arg(0));
- DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
- Dispatch();
- }
-
OpCase(i_move_call_ext_last_ePc): {
r(0) = Arg(2);
}
@@ -1671,37 +1111,6 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0));
Dispatchx();
- OpCase(init_y): {
- BeamInstr *next;
-
- PreFetch(1, next);
- make_blank(yb(Arg(0)));
- NextPF(1, next);
- }
-
- OpCase(i_trim_I): {
- BeamInstr *next;
- Uint words;
- Uint cp;
-
- words = Arg(0);
- cp = E[0];
- PreFetch(1, next);
- E += words;
- E[0] = cp;
- NextPF(1, next);
- }
-
- OpCase(move_x1_c): {
- x(1) = Arg(0);
- Next(1);
- }
-
- OpCase(move_x2_c): {
- x(2) = Arg(0);
- Next(1);
- }
-
OpCase(return): {
SET_I(c_p->cp);
DTRACE_RETURN_FROM_PC(c_p);
@@ -3457,21 +2866,6 @@ do { \
goto do_schedule1;
}
- OpCase(set_tuple_element_sdP): {
- Eterm element;
- Eterm tuple;
- BeamInstr *next;
- Eterm* p;
-
- PreFetch(3, next);
- GetArg1(0, element);
- tuple = REG_TARGET(Arg(1));
- ASSERT(is_tuple(tuple));
- p = (Eterm *) ((unsigned char *) tuple_val(tuple) + Arg(2));
- *p = element;
- NextPF(3, next);
- }
-
OpCase(normal_exit): {
SWAPOUT;
c_p->freason = EXC_NORMAL;
@@ -3707,26 +3101,6 @@ do { \
}
}
- OpCase(i_get_sd):
- {
- Eterm arg;
- Eterm result;
-
- GetArg1(0, arg);
- result = erts_pd_hash_get(c_p, arg);
- StoreBifResult(1, result);
- }
-
- OpCase(i_get_hash_cId):
- {
- Eterm arg;
- Eterm result;
-
- GetArg1(0, arg);
- result = erts_pd_hash_get_with_hx(c_p, Arg(1), arg);
- StoreBifResult(2, result);
- }
-
{
Eterm case_end_val;
@@ -4729,20 +4103,6 @@ do { \
#include "beam_cold.h"
-
- /*
- * This instruction is probably never used (because it is combined with a
- * a return). However, a future compiler might for some reason emit a
- * deallocate not followed by a return, and that should work.
- */
- OpCase(deallocate_I): {
- BeamInstr *next;
-
- PreFetch(1, next);
- D(Arg(0));
- NextPF(1, next);
- }
-
/*
* Trace and debugging support.
*/
@@ -4847,9 +4207,9 @@ do { \
targ1 = REG_TARGET(Arg(0));
PreFetch(2, next);
if (is_small(targ1)) {
- fb(fr) = (double) signed_val(targ1);
+ lb(fr) = (double) signed_val(targ1);
} else if (is_big(targ1)) {
- if (big_to_double(targ1, &fb(fr)) < 0) {
+ if (big_to_double(targ1, &lb(fr)) < 0) {
goto fbadarith;
}
} else if (is_float(targ1)) {
@@ -4893,8 +4253,8 @@ do { \
PreFetch(3, next);
ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(2)) = fb(Arg(0)) + fb(Arg(1));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ lb(Arg(2)) = lb(Arg(0)) + lb(Arg(1));
+ ERTS_NO_FPE_ERROR(c_p, lb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fsub_lll): {
@@ -4902,8 +4262,8 @@ do { \
PreFetch(3, next);
ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(2)) = fb(Arg(0)) - fb(Arg(1));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ lb(Arg(2)) = lb(Arg(0)) - lb(Arg(1));
+ ERTS_NO_FPE_ERROR(c_p, lb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fmul_lll): {
@@ -4911,8 +4271,8 @@ do { \
PreFetch(3, next);
ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(2)) = fb(Arg(0)) * fb(Arg(1));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ lb(Arg(2)) = lb(Arg(0)) * lb(Arg(1));
+ ERTS_NO_FPE_ERROR(c_p, lb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fdiv_lll): {
@@ -4920,8 +4280,8 @@ do { \
PreFetch(3, next);
ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(2)) = fb(Arg(0)) / fb(Arg(1));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ lb(Arg(2)) = lb(Arg(0)) / lb(Arg(1));
+ ERTS_NO_FPE_ERROR(c_p, lb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fnegate_ll): {
@@ -4929,8 +4289,8 @@ do { \
PreFetch(2, next);
ERTS_NO_FPE_CHECK_INIT(c_p);
- fb(Arg(1)) = -fb(Arg(0));
- ERTS_NO_FPE_ERROR(c_p, fb(Arg(1)), goto fbadarith);
+ lb(Arg(1)) = -lb(Arg(0));
+ ERTS_NO_FPE_ERROR(c_p, lb(Arg(1)), goto fbadarith);
NextPF(2, next);
fbadarith:
diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab
new file mode 100644
index 0000000000..420fd3074c
--- /dev/null
+++ b/erts/emulator/beam/bs_instrs.tab
@@ -0,0 +1,179 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+i_bs_get_binary_all2(Fail, Ms, Live, Unit, Dst) {
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+ TestHeap(ERL_SUB_BIN_SIZE, $Live);
+ _mb = ms_matchbuffer($Ms);
+ if (((_mb->size - _mb->offset) % $Unit) == 0) {
+ LIGHT_SWAPOUT;
+ _result = erts_bs_get_binary_all_2(c_p, _mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ ASSERT(is_value(_result));
+ $Dst = _result;
+ } else {
+ HEAP_SPACE_VERIFIED(0);
+ $FAIL($Fail);
+ }
+}
+
+i_bs_get_binary2(Fail, Ms, Live, Sz, Flags, Dst) {
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+ Uint _size;
+ BsGetFieldSize($Sz, (($Flags) >> 3), $FAIL($Fail), _size);
+ TestHeap(ERL_SUB_BIN_SIZE, $Live);
+ _mb = ms_matchbuffer($Ms);
+ LIGHT_SWAPOUT;
+ _result = erts_bs_get_binary_2(c_p, _size, $Flags, _mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(_result)) {
+ $FAIL($Fail);
+ } else {
+ $Dst = _result;
+ }
+}
+
+i_bs_get_binary_imm2(Fail, Ms, Live, Sz, Flags, Dst) {
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+ TestHeap(heap_bin_size(ERL_ONHEAP_BIN_LIMIT), $Live);
+ _mb = ms_matchbuffer($Ms);
+ LIGHT_SWAPOUT;
+ _result = erts_bs_get_binary_2(c_p, $Sz, $Flags, _mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(_result)) {
+ $FAIL($Fail);
+ } else {
+ $Dst = _result;
+ }
+}
+
+i_bs_get_float2(Fail, Ms, Live, Sz, Flags, Dst) {
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+ Sint _size;
+
+ if (!is_small($Sz) || (_size = unsigned_val($Sz)) > 64) {
+ $FAIL($Fail);
+ }
+ _size *= (($Flags) >> 3);
+ TestHeap(FLOAT_SIZE_OBJECT, $Live);
+ _mb = ms_matchbuffer($Ms);
+ LIGHT_SWAPOUT;
+ _result = erts_bs_get_float_2(c_p, _size, ($Flags), _mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(_result)) {
+ $FAIL($Fail);
+ } else {
+ $Dst = _result;
+ }
+}
+
+i_bs_skip_bits2(Fail, Ms, Bits, Unit) {
+ ErlBinMatchBuffer *_mb;
+ size_t new_offset;
+ Uint _size;
+
+ _mb = ms_matchbuffer($Ms);
+ BsGetFieldSize($Bits, $Unit, $FAIL($Fail), _size);
+ new_offset = _mb->offset + _size;
+ if (new_offset <= _mb->size) {
+ _mb->offset = new_offset;
+ } else {
+ $FAIL($Fail);
+ }
+}
+
+i_bs_skip_bits_all2(Fail, Ms, Unit) {
+ ErlBinMatchBuffer *_mb;
+ _mb = ms_matchbuffer($Ms);
+ if (((_mb->size - _mb->offset) % $Unit) == 0) {
+ _mb->offset = _mb->size;
+ } else {
+ $FAIL($Fail);
+ }
+}
+
+i_bs_skip_bits_imm2(Fail, Ms, Bits) {
+ ErlBinMatchBuffer *_mb;
+ size_t new_offset;
+ _mb = ms_matchbuffer($Ms);
+ new_offset = _mb->offset + ($Bits);
+ if (new_offset <= _mb->size) {
+ _mb->offset = new_offset;
+ } else {
+ $FAIL($Fail);
+ }
+}
+
+i_new_bs_put_binary(Fail, Sz, Flags, Src) {
+ Sint _size;
+ BsGetUncheckedFieldSize($Sz, (($Flags) >> 3), goto badarg, _size);
+ if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2(($Src), _size))) {
+ goto badarg;
+ }
+}
+
+i_new_bs_put_binary_all(Fail, Src, Unit) {
+ if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2(($Src), ($Unit)))) {
+ goto badarg;
+ }
+}
+
+i_new_bs_put_binary_imm(Fail, Sz, Src) {
+ if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2(($Src), ($Sz)))) {
+ goto badarg;
+ }
+}
+
+i_new_bs_put_float(Fail, Sz, Flags, Src) {
+ Sint _size;
+ BsGetUncheckedFieldSize($Sz, (($Flags) >> 3), goto badarg, _size);
+ if (!erts_new_bs_put_float(c_p, ($Src), _size, ($Flags))) {
+ goto badarg;
+ }
+}
+
+i_new_bs_put_float_imm(Fail, Sz, Flags, Src) {
+ if (!erts_new_bs_put_float(c_p, ($Src), ($Sz), ($Flags))) {
+ goto badarg;
+ }
+}
+
+i_new_bs_put_integer(Fail, Sz, Flags, Src) {
+ Sint _size;
+ BsGetUncheckedFieldSize($Sz, (($Flags) >> 3), goto badarg, _size);
+ if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), _size, ($Flags)))) {
+ goto badarg;
+ }
+}
+
+i_new_bs_put_integer_imm(Fail, Sz, Flags, Src) {
+ if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), ($Sz), ($Flags)))) {
+ goto badarg;
+ }
+}
diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab
new file mode 100644
index 0000000000..ca0cb2f63d
--- /dev/null
+++ b/erts/emulator/beam/instrs.tab
@@ -0,0 +1,594 @@
+// -*- c -*-
+//
+// %CopyrightBegin%
+//
+// Copyright Ericsson AB 2017. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+//
+
+// Macros only used to generate instructions.
+
+FAIL(Fail) {
+ //| -no_prefetch
+ SET_I((BeamInstr *) $Fail);
+ Goto(*I);
+}
+
+JUMP(Fail) {
+ //| -no_next
+ SET_I((BeamInstr *) $Fail);
+ Goto(*I);
+}
+
+GC_TEST(Ns, Nh, Live) {
+ unsigned need = $Nh + $Ns;
+ if (E - HTOP < need) {
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ SWAPIN;
+ }
+ HEAP_SPACE_VERIFIED($Nh);
+}
+
+// Make sure that there are NeedStack + NeedHeap + 1 words available
+// on the combined heap/stack segment, then allocates NeedHeap + 1
+// words on the stack and saves CP.
+AH(NeedStack, NeedHeap, Live) {
+ unsigned needed = $NeedStack + 1;
+ $GC_TEST(needed, $NeedHeap, $Live);
+ E -= needed;
+ SAVE_CP(E);
+}
+
+// Start of instruction listings
+
+// Call instructions
+
+DO_CALL(CallDest, NextInstr) {
+ //| -no_next
+ SET_CP(c_p, $NextInstr);
+ SET_I((BeamInstr *) $CallDest);
+ DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
+ Dispatch();
+}
+
+i_call(CallDest) {
+ $DO_CALL($CallDest, $NEXT_INSTRUCTION);
+}
+
+move_call(Src, CallDest) {
+ x(0) = $Src;
+ $DO_CALL($CallDest, $NEXT_INSTRUCTION);
+}
+
+i_call_last(CallDest, Deallocate) {
+ //| -no_next
+ RESTORE_CP(E);
+ E = ADD_BYTE_OFFSET(E, ($Deallocate));
+ SET_I((BeamInstr *) $CallDest);
+ DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
+ Dispatch();
+}
+
+move_call_last(Src, CallDest, Deallocate) {
+ x(0) = $Src;
+ $i_call_last($CallDest, $Deallocate);
+}
+
+i_call_only(CallDest) {
+ //| -no_next
+ SET_I((BeamInstr *) $CallDest);
+ DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I));
+ Dispatch();
+}
+
+move_call_only(Src, CallDest) {
+ x(0) = $Src;
+ $i_call_only($CallDest);
+}
+
+// Other instructions
+
+allocate(NeedStack, Live) {
+ $AH($NeedStack, 0, $Live);
+}
+
+allocate_heap(NeedStack, NeedHeap, Live) {
+ $AH($NeedStack, $NeedHeap, $Live);
+}
+
+allocate_init(NeedStack, Live, Y) {
+ $AH($NeedStack, 0, $Live);
+ make_blank($Y);
+}
+
+allocate_zero(NeedStack, Live) {
+ Eterm* ptr;
+ int i = $NeedStack;
+ $AH(i, 0, $Live);
+ for (ptr = E + i; ptr > E; ptr--) {
+ make_blank(*ptr);
+ }
+}
+
+allocate_heap_zero(NeedStack, NeedHeap, Live) {
+ Eterm* ptr;
+ int i = $NeedStack;
+ $AH(i, $NeedHeap, $Live);
+ for (ptr = E + i; ptr > E; ptr--) {
+ make_blank(*ptr);
+ }
+}
+
+// This instruction is probably never used (because it is combined with a
+// a return). However, a future compiler might for some reason emit a
+// deallocate not followed by a return, and that should work.
+
+deallocate(Deallocate) {
+ //| -no_prefetch
+ RESTORE_CP(E);
+ E = ADD_BYTE_OFFSET(E, $Deallocate);
+}
+
+deallocate_return(Deallocate) {
+ //| -no_next
+ int words_to_pop = $Deallocate;
+ SET_I((BeamInstr *) cp_val(*E));
+ E = ADD_BYTE_OFFSET(E, words_to_pop);
+ CHECK_TERM(x(0));
+ DispatchReturn;
+}
+
+get_list(Src, Hd, Tl) {
+ Eterm* tmp_ptr = list_val($Src);
+ Eterm hd, tl;
+ hd = CAR(tmp_ptr);
+ tl = CDR(tmp_ptr);
+ $Hd = hd;
+ $Tl = tl;
+}
+
+i_get(Src, Dst) {
+ $Dst = erts_pd_hash_get(c_p, $Src);
+}
+
+i_get_hash(Src, Hash, Dst) {
+ $Dst = erts_pd_hash_get_with_hx(c_p, $Hash, $Src);
+}
+
+i_get_tuple_element(Src, Element, Dst) {
+ Eterm* src = ADD_BYTE_OFFSET(tuple_val($Src), $Element);
+ $Dst = *src;
+}
+
+i_get_tuple_element2(Src, Element, Dst) {
+ Eterm* src;
+ Eterm* dst;
+ Eterm E1, E2;
+ src = ADD_BYTE_OFFSET(tuple_val($Src), $Element);
+ dst = &($Dst);
+ E1 = src[0];
+ E2 = src[1];
+ dst[0] = E1;
+ dst[1] = E2;
+}
+
+i_get_tuple_element2y(Src, Element, D1, D2) {
+ Eterm* src;
+ Eterm E1, E2;
+ src = ADD_BYTE_OFFSET(tuple_val($Src), $Element);
+ E1 = src[0];
+ E2 = src[1];
+ $D1 = E1;
+ $D2 = E2;
+}
+
+i_get_tuple_element3(Src, Element, Dst) {
+ Eterm* src;
+ Eterm* dst;
+ Eterm E1, E2, E3;
+ src = ADD_BYTE_OFFSET(tuple_val($Src), $Element);
+ dst = &($Dst);
+ E1 = src[0];
+ E2 = src[1];
+ E3 = src[2];
+ dst[0] = E1;
+ dst[1] = E2;
+ dst[2] = E3;
+}
+
+init(Y) {
+ make_blank($Y);
+}
+
+init2(Y1, Y2) {
+ make_blank($Y1);
+ make_blank($Y2);
+}
+
+init3(Y1, Y2, Y3) {
+ make_blank($Y1);
+ make_blank($Y2);
+ make_blank($Y3);
+}
+
+i_make_fun(FunP, NumFree) {
+ HEAVY_SWAPOUT;
+ x(0) = new_fun(c_p, reg, (ErlFunEntry *) $FunP, $NumFree);
+ HEAVY_SWAPIN;
+}
+
+i_trim(Words) {
+ Uint cp = E[0];
+ E += $Words;
+ E[0] = cp;
+}
+
+move(Src, Dst) {
+ $Dst = $Src;
+}
+
+move3(S1, D1, S2, D2, S3, D3) {
+ $D1 = $S1;
+ $D2 = $S2;
+ $D3 = $S3;
+}
+
+move_deallocate_return(Src, Deallocate) {
+ //| -no_next
+ x(0) = $Src;
+ $deallocate_return($Deallocate);
+}
+
+move_dup(Src, D1, D2) {
+ $D1 = $D2 = $Src;
+}
+
+move2_par(S1, D1, S2, D2) {
+ Eterm V1, V2;
+ V1 = $S1;
+ V2 = $S2;
+ $D1 = V1;
+ $D2 = V2;
+}
+
+move_shift(Src, SD, D) {
+ Eterm V;
+ V = $Src;
+ $D = $SD;
+ $SD = V;
+}
+
+move_window3(S1, S2, S3, D) {
+ Eterm xt0, xt1, xt2;
+ Eterm* y = &$D;
+ xt0 = $S1;
+ xt1 = $S2;
+ xt2 = $S3;
+ y[0] = xt0;
+ y[1] = xt1;
+ y[2] = xt2;
+}
+
+move_window4(S1, S2, S3, S4, D) {
+ Eterm xt0, xt1, xt2, xt3;
+ Eterm* y = &$D;
+ xt0 = $S1;
+ xt1 = $S2;
+ xt2 = $S3;
+ xt3 = $S4;
+ y[0] = xt0;
+ y[1] = xt1;
+ y[2] = xt2;
+ y[3] = xt3;
+}
+
+move_window5(S1, S2, S3, S4, S5, D) {
+ Eterm xt0, xt1, xt2, xt3, xt4;
+ Eterm *y = &$D;
+ xt0 = $S1;
+ xt1 = $S2;
+ xt2 = $S3;
+ xt3 = $S4;
+ xt4 = $S5;
+ y[0] = xt0;
+ y[1] = xt1;
+ y[2] = xt2;
+ y[3] = xt3;
+ y[4] = xt4;
+}
+
+move_return(Src) {
+ //| -no_next
+ x(0) = $Src;
+ SET_I(c_p->cp);
+ c_p->cp = 0;
+ DispatchReturn;
+}
+
+move_x1(Src) {
+ x(1) = $Src;
+}
+
+move_x2(Src) {
+ x(2) = $Src;
+}
+
+node(Dst) {
+ $Dst = erts_this_node->sysname;
+}
+
+put_list(Hd, Tl, Dst) {
+ HTOP[0] = $Hd;
+ HTOP[1] = $Tl;
+ $Dst = make_list(HTOP);
+ HTOP += 2;
+}
+
+i_put_tuple(Dst, Arity) {
+ //| -no_next
+ $Dst = make_tuple(HTOP);
+ pt_arity = $Arity;
+ I = $NEXT_INSTRUCTION;
+ goto do_put_tuple;
+}
+
+self(Dst) {
+ $Dst = c_p->common.id;
+}
+
+set_tuple_element(Element, Tuple, Offset) {
+ Eterm* p;
+
+ ASSERT(is_tuple($Tuple));
+ p = (Eterm *) ((unsigned char *) tuple_val($Tuple) + $Offset);
+ *p = $Element;
+}
+
+swap(R1, R2) {
+ Eterm V = $R1;
+ $R1 = $R2;
+ $R2 = V;
+}
+
+swap_temp(R1, R2, Tmp) {
+ Eterm V = $R1;
+ $R1 = $R2;
+ $R2 = $Tmp = V;
+}
+
+test_heap(Nh, Live) {
+ $GC_TEST(0, $Nh, $Live);
+}
+
+test_heap_1_put_list(Nh, Reg) {
+ $test_heap($Nh, 1);
+ $put_list($Reg, x(0), x(0));
+}
+
+is_integer_allocate(Fail, Src, NeedStack, Live) {
+ //| -no_prefetch
+ $is_integer($Fail, $Src);
+ $AH($NeedStack, 0, $Live);
+}
+
+is_nonempty_list(Fail, Src) {
+ //| -no_prefetch
+ if (is_not_list($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_nonempty_list_test_heap(Fail, Need, Live) {
+ //| -no_prefetch
+ $is_nonempty_list($Fail, x(0));
+ $test_heap($Need, $Live);
+}
+
+is_nonempty_list_allocate(Fail, Src, Need, Live) {
+ //| -no_prefetch
+ $is_nonempty_list($Fail, $Src);
+ $AH($Need, 0, $Live);
+}
+
+is_nonempty_list_get_list(Fail, Src, Hd, Tl) {
+ //| -no_prefetch
+ $is_nonempty_list($Fail, $Src);
+ $get_list($Src, $Hd, $Tl);
+}
+
+move_jump(Fail, Src) {
+ x(0) = $Src;
+ $JUMP($Fail);
+}
+
+//
+// Test instructions.
+//
+
+is_atom(Fail, Src) {
+ if (is_not_atom($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_boolean(Fail, Src) {
+ if (($Src) != am_true && ($Src) != am_false) {
+ $FAIL($Fail);
+ }
+}
+
+is_binary(Fail, Src) {
+ if (is_not_binary($Src) || binary_bitsize($Src) != 0) {
+ $FAIL($Fail);
+ }
+}
+
+is_bitstring(Fail, Src) {
+ if (is_not_binary($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_float(Fail, Src) {
+ if (is_not_float($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_function(Fail, Src) {
+ if ( !(is_any_fun($Src)) ) {
+ $FAIL($Fail);
+ }
+}
+
+is_function2(Fail, Fun, Arity) {
+ if (erl_is_function(c_p, $Fun, $Arity) != am_true ) {
+ $FAIL($Fail);
+ }
+}
+
+is_integer(Fail, Src) {
+ if (is_not_integer($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_list(Fail, Src) {
+ if (is_not_list($Src) && is_not_nil($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_map(Fail, Src) {
+ if (is_not_map($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_nil(Fail, Src) {
+ if (is_not_nil($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_number(Fail, Src) {
+ if (is_not_integer($Src) && is_not_float($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_pid(Fail, Src) {
+ if (is_not_pid($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_port(Fail, Src) {
+ if (is_not_port($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_reference(Fail, Src) {
+ if (is_not_ref($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_tagged_tuple(Fail, Src, Arityval, Tag) {
+ if (!(BEAM_IS_TUPLE($Src) &&
+ (tuple_val($Src))[0] == $Arityval &&
+ (tuple_val($Src))[1] == $Tag)) {
+ $FAIL($Fail);
+ }
+}
+
+is_tuple(Fail, Src) {
+ if (is_not_tuple($Src)) {
+ $FAIL($Fail);
+ }
+}
+
+is_tuple_of_arity(Fail, Src, Arityval) {
+ if (!(BEAM_IS_TUPLE($Src) && *tuple_val($Src) == $Arityval)) {
+ $FAIL($Fail);
+ }
+}
+
+test_arity(Fail, Pointer, Arity) {
+ if (*tuple_val($Pointer) != $Arity) {
+ $FAIL($Fail);
+ }
+}
+i_is_eq_exact_immed(Fail, X, Y) {
+ if ($X != $Y) {
+ $FAIL($Fail);
+ }
+}
+
+i_is_ne_exact_immed(Fail, X, Y) {
+ if ($X == $Y) {
+ $FAIL($Fail);
+ }
+}
+
+is_eq_exact(Fail, X, Y) {
+ if (!EQ($X, $Y)) {
+ $FAIL($Fail);
+ }
+}
+
+is_ne_exact(Fail, X, Y) {
+ if (EQ($X, $Y)) {
+ $FAIL($Fail);
+ }
+}
+
+is_eq(Fail, X, Y) {
+ CMP_EQ_ACTION($X, $Y, $FAIL($Fail));
+}
+
+is_ne(Fail, X, Y) {
+ CMP_NE_ACTION($X, $Y, $FAIL($Fail));
+}
+
+is_lt(Fail, X, Y) {
+ CMP_LT_ACTION($X, $Y, $FAIL($Fail));
+}
+
+is_ge(Fail, X, Y) {
+ CMP_GE_ACTION($X, $Y, $FAIL($Fail));
+}
+
+i_get_map_element(Fail, Src, Key, Dst) {
+ Eterm res = get_map_element($Src, $Key);
+ if (is_non_value(res)) {
+ $FAIL($Fail);
+ }
+ $Dst = res;
+}
+
+i_get_map_element_hash(Fail, Src, Key, Hx, Dst) {
+ Eterm res = get_map_element_hash($Src, $Key, $Hx);
+ if (is_non_value(res)) {
+ $FAIL($Fail);
+ }
+ $Dst = res;
+}
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index ed856b760b..8c9034518b 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -96,16 +96,13 @@ line Loc | func_info M F A => func_info M F A | line Loc
line I
-
-%macro: allocate Allocate -pack
-%macro: allocate_zero AllocateZero -pack
-%macro: allocate_heap AllocateHeap -pack
-%macro: allocate_heap_zero AllocateHeapZero -pack
-%macro: test_heap TestHeap -pack
-
allocate t t
allocate_heap t I t
-deallocate I
+
+%cold
+deallocate Q
+%hot
+
init y
allocate_zero t t
allocate_heap_zero t I t
@@ -122,8 +119,6 @@ init2 y y
init3 y y y
init Y1 | init Y2 | init Y3 => init3 Y1 Y2 Y3
init Y1 | init Y2 => init2 Y1 Y2
-%macro: init2 Init2 -pack
-%macro: init3 Init3 -pack
# Selecting values
@@ -174,7 +169,6 @@ i_jump_on_val_zero xy f I
i_jump_on_val xy f I I
-%macro: get_list GetList -pack
get_list xy xy xy
# The following get_list instructions using x(0) are frequently used.
@@ -202,23 +196,17 @@ set_tuple_element s d P
# Get tuple element
-%macro: i_get_tuple_element GetTupleElement -pack
i_get_tuple_element xy P x
%cold
i_get_tuple_element xy P y
%hot
-%macro: i_get_tuple_element2 GetTupleElement2 -pack
i_get_tuple_element2 x P x
-
-%macro: i_get_tuple_element2y GetTupleElement2Y -pack
i_get_tuple_element2y x P y y
-%macro: i_get_tuple_element3 GetTupleElement3 -pack
i_get_tuple_element3 x P x
-%macro: is_number IsNumber -fail_action
%cold
is_number f x
is_number f y
@@ -252,7 +240,6 @@ system_limit j
move C=cxy x==0 | jump Lbl => move_jump Lbl C
-%macro: move_jump MoveJump -nonext
move_jump f ncxy
# Movement to and from the stack is common
@@ -276,10 +263,6 @@ move_window X1=x X2=x X3=x X4=x Y1=y Y4=y | move X5=x Y5=y | succ(Y4,Y5) => \
move_window X1=x X2=x X3=x Y1=y Y3=y => move_window3 X1 X2 X3 Y1
move_window X1=x X2=x X3=x X4=x Y1=y Y4=y => move_window4 X1 X2 X3 X4 Y1
-%macro: move_window3 MoveWindow3 -pack
-%macro: move_window4 MoveWindow4 -pack
-%macro: move_window5 MoveWindow5 -pack
-
move_window3 x x x y
move_window4 x x x x y
move_window5 x x x x x y
@@ -304,10 +287,8 @@ swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \
swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \
is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D
-%macro: swap_temp SwapTemp -pack
swap_temp x xy x
-%macro: swap Swap -pack
swap x xy
move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2
@@ -351,17 +332,13 @@ move C=aiq X=x==2 => move_x2 C
move_x1 c
move_x2 c
-%macro: move_shift MoveShift -pack
move_shift x x x
move_shift y x x
move_shift x y x
move_shift x x y
-%macro: move_dup MoveDup -pack
move_dup xy x xy
-%macro: move2_par Move2Par -pack
-
move2_par x y x y
move2_par y x y x
move2_par x x x x
@@ -373,7 +350,6 @@ move2_par y x x y
move2_par x x y x
move2_par y x x x
-%macro: move3 Move3 -pack
move3 x y x y x y
move3 y x y x y x
move3 x x x x x x
@@ -383,7 +359,6 @@ move3 x x x x x x
move S=n D=y => init D
move S=c D=y => move S x | move x D
-%macro:move Move -pack
move x x
move x y
move y x
@@ -440,22 +415,18 @@ is_eq_exact Lbl R=xy C=q => i_is_eq_exact_literal Lbl R C
is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C
is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C
-%macro: i_is_eq_exact_immed EqualImmed -fail_action
-
i_is_eq_exact_immed f rxy c
+
i_is_eq_exact_literal f xy c
-%macro: i_is_ne_exact_immed NotEqualImmed -fail_action
i_is_ne_exact_immed f xy c
i_is_ne_exact_literal f xy c
is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y
-%macro: is_eq_exact EqualExact -fail_action -pack
is_eq_exact f x xy
is_eq_exact f s s
-%macro: is_lt IsLessThan -fail_action
is_lt f x x
is_lt f x c
is_lt f c x
@@ -463,7 +434,6 @@ is_lt f c x
is_lt f s s
%hot
-%macro: is_ge IsGreaterEqual -fail_action
is_ge f x x
is_ge f x c
is_ge f c x
@@ -471,13 +441,10 @@ is_ge f c x
is_ge f s s
%hot
-%macro: is_ne_exact NotEqualExact -fail_action
is_ne_exact f s s
-%macro: is_eq Equal -fail_action
is_eq f s s
-%macro: is_ne NotEqual -fail_action
is_ne f s s
#
@@ -495,7 +462,6 @@ i_put_tuple Dst Arity Puts=* | put S => \
i_put_tuple/2
-%macro:i_put_tuple PutTuple -pack -goto:do_put_tuple
i_put_tuple xy I
#
@@ -505,8 +471,6 @@ i_put_tuple xy I
#
put_list Const=c n Dst => move Const x | put_list x n Dst
-%macro:put_list PutList -pack
-
put_list x n x
put_list y n x
put_list x x x
@@ -564,22 +528,18 @@ return_trace
move S x==0 | return => move_return S
-%macro: move_return MoveReturn -nonext
move_return xcn
move S x==0 | deallocate D | return => move_deallocate_return S D
-%macro: move_deallocate_return MoveDeallocateReturn -pack -nonext
move_deallocate_return xycn Q
deallocate D | return => deallocate_return D
-%macro: deallocate_return DeallocateReturn -nonext
deallocate_return Q
test_heap Need u==1 | put_list Y=y x==0 x==0 => test_heap_1_put_list Need Y
-%macro: test_heap_1_put_list TestHeapPutList -pack
test_heap_1_put_list I y
#
@@ -590,8 +550,6 @@ is_tagged_tuple Fail Literal=q Arity Atom => \
move Literal x | is_tagged_tuple Fail x Arity Atom
is_tagged_tuple Fail=f c Arity Atom => jump Fail
-%macro:is_tagged_tuple IsTaggedTuple -fail_action
-
is_tagged_tuple f rxy A a
# Test tuple & arity (head)
@@ -600,17 +558,13 @@ is_tuple Fail Literal=q => move Literal x | is_tuple Fail x
is_tuple Fail=f c => jump Fail
is_tuple Fail=f S=xy | test_arity Fail=f S=xy Arity => is_tuple_of_arity Fail S Arity
-%macro:is_tuple_of_arity IsTupleOfArity -fail_action
-
is_tuple_of_arity f rxy A
-%macro: is_tuple IsTuple -fail_action
is_tuple f rxy
test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity
test_arity Fail=f c Arity => jump Fail
-%macro: test_arity IsArity -fail_action
test_arity f xy A
get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
@@ -632,16 +586,13 @@ is_integer Fail Literal=q => move Literal x | is_integer Fail x
is_integer Fail=f S=x | allocate Need Regs => is_integer_allocate Fail S Need Regs
-%macro: is_integer_allocate IsIntegerAllocate -fail_action
is_integer_allocate f x I I
-%macro: is_integer IsInteger -fail_action
is_integer f xy
is_list Fail=f n =>
is_list Fail Literal=q => move Literal x | is_list Fail x
is_list Fail=f c => jump Fail
-%macro: is_list IsList -fail_action
is_list f x
%cold
is_list f y
@@ -649,24 +600,16 @@ is_list f y
is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs
-%macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -pack
-is_nonempty_list_allocate f rx I t
-
-is_nonempty_list F=f x==0 | test_heap I1 I2 => is_non_empty_list_test_heap F I1 I2
-
-%macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -pack
-is_non_empty_list_test_heap f I t
+is_nonempty_list F=f x==0 | test_heap I1 I2 => is_nonempty_list_test_heap F I1 I2
is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \
is_nonempty_list_get_list Fail S D1 D2
-%macro: is_nonempty_list_get_list IsNonemptyListGetList -fail_action -pack
+is_nonempty_list_allocate f rx I t
+is_nonempty_list_test_heap f I t
is_nonempty_list_get_list f rx x x
-
-%macro: is_nonempty_list IsNonemptyList -fail_action
is_nonempty_list f xy
-%macro: is_atom IsAtom -fail_action
is_atom f x
%cold
is_atom f y
@@ -674,7 +617,6 @@ is_atom f y
is_atom Fail=f a =>
is_atom Fail=f niq => jump Fail
-%macro: is_float IsFloat -fail_action
is_float f x
%cold
is_float f y
@@ -685,12 +627,10 @@ is_float Fail Literal=q => move Literal x | is_float Fail x
is_nil Fail=f n =>
is_nil Fail=f qia => jump Fail
-%macro: is_nil IsNil -fail_action
is_nil f xy
is_binary Fail Literal=q => move Literal x | is_binary Fail x
is_binary Fail=f c => jump Fail
-%macro: is_binary IsBinary -fail_action
is_binary f x
%cold
is_binary f y
@@ -701,28 +641,24 @@ is_bitstr Fail Term => is_bitstring Fail Term
is_bitstring Fail Literal=q => move Literal x | is_bitstring Fail x
is_bitstring Fail=f c => jump Fail
-%macro: is_bitstring IsBitstring -fail_action
is_bitstring f x
%cold
is_bitstring f y
%hot
is_reference Fail=f cq => jump Fail
-%macro: is_reference IsRef -fail_action
is_reference f x
%cold
is_reference f y
%hot
is_pid Fail=f cq => jump Fail
-%macro: is_pid IsPid -fail_action
is_pid f x
%cold
is_pid f y
%hot
is_port Fail=f cq => jump Fail
-%macro: is_port IsPort -fail_action
is_port f x
%cold
is_port f y
@@ -733,7 +669,6 @@ is_boolean Fail=f a==am_false =>
is_boolean Fail=f ac => jump Fail
%cold
-%macro: is_boolean IsBoolean -fail_action
is_boolean f xy
%hot
@@ -741,13 +676,11 @@ is_function2 Fail=f acq Arity => jump Fail
is_function2 Fail=f Fun a => jump Fail
is_function2 f s s
-%macro: is_function2 IsFunction2 -fail_action
# Allocating & initializing.
allocate Need Regs | init Y => allocate_init Need Regs Y
init Y1 | init Y2 => init2 Y1 Y2
-%macro: allocate_init AllocateInit -pack
allocate_init t I y
#################################################################
@@ -1027,10 +960,8 @@ bif2 Fail Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst
i_get_hash c I d
i_get s d
-%macro: self Self
self xy
-%macro: node Node
node x
%cold
node y
@@ -1050,35 +981,20 @@ i_bif2_body b s s d
# Internal calls.
#
-move S=c x==0 | call Ar P=f => i_move_call S P
-move S=s x==0 | call Ar P=f => move_call S P
-
-i_move_call c f
+move S=cxy x==0 | call Ar P=f => move_call S P
-%macro:move_call MoveCall -arg_f -size -nonext
move_call/2
+move_call cxy f
-move_call xy f
-
-move S=c x==0 | call_last Ar P=f D => i_move_call_last P D S
move S x==0 | call_last Ar P=f D => move_call_last S P D
-i_move_call_last f P c
-
-%macro:move_call_last MoveCallLast -arg_f -nonext -pack
-
move_call_last/3
-move_call_last xy f Q
-
-move S=c x==0 | call_only Ar P=f => i_move_call_only P S
-move S=x x==0 | call_only Ar P=f => move_call_only S P
+move_call_last cxy f Q
-i_move_call_only f c
+move S=cx x==0 | call_only Ar P=f => move_call_only S P
-%macro:move_call_only MoveCallOnly -arg_f -nonext
move_call_only/2
-
-move_call_only x f
+move_call_only cx f
call Ar Func => i_call Func
call_last Ar Func D => i_call_last Func D
@@ -1106,12 +1022,10 @@ i_call_fun_last I P
make_fun2 OldIndex=u => gen_make_fun2(OldIndex)
-%macro: i_make_fun MakeFun -pack
%cold
i_make_fun I t
%hot
-%macro: is_function IsFunction -fail_action
is_function f xy
is_function Fail=f c => jump Fail
@@ -1152,10 +1066,6 @@ i_bs_get_integer_32 x f I x
bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \
gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
-%macro: i_bs_get_binary_imm2 BsGetBinaryImm_2 -fail_action
-%macro: i_bs_get_binary2 BsGetBinary_2 -fail_action
-%macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action
-
i_bs_get_binary_imm2 f x I I I x
i_bs_get_binary2 f x I s I x
i_bs_get_binary_all2 f x I I x
@@ -1167,7 +1077,6 @@ bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \
bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail
-%macro: i_bs_get_float2 BsGetFloat2 -fail_action
i_bs_get_float2 f x I s I x
# Miscellanous
@@ -1175,14 +1084,9 @@ i_bs_get_float2 f x I s I x
bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \
gen_skip_bits2(Fail, Ms, Sz, Unit, Flags)
-%macro: i_bs_skip_bits_imm2 BsSkipBitsImm2 -fail_action
i_bs_skip_bits_imm2 f x I
-
-%macro: i_bs_skip_bits2 BsSkipBits2 -fail_action
i_bs_skip_bits2 f x xy I
-
-%macro: i_bs_skip_bits_all2 BsSkipBitsAll2 -fail_action
-i_bs_skip_bits_all2 f x I
+i_bs_skip_bits_all2 f x I
bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms
bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits
@@ -1294,9 +1198,6 @@ i_bs_private_append j I s s x
bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \
gen_put_integer(Fail, Sz, Unit, Flags, Src)
-%macro: i_new_bs_put_integer NewBsPutInteger
-%macro: i_new_bs_put_integer_imm NewBsPutIntegerImm
-
i_new_bs_put_integer j s I s
i_new_bs_put_integer_imm j I I s
@@ -1331,9 +1232,6 @@ bs_put_float Fail Sz=q Unit Flags Val => badarg Fail
bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_float(Fail, Sz, Unit, Flags, Src)
-%macro: i_new_bs_put_float NewBsPutFloat
-%macro: i_new_bs_put_float_imm NewBsPutFloatImm
-
i_new_bs_put_float j s I s
i_new_bs_put_float_imm j I I s
@@ -1344,13 +1242,8 @@ i_new_bs_put_float_imm j I I s
bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_binary(Fail, Sz, Unit, Flags, Src)
-%macro: i_new_bs_put_binary NewBsPutBinary
i_new_bs_put_binary j s I s
-
-%macro: i_new_bs_put_binary_imm NewBsPutBinaryImm
i_new_bs_put_binary_imm j I s
-
-%macro: i_new_bs_put_binary_all NewBsPutBinaryAll
i_new_bs_put_binary_all j s I
#
@@ -1436,7 +1329,6 @@ update_map_exact j s d I I
is_map Fail Lit=q | literal_is_map(Lit) =>
is_map Fail cq => jump Fail
-%macro: is_map IsMap -fail_action
is_map f xy
## Transform has_map_fields #{ K1 := _, K2 := _ } to has_map_elements
@@ -1456,10 +1348,8 @@ i_get_map_elements f s I
i_get_map_element Fail Src=xy Key=y Dst => \
move Key x | i_get_map_element Fail Src x Dst
-%macro: i_get_map_element_hash GetMapElementHash -fail_action
i_get_map_element_hash f xy c I xy
-%macro: i_get_map_element GetMapElement -fail_action
i_get_map_element f xy x xy
#
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index 0a30553f71..8041a96bcb 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -91,8 +91,9 @@ my @op_to_name;
my @obsolete;
-my %macro;
-my %macro_flags;
+# Instructions implemented in C.
+my %c_code; # C code block, location, arguments.
+my %c_code_used; # Used or not.
my %hot_code;
my %cold_code;
@@ -259,8 +260,25 @@ if ($wordsize == 64) {
# Parse the input files.
#
+my $in_c_code = '';
+my $c_code_block;
+my $c_code_loc;
+my @c_args;
+
while (<>) {
my($op_num);
+ if ($in_c_code) {
+ if (/^\}/) {
+ $c_code_block =~ s/^ //mg;
+ chomp $c_code_block;
+ $c_code{$in_c_code} =
+ [$c_code_block,$c_code_loc,@c_args];
+ $in_c_code = '';
+ } else {
+ $c_code_block .= $_;
+ }
+ next;
+ }
chomp;
if (s/\\$//) {
$_ .= <>;
@@ -268,6 +286,7 @@ while (<>) {
}
next if /^\s*$/;
next if /^\#/;
+ next if m@^//@;
#
# Handle %if.
@@ -325,23 +344,6 @@ while (<>) {
$hot = 0;
next;
}
-
- #
- # Handle macro definitions.
- #
- if (/^\%macro:(.*)/) {
- my($op, $macro, @flags) = split(' ', $1);
- defined($macro) and $macro =~ /^-/ and
- error("A macro must not start with a hyphen");
- foreach (@flags) {
- /^-/ or error("Flags for macros should start with a hyphen");
- }
- error("Macro for '$op' is already defined")
- if defined $macro{$op};
- $macro{$op} = $macro;
- $macro_flags{$op} = join('', @flags);
- next;
- }
#
# Handle transformations.
@@ -352,6 +354,22 @@ while (<>) {
}
#
+ # Handle C code blocks.
+ #
+ if (/^(\w+)\(([^\)]*)\)\s*{/) {
+ my $name = $1;
+ $in_c_code = $name;
+ $c_code_block = '';
+ @c_args = parse_c_args($2);
+ $c_code_loc = "$ARGV($.)";
+ if (defined $c_code{$name}) {
+ my $where = $c_code{$name}->[1];
+ error("$name: already defined at $where");
+ }
+ next;
+ }
+
+ #
# Parse off the number of the operation.
#
$op_num = undef;
@@ -449,6 +467,18 @@ $num_file_opcodes = @gen_opname;
&$target();
#
+# Ensure that all C code implementations have been used.
+#
+{
+ my(@unused) = grep(!$c_code_used{$_}, keys %c_code);
+ foreach my $unused (@unused) {
+ my(undef,$where) = @{$c_code{$unused}};
+ warn "$where: $unused is unused\n";
+ }
+ die "\n" if @unused;
+}
+
+#
# Produce output needed by the emulator/loader.
#
@@ -893,6 +923,18 @@ sub save_specific_ops {
}
}
+sub parse_c_args {
+ local($_) = @_;
+ my @res;
+
+ while (s/^(\w[\w\d]*)\s*//) {
+ push @res, $1;
+ s/^,\s*// or last;
+ }
+ $_ eq '' or error("garbage in argument list: $_");
+ @res;
+}
+
sub error {
my(@message) = @_;
my($where) = $. ? "$ARGV($.): " : "";
@@ -940,51 +982,20 @@ sub comment {
sub basic_generator {
my($name, $hot, @args) = @_;
- my($size) = 0;
- my($macro) = '';
- my($flags) = '';
- my(@f);
- my(@f_types);
- my($fail_type);
- my($prefix) = '';
- my($tmp_arg_num) = 1;
- my($pack_spec) = '';
- my($var_decls) = '';
- my($i);
- my($no_prefetch) = 0;
-
- # The following argument types should be included as macro arguments.
- my(%incl_arg) = ('c' => 1,
- 'i' => 1,
- 'a' => 1,
- 'A' => 1,
- 'N' => 1,
- 'U' => 1,
- 'I' => 1,
- 't' => 1,
- 'P' => 1,
- 'Q' => 1,
- );
-
- # Pick up the macro to use and its flags (if any).
-
- $macro = $macro{$name} if defined $macro{$name};
- $flags = $macro_flags{$name} if defined $macro_flags{$name};
+ my $size = 0;
+ my $flags = '';
+ my @f;
+ my $prefix = '';
+ my $tmp_arg_num = 1;
+ my $pack_spec = '';
+ my $var_decls = '';
#
- # Add any arguments to be included as macro arguments (for instance,
- # 'p' is usually not an argument, except for calls).
+ # Pack arguments for hot code with an implementation.
#
- while ($flags =~ /-arg_(\w)/g) {
- $incl_arg{$1} = 1;
- };
-
- #
- # Pack arguments if requested.
- #
-
- if ($flags =~ /-pack/ && $hot) {
+ my $c_code = $c_code{$name};
+ if ($hot and defined $c_code) {
($prefix, $pack_spec, @args) = do_pack(@args);
}
@@ -997,40 +1008,41 @@ sub basic_generator {
my($this_size) = $arg_size{$_};
SWITCH:
{
- /^pack:(\d):(.*)/ and do { push(@f, $2);
- push(@f_types, 'packed');
- $this_size = $1;
- last SWITCH;
- };
- /r/ and do { push(@f, "r(0)"); push(@f_types, $_); last SWITCH };
- /[xy]/ and do { push(@f, "$_" . "b(Arg($size))");
- push(@f_types, $_);
- last SWITCH;
- };
- /n/ and do { push(@f, "NIL"); push(@f_types, $_); last SWITCH };
- /s/ and do { my($tmp) = "targ$tmp_arg_num";
- $var_decls .= "Eterm $tmp; ";
- $tmp_arg_num++;
- push(@f, $tmp);
- push(@f_types, $_);
- $prefix .= "GetR($size, $tmp);\n";
- last SWITCH; };
- /d/ and do { $var_decls .= "Eterm dst; Eterm* dst_ptr; ";
- push(@f, "*dst_ptr");
- push(@f_types, $_);
- $prefix .= "dst = Arg($size);\n";
- $prefix .= "dst_ptr = REG_TARGET_PTR(dst);\n";
- last SWITCH;
- };
- defined($incl_arg{$_})
- and do { push(@f, "Arg($size)");
- push(@f_types, $_);
- last SWITCH;
- };
-
- /[fp]/ and do { $fail_type = $_; last SWITCH };
-
- /[eLIFEbASjPowlq]/ and do { last SWITCH; };
+ /^pack:(\d):(.*)/ and do {
+ push(@f, $2);
+ $this_size = $1;
+ last SWITCH;
+ };
+ /r/ and do {
+ push(@f, "r(0)");
+ last SWITCH;
+ };
+ /[lxy]/ and do {
+ push(@f, $_ . "b(Arg($size))");
+ last SWITCH;
+ };
+ /n/ and do {
+ push(@f, "NIL");
+ last SWITCH;
+ };
+ /s/ and do {
+ my($tmp) = "targ$tmp_arg_num";
+ $var_decls .= "Eterm $tmp;\n";
+ $tmp_arg_num++;
+ push(@f, $tmp);
+ $prefix .= "GetR($size, $tmp);\n";
+ last SWITCH;
+ };
+ /d/ and do {
+ $var_decls .= "Eterm dst = Arg($size);\n" .
+ "Eterm* dst_ptr = REG_TARGET_PTR(dst);\n";
+ push(@f, "*dst_ptr");
+ last SWITCH;
+ };
+ defined $arg_size{$_} and do {
+ push(@f, "Arg($size)");
+ last SWITCH;
+ };
die "$name: The generator can't handle $_, at";
}
@@ -1038,77 +1050,156 @@ sub basic_generator {
}
#
- # Add a fail action macro if requested.
+ # If the implementation is in beam_emu.c, there is nothing
+ # more to do.
#
+ unless (defined $c_code) {
+ return ($size+1, undef, '');
+ }
- $flags =~ /-fail_action/ and do {
- $no_prefetch = 1;
- if (!defined $fail_type) {
- my($i);
- for ($i = 0; $i < @f_types; $i++) {
- local($_) = $f_types[$i];
- /[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next };
- }
- } elsif ($fail_type eq 'f') {
- push(@f, "ClauseFail()");
- } else {
- my($i);
- for ($i = 0; $i < @f_types; $i++) {
- local($_) = $f_types[$i];
- /[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next };
- }
- }
- };
+ #
+ # Generate main body of the implementation.
+ #
+ my $macro_code;
+ if (defined $c_code) {
+ my($c_code,$where,@c_args) = @{$c_code};
+ my %bindings;
+ $c_code_used{$name} = 1;
+
+ if (@f != @c_args) {
+ error("$where: defining '$name' with ", scalar(@c_args),
+ " arguments instead of expected ", scalar(@f), " arguments");
+ }
+
+ for (my $i = 0; $i < @f; $i++) {
+ my $var = $c_args[$i];
+ $bindings{$var} = $f[$i];
+ }
+ $bindings{'NEXT_INSTRUCTION'} = "I+" . ($size + 1);
+ $c_code = eval { expand_all($c_code, \%bindings) };
+ unless (defined $c_code) {
+ warn $@;
+ error("... from the body of $name at $where");
+ }
+ my(@comments) = $c_code =~ m@//[|]\s*(.*)@g;
+ $flags = "@comments";
+ $macro_code = "$prefix$c_code";
+ }
#
- # Add a size argument if requested.
+ # Generate code for transferring to the next instruction.
#
+ my $dispatch_next;
+ my $offset = $size + 1;
+
+ if ($flags =~ /-no_next/) {
+ $dispatch_next = "";
+ } elsif ($flags =~ /-no_prefetch/) {
+ $dispatch_next = "\nI += $offset;\n" .
+ "ASSERT(VALID_INSTR(*I));\n" .
+ "Goto(*I);";
+ } else {
+ $var_decls .= "BeamInstr* _nextpf = " .
+ "(BeamInstr *) I[$offset];\n";
+ $dispatch_next = "\nI += $offset;\n" .
+ "ASSERT(VALID_INSTR(_nextpf));\n" .
+ "Goto(_nextpf);";
+ }
- $flags =~ /-size/ and do {
- push(@f, $size);
- };
-
- # Generate the macro if requested.
- my($code);
- if (defined $macro{$name}) {
- my($macro_code) = "$prefix$macro(" . join(', ', @f) . ");";
- $var_decls .= "BeamInstr tmp_packed1;"
- if $macro_code =~ /tmp_packed1/;
- $var_decls .= "BeamInstr tmp_packed2;"
- if $macro_code =~ /tmp_packed2/;
- if ($flags =~ /-nonext/) {
- $code = join("\n",
- "{ $var_decls",
- $macro_code,
- "}");
- } elsif ($flags =~ /-goto:(\S*)/) {
- my $goto = $1;
- $code = join("\n",
- "{ $var_decls",
- $macro_code,
- "I += $size + 1;",
- "goto $goto;",
- "}");
- } elsif ($no_prefetch) {
- $code = join("\n",
- "{ $var_decls",
- $macro_code,
- "Next($size);",
- "}", "");
- } else {
- $code = join("\n",
- "{ $var_decls",
- "BeamInstr* next;",
- "PreFetch($size, next);",
- "$macro_code",
- "NextPF($size, next);",
- "}", "");
- }
+ #
+ # Assemble the complete code for the instruction.
+ #
+ my $code = join("\n",
+ "{",
+ "$var_decls$macro_code$dispatch_next",
+ "}", "");
+ ($size+1, $code, $pack_spec);
+}
+
+sub expand_all {
+ my($code,$bindings_ref) = @_;
+ my %bindings = %{$bindings_ref};
+
+ # Expand all $Var occurrences.
+ $code =~ s/[\$](\w[\w\d]*)(?!\()/defined $bindings{$1} ? $bindings{$1} : "\$$1"/ge;
+
+ # Find calls to macros, $name(...), and expand them.
+ my $res = "";
+ while ($code =~ /[\$](\w[\w\d]*)\(/) {
+ my $macro_name = $1;
+ my $keep = substr($code, 0, $-[0]);
+ my $after = substr($code, $+[0]);
+
+ # Keep the special, pre-defined bindings.
+ my %new_bindings;
+ foreach my $key (qw(NEXT_INSTRUCTION)) {
+ $new_bindings{$key} = $bindings{$key};
+ }
+
+ my $body;
+ ($body,$code) = expand_macro($macro_name, $after, \%new_bindings);
+ $res .= "$keep$body";
+ }
+
+ $res . $code;
+}
+
+sub expand_macro {
+ my($name,$rest,$bindings_ref) = @_;
+
+ my $c_code = $c_code{$name};
+ defined $c_code or
+ error("calling undefined macro '$name'...");
+ $c_code_used{$name} = 1;
+ my ($body,$where,@vars) = @{$c_code};
+
+ # Separate the arguments into @args;
+ my @args;
+ my $level = 1;
+ my %inc = ('(' => 1, ')' => -1,
+ '[' => 1, ']' => -1,
+ '{' => 1, '}' => -1);
+ my $arg = undef;
+ while ($rest =~ /([,\(\[\{\}\]\)]|([^,\(\[\{\}\]\)]*))/g) {
+ my $token = $1;
+ my $inc = $inc{$token} || 0;
+ $level += $inc;
+ if ($level == 0) {
+ $rest = substr($rest, pos($rest));
+ push @args, $arg if defined $arg;
+ last;
+ }
+ if ($token eq ',') {
+ if ($level == 1) {
+ push @args, $arg;
+ $arg = "";
+ }
+ next;
+ }
+ $arg .= $token;
+ }
+
+ # Trim leading whitespace from each argument.
+ foreach my $arg (@args) {
+ $arg =~ s/^\s*//;
}
- # Return the size and code for the macro (if any).
- $size++;
- ($size, $code, $pack_spec);
+ # Now combine bindings from the parameter names and arguments.
+ my %bindings = %{$bindings_ref};
+ if (@vars != @args) {
+ error("calling $name with ", scalar(@args),
+ " arguments instead of expected ", scalar(@vars), " arguments...");
+ }
+ for (my $i = 0; $i < @vars; $i++) {
+ $bindings{$vars[$i]} = $args[$i];
+ }
+
+ $body = eval { expand_all($body, \%bindings) };
+ unless (defined $body) {
+ warn $@;
+ die "... from the body of $name at $where\n";
+ }
+ ("do {\n$body\n} while (0)",$rest);
}
sub do_pack {
@@ -1201,7 +1292,7 @@ sub do_pack {
$did_some_packing = 1;
if ($ap == 0) {
- $pack_prefix .= "tmp_packed$tmpnum = Arg($size);\n";
+ $pack_prefix .= "Eterm tmp_packed$tmpnum = Arg($size);\n";
$up .= "p";
$down = "P$down";
$this_size = 1;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 23:51:18 +0000