/******************************************************************************
Make a mosaic with the objects in their original relative positions.
*/
static rc_t mosaic_org(gras_t *gr, const objl_t *ol,
unsigned bg, unsigned fg, int mflags,
const gras_t *gr_o) {
pixl_t org ;
int o,nx,ny,x,y,xo,yo ;
rc_t check ;
const char *me = "mosaic_org" ;
pixl_init(&org,ORG_CHUNK) ;
if (gr_o) {
nx = gr_o->nx ; ny = gr_o->ny ; xo = yo = 0 ;
} else {
xo = yo = INT_MAX ; nx = ny = 0 ;
for(o=0;o<ol->n;o++) {
xo = MIN(xo,ol->obj[o]->xorg) ;
yo = MIN(yo,ol->obj[o]->yorg) ;
nx = MAX(nx,ol->obj[o]->xorg + ol->obj[o]->nx) ;
ny = MAX(ny,ol->obj[o]->yorg + ol->obj[o]->ny) ;
} ;
nx -= xo ; ny -= yo ;
xo += BORDER ; yo += BORDER ; nx += 2*BORDER ; ny += 2*BORDER ;
} ;
for(o=0;o<ol->n;o++) {
x = ol->obj[o]->xorg - xo ;
y = ol->obj[o]->yorg - yo ;
if (pixl_add(&org,y,x) != OK) return(memfail(__FILE__,__LINE__,me)) ;
} ;
check = mosaic(gr,ol,&org,ny,nx,bg,fg,mflags) ;
pixl_free(&org) ;
return(check) ;
}
/******************************************************************************
The basic mosaic maker.
org = list of origins for the objects.
ny,nx = size of the mosaic raster.
bg = color of pixels not part of any object.
fg = color of object pixels when (flags & MOSAIC_SILH).
*/
static rc_t mosaic(gras_t *gr, const objl_t *ol, const pixl_t *org,
int ny, int nx, unsigned bg, unsigned fg, int flags) {
int i,j,nx_y,x,y,o ;
double xcom,ycom ;
obj_t *ob ;
const char *me = "mosaic" ;
if (gras_chksz(gr,ny,nx) != OK) return(memfail(__FILE__,__LINE__,me)) ;
for(i=0;i<ny;i++) for(j=0;j<nx;j++) gr->ras[i][j] = bg ;
if (flags & MOSAIC_GRID) gras_paint_grid(gr,0,0,100,100,255) ;
if (flags & MOSAIC_OBJ_VLINE)
for(o=0;o<ol->n;o++) gras_paint_vline(gr,org->x[o] - BORDER/2,255) ;
for(o=0;o<ol->n;o++) {
ob = ol->obj[o] ;
for(i=0;i<ob->ny;i++) {
nx_y = ob->nx_y[i] ;
for(j=0;j<nx_y;j++) {
y = org->y[o] + ob->yras[i][j] ;
x = org->x[o] + ob->xras[i][j] ;
gr->ras[y][x] = ((flags & MOSAIC_SILH) ? fg : ob->gras[i][j]) ;
} ;
} ;
if (flags & MOSAIC_ID) {
geo_com_rel(ob,&ycom,&xcom) ;
y = org->y[o] + (int)floor(ycom) ;
x = org->x[o] + (int)floor(xcom) ;
gras_paint_number(gr,y,x,o) ;
} ;
} ;
gras_maxmin(gr) ;
return(OK) ;
}
/******************************************************************************
Sort objects in an object list by floating point property prop.
If plist != 0 copy into it the sorted list of the values of the property.
*/
static rc_t geo_sort_f(objl_t *ol, geo_t prop, double *plist) {
double *crit ;
int o ;
const char *me = "geo_sort_f" ;
if (prop == GEO_NONE) return(OK) ;
if (!(crit = (double *)malloc(ol->n * sizeof(double))))
return(memfail(__FILE__,__LINE__,me)) ;
switch (prop) {
case GEO_ASPECT :
for(o=0;o<ol->n;o++) crit[o] = geo_aspect(ol->obj[o]) ;
break ;
case GEO_RG :
for(o=0;o<ol->n;o++) crit[o] = geo_rg2(ol->obj[o]) ;
break ;
case GEO_RRG :
for(o=0;o<ol->n;o++) crit[o] = geo_rrg2(ol->obj[o]) ;
break ;
default :
return(punt(__FILE__,__LINE__,me,"bad property specified.")) ;
} ;
sort_dx_desc(ol->n,crit,(void **)ol->obj) ;
if (plist && memcpy(plist,crit,ol->n * sizeof(double))) ;
free(crit) ;
return(OK) ;
}
static remset_t *
create_labelled_remset_with_owner_attrib
( int tbl_entries, /* size of hash table, 0=default */
int pool_entries, /* size of remset, 0 = default */
int major_id, /* for stats */
int minor_id, /* for stats */
unsigned owner_attrib
)
{
word *heapptr;
remset_t *rs;
remset_data_t *data;
pool_t *p;
assert( tbl_entries >= 0 && (tbl_entries == 0 || ilog2( tbl_entries ) != -1));
assert( pool_entries >= 0 );
if (pool_entries == 0) pool_entries = DEFAULT_REMSET_POOLSIZE;
if (tbl_entries == 0) tbl_entries = DEFAULT_REMSET_TBLSIZE;
annoyingmsg( "Allocated remembered set\n hash=%d pool=%d",
tbl_entries, pool_entries );
rs = (remset_t*)must_malloc( sizeof( remset_t ) );
data = (remset_data_t*)must_malloc( sizeof( remset_data_t ) );
while(1) {
heapptr = gclib_alloc_rts( tbl_entries*sizeof(word),
owner_attrib );
if (heapptr != 0) break;
memfail( MF_RTS, "Can't allocate table and SSB for remembered set." );
}
/* Hash table */
data->tbl_bot = heapptr;
heapptr += tbl_entries;
data->tbl_lim = heapptr;
/* Node pool */
p = allocate_pool_segment( pool_entries, data->mem_attribute ); /* XXX */
data->first_pool = data->curr_pool = p;
assert( data->curr_pool != 0 );
data->numpools = 1;
/* Misc */
memset( &data->stats, 0, sizeof( data->stats ));
data->pool_entries = pool_entries;
data->self = stats_new_remembered_set( major_id, minor_id );
data->mem_attribute = owner_attrib;
rs->live = 0;
rs->has_overflowed = FALSE;
rs->data = data;
rs_clear( rs );
return rs;
}
/*************************************************************************
Allocate memory.
*/
static int check_memory(int o, int n) {
static double *udat = 0 ;
static double *vdat = 0 ;
static double *cvmdat = 0 ;
static int osz = 0 ;
static int nsz = 0 ;
int ow,nw,i ;
const char *me = "check_memory" ;
ow = osz ;
if (o > osz) {
ow = MAX(o,osz + O_CHUNK) ;
if (!(vdat = (double * )realloc(vdat,ow*ow * sizeof(double ))) ||
!(v = (double **)realloc(v,ow * sizeof(double *))) ||
!(w = (double * )realloc(w,ow * sizeof(double ))) ||
!(f = (double * )realloc(f,ow * sizeof(double ))) ||
!(cvmdat = (double * )realloc(cvmdat,ow*ow * sizeof(double ))) ||
!(cvm = (double **)realloc(cvm,ow * sizeof(double *))) )
return(memfail(__LINE__,me)) ;
for(i=0;i<ow;i++) v[i] = vdat + i*ow ;
for(i=0;i<ow;i++) cvm[i] = cvmdat + i*ow ;
} ;
nw = nsz ;
if (n > nsz) {
nw = MAX(n,nsz + N_CHUNK) ;
if (!(b = (double * )realloc(b,nw * sizeof(double ))) ||
!(u = (double **)realloc(u,nw * sizeof(double *))) )
return(memfail(__LINE__,me)) ;
} ;
if ((ow != osz) || (nw != nsz)) {
if (!(udat = (double * )malloc(nw*ow * sizeof(double))))
return(memfail(__LINE__,me)) ;
for(i=0;i<nw;i++) u[i] = udat + i*ow ;
} ;
osz = ow ; nsz = nw ;
return(OK) ;
}
void *osdep_alloc_aligned( int bytes )
{
byte *p, *q;
again:
p = (byte*)malloc( bytes+4096 );
if (p == 0) {
memfail( MF_MALLOC, "Failed to allocate %d bytes heap memory.", bytes );
goto again;
}
q = (byte*)roundup( (word)p, 4096 );
fragmentation += 4096;
register_pointer( q, p );
return q;
}
void *must_realloc( void *ptr, unsigned bytes )
{
void *p;
again:
p = realloc( ptr, bytes );
#if 0
supremely_annoyingmsg( "Re-allocating %u bytes", bytes);
#endif
if (p == 0) {
memfail( MF_REALLOC, "Could not allocate RTS-internal data." );
goto again;
}
return p;
}
/******************************************************************************
General linear least squares fit routine
from section 15.4 of Numerical Recipes.
yfit(x) = function which fills f[i],i=0..o-1 with the o
fitting functions evaluated at x.
fom = if nonzero figure-of-merit is returned here.
a = fitting parameters
av = if (av) error variances for the fitting parameters returned here.
x = n abscissas
y = n ordinates
ys = if (ys) = n error standard deviations for y values
tol = smallest fraction of maximum singular value (eigenvalues, roughly)
which a small singular value can equal -- smaller values are
set to zero, assumed to indicate redundancy. NR suggests
of order 10^-6
n = number of abscissas.
o = number of fitting parameters.
*/
static fit_rc fit_lsq(void (*yfit)(), double *fom, double *a, double *av,
const double *x, const double *y, const double *ys,
double tol, int n, int o) {
double wmax,wmin,xsq,sum ;
int i,j ;
const char *me = "fit_lsq" ;
if (check_memory(o,n) != OK) return(memfail(__LINE__,me)) ;
for(i=0;i<n;i++) {
yfit(x[i]) ;
for(j=0;j<o;j++) u[i][j] = f[j] * (ys ? 1.0/ys[i] : 1.0) ;
} ;
memcpy(b,y,n*sizeof(double)) ;
if (ys) for(i=0;i<n;i++) b[i] /= ys[i] ;
if (svdcmp(u,n,o) != OK)
return(punt(__LINE__,me,"singular value decomposition failed.")) ;
wmax = 0.0 ;
for(wmax=0.0,j=0;j<o;j++) if (w[j] > wmax) wmax = w[j] ;
wmin = tol * wmax ;
for(j=0;j<o;j++) if (w[j] < wmin) w[j] = 0.0 ;
if (svbksb(a,n,o) != OK)
return(punt(__LINE__,me,"back substitution failed.")) ;
if (av) {
if (svdvar(o) != OK)
return(punt(__LINE__,me,"variance calculation failed.")) ;
for(i=0;i<o;i++) av[i] = cvm[i][i] ;
} ;
if (fom) {
xsq = 0.0 ;
for(i=0;i<o;i++) {
yfit(x[i]) ;
sum = 0.0 ;
for(j=0;j<o;j++) sum += a[j] * f[j] ;
sum = (y[i] - sum)/(ys ? ys[i]*ys[i] : 1.0) ;
xsq += sum*sum ;
} ;
*fom = xsq ;
} ;
return(OK) ;
}
/******************************************************************************
Prune objects from a list which have floating point properties >min, <max.
*/
rc_t geo_prune_f(objl_t *ol, geo_t prop, double min, double max) {
double *crit ;
int omin,omax ;
const char *me = "geo_prune_f" ;
if (prop == GEO_NONE) return(OK) ;
if (!(crit = (double *)malloc(ol->n * sizeof(double))))
return(memfail(__FILE__,__LINE__,me)) ;
if (geo_sort_f(ol,prop,crit) != OK) return(subfail(__FILE__,__LINE__,me)) ;
for(omin=0;(omin<ol->n) && (crit[omin] > max);omin++) ;
for(omax=omin;(omax<ol->n) && (crit[omax] > min);omax++) ;
memmove(ol->obj,ol->obj+omin,(omax-omin)*sizeof(obj_t *)) ;
ol->n = (omax-omin) ;
free(crit) ;
return(OK) ;
}
young_heap_t *
create_nursery( int gen_no,
gc_t *gc, /* the owning GC */
nursery_info_t *info, /* creation parameters */
word *globals /* the globals array (not in heap) */
)
{
int size_bytes = info->size_bytes;
young_data_t *data;
young_heap_t *heap;
heap = allocate_nursery( gen_no, gc );
data = heap->data;
assert( size_bytes >= GC_LARGE_OBJECT_LIMIT + MAX_STACK_FRAME );
size_bytes = roundup_page( size_bytes );
data->globals = globals;
data->heapsize = size_bytes;
again2:
data->heapbot = (word*)gclib_alloc_heap( size_bytes, data->gen_no );
if (data->heapbot == 0) {
memfail( MF_HEAP, "young-heap: Could not allocate heap data area." );
goto again2;
}
data->heaplim = data->heapbot + bytes2words(size_bytes);
/* Setup heap pointers needed by RTS */
globals[ G_EBOT ] = (word)(data->heapbot);
globals[ G_ETOP ] = (word)(data->heapbot);
globals[ G_ELIM ] = (word)(data->heaplim);
/* Must be set up before stack can be initialized */
globals[ G_STKP ] = globals[ G_ELIM ];
globals[ G_STKUFLOW ] = 0;
heap->maximum = DATA(heap)->heapsize;
heap->allocated = 0;
return heap;
}
/******************************************************************************
Make one long strip mosaic.
*/
static rc_t mosaic_strip(gras_t *gr, const objl_t *ol,
unsigned bg, unsigned fg, int mflags) {
pixl_t org ;
int o,nx,ny,x,y ;
rc_t check ;
const char *me = "mosaic_strip" ;
pixl_init(&org,ORG_CHUNK) ;
nx = 0 ; ny = 0 ;
for(o=0;o<ol->n;o++) {
x = (nx += BORDER) ; y = BORDER ;
if (pixl_add(&org,y,x) != OK) return(memfail(__FILE__,__LINE__,me)) ;
ny = MAX(ny,ol->obj[o]->ny) ;
nx += ol->obj[o]->nx ;
} ;
ny += 2*BORDER ;
check = mosaic(gr,ol,&org,ny,nx,bg,fg,mflags) ;
pixl_free(&org) ;
return(check) ;
}
/******************************************************************************
Sort objects in an object list by integer property prop.
If plist != 0 copy into it the sorted list of the values of the property.
*/
static rc_t geo_sort_i(objl_t *ol, geo_t prop, int *plist) {
int *crit ;
int o ;
const char *me = "geo_sort_i" ;
if (prop == GEO_NONE) return(OK) ;
if (!(crit = (int *)malloc(ol->n * sizeof(int))))
return(memfail(__FILE__,__LINE__,me)) ;
switch (prop) {
case GEO_AREA :
for(o=0;o<ol->n;o++) crit[o] = ol->obj[o]->n ;
break ;
default :
return(punt(__FILE__,__LINE__,me,"bad property specified.")) ;
} ;
sort_ix_desc(ol->n,crit,(void **)ol->obj) ;
if (plist) memcpy(plist,crit,ol->n * sizeof(int)) ;
free(crit) ;
return(OK) ;
}
void *must_malloc( unsigned bytes )
{
void *p;
#ifdef __MWERKS__
/* Default CodeWarrior behavior is to return NULL if malloc is
called with 0. (Not ANSI compliant; stupid; etc.) */
bytes = max( bytes, 1 );
#endif /* __MWERKS__ */
again:
p = malloc( bytes );
bytes_allocated_by_malloc += bytes;
#if 0
supremely_annoyingmsg( "Allocating %u bytes; total = %u bytes",
bytes, bytes_allocated_by_malloc);
#endif
if (p == 0) {
memfail( MF_MALLOC, "Could not allocate RTS-internal data." );
goto again;
}
return p;
}
