symbol.c

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

void create_dim(char *name,char type) /* create command 'dim' */
/* type can be 's'=string or 'd'=double Array */
{ 
  struct command *cmd;
  
  cmd=add_command(cDIM,name);
  cmd->tag=type; /* type: string or double */
  cmd->args=-1;
}


void dim(struct command *cmd) /* get room for array */
{
  struct array *nar,*oar;
  char *nul;
  int ntotal,ototal,esize,i,j;
  int ind[10],nbounds[10],larger;
  struct symbol *s;
  int local;

  local=((cmd->tag==tolower(cmd->tag))?TRUE:FALSE);
  if (cmd->args<0) cmd->args=count_args(FALSE);
  if (cmd->args<0) {
    error(ERROR,"only numerical indices allowed for arrays");
    return;
  }
  s=get_sym(cmd->name,syARRAY,local?amADD_LOCAL:amADD_GLOBAL);
  if (search_label(cmd->name,smSUB|smLINK)) {
    sprintf(string,"array '%s()' conflicts with user subroutine",strip(cmd->name));
    error(ERROR,string);
    return;
  }

  /* check for dimensions */
  if (cmd->args>10) {
    error(ERROR,"more than 10 indices");
    return;
  }
  oar=s->pointer;
  if (oar) {
    /* check, if old and new array are compatible */
    if (cmd->args!=oar->dimension) {
      sprintf(string,"cannot change dimension of '%s()' from %d to %d",
	      strip(cmd->name),oar->dimension,cmd->args);
      error(ERROR,string);
    }
  }
  /* check, if redim is actually needed */
  for(i=0;i<10;i++) nbounds[i]=0;
  larger=FALSE;
  for(i=0;i<cmd->args;i++) {
    nbounds[i]=1+(int)pop(stNUMBER)->value;
    if (nbounds[i]<=1) {
      sprintf(string,"array index %d is less or equal zero",cmd->args-i);
      error(ERROR,string);
      return;
    }
    if (oar) {
      if (nbounds[i]>oar->bounds[i]) 
	larger=TRUE;
      else
	nbounds[i]=oar->bounds[i];
    }
  }
  pop(stFREE); /* remove left over stFREE */
  if (oar && !larger) return; /* new array won't be larger than old one */

  /* create array */
  nar=create_array(tolower(cmd->tag),cmd->args);

  /* count needed memory */
  ntotal=1;
  for(i=0;i<nar->dimension;i++) {
    (nar->bounds)[i]=nbounds[i];
    ntotal*=nbounds[i];
  }
  esize=(nar->type=='s')?sizeof(char *):sizeof(double); /* size of one array element */
  nar->pointer=my_malloc(ntotal*esize);

  if (oar) { /* array already exists, get its size */
    ototal=1;
    for(i=0;i<oar->dimension;i++) ototal*=(oar->bounds)[i];
  }

  /* initialize Array */
  for(i=0;i<ntotal;i++) {
    if (nar->type=='s') { 
      nul=my_malloc(sizeof(char));
      *nul='\0';
      ((char **)nar->pointer)[i]=nul;
    } else {
      ((double *)nar->pointer)[i]=0.0;
    }
  }  
  
  if (oar) { /* copy contents of old array onto new */
    for(i=0;i<ototal;i++) {
      off_to_ind(i,oar->bounds,ind);
      j=ind_to_off(ind,nar->bounds);
      if (nar->type=='s') {
	my_free(((char **)nar->pointer)[j]);
	((char **)nar->pointer)[j]= ((char **)oar->pointer)[i];
      } else {
	((double *)nar->pointer)[j]= ((double *)oar->pointer)[i];
      }
    }
    my_free(oar->pointer);
    my_free(oar);
  }
  
  s->pointer=nar;
  cmd->symbol=nar;
}


static int ind_to_off(int *ind,int *bound) /* convert array of indices to single offset */
{
  int i;
  int cur,off;

  off=0;
  cur=1;
  for(i=0;i<10 && bound[i];i++) {
    off+=ind[i]*cur;
    cur*=bound[i];
  }
  return off;
}


static void off_to_ind(int off,int *bound,int *ind) /* convert a single offset to an array of indices */
{
  int i;
  int cur;
  
  cur=1;
  for(i=0;i<10;i++) {
    if (bound[i]) cur*=bound[i];
    ind[i]=0;
  }
  for(i=9;i>=0;i--) {
    if (bound[i]) {
      cur/=bound[i];
      ind[i]=off/cur;
      off-=ind[i]*cur;
    } else {
      ind[i]=0;
    }
  }
}


void query_array(struct command *cmd) /* query array */
{
  int index;
  struct stackentry *s;
  struct array *ar;
  struct symbol *sym;

  if (cmd->type==cARSIZE) index=(int)pop(stNUMBER)->value;

  s=pop(stSTRING_OR_NUMBER_ARRAYREF);
  
  if (!cmd->symbol) {
    sym=get_sym(s->pointer,syARRAY,amSEARCH);
    if (!sym || !sym->pointer) {
      sprintf(string,"array '%s()' is not defined",strip(s->pointer));
      error(ERROR,string);
      return;
    }
    cmd->symbol=sym;
  }

  ar=((struct symbol *)cmd->symbol)->pointer;

  if (cmd->type==cARSIZE && (index<1 || index>ar->dimension)) {
    sprintf(string,"only indices between 1 and %d allowed",ar->dimension);
    error(ERROR,string);
    return;
  }
  s=push();
  s->type=stNUMBER;
  if (cmd->type==cARSIZE)
    s->value=ar->bounds[ar->dimension-index]-1;
  else
    s->value=ar->dimension;
  
  return;
}


void create_doarray(char *symbol,int command) /* creates array-commands */ 
{
  struct command *cmd;

  cmd=add_command(cDOARRAY,symbol);
  cmd->tag=command; /* operation to perform */
  cmd->args=-1;
}


void doarray(struct command *cmd) /* call an array */
{
  struct array *ar;
  struct stackentry *stack;
  struct symbol *sym;
  void *p;
  char **str;
  double *dbl;
  int i,j,bnd,index,cur,rval;
 

  if (!cmd->symbol) {
    sym=get_sym(cmd->name,syARRAY,amSEARCH);
    if (!sym || !sym->pointer) {
      sprintf(string,"'%s()' is neither array nor subroutine",strip(cmd->name));
      error(ERROR,string);
      return;
    }
    cmd->symbol=sym;
  }
  rval=(current->tag==CALLARRAY || current->tag==CALLSTRINGARRAY || current->tag==GETSTRINGPOINTER);
  if (cmd->args<0) cmd->args=count_args(!rval);
  if (cmd->args<0) {
    error(ERROR,"only numerical indices allowed for arrays");
    return;
  }
  cmd->args=abs(cmd->args);
  if (!cmd->args) { /* no indizes supplied, create a reference to an array */
    pop(stFREE); /* remove left over stFREE */
    stack=push();
    if (cmd->tag==CALLARRAY)
      stack->type=stNUMBERARRAYREF;
    else
      stack->type=stSTRINGARRAYREF;
    stack->pointer=my_strdup(cmd->name);
    return;
  }

  ar=((struct symbol *)cmd->symbol)->pointer;

  if (!ar->dimension) {
    sprintf(string,"array parameter '%s()' has not been supplied",strip(cmd->name));
    error(ERROR,string);
    return;
  }
  if (cmd->args!=ar->dimension) {
    sprintf(string,"%d indices supplied, %d expected for '%s()'",cmd->args,ar->dimension,strip(cmd->name));
    error(ERROR,string);
    return;
  }

  if (!rval) stack=pop(stSTRING_OR_NUMBER);
  index=0;
  cur=1;
  for(i=0;i<ar->dimension;i++) {
    bnd=(ar->bounds[i]);
    j=(int)pop(stNUMBER)->value;
    if (j<0 || j>=bnd) {
      sprintf(string,"index %d (=%d) out of range",ar->dimension-i,j);
      error(ERROR,string);
      return;
    }
    index+=j*cur;
    cur*=bnd;
  }
  
  pop(stFREE); /* remove left over stFREE */
  if (rval) stack=push();
  
  p=ar->pointer;
  switch(current->tag) {
  case CALLARRAY:
    dbl=(double *)p+index;
    stack->value= *dbl;
    stack->type=stNUMBER;
    break;
  case ASSIGNARRAY:
    dbl=(double *)p+index;
    *dbl=stack->value;
    break;
  case CALLSTRINGARRAY:
    str=((char **)p+index);
    stack->pointer=my_strdup(*str);
    stack->type=stSTRING;
    break;
  case ASSIGNSTRINGARRAY:
    str=((char **)p+index);
    if (*str!=NULL)my_free(*str);
    *str=my_strdup(stack->pointer);
    break;
  case GETSTRINGPOINTER:
    str=((char **)p+index);
    stack->pointer=*str;
    stack->type=stSTRING;
    break;
  }
}


struct array *create_array(int type,int dimension) /* create an array */
{
  int i;
  struct array *ar;

  ar=my_malloc(sizeof(struct array));
  ar->type=type;
  ar->dimension=dimension;
  ar->pointer=NULL;
  for(i=0;i<10;i++) ar->bounds[i]=0;

  return ar;
}


static int count_args(int skipfirst) /* count number of numeric arguments on stack */
{
  int i=0;
  int sign=1;
  struct stackentry *curr;

  curr=stackhead->prev;
  if (skipfirst) curr=curr->prev;
  while(curr) {
    if (curr->type==stFREE) return i*sign;
    if (curr->type!=stNUMBER) sign=-1;
    curr=curr->prev;
    i++;
  }
  return -1;
}


void skipper()
/* used for on_goto/gosub, skip specified number of commands */
{
  int i,len;
  struct command *ahead; /* command to follow */
  
  len=(int)pop(stNUMBER)->value;
  i=1;
  current=current->next; /* advance to first goto/gosub */
  for(i=1;i<len;i++) {
    ahead=current->next->next; /* skip interleaving findnop statement */
    if (ahead->type==cNOP) 
      break;
    else
      current=ahead;
  }
}


void skiponce(struct command *cmd) /* skip next command exectly once */
{
  if (cmd->tag) current=current->next;
  cmd->tag=0;
}


void resetskiponce(struct command *cmd) /* find and reset next skip */
{
 struct command *c;
  
  c=cmd;
  while(c->type!=cSKIPONCE) c=c->next;
  c->tag=1;
}

void create_break_mark(int minor,int major) /* create marks for break */
{
  struct command *cmd;

  in_loop+=major;
  cmd=add_command(cBREAK_MARK,NULL);
  cmd->tag=(major+2)*16+minor+2;
}


void next_case(void) /* go to next case in switch statement */
{
  if (stackhead->prev->type==stSTRING || stackhead->prev->type==stSWITCH_STRING) 
    stackhead->prev->type=stSWITCH_STRING;
  else
    stackhead->prev->type=stSWITCH_NUMBER;
}


void push_switch_id(void) /* generate a new switch id */
{
  static int max_switch_id=0;
  static int switch_stack_depth=1;

  struct switch_id *new_id;
  if (switch_id_stackhead==NULL || switch_id_stackhead->next==NULL) {
    if (switch_id_stackroot && switch_id_stackhead==NULL) {
      new_id=switch_id_stackroot;
    } else {
      new_id=my_malloc(sizeof(struct switch_id));
      new_id->next=NULL;
      new_id->depth=switch_stack_depth++;
    }
  } else {
    new_id=switch_id_stackhead->next;
  }
  max_switch_id++;
  new_id->id=max_switch_id;
  if (switch_id_stackhead==NULL) {
    switch_id_stackhead=new_id;
    switch_id_stackhead->prev=NULL;
  } else {
    switch_id_stackhead->next=new_id;
    new_id->prev=switch_id_stackhead;
    switch_id_stackhead=new_id;    
  }
}


void pop_switch_id(void) /* get previous switch id */
{
  if (switch_id_stackhead) switch_id_stackhead=switch_id_stackhead->prev;
}


int get_switch_id(void) /* get current switch id */
{
  return switch_id_stackhead ? switch_id_stackhead->id : 0;
}


int get_switch_depth(void) /* get current depth of switch id stack */
{
  return switch_id_stackhead ? switch_id_stackhead->depth : 0;
}


void push_switch_mark(void) /* push a switch mark */
{
  push()->type=stSWITCH_MARK;
}


void create_clean_switch_mark(int keep,int ret) /* add command clean_switch_mark */
{
  struct command *cmd;

  cmd=add_command(cCLEAN_SWITCH_MARK,NULL);
  cmd->args=keep;
  cmd->tag=ret;
}


void clean_switch_mark(struct command *cmd) /* pop everything up to (and including) first switch_mark from stack */
{
  struct stackentry *t,*tt,*b,*bb,*s;
  int keep,k,ret;
  
  k=keep=cmd->args;
  ret=cmd->tag;
  s=stackhead->prev;
  while(k && s!=stackroot) {
    k--;
    s=s->prev;
  }
  t=s;
  tt=s->next;
  while(((ret && s->type!=stRETADDCALL) || (!ret && s->type!=stSWITCH_MARK)) && s!=stackroot) {
    s=s->prev;
  }
  if (ret) {
    bb=s;
    b=s->next;
  } else {
    b=s;
    bb=s->prev;
  }

  /* cut part between (and including) b and t out of stack */
  bb->next=tt;
  tt->prev=bb;
  /* insert cut-out part between stackhead and stackhead->prev */
  stackhead->prev->next=b;
  b->prev=stackhead->prev;
  t->next=stackhead;
  stackhead->prev=t;
  if (keep) 
    stackhead=tt->next;
  else
    stackhead=bb->next;
}


void mybreak(struct command *cmd) /* find break_here statement */
{
  struct command *curr;
  int major,minor;
  int major_nesting=0;
  int minor_nesting=0;

  if (cmd->type==cBREAK) 
    major_nesting=1;
  else
    minor_nesting=0;
  curr=cmd;
  while(curr->type!=cBREAK_HERE || major_nesting || minor_nesting) {
    if (curr->type==cBREAK_MARK) {
      minor=(curr->tag&15)-2;
      major=((curr->tag&240)/16)-2;
      if (!major_nesting) minor_nesting+=minor;
      major_nesting+=major;
      if (infolevel>=DEBUG) {
	sprintf(string,"searching break-mark: diff(%d,%d), total(%d,%d)",minor,major,minor_nesting,major_nesting);
	error(DEBUG,string);
      }
    }
    curr=curr->next;
    if (!curr) error(FATAL,"break has left program");
  }
  cmd->type=cQGOTO;
  if (infolevel>=DEBUG) error(DEBUG,"converting cBREAK to cQGOTO");
  cmd->jump=current=curr;
}


void mycontinue(struct command *cmd) /* find continue_here statement */
{
  struct command *curr;
  int major;
  int major_nesting=-1;

  curr=cmd;
  while(curr->type!=cCONTINUE_HERE || major_nesting) {
    if (curr->type==cBREAK_MARK) {
      major=((curr->tag&240)>>4)-2;
      major_nesting+=major;
    }
    if (curr->type==cCONTINUE_CORRECTION) major_nesting--;
    curr=curr->prev;
    if (!curr) error(FATAL,"continue has left program");
  }
  cmd->type=cQGOTO;
  if (infolevel>=DEBUG) error(DEBUG,"converting cCONTINUE to cQGOTO");
  cmd->jump=current=curr;
}


void findnop()
/* used for on_gosub, find trailing nop command */
{
  while(current->type!=cNOP) {
    current=current->next; /* next label */
  }
}


void forcheck(void) /* check, if for-loop is done */
{
  double start,bound,step,val;
  
  val=pop(stNUMBER)->value;
  step=pop(stNUMBER)->value;
  bound=pop(stNUMBER)->value;
  start=stackhead->prev->value;
  if ((val<=bound && val>=start && step>=0) || (val<=start && val>=bound && step<=0)) 
    stackhead->prev->value=1.;
  else
    stackhead->prev->value=0.;
}


void forincrement(void) /* increment value on stack */
{
/* expecting on stack: BOUND,STEP,VAL,stackhead
  where for VAL=START to BOUND step STEP */
  stackhead->prev->value+=stackhead->prev->prev->value;
}


void startfor(void) /* compute initial value of for-variable */
{
  struct stackentry *p;
  
  p=push();
  p->value=stackhead->prev->prev->prev->prev->value-stackhead->prev->prev->value;
  p->type=stNUMBER;
  
  return;
}