/* read one character -- slowly */
static int
slow_next(void)
{
while (*buffp == 0) {
if (!eof_flag) {
buffp = buffer;
scan_fillbuff();
} else if (pfile_list /* open another program file */ ) {
PFILE *q;
if (program_fd > 0)
close(program_fd);
eof_flag = 0;
pfile_name = pfile_list->fname;
q = pfile_list;
pfile_list = pfile_list->link;
ZFREE(q);
scan_open();
token_lineno = lineno = 1;
} else {
break; /* real eof */
}
}
return *buffp++; /* note can un_next() , eof which is zero */
}
/*
* parse filename. return a linked list containing all the parsed
* statements if successful, NULL if some error occurred. the
* function automatically logs all errors
*/
section_t *parse (const char *filename)
{
scan_t sc;
section_t *section;
int result;
if ((section = (section_t *) mem_alloc (sizeof (section_t))) == NULL)
{
log_printf (LOG_ERROR,"Out of memory\n");
return (NULL);
}
section->n = 0;
section->name = NULL;
section->stmt = NULL;
section->child = NULL;
log_printf (LOG_VERBOSE,"Opening configuration file: %s\n",filename);
if (scan_open (&sc,filename) < 0)
{
mem_free (section);
return (NULL);
}
result = parse_section (§ion,&sc,NULL);
if (result == FIN) log_printf (LOG_VERBOSE,"Successfully parsed configuration file\n");
scan_close (&sc);
log_printf (LOG_VERBOSE,"Closed configuration file\n");
if (result == ERR) parse_destroy (§ion);
return (section);
}
void
scan_init(const char *cmdline_program)
{
if (cmdline_program) {
program_fd = -1; /* command line program */
program_string = new_STRING0(strlen(cmdline_program) + 1);
strcpy(program_string->str, cmdline_program);
/* simulate file termination */
program_string->str[program_string->len - 1] = '\n';
buffp = (UChar *) program_string->str;
eof_flag = 1;
} else { /* program from file[s] */
scan_open();
buffp = buffer = (UChar *) zmalloc((size_t) (BUFFSZ + 1));
scan_fillbuff();
}
#ifdef OS2 /* OS/2 "extproc" is similar to #! */
if (strnicmp(buffp, "extproc ", 8) == 0)
eat_comment();
#endif
eat_nl(); /* scan to first token */
if (next() == 0) {
/* no program */
mawk_exit(0);
}
un_next();
}
void test_scan_while(){
int fd = open("scanner_test_code", O_RDONLY);
check_msg(fd != -1, "failed to open the scanner_test_code file");
scanner_p scan = scan_open(fd);
slice_t slice;
// Throw the first two lines away
scan_until(scan, &slice, '\n');
check_str(slice.ptr, "\"hello world\"");
free(slice.ptr);
scan_until(scan, &slice, '\n');
check_str(slice.ptr, "\t ");
free(slice.ptr);
int c = scan_while(scan, &slice, '0', '1', '2', '3', '4', '5', '6', '7', '8', '9');
check_msg(c == '\n', "expected newline as terminator but got %d", c);
check_msg(slice.length == 10, "expected length of 10 but got %d", slice.length);
check_str(slice.ptr, "1234567890");
free(slice.ptr);
c = scan_while(scan, &slice, '\n', '-');
check_msg(c == EOF, "expected EOF as terminator but got %d", c);
check_msg(slice.length == 5, "expected length of 10 but got %d", slice.length);
check_str(slice.ptr, "\n----");
free(slice.ptr);
scan_close(scan);
close(fd);
}
void test_scan_until(){
int fd = open("scanner_test_code", O_RDONLY);
check_msg(fd != -1, "failed to open the scanner_test_code file");
scanner_p scan = scan_open(fd);
slice_t slice;
int c = scan_until(scan, &slice, '"');
check_msg(c == '"', "expected terminator \" but got %c (%d)", c, c);
check_msg(slice.length == 0, "expected length of 0 but got %d", slice.length);
check_str(slice.ptr, "");
free(slice.ptr);
c = scan_until(scan, &slice, '"');
check_msg(c == '"', "expected terminator \" but got %c (%d)", c, c);
check_msg(slice.length == 11, "expected length of 11 but got %d", slice.length);
check_str(slice.ptr, "hello world");
free(slice.ptr);
c = scan_until(scan, &slice, EOF);
check_msg(c == EOF, "expected terminator EOF but got %d", c);
check_str(slice.ptr, "\n\t \n1234567890\n----");
free(slice.ptr);
scan_close(scan);
close(fd);
}
void test_scan_until_func(){
int fd = open("scanner_test_code", O_RDONLY);
check_msg(fd != -1, "failed to open the scanner_test_code file");
scanner_p scan = scan_open(fd);
slice_t slice;
int c = scan_until_func(scan, &slice, isspace);
check_msg(c == ' ', "expected a space as terminator but got %d", c);
check_msg(slice.length == 6, "expected length of 6 but got %d", slice.length);
check_str(slice.ptr, "\"hello");
free(slice.ptr);
scan_close(scan);
close(fd);
}
void test_scan_while_func(){
int fd = open("scanner_test_code", O_RDONLY);
check_msg(fd != -1, "failed to open the scanner_test_code file");
scanner_p scan = scan_open(fd);
slice_t slice;
int c = scan_while_func(scan, &slice, ispunct, islower, isblank);
check_msg(c == '\n', "expected newline as terminator but got %c", c);
check_msg(slice.length == 13, "expected length of 13 but got %d", slice.length);
check_str(slice.ptr, "\"hello world\"");
free(slice.ptr);
scan_close(scan);
close(fd);
}
void test_scan_one_of(){
int fd = open("scanner_test_code", O_RDONLY);
check_msg(fd != -1, "failed to open the scanner_test_code file");
scanner_p scan = scan_open(fd);
int c = scan_one_of(scan, '"');
check_msg(c == '"', "expected an \", got %c", c);
// This tests if scan_one_of really consumes one character and not only
// increments the buffer position.
slice_t slice;
c = scan_until(scan, &slice, '"');
check_str(slice.ptr, "hello world");
free(slice.ptr);
c = scan_one_of(scan, '\n');
check_msg(c == '\n', "expected a line break, got %d", c);
c = scan_one_of(scan, ' ', '\n', '\t');
check_msg(c == '\t', "expected a tab, got %d", c);
scan_close(scan);
close(fd);
}
void test_line_and_col_numbers(){
int fd = open("scanner_test_code", O_RDONLY);
check_msg(fd != -1, "failed to open the scanner_test_code file");
scanner_p scan = scan_open(fd);
check_msg(scan->line == 1, "the line number should start with 1 but got %d", scan->line);
check_msg(scan->col == 1, "the column number should start with 1 but got %d", scan->col);
int c = scan_until(scan, NULL, '"');
check_msg(scan->line == 1, "the line number should not change but it did: %d", scan->line);
check_msg(scan->col == 2, "one char consumed, col should be 2 but is %d", scan->col);
c = scan_until(scan, NULL, '"');
check_msg(scan->line == 1, "the line number should not change but it did: %d", scan->line);
check_msg(scan->col == 14, "we're at the end of the first line, col is supposed to be 14 but is %d", scan->col);
c = scan_while_func(scan, NULL, isspace);
check_msg(c == '1', "expected 1 as terminator but got %c", c);
check_msg(scan->line == 3, "the line number should not change but it did: %d", scan->line);
check_msg(scan->col == 1, "we're at the start of the third line, col is supposed to be 1 but is %d", scan->col);
scan_close(scan);
close(fd);
}
int co2_init(file init, co2control_struct* co2, int simyears)
{
int ok = 1;
int i;
char key1[] = "CO2_CONTROL";
char keyword[80];
char junk[80];
file temp;
int reccount = 0;
/********************************************************************
** **
** Begin reading initialization file block starting with keyword: **
** CO2_CONTROL **
** **
********************************************************************/
/* scan for the climate change block keyword, exit if not next */
if (ok && scan_value(init, keyword, 's'))
{
bgc_printf(BV_ERROR, "Error reading keyword, co2_init()\n");
ok=0;
}
if (ok && strcmp(keyword,key1))
{
bgc_printf(BV_ERROR, "Expecting keyword --> %s in %s\n",key1,init.name);
ok=0;
}
/* begin reading co2 control information */
if (ok && scan_value(init, &co2->varco2, 'i'))
{
bgc_printf(BV_ERROR, "Error reading variable CO2 flag: co2_init()\n");
ok=0;
}
if (ok && scan_value(init, &co2->co2ppm, 'd'))
{
bgc_printf(BV_ERROR, "Error reading constant CO2 value: co2_init()\n");
ok=0;
}
/* if using variable CO2 file, open it, otherwise
discard the next line of the ini file */
if (ok && co2->varco2)
{
if (scan_open(init,&temp,'r'))
{
bgc_printf(BV_ERROR, "Error opening annual CO2 file\n");
ok=0;
}
/* Find the number of lines in the file*/
/* Then use that number to malloc the appropriate arrays */
while(fscanf(temp.ptr,"%*lf%*lf") != EOF)
{
reccount++;
}
rewind(temp.ptr);
/* Store the total number of CO2 records found in the co2vals variable */
co2->co2vals = reccount;
bgc_printf(BV_DIAG,"Found: %i CO2 records in co2_init()\n",reccount);
/* allocate space for the annual CO2 array */
if (ok && !(co2->co2ppm_array = (double*) malloc(reccount *
sizeof(double))))
{
bgc_printf(BV_ERROR, "Error allocating for annual CO2 array, co2_init()\n");
ok=0;
}
if (ok && !(co2->co2year_array = (int*) malloc(reccount *
sizeof(int))))
{
bgc_printf(BV_ERROR, "Error allocating for annual CO2 year array, co2_init()\n");
ok=0;
}
/* read year and co2 concentration for each simyear */
for (i=0 ; ok && i<reccount ; i++)
{
if (fscanf(temp.ptr,"%i%lf",
&(co2->co2year_array[i]),&(co2->co2ppm_array[i]))==EOF)
{
bgc_printf(BV_ERROR, "Error reading annual CO2 array, ctrl_init()\n");
bgc_printf(BV_ERROR, "Note: file must contain a pair of values for each\n");
bgc_printf(BV_ERROR, "simyear: year and CO2.\n");
ok=0;
}
/* printf("CO2 value read: %i %lf\n",co2->co2year_array[i],co2->co2ppm_array[i]); */
if (co2->co2ppm_array[i] < 0.0)
{
bgc_printf(BV_ERROR, "Error in co2_init(): co2 (ppm) must be positive\n");
ok=0;
}
}
fclose(temp.ptr);
}
else
{
if (scan_value(init, junk, 's'))
{
bgc_printf(BV_ERROR, "Error scanning annual co2 filename\n");
ok=0;
}
}
if (co2->co2ppm < 0.0)
{
bgc_printf(BV_ERROR, "Error in co2_init(): co2 (ppm) must be positive\n");
ok=0;
}
return (!ok);
}
int epc_init(file init, epconst_struct* epc)
{
int ok = 1;
double t1,t2,t3,t4,r1;
file temp;
char key1[] = "EPC_FILE";
char key2[] = "ECOPHYS";
char keyword[80];
/********************************************************************
** **
** Begin reading initialization file block starting with keyword: **
** EPC_FILES **
** **
********************************************************************/
/* scan for the EPC file keyword, exit if not next */
if (ok && scan_value(init, keyword, 's'))
{
bgc_printf(BV_ERROR, "Error reading keyword for control data\n");
ok=0;
}
if (ok && strcmp(keyword, key1))
{
bgc_printf(BV_ERROR, "Expecting keyword --> %s in file %s\n",key1,init.name);
ok=0;
}
/* open file */
if (ok && scan_open(init,&temp,'r'))
{
bgc_printf(BV_ERROR, "Error opening epconst file, epc_init()\n");
ok=0;
}
/* first scan epc keyword to ensure proper *.init format */
if (ok && scan_value(temp, keyword, 's'))
{
bgc_printf(BV_ERROR, "Error reading keyword, epc_init()\n");
ok=0;
}
if (ok && strcmp(keyword,key2))
{
bgc_printf(BV_ERROR, "Expecting keyword --> %s in %s\n",key2,init.name);
ok=0;
}
/* begin reading constants from *.init */
if (ok && scan_value(temp, &epc->woody, 'i'))
{
bgc_printf(BV_ERROR, "Error reading woody/non-woody flag, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->evergreen, 'i'))
{
bgc_printf(BV_ERROR, "Error reading evergreen/deciduous flag, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->c3_flag, 'i'))
{
bgc_printf(BV_ERROR, "Error reading C3/C4 flag, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->phenology_flag, 'i'))
{
bgc_printf(BV_ERROR, "Error reading phenology flag, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->onday, 'i'))
{
bgc_printf(BV_ERROR, "Error reading onday, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->offday, 'i'))
{
bgc_printf(BV_ERROR, "Error reading offday, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->transfer_pdays, 'd'))
{
bgc_printf(BV_ERROR, "Error reading transfer_pdays, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->litfall_pdays, 'd'))
{
bgc_printf(BV_ERROR, "Error reading litfall_pdays, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->leaf_turnover, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf turnover, epc_init()\n");
ok=0;
}
/* force leaf turnover fraction to 1.0 if deciduous */
if (!epc->evergreen)
{
epc->leaf_turnover = 1.0;
}
epc->froot_turnover = epc->leaf_turnover;
if (ok && scan_value(temp, &epc->livewood_turnover, 'd'))
{
bgc_printf(BV_ERROR, "Error reading livewood turnover, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading whole-plant mortality, epc_init()\n");
ok=0;
}
epc->daily_mortality_turnover = t1/365;
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading fire mortality, epc_init()\n");
ok=0;
}
epc->daily_fire_turnover = t1/365;
if (ok && scan_value(temp, &epc->alloc_frootc_leafc, 'd'))
{
bgc_printf(BV_ERROR, "Error reading froot C:leaf C, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->alloc_newstemc_newleafc, 'd'))
{
bgc_printf(BV_ERROR, "Error reading new stemC:new leaf C, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->alloc_newlivewoodc_newwoodc, 'd'))
{
bgc_printf(BV_ERROR, "Error reading new livewood C:new wood C, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->alloc_crootc_stemc, 'd'))
{
bgc_printf(BV_ERROR, "Error reading croot C:stem C, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->alloc_prop_curgrowth, 'd'))
{
bgc_printf(BV_ERROR, "Error reading new growth:storage growth, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->leaf_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading average leaf C:N, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->leaflitr_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf litter C:N, epc_init()\n");
ok=0;
}
/* test for leaflitter C:N > leaf C:N */
if (epc->leaflitr_cn < epc->leaf_cn)
{
bgc_printf(BV_ERROR, "Error: leaf litter C:N must be >= leaf C:N\n");
bgc_printf(BV_ERROR, "change the values in ECOPHYS block of initialization file\n");
ok=0;
}
if (ok && scan_value(temp, &epc->froot_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading initial fine root C:N, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->livewood_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading initial livewood C:N, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->deadwood_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading initial deadwood C:N, epc_init()\n");
ok=0;
}
/* test for deadwood C:N > livewood C:N */
if (epc->deadwood_cn < epc->livewood_cn)
{
bgc_printf(BV_ERROR, "Error: livewood C:N must be >= deadwood C:N\n");
bgc_printf(BV_ERROR, "change the values in ECOPHYS block of initialization file\n");
ok=0;
}
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf litter labile proportion, epc_init()\n");
ok=0;
}
epc->leaflitr_flab = t1;
if (ok && scan_value(temp, &t2, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf litter cellulose proportion, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &t3, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf litter lignin proportion, epc_init()\n");
ok=0;
}
epc->leaflitr_flig = t3;
/* test for litter fractions sum to 1.0 */
if ( ok && (fabs(t1+t2+t3-1.0) > FLT_COND_TOL) )
{
bgc_printf(BV_ERROR, "Error:\n");
bgc_printf(BV_ERROR, "leaf litter proportions of labile, cellulose, and lignin\n");
bgc_printf(BV_ERROR, "must sum to 1.0. Check initialization file and try again.\n");
ok=0;
}
/* calculate shielded and unshielded cellulose fraction */
if (ok)
{
r1 = t3/t2;
if (r1 <= 0.45)
{
epc->leaflitr_fscel = 0.0;
epc->leaflitr_fucel = t2;
}
else if (r1 > 0.45 && r1 < 0.7)
{
t4 = (r1 - 0.45)*3.2;
epc->leaflitr_fscel = t4*t2;
epc->leaflitr_fucel = (1.0 - t4)*t2;
}
else
{
epc->leaflitr_fscel = 0.8*t2;
epc->leaflitr_fucel = 0.2*t2;
}
}
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading froot litter labile proportion, epc_init()\n");
ok=0;
}
epc->frootlitr_flab = t1;
if (ok && scan_value(temp, &t2, 'd'))
{
bgc_printf(BV_ERROR, "Error reading froot litter cellulose proportion, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &t3, 'd'))
{
bgc_printf(BV_ERROR, "Error reading froot litter lignin proportion, epc_init()\n");
ok=0;
}
epc->frootlitr_flig = t3;
/* test for litter fractions sum to 1.0 */
if ( ok && (fabs(t1+t2+t3-1.0) > FLT_COND_TOL) )
{
bgc_printf(BV_ERROR, "Error:\n");
bgc_printf(BV_ERROR, "froot litter proportions of labile, cellulose, and lignin\n");
bgc_printf(BV_ERROR, "must sum to 1.0. Check initialization file and try again.\n");
ok=0;
}
/* calculate shielded and unshielded cellulose fraction */
if (ok)
{
r1 = t3/t2;
if (r1 <= 0.45)
{
epc->frootlitr_fscel = 0.0;
epc->frootlitr_fucel = t2;
}
else if (r1 > 0.45 && r1 < 0.7)
{
t4 = (r1 - 0.45)*3.2;
epc->frootlitr_fscel = t4*t2;
epc->frootlitr_fucel = (1.0 - t4)*t2;
}
else
{
epc->frootlitr_fscel = 0.8*t2;
epc->frootlitr_fucel = 0.2*t2;
}
}
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading dead wood %% cellulose, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &t2, 'd'))
{
bgc_printf(BV_ERROR, "Error reading dead wood %% lignin, epc_init()\n");
ok=0;
}
epc->deadwood_flig = t2;
/* test for litter fractions sum to 1.0 */
if (ok && (fabs(t1+t2-1.0) > FLT_COND_TOL) )
{
bgc_printf(BV_ERROR, "Error:\n");
bgc_printf(BV_ERROR, "deadwood proportions of cellulose and lignin must sum\n");
bgc_printf(BV_ERROR, "to 1.0. Check initialization file and try again.\n");
ok=0;
}
/* calculate shielded and unshielded cellulose fraction */
if (ok)
{
r1 = t2/t1;
if (r1 <= 0.45)
{
epc->deadwood_fscel = 0.0;
epc->deadwood_fucel = t1;
}
else if (r1 > 0.45 && r1 < 0.7)
{
t4 = (r1 - 0.45)*3.2;
epc->deadwood_fscel = t4*t1;
epc->deadwood_fucel = (1.0 - t4)*t1;
}
else
{
epc->deadwood_fscel = 0.8*t1;
epc->deadwood_fucel = 0.2*t1;
}
}
if (ok && scan_value(temp, &epc->int_coef, 'd'))
{
bgc_printf(BV_ERROR, "Error reading canopy water int coef, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->ext_coef, 'd'))
{
bgc_printf(BV_ERROR, "Error reading canopy light ext coef, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->lai_ratio, 'd'))
{
bgc_printf(BV_ERROR, "Error reading all to projected LA ratio, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->avg_proj_sla, 'd'))
{
bgc_printf(BV_ERROR, "Error reading canopy average projected specific leaf area, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->sla_ratio, 'd'))
{
bgc_printf(BV_ERROR, "Error reading shaded to sunlit SLA ratio, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->flnr, 'd'))
{
bgc_printf(BV_ERROR, "Error reading Rubisco N fraction, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->gl_smax, 'd'))
{
bgc_printf(BV_ERROR, "Error reading gl_smax, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->gl_c, 'd'))
{
bgc_printf(BV_ERROR, "Error reading gl_c, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->gl_bl, 'd'))
{
bgc_printf(BV_ERROR, "Error reading gl_bl, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->psi_open, 'd'))
{
bgc_printf(BV_ERROR, "Error reading psi_close, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->psi_close, 'd'))
{
bgc_printf(BV_ERROR, "Error reading psi_sat, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->vpd_open, 'd'))
{
bgc_printf(BV_ERROR, "Error reading vpd_max, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->vpd_close, 'd'))
{
bgc_printf(BV_ERROR, "Error reading vpd_min, epc_init()\n");
ok=0;
}
fclose(temp.ptr);
return (!ok);
}
int
main(int argc, char **argv)
{
char **real_argv = argv;
struct scan_st *sc;
struct symbol_table *stab;
struct ast *a;
char *source = NULL;
int opt;
int err_count = 0;
#ifdef DEBUG
int run_program = 1;
int dump_symbols = 0;
int dump_program = 0;
int dump_icode = 0;
#endif
#ifdef DEBUG
setvbuf(stdout, NULL, _IOLBF, 0);
#endif
/*
* Get command-line arguments.
*/
while ((opt = getopt(argc, argv, OPTS)) != -1) {
switch(opt) {
#ifdef DEBUG
case 'c':
trace_scheduling++;
break;
#ifdef POOL_VALUES
case 'd':
trace_pool++;
break;
#endif
case 'g':
trace_gc++;
break;
#endif
case 'G':
gc_trigger = atoi(optarg);
break;
#ifdef DEBUG
case 'i':
dump_icode++;
break;
case 'l':
trace_gen++;
break;
case 'm':
trace_vm++;
break;
case 'n':
run_program = 0;
break;
case 'o':
trace_valloc++;
break;
case 'p':
dump_program = 1;
break;
case 's':
dump_symbols = 1;
break;
case 'v':
trace_activations++;
break;
case 'y':
trace_type_inference++;
break;
#endif
case '?':
default:
usage(argv);
}
}
argc -= optind;
argv += optind;
if (*argv != NULL)
source = *argv;
else
usage(real_argv);
#ifdef POOL_VALUES
value_pool_new();
#endif
gc_target = gc_trigger;
if ((sc = scan_open(source)) != NULL) {
stab = symbol_table_new(NULL, 0);
global_ar = activation_new_on_heap(100, NULL, NULL);
register_std_builtins(stab);
report_start();
a = parse_program(sc, stab);
scan_close(sc);
#ifdef DEBUG
if (dump_symbols)
symbol_table_dump(stab, 1);
if (dump_program) {
ast_dump(a, 0);
}
#endif
#ifndef DEBUG
symbol_table_free(stab);
types_free();
#endif
err_count = report_finish();
if (err_count == 0) {
struct iprogram *ip;
struct vm *vm;
struct process *p;
unsigned char *program;
program = bhuna_malloc(16384);
ip = ast_gen_iprogram(a);
iprogram_eliminate_nops(ip);
iprogram_eliminate_useless_jumps(ip);
iprogram_optimize_tail_calls(ip);
iprogram_optimize_push_small_ints(ip);
iprogram_eliminate_dead_code(ip);
iprogram_gen(&program, ip);
#ifdef DEBUG
if (dump_icode > 0)
iprogram_dump(ip, program);
#endif
vm = vm_new(program, 16384);
vm_set_pc(vm, program);
vm->current_ar = global_ar;
p = process_new(vm);
/* ast_dump(a, 0); */
if (RUN_PROGRAM) {
process_scheduler();
}
vm_free(vm);
bhuna_free(program);
/*value_dump_global_table();*/
}
ast_free(a); /* XXX move on up */
/* gc(); */ /* actually do a full blow out at the end */
/* activation_free_from_stack(global_ar); */
#ifdef DEBUG
symbol_table_free(stab);
types_free();
if (trace_valloc > 0) {
/*
value_dump_global_table();
*/
printf("Created: %8d\n", num_vars_created);
printf("Cached: %8d\n", num_vars_cached);
printf("Freed: %8d\n", num_vars_freed);
}
if (trace_activations > 0) {
printf("AR's alloc'ed: %8d\n", activations_allocated);
printf("AR's freed: %8d\n", activations_freed);
}
#ifdef POOL_VALUES
if (trace_pool > 0) {
pool_report();
}
#endif
#endif
return(0);
} else {
fprintf(stderr, "Can't open `%s'\n", source);
return(1);
}
}
