hash.c

类PASCAL语言的编译器,LINUX环境的,我没试过是否正确.

    /* Get the structure pointer */
    CALL(GetIdentifier(scr, name, &ident));
  }

  if( (ident->flags&FPL_EXPORT_SYMBOL) ||
     !(ident->flags & FPL_COMPILER_ADDED)) {
    /*
     * Symbols added by compiled programs are not added to the hash
     * list (unless they are exported)!
     */
    
    /* Link the previous member in the list to the next member */
    if(ident->prev)
      /* If there is a previous member */
      ident->prev->next=ident->next;
    else
      /* if this was the first in the list */
      scr->hash[ident->hash%scr->hash_size]=ident->next;
  
    if(ident->next)
      ident->next->prev=ident->prev;
  }

  /*
   * If it is any kind of funtion, all the data the pointers points to
   * should (in the specs) be static and should therefore *NOT* be
   * freed here!
   *
   * Notice that even internal functions are possible to remove here...
   */

  if(ident->flags & FPL_VARIABLE) {
    /*
     * It's a variable identifier. Free some members:
     */
    
    var=&ident->data.variable;
    
    if(ident->flags & FPL_REFERENCE) {
      /* only keep a reference pointer! */
    }
    else {
      if(ident->flags & FPL_STRING_VARIABLE) {
	/* it's a string array! */
	for(i=0; i<var->size; i++)
	  if(var->var.str[i]) {
	    FREE_KIND(var->var.str[i]);
	  }
      }
      if(var->num)
	FREE_KIND(var->dims);
      FREE_KIND(var->var.val);
    }
  } else if(ident->flags&FPL_INSIDE_FUNCTION &&
            ident->data.inside.format) {
    FREE_KIND(ident->data.inside.format);
  }
  if((ident->flags&FPL_EXTERNAL_FUNCTION)||
     (ident->flags&(FPL_INTERNAL_FUNCTION|FPL_KEYWORD))) {
    /* internal or external function/keyword */
    if(ident->flags&FPL_DEALLOC_NAME_ANYWAY)
      /* this name has been renamed into this! */
      FREE_KIND(ident->name);
    FREEA(ident);
  } else  {
    if(!(ident->flags&FPL_COMPILER_ADDED)) {
      FREE_KIND(ident->name);
    }
    FREE_KIND(ident);
  }
  return(ret);
}


#ifndef AMIGA /* if not using SAS/C on Amiga */

#ifdef VARARG_FUNCTIONS
void *fplInitTags(long (*func)(void *), ...)
{
  va_list tags;
  void *ret;
#ifdef SUNOS
  va_start(tags); /* get parameter list */
#else
  va_start(tags, func); /* get parameter list */
#endif
  ret = fplInit(func, (unsigned long *)tags);
  va_end(tags);
  return ret;
}
#else
PREFIX void *fplInitTags(long (*func)(void *), unsigned long tags, ...)
{
  return(fplInit(func, (unsigned long *)&tags));
}
#endif

#endif

/**********************************************************************
 *
 * fplInit();
 *
 * Initialize a lot of FPL internal structures and references. Returns
 * NULL if anything went wrong!
 *
 *******/

void * ASM fplInit(AREG(0) long (*function) (void *),
		   /* function handler pointer */
		   AREG(1) unsigned long *tags) /* taglist */
{
  struct Data point;
  struct Data *scr;
  void *init;
  scr=&point;

#ifdef AMIGA
  /* Store all register before loading index register */
  StoreRegisters(scr);
  geta4();
#endif

  init=Init(&point, function, tags);
  if(!init)
    FREEALLA();
#ifdef DEBUGMAIL
  DebugMail(scr, MAIL_FUNCTION, 500, "fplInit");
#endif
  return(init);
}

static void * INLINE Init(struct Data *scr,	/* stack oriented */
			  long ASM (*function) (AREG(0) void *), 
			  unsigned long *tags) /* taglist */
{
  ReturnCode ret;
  uchar *buffer;
  struct Data *ptr;
#ifdef AMIGA
  long registers[11];

  memcpy(registers, scr->registers, sizeof(long)*11);
#endif
  /* Set default that just might get changed in SetTags(); */

  memset(scr, 0, sizeof(struct Data)); /* NULLs everything! */

  scr->Alloc=DefaultAlloc;
  scr->Dealloc=DefaultDealloc;;
  scr->hash_size=FPL_HASH_SIZE;
  scr->runs=0;
  InitFree(scr); /* init memory caches */

#ifdef AMIGA

  memcpy(scr->registers, registers, sizeof(long)*11);

  scr->stack_size=FPL_MIN_STACK;
  scr->stack_max=FPL_MAX_STACK;
  scr->stack_limit=FPL_MAX_LIMIT;
  scr->stack_margin=FPLSTACK_MINIMUM;
#endif

  SetTags(scr, tags); /* read tags and set proper members */

  buffer=(uchar *)MALLOCA(BUF_SIZE);
  if(!buffer)
    /* fail! */
    return(NULL);

#ifdef AMIGA
#pragma msg 225 ignore	/* ignore the 225 warnings that occur on the following
			   assign! */
#endif
  scr->function=(long ASM (*)(AREG(0) void *))function;

#ifdef AMIGA
#pragma msg 225 warning	/* enable the 225 warnings again! */
#endif

  scr->buf=buffer;

#if defined(AMIGA) && defined(SHARED)
  scr->stack_base=MALLOCA(scr->stack_size);
  if(!scr->stack_base)
    return(NULL);
  scr->intern_stack = (long)scr->stack_base + scr->stack_size;
  Forbid();
  scr->task = FindTask(NULL);  /* get pointer to our task! */
  Permit();
#endif

  if(ret=InitHash(scr))
    return(NULL);

  ptr=(struct Data *)MALLOCA(sizeof(struct Data));
  if(ptr)
    *ptr=*scr; /* copy the entire structure! */

  return((void *)ptr);
}

#ifndef AMIGA /* if not using SAS/C on Amiga */

#ifdef VARARG_FUNCTIONS
long fplResetTags(void *anchor, ...)
{
  va_list tags;
  long ret;
#ifdef SUNOS
  va_start(tags); /* get parameter list */
#else
  va_start(tags, anchor); /* get parameter list */
#endif
  ret = fplReset(anchor, (unsigned long *)tags);
  va_end(tags);
  return ret;
}
#else
long PREFIX fplResetTags(void *anchor, unsigned long tags, ...)
{
  return(fplReset(anchor, &tags));
}
#endif

#endif

/**********************************************************************
 *
 * fplReset();
 *
 * This function is used to change or add tags to FPL. All tags
 * available for fplFree() is legal. Not changed tags will remain
 * as they were before this call!
 *
 * I had to insert this function since I found out that I wanted to
 * alter the userdata in my application using FPL, and that was hard
 * doing so (nice) without this change.
 * 
 * Library front end to SetTags();
 *
 *****/

ReturnCode PREFIX fplReset(AREG(0) struct Data *scr,
		 	   AREG(1) unsigned long *tags)
{
#ifdef DEBUGMAIL
  DebugMail(scr, MAIL_FUNCTION, 500, "fplReset");
#endif
  if(!scr)
    return FPLERR_ILLEGAL_ANCHOR;
  return SetTags(scr, tags);
}


/**********************************************************************
 *
 * SetTags();
 *
 * Read the taglist supplied in the second parameter, and set all data
 * according to those.
 *
 *****/

static ReturnCode REGARGS
SetTags(struct Data *scr,
        unsigned long *tags)
{
  if(!scr)
    return(FPLERR_ILLEGAL_ANCHOR);

  while(tags && *tags) {
    switch(*tags++) {
#ifdef AMIGA
#pragma msg 225 ignore	/* ignore the 225 warnings that occur on the following
			   four assigns! */
#endif
    case FPLTAG_INTERVAL:
      scr->interfunc=(long ASM (*)(AREG(0) void *))*tags;
      break;

    case FPLTAG_INTERNAL_ALLOC:
      scr->Alloc=(void * ASM (*)(DREG(0) long,
								 AREG(0) void *))*tags;
      break;
    case FPLTAG_INTERNAL_DEALLOC:
      scr->Dealloc=(void ASM (*)(AREG(1) void *,
								 DREG(0) long,
								 AREG(0) void *))*tags;
      break;
#ifdef AMIGA
#pragma msg 225 warning /* enable the 225 warning again for correct program
			   checking! */
#endif

    case FPLTAG_REREAD_CHANGES:
      scr->flags = BitToggle(scr->flags, FPLDATA_REREAD_CHANGES, *tags);
      break;

    case FPLTAG_FLUSH_NOT_IN_USE:
      scr->flags = BitToggle(scr->flags, FPLDATA_FLUSH_NOT_IN_USE, *tags);
      break;

    case FPLTAG_KIDNAP_CACHED:
      scr->flags = BitToggle(scr->flags, FPLDATA_KIDNAP_CACHED, *tags);
      break;

    case FPLTAG_PREVENT_RUNNING_SAME:
      scr->flags = BitToggle(scr->flags, FPLDATA_PREVENT_RUNNING_SAME, *tags);
      break;

    case FPLTAG_AUTOCOMPILE:
      scr->flags = BitToggle(scr->flags, FPLDATA_AUTOCOMPILE, *tags);
      break;

    case FPLTAG_AUTORUN:
      scr->flags = BitToggle(scr->flags, FPLDATA_AUTORUN, *tags);
      break;
      
    case FPLTAG_HASH_TABLE_SIZE:
      if(*tags>FPL_MIN_HASH)
	scr->hash_size=*tags;
      break;

    case FPLTAG_USERDATA:
      scr->userdata=(void *)*tags;
      break;

    case FPLTAG_ALLFUNCTIONS:
      scr->flags = BitToggle(scr->flags, FPLDATA_ALLFUNCTIONS, *tags);
      break;

    case FPLTAG_NESTED_COMMENTS:
      scr->flags = BitToggle(scr->flags, FPLDATA_NESTED_COMMENTS, *tags);
      break;

    case FPLTAG_CACHEALLFILES:
      if(*tags) {
	scr->flags|=FPLDATA_CACHEALLFILES;
	if(*tags == FPLCACHE_EXPORTS)
	  scr->flags|=FPLDATA_CACHEEXPORTS;
      } else
	scr->flags &= ~(FPLDATA_CACHEALLFILES|FPLDATA_CACHEEXPORTS);
      break;

#ifdef AMIGA
    case FPLTAG_STACK:
      /* Only change stack if the required size is large enough! */
      if(*tags>FPL_MIN_STACK)
	scr->stack_size=(long)*tags;
      break;

    case FPLTAG_MAXSTACK:
      /* Only change this if the required size is large enough! */
      if(*tags>FPL_MIN_STACK)
	scr->stack_max=(long)*tags;
      break;

    case FPLTAG_STACKLIMIT:
      /* Only change this if the required size is large enough! */
      if(*tags>FPL_MIN_STACK)
	scr->stack_limit=(long)*tags;      
      break;

    case FPLTAG_MINSTACK:
      /* Only change this if the required size is larger than default! */
      if(*tags>FPLSTACK_MINIMUM)
	scr->stack_margin=*tags;
      break;
#endif

    case FPLTAG_IDENTITY:
      /* new from version 9: Host process identifier! */
      scr->identifier = (uchar *)(*tags);
      break;
      
    case FPLTAG_DEBUG:
      scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_GLOBAL, *tags);
      break;
      
    case FPLTAG_ERROR_BUFFER:
      scr->error = (uchar *)(*tags);
      break;

    }
    tags++; /* next! */
  }
  return(FPL_OK);
}

long REGARGS
BitToggle(long original, /* Original 32 bits */
	  long bit,      /* alternate bit pattern */
	  long OnOff)    /* Or/And boolean, TRUE==OR, FALSE==AND */
{
  if(OnOff)
    return ( original | bit );
  else
    return ( original & ~bit );
}