// precondition: size(x) >= size(y)
//
mword *badd_array(bvm_cache *this_bvm, mword *x, mword *y){
mword max_size = MAX(size(x), size(y));
mword min_size = MIN(size(x), size(y));
mword *result = _newlfi(this_bvm, max_size+1, 0);
int i;
mword carry = 0;
for(i=0; i<min_size; i++){
carry = badd_term(this_bvm, rcl(x,i), rcl(y,i), (result+i), carry);
}
for(;i<max_size;i++){
carry = badd_term(this_bvm, rcl(x,i), 0, (result+i), carry);
}
if(carry){
lcl(result,max_size) = carry;
}
else{
s(result) = (s(result)-MWORD_SIZE);
}
return result;
}
mword bpdl_is_squote(mword *entry){ // bpdl_is_squote#
#ifdef BPDL_TRACE
_trace;
#endif
return (rcl(entry,0) == '\'') && (rcl(entry,size(entry)-1) == '\'');
}
mword bpdl_is_bnumber(mword *entry){ // bpdl_is_bnumber#
#ifdef BPDL_TRACE
_trace;
#endif
return (rcl(entry,0) == '0') && (rcl(entry,1) == 'b');
}
mword *bpdl_dnumber_to_bstruct(bvm_cache *this_bvm, mword *entry){ // bpdl_dnumber_to_bstruct#
#ifdef BPDL_TRACE
_trace;
#endif
mword is_negative = 0;
if(rcl(entry,0) == '-'){ // Negative number
is_negative = 1;
}
if(!is_negative){
char *str = (char*)_ar2str( this_bvm, entry );
return _val(this_bvm, (mword)atoi((char*)str));
}
else{
char *str = (char*)_ar2str( this_bvm, entry );
return _val(this_bvm, (mword)(-1*atoi((char*)(str+1))));
}
return 0; // Silence compiler warning
}
Code()
{
Xbyak::Label label;
cmpss(xmm0, ptr[rip + label], 0);
test(dword[rip + label], 33);
bt(dword[rip + label ], 3);
vblendpd(xmm0, dword[rip + label], 3);
vpalignr(xmm0, qword[rip + label], 4);
vextractf128(dword[rip + label], ymm3, 12);
vperm2i128(ymm0, ymm1, qword[rip + label], 13);
vcvtps2ph(ptr[rip + label], xmm2, 44);
mov(dword[rip + label], 0x1234);
shl(dword[rip + label], 3);
shr(dword[rip + label], 1);
shld(qword[rip + label], rax, 3);
imul(rax, qword[rip + label], 21);
rorx(rax, qword[rip + label], 21);
test(dword[rip + label], 5);
pextrq(ptr[rip + label], xmm0, 3);
pinsrq(xmm2, ptr[rip + label], 5);
pextrw(ptr[rip + label], xmm1, 4);
adc(dword[rip + label], 0x12345);
bt(byte[rip + label], 0x34);
btc(word[rip + label], 0x34);
btr(dword[rip + label], 0x34);
rcl(dword[rip + label], 4);
shld(qword[rip + label], rax, 4);
palignr(mm0, ptr[rip + label], 4);
aeskeygenassist(xmm3, ptr[rip + label], 4);
vpcmpestrm(xmm2, ptr[rip + label], 7);
ret();
L(label);
dq(0x123456789abcdef0ull);
};
void tptr_update_hash(bvm_cache *this_bvm, mword *tptr, mword *hash){ // tptr_update_hash#
int i;
for(i=0; i<HASH_SIZE; i++){// FIXME: PERF... use memcpy
tptr[i] = rcl(hash,i);
}
}
mword *tptr_extract_hash(bvm_cache *this_bvm, mword *tptr){ // tptr_extract_hash#
mword *ptr = _newlfi(this_bvm, HASH_SIZE, 0);
int i;
for(i=0; i<HASH_SIZE; i++){// FIXME: PERF... use memcpy
ptr[i] = rcl(tptr,i);
}
return ptr;
}
mword is_false_leaf(mword *bs){ // is_false_leaf#
int i;
for(i=0;i<size(bs);i++){
if(rcl(bs,i) != 0){
return 0;
}
}
return 1;
}
mword *_babel_root(bvm_cache *this_bvm, mword *loaded_bvm){ // _babel_root#
#ifdef BABEL_RESET_TRACE
_trace;
#endif
bvm_cache new_bvm;
bvm_cache *new_bvm_ptr = &new_bvm;
cache_new(this_bvm, new_bvm_ptr, loaded_bvm);
mword *bvm_initd = rci(cache_read_from_bvm(this_bvm, BABEL_SYM_BVM_INITD),0);
if(!rcl(bvm_initd,0)){
bvm_new(new_bvm_ptr);
lcl(bvm_initd,0) = 1;
}
else{
cache_update(new_bvm_ptr);
}
new_bvm_ptr->flags->BVM_CACHE_DIRTY = FLAG_CLR;
new_bvm_ptr->flags->BVM_CACHE_INVALID = FLAG_CLR;
babel_root_code_injection_point(new_bvm_ptr);
new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY = FLAG_CLR;
interp_core(new_bvm_ptr);
this_bvm->flags->BVM_CACHE_DIRTY = FLAG_CLR;
this_bvm->flags->BVM_CACHE_INVALID = FLAG_CLR;
// XXX Enhancement: handle return-from-root
// if(new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY == FLAG_SET){
// _msg("BVM_CODE_LIST_EMPTY");
// }
return nil;
}
mword bpdl_is_dnumber(mword *entry){ // bpdl_is_dnumber#
#ifdef BPDL_TRACE
_trace;
#endif
mword is_dnumber =
((size(entry) == 1) && (rcl(entry,0) == '0'))
||
((rcl(entry,0) >= '1') && (rcl(entry,0) <= '9'))
||
((rcl(entry,0) == '-') &&
(rcl(entry,1) >= '1') && (rcl(entry,1) <= '9'));
return is_dnumber;
}
mword is_false_val(mword *bs){ // is_false_val#
return (rcl(bs,0) == 0);
}
mword *_babel(bvm_cache *this_bvm, mword *loaded_bvm, mword *arg_stack, mword *sym_table){ // _babel#
bvm_cache new_bvm;
bvm_cache *new_bvm_ptr = &new_bvm;
mword *result = nil;
cache_new(this_bvm, new_bvm_ptr, loaded_bvm);
mword *self = tptr_detag(new_bvm_ptr, tptr_detag(new_bvm_ptr, new_bvm_ptr->self)); // Could blow up due to mem_alloc()
if( !trie_exists(new_bvm_ptr, self, BABEL_SYM_BVM_INITD, nil) ){
trie_insert( new_bvm_ptr, self, BABEL_SYM_BVM_INITD, nil, _val(new_bvm_ptr,1) );
// trie_insert( new_bvm_ptr, self, BABEL_SYM_BVM_INITD, nil, _val(new_bvm_ptr,0) );
}
mword *bvm_initd = rci(cache_read_from_bvm(new_bvm_ptr, BABEL_SYM_BVM_INITD),0);
if(!rcl(bvm_initd,0)){
bvm_new(new_bvm_ptr);
lcl(bvm_initd,0) = 1;
}
else{
cache_update(new_bvm_ptr);
}
if( !trie_exists(new_bvm_ptr, self, BABEL_SYM_CODE_RESTART_POINT, nil) ){
trie_insert( new_bvm_ptr, self, BABEL_SYM_CODE_RESTART_POINT, nil, rci(new_bvm_ptr->code_ptr,0));
}
new_bvm_ptr->flags->BVM_CACHE_DIRTY = FLAG_CLR;
new_bvm_ptr->flags->BVM_CACHE_INVALID = FLAG_CLR;
cache_flush(this_bvm);
if(!is_nil(sym_table)){
trie_insert(new_bvm_ptr, tptr_detag(new_bvm_ptr, new_bvm_ptr->self), BABEL_SYM_SOFT_ROOT, nil, sym_table);
}
trie_insert(new_bvm_ptr, tptr_detag(new_bvm_ptr, new_bvm_ptr->self), BABEL_SYM_PARENT_BVM, nil, this_bvm->self);
new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY = FLAG_CLR;
while(!is_nil(arg_stack)){ // give the arg-list onto the BVM's dstack
interp_push_operand(new_bvm_ptr, rci(arg_stack, 0));
arg_stack = rci(arg_stack,1);
}
interp_core(new_bvm_ptr);
cache_cp(new_bvm_ptr, this_bvm); //update flags and interp
this_bvm->self = _ith( this_bvm,
trie_lookup_hash(
new_bvm_ptr,
tptr_detag(new_bvm_ptr, new_bvm_ptr->self),
BABEL_SYM_PARENT_BVM,
nil),
2 );
cache_update(this_bvm);
this_bvm->flags->BVM_CACHE_DIRTY = FLAG_CLR;
this_bvm->flags->BVM_CACHE_INVALID = FLAG_CLR;
//copy TOS from new_bvm to this_bvm
oinfo oi;
oi.default_data = nil;
oi.required_tag = nil;
oi.mask = OI_MASK_ANY;
oi.min_size = 0;
oi.max_size = 1;
if( new_bvm_ptr->flags->BVM_RETURN_TOS_ON_EXIT == FLAG_SET
&&
(new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY == FLAG_SET
||
(get_advance_type(new_bvm_ptr) == BVM_RETURN))){
get_operands(new_bvm_ptr,1,&oi);
result = oi.data;
stack_pop(new_bvm_ptr,rci(new_bvm_ptr->dstack_ptr,0));
// stack_push(this_bvm,
// rci(this_bvm->dstack_ptr,0),
// stack_new_entry(
// this_bvm,
// oi.data,
// nil));
}
// Reset all flags in case of re-entry
new_bvm_ptr->flags->BVM_RETURN_TOS_ON_EXIT = FLAG_CLR; // FIXME: This restore to previous value, not force-clear
new_bvm_ptr->flags->BVM_CODE_LIST_EMPTY = FLAG_CLR;
if(get_advance_type(new_bvm_ptr) == BVM_RETURN){
set_advance_type(new_bvm_ptr, BVM_ADVANCE);
}
this_bvm->flags->BVM_RETURN_TOS_ON_EXIT = FLAG_CLR;
this_bvm->flags->BVM_CODE_LIST_EMPTY = FLAG_CLR;
return result;
}
