int code_block(ASTNode block,int BASEREG){
CODE86 *code;
PRAGMA *prag;
char *labelmp;
int skiplink=0;
ASTNode p=block->firstchild;
ASTNode pp;
//fprintf(stderr,"enter a block\n");
while(p){
switch(p->type){
case VarDecl:
/* no need to generate code for var decl */
p->codes.head=p->codes.tail=NULL;
break;
case ConstDecl:
p->codes.head=p->codes.tail=NULL;
code_blockconst(p,BASEREG);
break;
case FuncDecl:
/* no need to generate code for funcdecl */
p->codes.head=p->codes.tail=NULL;
break;
case CompilerDirective:
//fprintf(stderr,"***************get one directive *\n");
prag=check_pragma(p->str);
p->codes.head=p->codes.tail=NULL;
if(prag->type==OMP){
pp=p->nextsibling;
if( omp_flag){
code_error("not suppored omp in another omp directive\n");
}
else if( (pp==NULL)||(pp->type==VarDecl) || (pp->type==ConstDecl) ||(pp->type==FuncDecl) ){
code_error("pragma omp must be followed by a stmt\n");
break;
}else{
omp_flag=1;
labelmp=code_omp_stmt(pp,BASEREG);
/* pushl 0 *2 */
code=newcode(OP_PUSHL,newdessrc(IMM,0,NULL,NONE,0,0),NULL,NULL);
code_link_one(&p->codes,code);
code=newcode(OP_PUSHL,newdessrc(IMM,0,NULL,NONE,0,0),NULL,NULL);
code_link_one(&p->codes,code);
/* pushl %ebp */
code=newcode(OP_PUSHL,newdessrc(REG,0,NULL,EBP,0,0),NULL,NULL);
code_link_one(&p->codes,code);
/* pushl ompfunc */
code=newcode(OP_PUSHL,newdessrc(IMM,0,NULL,NONE,0,0),NULL,(void *)labelmp);
code_link_one(&p->codes,code);
/* call GOMP_parallel */
code=newcode(OP_CALL,NULL,NULL,(void *)STR_GOMPP);
code_link_one(&p->codes,code);
/* addl $16,%esp */
code=newcode(OP_ADDL,newdessrc(IMM,16,NULL,NONE,0,0),newdessrc(REG,0,NULL,ESP,0,0),NULL);
code_link_one(&p->codes,code);
omp_flag=0;
skiplink=1;
}
}else{
fprintf(stderr,"unsupported pragma \n");
}
break;
default:
p->codes.head=p->codes.tail=NULL;
//fprintf(stderr,"checked one statements item\n");
code_stmt(p,BASEREG);
}
code_link(&block->codes,&p->codes);
if(skiplink){
skiplink=0;
p=pp->nextsibling;
}else{
p=p->nextsibling;
}
}
return 0;
}
list_t* do_prim_op(char *name, list_t *args)
{
int i = 0;
int j;
int val = 0;
list_t *l1;
list_t* nl = c_malloc(sizeof(list_t));
char *buf;
if (!strcmp(name, "+")) {
val = 0;
for (i = 0; i < args->cc; ++i) {
if (args->c[i]->type != NUMBER) {
error_msg("+ expects numbers");
code_error();
}
val += args->c[i]->val;
}
nl->type = NUMBER;
nl->val = val;
return nl;
}
if (!strcmp(name, "-")) {
if (args->cc == 1) {
/* single argument: unary minus sign */
if (args->c[0]->type != NUMBER) {
error_msg("- expects numbers");
code_error();
}
val = -args->c[0]->val;
} else {
/* otherwise, standard N-ary subtraction */
for (i = 0; i < args->cc; ++i) {
if (args->c[i]->type != NUMBER) {
error_msg("- expects numbers");
code_error();
}
if (i == 0)
val = args->c[i]->val;
else
val -= args->c[i]->val;
}
}
nl->val = val;
nl->type = NUMBER;
return nl;
}
if (!strcmp(name, "*")) {
val = 1;
for (i = 0; i < args->cc; ++i) {
if (args->c[i]->type != NUMBER) {
error_msg("* expects numbers");
code_error();
}
val *= args->c[i]->val;
}
nl->type = NUMBER;
nl->val = val;
return nl;
}
if (!strcmp(name, "remainder")) {
if (args->cc != 2
|| args->c[0]->type != NUMBER
|| args->c[1]->type != NUMBER) {
error_msg("`remainder' expects two numbers");
code_error();
}
nl->type = NUMBER;
nl->val = args->c[0]->val % args->c[1]->val;
return nl;
}
if (!strcmp(name, "=")) {
if (args->cc != 2
|| args->c[0]->type != NUMBER
|| args->c[1]->type != NUMBER) {
error_msg("= expects two numbers");
code_error();
}
return makebool(args->c[0]->val == args->c[1]->val);
}
if (!strcmp(name, ">")) {
if (args->cc != 2
|| args->c[0]->type != NUMBER
|| args->c[1]->type != NUMBER) {
error_msg("> expects two numbers");
code_error();
}
return makebool(args->c[0]->val > args->c[1]->val);
}
if (!strcmp(name, "<")) {
if (args->cc != 2
|| args->c[0]->type != NUMBER
|| args->c[1]->type != NUMBER) {
error_msg("< expects two numbers");
code_error();
}
return makebool(args->c[0]->val < args->c[1]->val);
}
if (!strcmp(name, "<=")) {
if (args->cc != 2
|| args->c[0]->type != NUMBER
|| args->c[1]->type != NUMBER) {
error_msg("<= expects two numbers");
code_error();
}
return makebool(args->c[0]->val <= args->c[1]->val);
}
if (!strcmp(name, ">=")) {
if (args->cc != 2
|| args->c[0]->type != NUMBER
|| args->c[1]->type != NUMBER) {
error_msg(">= expects two numbers");
code_error();
}
return makebool(args->c[0]->val >= args->c[1]->val);
}
if (!strcmp(name, "not")) {
val = 0;
if (args->cc != 1) {
error_msg("`not' expects one argument");
code_error();
}
/* r6rs.pdf section 11.8, page 47 */
val = args->c[0]->type == BOOL && !args->c[i]->val;
return makebool(val);
}
if (!strcmp(name, "cons")) {
if (args->cc != 2) {
error_msg("`cons' expects 2 arguments");
code_error();
}
/* just return the list as-is for now */
memcpy(nl, args, sizeof(list_t));
nl->type = CONS;
return nl;
}
if (!strcmp(name, "car")) {
if (args->cc != 1) {
error_msg("`car' expects 1 argument");
code_error();
}
if (args->c[0]->type != CONS) {
error_msg("`car' expects a linked-list");
code_error();
}
if (args->c[0]->cc < 1) {
error_msg("`car' has failed");
code_error();
}
return args->c[0]->c[0];
}
if (!strcmp(name, "cdr")) {
if (args->cc != 1) {
error_msg("`cdr' expects 1 argument");
code_error();
}
if (args->c[0]->type != CONS) {
error_msg("`cdr' expects a linked-list");
code_error();
}
if (args->c[0]->cc < 2) {
error_msg("`cdr' has failed");
code_error();
}
return args->c[0]->c[1];
}
if (!strcmp(name, "null?")) {
return makebool(args->cc == 1
&& (
((args->c[0]->type == SYMBOL && !strcmp(args->c[0]->head, "NIL"))
|| (args->c[0]->type == CONS && args->c[0]->cc == 0))));
}
if (!strcmp(name, "display")) {
buf = malloc(LINEBUFSIZ);
if (!buf) {
error_msg("malloc failed");
code_error();
}
*buf = 0;
printout(args->c[0], buf);
#ifdef JS_GUI
c_writeback(buf);
#else
printf("%s", buf);
#endif
free(buf);
return args->c[0];
}
if (!strcmp(name, "pair?")) {
/* check for null first */
j = args->cc == 1
&& (
((args->c[0]->type == SYMBOL && !strcmp(args->c[0]->head, "NIL"))
|| (args->c[0]->type == CONS && args->c[0]->cc == 0)));
return makebool(!j /* not null, then the rest */
&& args->cc == 1 && args->c[0]->type == CONS);
}
/* the following bit deals with (eq? A B) --
* apparently, eq? checks if two things evaluate
* to the same memory pointer. but further hackery
* is sufficient to deal with the case (eq? 'foo 'foo) */
if (!strcmp(name, "eq?")) {
if (args->cc != 2) {
error_msg("`eq?' expects two arguments");
code_error();
}
return makebool(args->c[0] == args->c[1]
|| (args->c[0]->type == SYMBOL
&& args->c[1]->type == SYMBOL
&& !strcmp(args->c[0]->head, args->c[1]->head))
/* (eq? 'NIL '()) => #t */
|| (args->c[0]->type == SYMBOL && !strcmp(args->c[0]->head, "NIL")
&& args->c[1]->type == CONS && args->c[1]->cc == 0)
/* (eq? '() 'NIL) => #t */
|| (args->c[1]->type == SYMBOL && !strcmp(args->c[1]->head, "NIL")
&& args->c[0]->type == CONS && args->c[0]->cc == 0)
/* (eq? '() '()) => #t */
|| (args->c[0]->type == CONS && args->c[0]->cc == 0
&& args->c[1]->type == CONS && args->c[1]->cc == 0));
}
if (!strcmp(name, "symbol?")) {
return makebool(args->cc == 1
&& args->c[0]->type == SYMBOL);
}
if (!strcmp(name, "number?")) {
return makebool(args->cc == 1
&& args->c[0]->type == NUMBER);
}
if (!strcmp(name, "newline")) {
#ifdef JS_GUI
c_writeback_nl("");
#else
puts("");
#endif
return mksym("NIL");
}
if (!strcmp(name, "save-to")) {
if (save_mode) {
return mksym("NIL");
}
save_file = fopen(args->c[0]->head, "w");
if (!save_file) {
error_msg("failed to open file for writing");
code_error();
}
save_mode = 1;
return mksym("savefile-ok");
}
if (!strcmp(name, "load")) {
buf = malloc(strlen(args->c[0]->head) + 1);
if (!buf) {
error_msg("malloc failed");
code_error();
}
strcpy(buf, args->c[0]->head);
load_code_from_file(buf);
free(buf);
return mksym("HERP-DERP");
}
if (!strcmp(name, "cons2list")) {
return cons2list(args->c[0]);
}
if (!strcmp(name, "debuglog")) {
stacktracer_barf();
return mksym("herp-derp");
}
if (!strcmp(name, "reverse")) {
/* r6rs.pdf, page 48 */
if (args->c[0]->type == CONS)
l1 = cons2list(args->c[0]);
else if (args->c[0]->type == LIST)
l1 = args->c[0];
else return mksym("NIL");
if (l1->cc == 0)
return mksym("NIL");
nl = new_list();
nl->type = LIST;
for (i = l1->cc - 1; i >= 0; --i)
add_child(nl, l1->c[i]);
return makelist(nl);
}
return NULL;
}
int do_read_file(char *buf, FILE *f, int repl)
{
int bal = -1;
char tmp[LINEBUFSIZ];
char *p;
int i = 0;
int bl = 0;
int ind;
/*
* This loops as long as there
* are unclosed parentheses
*/
while (bal) {
/*
* If in interactive mode,
* handle prompts/autoindent
*/
if (repl) {
/*
* If i = 0, print a new logical-line prompt
* (This counts the number of UNIX lines
* in this logical line, so far)
*/
if (!i++)
printf("]=> ");
else {
/*
* The logical-line is incomplete; print
* a "..." prompt then auto-indent
*/
printf("... ");
if (bal > 0) {
for (ind = 0; ind < bal; ++ind) {
printf(" ");
/*
* Transcribe the auto-indentation
* to the logfile if logging is enabled
*/
if (save_mode)
fprintf(save_file, " ");
}
}
}
/*
* Flush out the prompt/autoindent to make sure
* it appears -- it's not newline-terminated,
* because the rest of the line is the user's code
*/
fflush(stdout);
}
/*
* Read in a line of input. exit the routine
* in various ways if this fails.
*/
if (!fgets(tmp, LINEBUFSIZ, f)) {
printf("\n");
/* ???? */
if (repl) {
return 0;
}
else
break;
}
/*
* Transcribe the line input to the logfile,
* if logging and interactive (repl) mode
* are enabled
*/
if (save_mode && repl && *tmp != '\n') {
fflush(save_file);
fprintf(save_file, "%s", tmp);
}
/* Check if the line is a comment */
if (check_comment(tmp)) {
/*
* If a comment was written on a "]=>" prompt,
* write another "]=>" prompt afterwards, not
* a "..."
*/
if (i == 1)
i = 0;
/*
* Go on to the next line of input;
* do not add the comment to the buffer
*/
continue;
}
/* Skip empty lines, parser hates them */
if (*tmp == '\n') {
if (repl) {
/*
* An empty line given on a "]=>" prompt
* leads to a new "]=>" prompt afterwards,
* not a "..." prompt.
*/
if (i == 1)
--i;
/*
* In interactive (repl) mode, blank
* lines cause the CLI reader to autocomplete
* missing closing parentheses. This loop
* is ugly because it has to transcribe these
* parentheses to the buffer, to stdout, and
* also to the logfile if logging is enabled.
*/
if (++bl > 0 && bal > 0) {
printf ("... ");
for (ind = 0; ind < bal; ++ind) {
printf(")");
strcat(buf, ")");
if (save_file)
fprintf(save_file, ")");
}
if (save_file) {
fflush(save_file);
fprintf(save_file, "\n");
}
fflush(stdout);
printf("\n");
break;
}
}
continue;
} else
bl = 0;
/* Trim the newline from the input line */
for (p = tmp; *p; ++p) {
if (*p == '\n' || *p == EOF) {
*p = 0;
break;
}
}
/* Add the input line to the logical-line buffer */
strcat(buf, tmp);
strcat(buf, " ");
/* Check parentheses balance */
bal = 0;
for (p = buf; *p; ++p) {
if (*p == '(')
++bal;
else if (*p == ')')
--bal;
}
/* Abort on negative parenthesis-nest */
if (bal < 0) {
error_msg("terrible syntax");
code_error();
}
}
return 1;
}