int main(int argc, char *argv[]) {
#define CHECK(expr,cod) if(!(expr)) \
{code=(cod); goto abort;}
enum ArchonErrors {
AE_SUCCESS,AE_FORMAT,AE_MEMORY,
AE_INT,AE_SOURCE,AE_DEST,AE_NULL
};
int code = 0; FILE *ff=NULL;
#ifdef VERBOSE
clock_t t0 = clock();
static char *errors[AE_NULL] = { NULL,
"Usage: archon4r0 [e|d] <source> <dest>",
"Memory allocation error!",
"Internal program error - sorry!",
"Source has no read permission!",
"Dest has no write permission!"
};
#endif //VERBOSE
setbuf(stdout,NULL);
printf("%s\n",IDENT);
CHECK(argc>=4,AE_FORMAT);
ff = fopen(argv[2],"rb");
CHECK(ff,AE_SOURCE);
fseek(ff,0,SEEK_END);
CHECK(geninit(ff),AE_MEMORY);
fclose(ff);
ff = fopen(argv[argc-1],"wb");
CHECK(ff,AE_DEST);
if(argv[1][0] == 'e') {
clock_t t1;
CHECK(gencode(),AE_MEMORY);
printf("memory: %d meg\n",memory>>20);
printf("Processing...\t");
//Suffix Array Construction
t1 = clock();
CHECK(compute()>=0,AE_INT);
printime("SAC",t1);
#ifdef VERIFY
printf("Verifying...\t");
t1 = verify();
printf("\nresult: %s\n",t1?"bad":"good");
#endif //VERIFY
CHECK(encode(ff)>=0,AE_INT);
genprint();
}else if(argv[1][0] == 'd') {
static void geninit P2 (const EXPR *, ep, unsigned char *, data)
{
UNUSEDARG (data);
if (!code_option)
return;
switch (ep->nodetype) {
case en_list:
for (; ep != NIL_EXPR; ep = ep->v.p[1]) {
geninit (ep->v.p[0], data);
}
break;
case en_icon:
case en_fcon:
case en_str:
geninittype (ep, data);
break;
case en_litval:
geninit (ep->v.p[0], data);
break;
default:
CANNOT_REACH_HERE ();
}
}
void g_init P1 (const EXPR *, ep)
{
unsigned char *data;
SIZE size;
switch (ep->nodetype) {
case en_literal:
size = (SIZE) ep->v.p[1]->v.i;
data = xalloc ((size_t) size);
VOIDCAST memset (data, 0, (size_t) size);
geninit (ep->v.p[0], data);
break;
default:
CANNOT_REACH_HERE ();
}
}
void
readfile( void )
{
VMRef v;
Symbol * s;
word op = 0;
/*
* Quick Test.
* Determine if the first byte in the input file is a GHOF
* directive. If not then do not bother to parse the rest
* of the file.
*/
op = getc( infd );
if (op >= 0x40)
{
#if defined __ARM && (defined RS6000 || defined __SUN4)
/* only support AOF -> GHOF conversion when cross linking */
if (op == 0xC3 || op == 0xC5)
{
s_aof * pAOF;
uword iCodeSize;
char * pTempFileName;
trace( "Assuming file is in AOF format" );
pTempFileName = malloc( strlen( infile_duplicate ) + 5 /* strlen( ".ghof" ) */ + 1 );
if (pTempFileName == NULL)
{
error( "Out of memory allocating temporary file name" );
return;
}
strcpy( pTempFileName, infile_duplicate );
strcat( pTempFileName, ".ghof" );
file_trace( "creating GHOF copy of AOF file '%s'", infile_duplicate );
pAOF = open_aof( infile_duplicate );
if (pAOF == NULL)
{
error( "Failed to reopen file in AOF mode" );
return;
}
(void)convert_aof( pAOF, pTempFileName, bSharedLib, bTinyModel, bDeviceDriver );
/* Open the temporary file again */
file_trace( "opening GHOF copy '%s'", pTempFileName );
infd = freopen( pTempFileName, "rb", infd );
if (infd == NULL)
{
error( "Unable to reopen temporary file %s", pTempFileName );
return;
}
else
file_trace( "copy opened" );
free( pTempFileName );
/* drop throiugh into normal readfile() code */
}
else
#endif /* __ARM and (RS6000 or __SUN4) */
{
error( "Input file is not in GHOF format" );
return;
}
}
else
{
ungetc( (char)op, infd );
}
do
{
op = rdint();
trace("OP = %x, curloc = %x, codepos = %x",op,curloc, codepos);
switch( op )
{
default:
error( "Illegal linker directive '%x'", op );
break;
case EOF: return;
case OBJCODE:
{
word size = rdint();
if (size < 0)
error( "Negative sized code directive encountered (%x)", size );
trace("CODE %d",size);
while( size-- ) genbyte(rdch());
break;
}
case OBJBSS:
{
word size = rdint();
if (size < 0)
error("Negative sized bss defined");
trace("BSS %d",size);
while( size-- ) genbyte(0L);
break;
}
case OBJWORD:
genpatch( OBJWORD );
break;
case OBJSHORT:
genpatch( OBJSHORT );
break;
case OBJBYTE:
genpatch( OBJBYTE );
break;
case OBJINIT:
geninit();
break;
case OBJMODULE:
genmodule(rdint());
break;
case OBJBYTESEX:
if( bytesex != 0 ) error("bytesex already set");
bytesex = rdint();
trace("BYTESEX %d",bytesex);
break;
case OBJREF:
v = rdsymb();
movesym(v); /* XXX - all REF symbols are implicitly global */
refsymbol_nondef(v);
break;
case OBJGLOBAL:
v = rdsymb();
s = VMAddr(Symbol,v);
movesym(v);
if (s->referenced)
{
refsymbol_def(v);
}
break;
case OBJLABEL:
v = rdsymb();
s = VMAddr(Symbol,v);
trace("LABEL %s",s->name);
if( s->type != S_UNBOUND )
{
if (!inlib)
warn( "Duplicate definition of symbol '%s' defined in file '%s'", s->name, s->file_name );
}
else
{
if (s->AOFassumedData)
{
error( "(AOF) Symbol '%s' has been assumed to be data in file '%s'",
s->name, s->file_name );
s->AOFassumedData = FALSE;
}
copycode();
s->type = S_CODESYMB;
s->value.v = codeptr();
s->module = curmod;
s->file_name = infile_duplicate;
if (s->referenced)
refsymbol_def(v);
{
int len = strlen( s->name );
/* hack to insert correct name for resident libraries */
VMlock( v );
if (len > 8 &&
strcmp( s->name + len - 8, ".library" ) == 0 &&
VMAddr( asm_Module, curmod )->id != -1 )
{
VMAddr( asm_Module, curmod )->file_name = s->name;
}
VMunlock( v );
}
}
break;
case OBJDATA:
case OBJCOMMON:
{
word size = rdint();
if (size < 0)
error("Negative sized data/common directive encountered");
v = rdsymb();
s = VMAddr(Symbol,v);
trace("%s %d %s",op== OBJDATA ? "DATA" : "COMMON",size,s->name);
if( s->type != S_UNBOUND )
{
if( s->type != S_COMMSYMB)
{
if (!inlib)
warn("Duplicate data definition of symbol '%s' defined in file '%s'",s->name, s->file_name);
}
else {
if( s->value.w < size )
s->value.w = size;
}
}
else {
s->type = op== OBJDATA ? S_DATASYMB : S_COMMSYMB;
s->value.w = size;
s->module = curmod;
s->file_name = infile_duplicate;
if(s->referenced)
refsymbol_def(v);
}
(void)newcode(op,0,0,curloc,v);
break;
}
case OBJCODETABLE:
{
if (!smtopt)
error("CODETABLE directive encountered without split module table mode set");
v = rdsymb();
s = VMAddr(Symbol,v);
#if 0 /* problems for .MaxCodeP */
movesym(v); /* implicit global directive */
#endif
trace("%s %s","CODETABLE",s->name);
if ( s->type != S_UNBOUND )
{
if (!inlib)
warn("Duplicate definition of symbol '%s' defined in file '%s'",
s->name, s->file_name);
}
else
{
if (s->AOFassumedData)
{
error( "(AOF) Symbol '%s' has been assumed to be data in file '%s'",
s->name, s->file_name );
s->AOFassumedData = FALSE;
}
s->type = S_FUNCSYMB;
s->value.w = 4;
s->module = curmod;
s->file_name = infile_duplicate;
if(s->referenced)
refsymbol_def(v);
}
(void)newcode(op,0,0,curloc,v);
break;
}
}
}
while( op != EOF );
return;
}
int main(int argc, char **argv)
{
char buf[1024];
Stab *globls;
Optctx ctx;
size_t i;
outfile = NULL;
optinit(&ctx, "cd:?hSo:I:9G:", argv, argc);
asmsyntax = Defaultasm;
while (!optdone(&ctx)) {
switch (optnext(&ctx)) {
case 'o':
outfile = ctx.optarg;
break;
case 'S':
writeasm = 1;
break;
case '?':
case 'h':
usage(argv[0]);
exit(0);
break;
case 'c':
extracheck = 1;
break;
case 'd':
while (ctx.optarg && *ctx.optarg)
debugopt[*ctx.optarg++ & 0x7f]++;
break;
case '9':
asmsyntax = Plan9;
break;
case 'G':
if (!strcmp(ctx.optarg, "e"))
asmsyntax = Gnugaself;
else if (!strcmp(ctx.optarg, "m"))
asmsyntax = Gnugasmacho;
else
die("unknown gnu syntax flavor");
break;
case 'I':
lappend(&incpaths, &nincpaths, ctx.optarg);
break;
default:
usage(argv[0]);
exit(0);
break;
}
}
lappend(&incpaths, &nincpaths, Instroot "/lib/myr");
if (ctx.nargs == 0) {
fprintf(stderr, "No input files given\n");
exit(1);
}
else if (ctx.nargs > 1)
outfile = NULL;
for (i = 0; i < ctx.nargs; i++) {
globls = mkstab(0);
tyinit(globls);
tokinit(ctx.args[i]);
file = mkfile(ctx.args[i]);
file->file.globls = globls;
yyparse();
/* before we do anything to the parse */
if (debugopt['T'])
dump(file, stdout);
infer(file);
if (hasmain(file))
geninit(file);
tagexports(file, 0);
/* after all type inference */
if (debugopt['t'])
dump(file, stdout);
if (writeasm) {
if (outfile != NULL)
swapout(buf, sizeof buf, ".s");
else
swapsuffix(buf, sizeof buf, ctx.args[i], ".myr", ".s");
} else {
gentempfile(buf, sizeof buf, ctx.args[i], ".s");
}
genuse(ctx.args[i]);
gen(file, buf);
assemble(buf, ctx.args[i]);
}
return 0;
}
/* Main program */
int main(int argc, char *argv[]){
unsigned int g, i; /* Counters. Reps counter, geno counter */
unsigned int reps; /* Length of simulation (no. of introductions of neutral site) */
double Bcheck = 0; /* Frequency of B after each reproduction */
double Acheck = 0; /* Frequency of polymorphism */
double Hsum = 0; /* Summed heterozygosity over transit time of neutral allele */
/* GSL random number definitions */
const gsl_rng_type * T;
gsl_rng * r;
/* This reads in data from command line. */
if(argc != 8){
fprintf(stderr,"Invalid number of input values.\n");
exit(1);
}
N = strtod(argv[1],NULL);
s = strtod(argv[2],NULL);
rec = strtod(argv[3],NULL);
sex = strtod(argv[4],NULL);
self = strtod(argv[5],NULL);
gc = strtod(argv[6],NULL);
reps = strtod(argv[7],NULL);
/* Arrays definition and memory assignment */
double *genotype = calloc(10,sizeof(double)); /* Genotype frequencies */
unsigned int *gensamp = calloc(10,sizeof(unsigned int)); /* New population samples */
/* create a generator chosen by the
environment variable GSL_RNG_TYPE */
gsl_rng_env_setup();
if (!getenv("GSL_RNG_SEED")) gsl_rng_default_seed = time(0);
T = gsl_rng_default;
r = gsl_rng_alloc(T);
/* Initialising genotypes */
geninit(genotype);
/* Run simulation for 2000 generations to create a burn in */
for(g = 0; g < 2000; g++){
/* Selection routine */
selection(genotype);
/* Reproduction routine */
reproduction(genotype);
/* Gene conversion routine */
gconv(genotype);
/* Sampling based on new frequencies */
gsl_ran_multinomial(r,10,N,genotype,gensamp);
for(i = 0; i < 10; i++){
*(genotype + i) = (*(gensamp + i))/(1.0*N);
}
/* Printing out results (for testing) */
/*
for(i = 0; i < 10; i++){
printf("%.10lf ", *(genotype + i));
}
printf("\n");
*/
}
/* Reintroducing neutral genotype, resetting hap sum */
neutinit(genotype,r);
Bcheck = ncheck(genotype);
Hsum = Bcheck*(1-Bcheck);
/* printf("%.10lf %.10lf\n",Bcheck,Hsum); */
/* Introduce and track neutral mutations 'reps' times */
g = 0;
while(g < reps){
/* Selection routine */
selection(genotype);
/* Reproduction routine */
reproduction(genotype);
/* Gene conversion routine */
gconv(genotype);
/* Sampling based on new frequencies */
gsl_ran_multinomial(r,10,N,genotype,gensamp);
for(i = 0; i < 10; i++){
*(genotype + i) = (*(gensamp + i))/(1.0*N);
}
/* Checking state of haplotypes: if B fixed reset so can start fresh next time */
Bcheck = ncheck(genotype);
Hsum += Bcheck*(1-Bcheck);
/* printf("%.10lf %.10lf\n",Bcheck,Hsum); */
/* If polymorphism fixed then abandon simulation */
Acheck = pcheck(genotype);
if(Acheck == 0){
g = reps;
}
if(Bcheck == 0 || Bcheck == 1){
printf("%.10lf\n",Hsum);
g++;
/* printf("Rep Number %d\n",g); */
if(Bcheck == 1){
/* Reset genotypes so B becomes ancestral allele */
*(genotype + 0) = *(genotype + 7);
*(genotype + 1) = *(genotype + 8);
*(genotype + 4) = *(genotype + 9);
*(genotype + 7) = 0;
*(genotype + 8) = 0;
*(genotype + 9) = 0;
}
/* Reintroducing neutral genotype, resetting hap sum */
neutinit(genotype,r);
Bcheck = ncheck(genotype);
Hsum = Bcheck*(1-Bcheck);
}
} /* End of simulation */
/* Freeing memory and wrapping up */
gsl_rng_free(r);
free(gensamp);
free(genotype);
/* printf("The End!\n"); */
return 0;
}
