// 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;
}
// Add with carry
//
mword *_addc(bvm_cache *this_bvm, mword a, mword b, mword carry_in){
mword sum = a + b + carry_in;
mword *result;
if(sum < a){
result = _newlfi(this_bvm, 2, 0);
lcl(result,0) = (mword)sum;
lcl(result,1) = 1; // carry bit
}
else{
result = _val(this_bvm, (mword)sum);
}
return result;
}
mword *tptr_new(bvm_cache *this_bvm, const mword *hash, mword *bs){ // tptr_new#
mword *ptr = mem_alloc( this_bvm, TPTR_SFIELD );
int i;
for(i=0; i<HASH_SIZE; i++){ // FIXME: PERF... use memcpy
ptr[i] = hash[i];
}
lcl(ptr,HASH_SIZE) = INTE_SFIELD*MWORD_SIZE;
set_tptr(ptr,bs);
return ptr;
}
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;
}
// This function almost a copy of lf2by() but slightly modified
//
mword *bpdl_quote_to_bstruct(bvm_cache *this_bvm, mword *entry){ // bpdl_quote_to_bstruct#
#ifdef BPDL_TRACE
_trace;
#endif
mword arr_size = size(entry)-2; // -2 because of the quote marks
mword arr8_size = _array8_size(this_bvm, arr_size);
unsigned char *result = (unsigned char *)_newlfi(this_bvm, arr8_size, 0);
int i;
for(i=1; i<arr_size+1; i++){
result[i-1] = (unsigned char)(entry[i] & 0xff);
}
lcl(result, arr8_size-1) = _alignment_word8(this_bvm, arr_size);
return (mword*)result;
}
void execALU(){
switch(controle_alu.op_code){
case 1: add(); break;
case 2: addinc(); break;
case 3: and(); break;
case 4: andnota(); break;
case 5: asl(); break;
case 6: asr(); break;
case 7: deca(); break;
case 8: inca(); break;
case 9: j(); break;
case 10: jal(); break;
case 11: jf(); break;
case 12: jr(); break;
case 13: jt(); break;
case 14: lch(); break;
case 15: lcl(); break;
case 16: load(); break;
case 17: loadlit(); break;
case 18: lsl(); break;
case 19: lsr(); break;
case 20: nand(); break;
case 21: nor(); break;
case 22: ones(); break;
case 23: or(); break;
case 24: ornotb(); break;
case 25: passa(); break;
case 26: passnota(); break;
case 27: store(); break;
case 28: sub(); break;
case 29: subdec(); break;
case 30: xnor(); break;
case 31: xor(); break;
case 32: zeros(); break;
}
}
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;
}
void tet_hp_cns::minvrt() {
int i,j,k,n,tind,msgn,sgn,sind,v0;
Array<FLT,2> spokemass;
int last_phase, mp_phase;
Array<double,1> lcl(NV), lclug(NV),lclres(NV),uavg(NV);
Array<TinyVector<double,MXGP>,2> P(NV,NV);
Array<TinyVector<double,MXGP>,1> u1d(NV),res1d(NV),temp1d(NV);
Array<TinyVector<double,MXTM>,1> ucoef(NV),rcoef(NV),tcoef(NV);
if (basis::tet(log2p).p > 2) {
*gbl->log << "cns minvrt only works for p = 1 and 2" << endl;
exit(4);
}
/* LOOP THROUGH EDGES */
if (basis::tet(log2p).em > 0) {
for(int eind = 0; eind<nseg;++eind) {
/* SUBTRACT SIDE CONTRIBUTIONS TO VERTICES */
for (k=0; k <basis::tet(log2p).em; ++k) {
for (i=0; i<2; ++i) {
v0 = seg(eind).pnt(i);
for(n=0;n<NV;++n)
gbl->res.v(v0,n) -= basis::tet(log2p).sfmv(i,k)*gbl->res.e(eind,k,n);
}
}
}
}
gbl->res.v(Range(0,npnt-1),Range::all()) *= gbl->vprcn(Range(0,npnt-1),Range::all())*basis::tet(log2p).vdiag;
/* LOOP THROUGH VERTICES */
for(int i=0;i<npnt;++i){
for(int n = 0; n < NV; ++n)
lclres(n) = gbl->res.v(i,n);
if(gbl->preconditioner == 0 || gbl->preconditioner == 1) {
for(int n = 0; n < NV; ++n)
lclug(n) = ug.v(i,n);
switch_variables(lclug,lclres);
for(int j=0;j<NV;++j){
FLT lcl0 = lclres(j);
for(int k=0;k<j;++k){
lcl0 -= gbl->vpreconditioner(i,j,k)*lclres(k);
}
lclres(j) = lcl0/gbl->vpreconditioner(i,j,j);
}
}
else {
int info,ipiv[NV];
Array<double,2> P(NV,NV);
for(int j=0;j<NV;++j)
for(int k=0;k<NV;++k)
P(j,k) = gbl->vpreconditioner(i,j,k);
GETRF(NV, NV, P.data(), NV, ipiv, info);
if (info != 0) {
*gbl->log << "DGETRF FAILED FOR CNS MINVRT" << std::endl;
sim::abort(__LINE__,__FILE__,gbl->log);
}
char trans[] = "T";
GETRS(trans,NV,1,P.data(),NV,ipiv,lclres.data(),NV,info);
}
for(int n = 0; n < NV; ++n)
gbl->res.v(i,n) = lclres(n);
}
for(last_phase = false, mp_phase = 0; !last_phase; ++mp_phase) {
pc0load(mp_phase,gbl->res.v.data());
pmsgpass(boundary::all_phased,mp_phase,boundary::symmetric);
last_phase = true;
last_phase &= pc0wait_rcv(mp_phase,gbl->res.v.data());
}
/* APPLY VERTEX DIRICHLET B.C.'S */
for(i=0;i<nfbd;++i)
hp_fbdry(i)->vdirichlet();
for(i=0;i<nebd;++i)
hp_ebdry(i)->vdirichlet3d();
for(i=0;i<nvbd;++i)
hp_vbdry(i)->vdirichlet3d();
if(basis::tet(log2p).em == 0) return;
/* LOOP THROUGH SIDES */
for(int sind=0;sind<nseg;++sind) {
for(int n = 0; n < NV; ++n)
lclres(n) = gbl->res.e(sind,0,n);
Array<FLT,2> P(NV,NV);
for(int j=0;j<NV;++j){
for(int k=0;k<NV;++k){
P(j,k) = gbl->epreconditioner(sind,j,k);
//P(j,k) = 0.5*(gbl->vpreconditioner(seg(sind).pnt(0),j,k)+gbl->vpreconditioner(seg(sind).pnt(1),j,k));
}
}
if(gbl->preconditioner == 0 || gbl->preconditioner == 1) {
for(int n = 0; n < NV; ++n)
uavg(n) = 0.5*(ug.v(seg(sind).pnt(0),n)+ug.v(seg(sind).pnt(1),n));
switch_variables(uavg,lclres);
for(int j=0;j<NV;++j){
FLT lcl0 = lclres(j);
for(int k=0;k<j;++k){
lcl0 -= P(j,k)*lclres(k);
}
lclres(j) = lcl0/P(j,j);
}
}
else {
int info,ipiv[NV];
GETRF(NV, NV, P.data(), NV, ipiv, info);
if (info != 0) {
*gbl->log << "DGETRF FAILED FOR CNS MINVRT EDGE" << std::endl;
sim::abort(__LINE__,__FILE__,gbl->log);
}
char trans[] = "T";
GETRS(trans,NV,1,P.data(),NV,ipiv,lclres.data(),NV,info);
}
for(int n = 0; n < NV; ++n)
gbl->res.e(sind,0,n) = lclres(n);
}
/* REMOVE VERTEX CONTRIBUTION FROM SIDE MODES */
/* SOLVE FOR SIDE MODES */
/* PART 1 REMOVE VERTEX CONTRIBUTIONS */
for(tind=0;tind<ntet;++tind) {
for(i=0;i<4;++i) {
v0 = tet(tind).pnt(i);
for(n=0;n<NV;++n)
uht(n)(i) = gbl->res.v(v0,n)*gbl->iprcn(tind,n);
}
/* edges */
for(i=0;i<6;++i) {
sind = tet(tind).seg(i);
sgn = tet(tind).sgn(i);
for(j=0;j<4;++j) {
msgn = 1;
for(k=0;k<basis::tet(log2p).em;++k) {
for(n=0;n<NV;++n)
gbl->res.e(sind,k,n) -= msgn*basis::tet(log2p).vfms(j,4+k+i*basis::tet(log2p).em)*uht(n)(j);
msgn *= sgn;
}
}
}
}
basis::tet(log2p).ediag(0) = 100.0;//for fast convergence
//basis::tet(log2p).ediag(0) = 48.0; //for accuracy mass lumped edge modes
gbl->res.e(Range(0,nseg-1),0,Range::all()) *= gbl->eprcn(Range(0,nseg-1),Range::all())*basis::tet(log2p).ediag(0);
for(last_phase = false, mp_phase = 0; !last_phase; ++mp_phase) {
sc0load(mp_phase,gbl->res.e.data(),0,0,gbl->res.e.extent(secondDim));
smsgpass(boundary::all_phased,mp_phase,boundary::symmetric);
last_phase = true;
last_phase &= sc0wait_rcv(mp_phase,gbl->res.e.data(),0,0,gbl->res.e.extent(secondDim));
}
/* APPLY DIRCHLET B.C.S TO MODE */
for(int i=0;i<nfbd;++i)
hp_fbdry(i)->edirichlet();
for (int i=0;i<nebd;++i)
hp_ebdry(i)->edirichlet3d();
return;
}