function.c

YBasic编程语言的移植和开发 YBasic编程语言的移植和开发 YBasic编程语言的移植和开发

#endif
  
  delay=pop(stNUMBER)->value;
  if (delay<0) delay=0.;
#ifdef UNIX
  tv.tv_sec=(int)delay;
  tv.tv_usec=(delay-(int)delay)*1000000;
  select(0,NULL,NULL,NULL,&tv);
#else /* WINDOWS */
  timerid=SetTimer(NULL,0,(int)(delay*1000),(TIMERPROC) NULL);
  GetMessage((LPMSG)&msg,NULL,WM_TIMER,WM_TIMER);
  KillTimer(NULL,timerid);
#endif
}


void mybell() /* ring ascii bell */
{
#ifdef UNIX
  printf("\007");
  fflush(stdout);
#else /* WINDOWS */
  Beep(1000,100);
#endif
}



void create_poke(char flag) /* create Command 'cPOKE' */
{
  struct command *cmd;
		
  if (flag=='S' || flag=='D')
    cmd=add_command(cPOKEFILE,FALSE);
  else
    cmd=add_command(cPOKE,FALSE);
  cmd->tag=flag;
}


void poke(struct command *cmd) /* poke into internals */
{
  char *dest,*s,c;
  char *sarg=NULL;
  double darg;
		
  if (cmd->tag=='s')
    sarg=pop(stSTRING)->pointer;
  else 
    darg=pop(stNUMBER)->value;
		
  dest=pop(stSTRING)->pointer;
  for(s=dest;*s;s++) *s=tolower((int)*s);
  if (!strcmp(dest,"fontheight") && !sarg) {
    fontheight=(int)darg;
#ifdef UNIX
    calc_psscale();
#endif
  }
  else if (!strcmp(dest,"font") && sarg) {
    font=my_strdup(sarg);
  }
  else if (!strcmp(dest,"dump") && sarg && !strcmp(sarg,"symbols")) {
    dump_sym();
  }
  else if (!strcmp(dest,"dump") && sarg && 
	   (!strcmp(sarg,"sub") || !strcmp(sarg,"subs") || !strcmp(sarg,"subroutine") || !strcmp(sarg,"subroutines"))) {
    dump_sub(0);
  }
  else if (!strcmp(dest,"winwidth") && !sarg) {
    winwidth=(int)darg;
    if (winwidth<1) {
      error(ERROR,"winwidth less than 1 pixel");
      return;
    }
#ifdef UNIX
    calc_psscale();
#endif
  }
  else if (!strcmp(dest,"winheight") && !sarg) {
    winheight=(int)darg;
    if (winheight<1) {
      error(ERROR,"winheight less than 1 pixel");
      return;
    }
#ifdef UNIX
    calc_psscale();
#endif
  }
  else if (!strcmp(dest,"textalign") && sarg) {
    if (!check_alignement(sarg)) return;
    strncpy(text_align,sarg,2);
  }
  else if (!strcmp(dest,"windoworigin") && sarg) {
    moveorigin(sarg);
  }
  else if (!strcmp(dest,"infolevel") && sarg) {
    c=tolower((int)*sarg);
    switch(c) {
    case 'd': infolevel=DEBUG;break;
    case 'n': infolevel=NOTE;break;
    case 'w': infolevel=WARNING;break;
    case 'e': infolevel=ERROR;break;
    case 'f': infolevel=FATAL;break;
    default:
      error(ERROR,"invalid infolevel");
      return;
    }
    if (infolevel>=DEBUG) {
      sprintf(string,"switching infolevel to '%c'",c);
      error(DEBUG,string);
    }
  }
  else if (!strcmp(dest,"stdout") && sarg) {
    fputs(sarg,stdout);
  }
  else if (!strcmp(dest,"read_controls") && !sarg) {
    read_controls= darg ? 1:0;
  }
  else if (dest[0]=='#') {
    error(ERROR,"don't use quotes when poking into file");
  }
  else {
    error(ERROR,"invalid poke");
  }
  return;
}


void pokefile(struct command *cmd) /* poke into file */
{
  char *sarg=NULL;
  double darg;
  int stream;
		
  if (cmd->tag=='S')
    sarg=pop(stSTRING)->pointer;
  else 
    darg=pop(stNUMBER)->value;
  stream=(int)(pop(stNUMBER)->value);
  
  if (badstream(stream,0)) return;
  
  if (!(stream_modes[stream] & smWRITE)) {
    sprintf(string,"Stream %d not open for writing",stream);
    error(ERROR,string);
    return;
  } 
  if (sarg) {
    fputs(sarg,streams[stream]);
  } else {
    if (darg<0 || darg>255) {
      error(ERROR,"stream poke out of byte range (0..255)");
      return;
    }
    fputc((int)darg,streams[stream]);
  }
}


static double peek(char *dest) /* peek into internals */
{
  char *s;
		
  for(s=dest;*s;s++) *s=tolower((int)*s);
  if (!strcmp(dest,"winwidth")) return winwidth;
  else if (!strcmp(dest,"winheight")) return winheight;
  else if (!strcmp(dest,"fontheight")) return fontheight;
  else if (!strcmp(dest,"screenheight")) return LINES;
  else if (!strcmp(dest,"screenwidth")) return COLS;
  else if (!strcmp(dest,"argument") || !strcmp(dest,"arguments") ) return yabargc;
  else if (!strcmp(dest,"version")) return strtod(VERSION,NULL);
  else if (!strcmp(dest,"error")) return errorcode;
  else if (!strcmp(dest,"read_controls")) return read_controls;
  else if (!strcmp(dest,"isbound")) return is_bound; 
  else if (dest[0]=='#') {
    error(ERROR,"don't use quotes when peeking into a file");
    return 0;
  }
  
  error(ERROR,"invalid peek");
  return 0;
}


static int peekfile(int stream) /* read a byte from stream */
{
  if (stream && badstream(stream,0)) return 0;
  if (stream && !(stream_modes[stream] & smREAD)) {
    sprintf(string,"stream %d not open for reading",stream);
    error(ERROR,string);
    return 0;
  } 
  return fgetc(stream?streams[stream]:stdin);
}


static char *peek2(char *dest,struct command *curr) /* peek into internals */
{
  char *s;
		
  for(s=dest;*s;s++) *s=tolower((int)*s);
  if (!strcmp(dest,"infolevel")) {
    if (infolevel==DEBUG) return my_strdup("debug");
    else if (infolevel==NOTE) return my_strdup("note");
    else if (infolevel==WARNING) return my_strdup("warning");
    else if (infolevel==ERROR) return my_strdup("error");
    else if (infolevel==FATAL) return my_strdup("fatal");
    else return my_strdup("unkown");
  }
  else if (!strcmp(dest,"textalign")) return my_strdup(text_align);
  else if (!strcmp(dest,"windoworigin")) return my_strdup(winorigin);
  else if (!strcmp(dest,"error")) return my_strdup(errorstring);
  else if (!strcmp(dest,"library")) return my_strdup(curr->lib->s);
  else if (!strcmp(dest,"os")) {
#ifdef UNIX
    return my_strdup("unix");
#else
    return my_strdup("windows");
#endif
  }
  else if (!strcmp(dest,"font")) return my_strdup(font);
  else if (!strcmp(dest,"argument") || !strcmp(dest,"arguments")) {
    if (yabargc>0) {
      s=yabargv[0];
      yabargc--;
      yabargv++;
    }
    else {
      s="";
    }
    return my_strdup(s);
  }
  else {
    error(ERROR,"invalid peek");
  }
  return my_strdup("");
}


static char *peek3(char *dest,char *cont) /* peek into internals */
{
  char *s;
		
  for(s=dest;*s;s++) *s=tolower((int)*s);
  if (!strcmp(dest,"env") || !strcmp(dest,"environment")) {
    return my_strdup(getenv(cont));
  } else {
    error(ERROR,"invalid peek");
  }
  return my_strdup("");
}


void create_exception(int flag) /* create command 'exception' */
{
  struct command *cmd;  
  
  cmd=add_command(cEXCEPTION,FALSE);
  cmd->args=flag;
}


void exception(struct command *cmd) /* change handling of exceptions */
{
  if (cmd->args) {
    signal(SIGINT,signal_handler); /* enable keyboard interrupt */
#ifdef SIGHUP
    signal(SIGHUP,signal_handler);
#endif
#ifdef SIGQUIT
    signal(SIGQUIT,signal_handler);
#endif
#ifdef SIGABRT
    signal(SIGABRT,signal_handler);
#endif
#ifdef SIGTERM
    signal(SIGTERM,signal_handler);
#endif
  }
  else {
    signal(SIGINT,SIG_IGN); /* ignore keyboard interrupt */
#ifdef SIGHUP
    signal(SIGHUP,SIG_IGN);
#endif
#ifdef SIGQUIT
    signal(SIGQUIT,SIG_IGN);
#endif
#ifdef SIGABRT
    signal(SIGABRT,SIG_IGN);
#endif
#ifdef SIGTERM
    signal(SIGTERM,SIG_IGN);
#endif
  }
  return;
}


void create_restore(char *label) /* create command 'restore' */
{
  struct command *c;
  
  c=add_command(cRESTORE,FALSE);
  c->pointer=my_strdup(label);
}


void restore(struct command *cmd) /* reset data pointer to given label */
{
  struct command *label;
  struct command **datapointer;
  
  datapointer=&(cmd->lib->datapointer);
  if (cmd->type==cRESTORE) { /* first time; got to search the label */
    if (*((char *)cmd->pointer)=='\0') {
      /* no label, restore to first command */
      label=cmd->lib->firstdata;
    } else {
      label=search_label(cmd->pointer,smLABEL|smGLOBAL);
      if (!label) {
	/* did not find label */
	sprintf(string,"can't find label '%s'",(char *)cmd->pointer);
	error(ERROR,string);
	return;
      }
    }
    *datapointer=label;
    if (lastdata) {
      while((*datapointer)->type!=cDATA && (*datapointer)!=cmdhead) {
	*datapointer=(*datapointer)->next;
      }
    }
    cmd->pointer=*datapointer;
    cmd->type=cQRESTORE;
  } else {
    *datapointer=cmd->pointer;
  }
  return;
}


void create_dbldata(double value)  /* create command dbldata */
{
  struct command *c;
  
  c=add_command(cDATA,FALSE);
  c->pointer=my_malloc(sizeof(double));
  if (lastdata) lastdata->nextassoc=c;
  lastdata=c;
  *((double *)c->pointer)=value;
  c->tag='d'; /* double value */
}


void create_strdata(char *value)  /* create command strdata */
{
  struct command *c;
  
  c=add_command(cDATA,FALSE);
  if (lastdata) lastdata->nextassoc=c;
  lastdata=c;
  c->pointer=my_strdup(value);
  c->tag='s'; /* string value */
}


void create_readdata(char type) /* create command readdata */
{
  struct command *cmd;
  
  cmd=add_command(cREADDATA,FALSE);
  cmd->tag=type;
}


void readdata(struct command *cmd) /* read data items */
{
  struct stackentry *read;
  char type;
  struct command **datapointer;
  
  datapointer=&(cmd->lib->datapointer);
  type=cmd->tag;
  while(*datapointer && ((*datapointer)->type!=cDATA || cmd->lib!=(*datapointer)->lib)) {
    *datapointer=(*datapointer)->nextassoc;
  }
  if (!*datapointer) {
    error(ERROR,"run out of data items");
    return;
  }
  if (type!=(*datapointer)->tag) {
    error(ERROR,"type of READ and DATA don't match");
    return;
  }
  read=push();
  if (type=='d') { /* read a double value */
    read->type=stNUMBER;
    read->value= *((double *)(*datapointer)->pointer);}
  else {
    read->type=stSTRING;
    read->pointer=my_strdup((*datapointer)->pointer);
  }
  *datapointer=(*datapointer)->nextassoc; /* next item */
}


void create_dblrelop(char c) /* create command dblrelop */ 
{
  int type;
  
  switch(c) {
  case '=': type=cEQ;break;
  case '!': type=cNE;break;
  case '<': type=cLT;break;
  case '{': type=cLE;break;
  case '>': type=cGT;break;
  case '}': type=cGE;break;
  }
  add_command(type,FALSE);
}


void dblrelop(struct command *type)  /* compare topmost double-values */
{
  double a,b,c;
  struct stackentry *result;
  
  b=pop(stNUMBER)->value;
  a=pop(stNUMBER)->value;
  switch(current->type) {
  case cEQ:c=(a==b);break;
  case cNE:c=(a!=b);break;
  case cLE:c=(a<=b);break;
  case cLT:c=(a<b);break;
  case cGE:c=(a>=b);break;
  case cGT:c=(a>b);break;
  }
  result=push();
  result->value=c;
  result->type=stNUMBER;
}    


void create_strrelop(char c) /* create command strrelop */ 
{
  int type;
  
  switch(c) {
  case '=': type=cSTREQ;break;
  case '!': type=cSTRNE;break;
  case '<': type=cSTRLT;break;
  case '{': type=cSTRLE;break;
  case '>': type=cSTRGT;break;
  case '}': type=cSTRGE;break;
  }
  add_command(type,FALSE);
}


void strrelop(struct command *type)  /* compare topmost string-values */
{
  char *a,*b;
  double c;
  struct stackentry *result;
  
  b=pop(stSTRING)->pointer;
  a=pop(stSTRING)->pointer;
  switch(current->type) {
  case cSTREQ:c=(strcmp(a,b)==0);break;
  case cSTRNE:c=(strcmp(a,b)!=0);break;
  case cSTRLT:c=(strcmp(a,b)<0);break;
  case cSTRLE:c=(strcmp(a,b)<=0);break;
  case cSTRGT:c=(strcmp(a,b)>0);break;
  case cSTRGE:c=(strcmp(a,b)>=0);break;
  }
  result=push();
  result->value=c;
  result->type=stNUMBER;
}    

void switch_compare(void) /* compare topmost values for switch statement */
{
  struct stackentry *result,*first,*second;
  double r=0.;

  first=pop(stANY);
  second=stackhead->prev;
  if ((second->type==stSWITCH_STRING || second->type==stSTRING) && first->type==stSTRING) {
    if (second->type==stSWITCH_STRING) 
      r=1.;
    else 
      r=(strcmp(first->pointer,second->pointer)==0)?1.:0.;
  } else if ((second->type==stSWITCH_NUMBER || second->type==stNUMBER) && first->type==stNUMBER) {
    if (second->type==stSWITCH_NUMBER)
      r=1.;
    else
      r=(first->value==second->value);
  } else {
    error(ERROR,"Cannot mix strings and numbers in a single switch statement");
  }
  result=push();
  result->type=stNUMBER;
  result->value=r;
}


void logical_shortcut(struct command *type)  /* shortcut and/or if possible */
{
  struct stackentry *result;
  double is;

  is=stackhead->prev->value;
  if ((type->type==cORSHORT && is!=0) || (type->type==cANDSHORT && is==0)) {
    result=push();
    error(DEBUG,"logical shortcut taken");
    result->type=stNUMBER;
    result->value=is;
  } else {
    current=current->next;
  }
}


void create_boole(char c) /* create command boole */ 
{
  int type;
  
  switch(c) {
  case '|': type=cOR;break;
  case '&': type=cAND;break;
  case '!': type=cNOT;break;
  }
  add_command(type,FALSE);
}


void boole(struct command *type)  /* perform and/or/not */
{
  int a,b,c;
  struct stackentry *result;
  
  a=(int)pop(stNUMBER)->value;
  if (current->type==cNOT) 
    c=!a;
  else {
    b=(int)pop(stNUMBER)->value;
    if (current->type==cAND)
      c=a&&b;
    else
      c=a||b;
  }
  result=push();
  result->value=c;
  result->type=stNUMBER;
}