extern int BackendDAEEXT_setAssignment(int lenass1, int lenass2, modelica_metatype ass1, modelica_metatype ass2) { int nelts=0; int i=0; nelts = MMC_HDRSLOTS(MMC_GETHDR(ass1)); if (nelts > 0) { n = lenass1; if(match) { free(match); } match = (int*) malloc(n * sizeof(int)); for(i=0; i<n; ++i) { match[i] = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(ass1)[i])-1; if (match[i]<0) match[i] = -1; } } nelts = MMC_HDRSLOTS(MMC_GETHDR(ass2)); if (nelts > 0) { m = lenass2; if(row_match) { free(row_match); } row_match = (int*) malloc(m * sizeof(int)); for(i=0; i<m; ++i) { row_match[i] = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(ass2)[i])-1; if (row_match[i]<0) row_match[i] = -1; } } return 1; }
extern void BackendDAEEXT_getAssignment(modelica_metatype ass1, modelica_metatype ass2) { int i=0; long len1 = MMC_HDRSLOTS(MMC_GETHDR(ass1)); long len2 = MMC_HDRSLOTS(MMC_GETHDR(ass2)); if (n > len1 || m > len2) { char nstr[64],mstr[64],len1str[64],len2str[64]; const char *tokens[4] = {len2str,mstr,len1str,nstr}; snprintf(nstr,64,"%ld", (long) n); snprintf(mstr,64,"%ld", (long) m); snprintf(len1str,64,"%ld", (long) len1); snprintf(len2str,64,"%ld", (long) len2); c_add_message(NULL,-1,ErrorType_symbolic,ErrorLevel_internal,"BackendDAEEXT.getAssignment failed because n=%s>arrayLength(ass1)=%s or m=%s>arrayLength(ass2)=%s",tokens,4); MMC_THROW(); } if (match != NULL) { for(i=0; i<n; ++i) { if (match[i] >= 0) MMC_STRUCTDATA(ass1)[i] = mmc_mk_icon(match[i]+1); else MMC_STRUCTDATA(ass1)[i] = mmc_mk_icon(-1); } } if (row_match != NULL) { for(i=0; i<m; ++i) { if (row_match[i] >= 0) MMC_STRUCTDATA(ass2)[i] = mmc_mk_icon(row_match[i]+1); else MMC_STRUCTDATA(ass2)[i] = mmc_mk_icon(-1); } } }
modelica_metatype arrayCopy(modelica_metatype arr) { int nelts = MMC_HDRSLOTS(MMC_GETHDR(arr)); void* res = (struct mmc_struct*)mmc_mk_box_no_assign(nelts, MMC_ARRAY_TAG); void **arrp = MMC_STRUCTDATA(arr); void **resp = MMC_STRUCTDATA(res); memcpy(resp, arrp, sizeof(modelica_metatype)*nelts); return res; }
modelica_metatype arrayCopy(modelica_metatype arr) { int nelts = MMC_HDRSLOTS(MMC_GETHDR(arr)); void* res = (struct mmc_struct*)mmc_mk_box_no_assign(nelts, MMC_ARRAY_TAG); void **arrp = MMC_STRUCTDATA(arr); void **resp = MMC_STRUCTDATA(res); int i = 0; for(i=0; i<nelts; i++) { resp[i] = arrp[i]; } return res; }
extern void BackendDAEEXT_setIncidenceMatrix(modelica_integer nvars, modelica_integer neqns, modelica_integer nz, modelica_metatype incidencematrix) { int i=0; long int i1; int j=0; modelica_integer nelts = MMC_HDRSLOTS(MMC_GETHDR(incidencematrix)); if (col_ptrs) free(col_ptrs); col_ptrs = (int*) malloc((neqns+1) * sizeof(int)); col_ptrs[neqns]=nz; if (col_ids) free(col_ids); col_ids = (int*) malloc(nz * sizeof(int)); for(i=0; i<neqns; ++i) { modelica_metatype ie = MMC_STRUCTDATA(incidencematrix)[i]; col_ptrs[i] = j; while(MMC_GETHDR(ie) == MMC_CONSHDR) { i1 = MMC_UNTAGFIXNUM(MMC_CAR(ie)); if (i1>0) { col_ids[j++] = i1-1; } ie = MMC_CDR(ie); } } }
modelica_metatype arrayAppend(modelica_metatype arr1, modelica_metatype arr2) { int nelts1 = MMC_HDRSLOTS(MMC_GETHDR(arr1)); int nelts2 = MMC_HDRSLOTS(MMC_GETHDR(arr2)); void* res = (struct mmc_struct*)mmc_mk_box_no_assign(nelts1 + nelts2, MMC_ARRAY_TAG); void **arr1p = MMC_STRUCTDATA(arr1); void **arr2p = MMC_STRUCTDATA(arr2); void **resp = MMC_STRUCTDATA(res); int i; for (i=0; i<nelts1; ++i) { resp[i] = arr1p[i]; } for (i=0; i<nelts2; ++i) { resp[i+nelts1] = arr2p[i]; } return res; }
extern void* HpcOmSchedulerExt_scheduleMetis(modelica_metatype xadjIn, modelica_metatype adjncyIn, modelica_metatype vwgtIn, modelica_metatype adjwgtIn, int npartsIn) { #if defined(_MSC_VER) HPC_OM_VS(); #else int xadjNelts = (int)MMC_HDRSLOTS(MMC_GETHDR(xadjIn)); //number of elements in xadj-array int adjncyNelts = (int)MMC_HDRSLOTS(MMC_GETHDR(adjncyIn)); //number of elements in adjncy-array int vwgtNelts = (int)MMC_HDRSLOTS(MMC_GETHDR(vwgtIn)); //number of elements in vwgt-array int adjwgtNelts = (int)MMC_HDRSLOTS(MMC_GETHDR(adjwgtIn)); //number of elements in adjwgt-array int nparts = npartsIn; int* xadj = (int *) malloc(xadjNelts*sizeof(int)); int* adjncy = (int *) malloc(adjncyNelts*sizeof(int)); int* vwgt = (int *) malloc(vwgtNelts*sizeof(int)); int* adjwgt = (int *) malloc(adjwgtNelts*sizeof(int)); //setup xadj for(int i=0; i<xadjNelts; i++) { int xadjElem = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(xadjIn)[i]); //std::cerr << "xadjElem: " << xadjElem << std::endl; xadj[i] = xadjElem; } //setup adjncy for(int i=0; i<adjncyNelts; i++) { int adjncyElem = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(adjncyIn)[i]); //std::cerr << "adjncyElem: " << adjncyElem << std::endl; adjncy[i] = adjncyElem; } //setup vwgt for(int i=0; i<vwgtNelts; i++) { int vwgtElem = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(vwgtIn)[i]); //std::cerr << "vwgtElem: " << vwgtElem << std::endl; vwgt[i] = vwgtElem; } //setup adjwgt for(int i=0; i<adjwgtNelts; i++) { int adjwgtElem = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(adjwgtIn)[i]); //std::cerr << "adjwgtElem: " << adjwgtElem << std::endl; adjwgt[i] = adjwgtElem; } return HpcOmSchedulerExtImpl__scheduleMetis(xadj, adjncy, vwgt, adjwgt, xadjNelts, adjncyNelts, nparts); }
modelica_metatype arrayList(modelica_metatype arr) { modelica_metatype result; int nelts = MMC_HDRSLOTS(MMC_GETHDR(arr))-1; void **vecp = MMC_STRUCTDATA(arr); void *res = mmc_mk_nil(); for(; nelts >= 0; --nelts) { res = mmc_mk_cons(vecp[nelts],res); } return res; }
extern void* HpcOmSchedulerExt_schedulehMetis(modelica_metatype xadjIn, modelica_metatype adjncyIn, modelica_metatype vwgtIn, modelica_metatype adjwgtIn, int npartsIn) { int vwgtsNelts = (int)MMC_HDRSLOTS(MMC_GETHDR(xadjIn)); //number of elements in xadj-array int eptrNelts = (int)MMC_HDRSLOTS(MMC_GETHDR(adjncyIn)); //number of elements in adjncy-array int eintNelts = (int)MMC_HDRSLOTS(MMC_GETHDR(vwgtIn)); //number of elements in vwgt-array int hewgtsNelts = (int)MMC_HDRSLOTS(MMC_GETHDR(adjwgtIn)); //number of elements in adjwgt-array int nparts = npartsIn; int* vwgts = (int *) malloc(vwgtsNelts*sizeof(int)); int* eptr = (int *) malloc(eptrNelts*sizeof(int)); int* eint = (int *) malloc(eintNelts*sizeof(int)); int* hewgts = (int *) malloc(hewgtsNelts*sizeof(int)); //setup xadj for(int i=0; i<vwgtsNelts; i++) { int xadjElem = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(xadjIn)[i]); std::cerr << "vwgtsElem: " << xadjElem << std::endl; vwgts[i] = xadjElem; } //setup adjncy for(int i=0; i<eptrNelts; i++) { int adjncyElem = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(adjncyIn)[i]); std::cerr << "eptrElem: " << adjncyElem << std::endl; eptr[i] = adjncyElem; } //setup vwgt for(int i=0; i<eintNelts; i++) { int vwgtElem = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(vwgtIn)[i]); std::cerr << "eintElem: " << vwgtElem << std::endl; eint[i] = vwgtElem; } //setup adjwgt for(int i=0; i<hewgtsNelts; i++) { int adjwgtElem = MMC_UNTAGFIXNUM(MMC_STRUCTDATA(adjwgtIn)[i]); std::cerr << "adjwgtElem: " << adjwgtElem << std::endl; hewgts[i] = adjwgtElem; } return HpcOmSchedulerExtImpl__scheduleMetis(vwgts, eptr, eint, hewgts, vwgtsNelts, eptrNelts, nparts); #endif }
modelica_metatype listArray(modelica_metatype lst) { int nelts = listLength(lst); void* arr = (struct mmc_struct*)mmc_mk_box_no_assign(nelts, MMC_ARRAY_TAG); void **arrp = MMC_STRUCTDATA(arr); int i = 0; for(i=0; i<nelts; i++) { arrp[i] = MMC_CAR(lst); lst = MMC_CDR(lst); } return arr; }
void shareEqual(void) { void *p, *q; void **pp, **qq; mmc_uint_t slotsIdx; #if defined(MMC_STATE_APTR) || defined(MMC_STATE_LPTR) struct mmc_state *mmcState = &mmc_state; #endif /*MMC_STATE_APTR || MMC_STATE_LPTR*/ if (*pp != *qq) /* if pointers are different */ { /* check to see if pointers are in young or older */ if (mmc_isYoungOrOlder((void**)MMC_UNTAGPTR(pp)) && mmc_isYoungOrOlder((void**)MMC_UNTAGPTR(qq))) { mmc_uint_t idx = 0; /* point *pp to *qq to have sharing. */ fprintf(stderr, "Sharing %d %p <-> %p\n", slotsIdx, *pp, *qq); fflush(stderr); if (*pp > *qq) /* store qq in pp as pp is > than qq */ { MMC_STRUCTDATA(p)[slotsIdx] = *qq; if (!MMC_ISIMM(*qq)) { /* also check here if the array is not already in the trail */ for (idx = mmc_array_trail_size; &mmc_array_trail[idx] >= mmcATP; idx--) if (mmc_array_trail[idx] == *qq) /* if found, do not add again */ { break; } /* add the address of the array into the roots to be taken into consideration at the garbage collection time */ if( mmcATP == &mmc_array_trail[0] ) { (void)fprintf(stderr, "Array Trail Overflow!\n"); fflush(stderr); mmc_exit(1); } if (!idx) /* we didn't already find it */ *--mmcATP = p; } } else /* store pp in qq as qq is > than pp */ { MMC_STRUCTDATA(q)[slotsIdx] = *pp; if (!MMC_ISIMM(*pp)) { /* also check here if the array is not already in the trail */ for (idx = mmc_array_trail_size; &mmc_array_trail[idx] >= mmcATP; idx--) if (mmc_array_trail[idx] == *pp) /* if found, do not add again */ { break; } /* add the address of the array into the roots to be taken into consideration at the garbage collection time */ if( mmcATP == &mmc_array_trail[0] ) { (void)fprintf(stderr, "Array Trail Overflow!\n"); fflush(stderr); mmc_exit(1); } if (!idx) /* we didn't already find it */ *--mmcATP = q; } } } } }