pike.git / src / pike_types.c

version» Context lines:

pike.git/src/pike_types.c:1: - /*\ - ||| This file a part of Pike, and is copyright by Fredrik Hubinette - ||| Pike is distributed as GPL (General Public License) - ||| See the files COPYING and DISCLAIMER for more information. - \*/ - /**/ + /* + || This file is part of Pike. For copyright information see COPYRIGHT. + || Pike is distributed under GPL, LGPL and MPL. See the file COPYING + || for more information. + */ +    #include "global.h" - RCSID("$Id: pike_types.c,v 1.145 2000/12/05 21:08:20 per Exp $"); +    #include <ctype.h>   #include "svalue.h" - #include "pike_types.h" +    #include "stralloc.h" -  + #include "pike_types.h"   #include "stuff.h"   #include "array.h"   #include "program.h"   #include "constants.h"   #include "object.h"   #include "multiset.h"   #include "mapping.h"   #include "pike_macros.h"   #include "pike_error.h"   #include "las.h" - #include "language.h" +    #include "lex.h"   #include "pike_memory.h"   #include "bignum.h"   #include "main.h"   #include "opcodes.h" -  + #include "cyclic.h" + #include "gc.h" + #include "pike_compiler.h" + #include "block_allocator.h"      #ifdef PIKE_DEBUG   #define PIKE_TYPE_DEBUG   #endif /* PIKE_DEBUG */    - int max_correct_args; + /* +  * Flags used by low_match_types(). +  */ + #define A_EXACT 1 + #define B_EXACT 2 + #define NO_MAX_ARGS 4 + #define NO_SHORTCUTS 8    - static void internal_parse_type(char **s); - static ptrdiff_t type_length(char *t); - static int low_pike_types_le(char *a, char *b, -  int array_cnt, unsigned int flags); - static int low_check_indexing(char *type, char *index_type, node *n); + #define TYPE_GROUPING    - #define TWOT(X,Y) (((X) << 8)+(Y)) - #define EXTRACT_TWOT(X,Y) TWOT(EXTRACT_UCHAR(X), EXTRACT_UCHAR(Y)) + /* +  * Flags used by pike_types_le() +  */ + #define LE_WEAK_OBJECTS 1 /* Perform weaker checking of objects. */ + #define LE_A_B_SWAPPED 2 /* Argument A and B have been swapped. +  * Relevant for markers. +  */ + #ifdef TYPE_GROUPING + #define LE_A_GROUPED 4 /* Argument A has been grouped. +  * Perform weaker checking for OR-nodes. */ + #define LE_B_GROUPED 8 /* Argument B has been grouped. +  * Perform weaker checking for OR-nodes. */ + #define LE_A_B_GROUPED 12 /* Both the above two flags. */ + #endif + #define LE_USE_HANDLERS 16 /* Call handlers if appropriate. */ + #define LE_EXPLICIT_ZERO 32 /* Zero is not subtype of all others. */      /* -  * basic types are represented by just their value in a string -  * basic type are string, type, int, float, object and program -  * arrays are coded like by the value T_ARRAY followed by the -  * data type, if the type is not known it is T_MIXED, ie: -  * T_ARRAY <data type> -  * mappings are followed by two arguments, the first is the type -  * for the indices, and the second is the type of the data, ie: -  * T_MAPPING <indice type> <data type> -  * multiset works similarly to arrays. -  * functions are _very_ special: -  * they are coded like this: -  * T_FUNCTION <arg type> <arg type> ... <arg type> T_MANY <arg type> <return type> -  * note that the type after T_MANY can be T_VOID -  * T_MIXED matches anything except T_VOID -  * PIKE_T_UNKNOWN only matches T_MIXED and PIKE_T_UNKNOWN -  * objects are coded thus: -  * T_OBJECT <0/1> <program_id> -  * ^ -  * 0 means 'implements' -  * 1 means 'is' (aka 'clone of') -  * Integers are encoded as: -  * T_INT <min> <max> -  * Everything except T_VOID matches T_ZERO. +  * Flags used by low_get_first_arg_type() +  * +  * Note that these differ for the flags to get_first_arg_type().    */ -  + #define FILTER_KEEP_VOID 1 /* Keep void during the filtering. */    - PMOD_EXPORT struct pike_string *string_type_string; - PMOD_EXPORT struct pike_string *int_type_string; - PMOD_EXPORT struct pike_string *float_type_string; - PMOD_EXPORT struct pike_string *function_type_string; - PMOD_EXPORT struct pike_string *object_type_string; - PMOD_EXPORT struct pike_string *program_type_string; - PMOD_EXPORT struct pike_string *array_type_string; - PMOD_EXPORT struct pike_string *multiset_type_string; - PMOD_EXPORT struct pike_string *mapping_type_string; - PMOD_EXPORT struct pike_string *type_type_string; - PMOD_EXPORT struct pike_string *mixed_type_string; - PMOD_EXPORT struct pike_string *void_type_string; - PMOD_EXPORT struct pike_string *zero_type_string; - PMOD_EXPORT struct pike_string *any_type_string; - PMOD_EXPORT struct pike_string *weak_type_string; /* array|mapping|multiset|function */ + /* +  * Flags used as flag_method to mk_type() +  */ + #define PT_COPY_CAR 1 + #define PT_COPY_CDR 2 + #define PT_COPY_BOTH 3 + #define PT_IS_MARKER 4 /* The node is a marker. */    - static struct pike_string *a_markers[10],*b_markers[10]; + /* Number of entries in the struct pike_type hash-table. */ + #define PIKE_TYPE_HASH_SIZE 65535    -  +  + #ifdef PIKE_TYPE_DEBUG + static int indent=0; + #endif +  + int max_correct_args; +  + PMOD_EXPORT struct pike_type *string0_type_string; + PMOD_EXPORT struct pike_type *string_type_string; + PMOD_EXPORT struct pike_type *int_type_string; + PMOD_EXPORT struct pike_type *float_type_string; + PMOD_EXPORT struct pike_type *function_type_string; + PMOD_EXPORT struct pike_type *object_type_string; + PMOD_EXPORT struct pike_type *program_type_string; + PMOD_EXPORT struct pike_type *array_type_string; + PMOD_EXPORT struct pike_type *multiset_type_string; + PMOD_EXPORT struct pike_type *mapping_type_string; + PMOD_EXPORT struct pike_type *type_type_string; + PMOD_EXPORT struct pike_type *mixed_type_string; + PMOD_EXPORT struct pike_type *void_type_string; + PMOD_EXPORT struct pike_type *zero_type_string; + PMOD_EXPORT struct pike_type *any_type_string; + PMOD_EXPORT struct pike_type *weak_type_string; /* array|mapping|multiset|function */ + struct pike_type *sscanf_type_string; + struct pike_type *sscanf_76_type_string; +  + #ifdef DO_PIKE_CLEANUP + struct pike_type_location *all_pike_type_locations = NULL; + #endif /* DO_PIKE_CLEANUP */ +  + static struct pike_type *a_markers[10], *b_markers[10]; +    static struct program *implements_a;   static struct program *implements_b; -  + static int implements_mode;    -  + #ifdef PIKE_DEBUG + void TYPE_STACK_DEBUG(const char *fun) + { + #if 0 +  fprintf(stderr, "%25s(): stack_depth:%ld mark_stack_depth:%ld\n", +  fun, (long)(Pike_compiler->type_stackp - type_stack), +  (long)(Pike_compiler->pike_type_mark_stackp - pike_type_mark_stack)); + #endif /* 0 */ + } + #endif /* PIKE_DEBUG */ +    static void clear_markers(void)   {    unsigned int e;    for(e=0;e<NELEM(a_markers);e++)    {    if(a_markers[e])    { -  free_string(a_markers[e]); +  free_type(a_markers[e]);    a_markers[e]=0;    }    if(b_markers[e])    { -  free_string(b_markers[e]); +  free_type(b_markers[e]);    b_markers[e]=0;    }    }   }    - #ifdef PIKE_DEBUG - void check_type_string(struct pike_string *s) + void compiler_discard_type (void)   { -  if(debug_findstring(s) != s) -  fatal("Type string not shared.\n"); +  ptrdiff_t len = pop_stack_mark(); +  TYPE_STACK_DEBUG("paranoid_pop_type"); +  for (;len > 0; len--) { +  /* Get rid of excess junk. */ +  free_type(*(Pike_compiler->type_stackp--)); +  } + }    -  if(type_length(s->str) != s->len) + struct pike_type *debug_pop_type(void)   { -  stupid_describe_type(s->str,s->len); -  fatal("Length of type is wrong. (should be %ld, is %ld)\n", -  PTRDIFF_T_TO_LONG(type_length(s->str)), -  PTRDIFF_T_TO_LONG(s->len)); +  struct pike_type *t = pop_unfinished_type(); +  TYPE_STACK_DEBUG("pop_type"); +  type_stack_mark(); +  return t;   } - } - #endif +     - void init_types(void) + struct pike_type *debug_compiler_pop_type(void)   { -  string_type_string = CONSTTYPE(tString); -  int_type_string = CONSTTYPE(tInt); -  object_type_string = CONSTTYPE(tObj); -  program_type_string = CONSTTYPE(tPrg); -  float_type_string = CONSTTYPE(tFloat); -  mixed_type_string=CONSTTYPE(tMix); -  array_type_string=CONSTTYPE(tArray); -  multiset_type_string=CONSTTYPE(tMultiset); -  mapping_type_string=CONSTTYPE(tMapping); -  function_type_string=CONSTTYPE(tFunction); -  type_type_string=CONSTTYPE(tType); -  void_type_string=CONSTTYPE(tVoid); -  zero_type_string=CONSTTYPE(tZero); -  any_type_string=CONSTTYPE(tOr(tVoid,tMix)); -  weak_type_string=CONSTTYPE(tOr4(tArray,tMultiset,tMapping, -  tFuncV(tNone,tZero,tOr(tMix,tVoid)))); +  TYPE_STACK_DEBUG("compiler_pop_type"); +  if(Pike_compiler->num_parse_error) +  { +  struct pike_type *res; +  compiler_discard_type(); +  add_ref(res = mixed_type_string); +  type_stack_mark(); +  return res; +  }else{ +  return debug_pop_type();    } -  + }    - static ptrdiff_t type_length(char *t) + PMOD_EXPORT char *get_name_of_type(TYPE_T t)   { -  char *q=t; - one_more_type: -  switch(EXTRACT_UCHAR(t++)) +  switch(t)    { -  default: -  fatal("Error in type string %d.\n",EXTRACT_UCHAR(t-1)); -  /*NOTREACHED*/ +  case T_ARRAY: return "array"; +  case T_MAPPING: return "mapping"; +  case T_MULTISET: return "multiset"; +  case T_OBJECT: return "object"; +  case T_FUNCTION: return "function"; +  case T_PROGRAM: return "program"; +  case T_STRING: return "string"; +  case T_TYPE: return "type"; +  case T_INT: return "int"; +  case T_FLOAT: return "float"; +  case T_ZERO: return "zero"; +  case T_VOID: return "void"; +  case T_MIXED: return "mixed"; +  default: return "unknown";    -  + #ifdef PIKE_DEBUG +  /* Let's make it able to describe any type constant in debug mode. */ +  case T_UNFINISHED: return "T_UNFINISHED"; +  case T_MANY: return "T_MANY"; +  case PIKE_T_INT_UNTYPED: return "PIKE_T_INT_UNTYPED"; +  case PIKE_T_GET_SET: return "PIKE_T_GET_SET"; +  case PIKE_T_FREE: return "PIKE_T_FREE"; +  case PIKE_T_ATTRIBUTE: return "PIKE_T_ATTRIBUTE"; +  case PIKE_T_NSTRING: return "PIKE_T_NSTRING"; +  case PIKE_T_RING: return "PIKE_T_RING"; +  case PIKE_T_NAME: return "PIKE_T_NAME"; +  case PIKE_T_SCOPE: return "PIKE_T_SCOPE"; +  case PIKE_T_TUPLE: return "PIKE_T_TUPLE"; +  case T_ASSIGN: return "T_ASSIGN"; +  case T_DELETED: return "T_DELETED"; +  case PIKE_T_UNKNOWN: return "PIKE_T_UNKNOWN"; +  case T_OBJ_INDEX: return "T_OBJ_INDEX"; +  case T_SVALUE_PTR: return "T_SVALUE_PTR"; +  case T_ARRAY_LVALUE: return "T_ARRAY_LVALUE"; +  case T_NOT: return "T_NOT"; +  case T_AND: return "T_AND"; +  case T_OR: return "T_OR"; +  +  case T_STORAGE: return "object storage"; +  case T_MAPPING_DATA: return "mapping_data"; +  case T_PIKE_FRAME: return "pike_frame"; +  case T_MULTISET_DATA: return "multiset_data"; +  case T_STRUCT_CALLABLE: return "callable"; + #endif +  } + } +  +  + #define TWOT(X,Y) (((X) << 8)+(Y)) +  + static int low_pike_types_le(struct pike_type *a, struct pike_type *b, +  int array_cnt, unsigned int flags); + static int low_check_indexing(struct pike_type *type, +  struct pike_type *index_type, +  node *n); + static void internal_parse_type(const char **s); +  + /* +  * New and improved type representation system. +  * +  * This representation is new in Pike 7.3. +  * +  * Node: Car: Cdr: +  * --------------------------------------------- +  * SCOPE num vars (int) type +  * ASSIGN variable (int) type +  * NAME name (string) type +  * ATTRIBUTE name (string) type Added in 7.7. +  * FUNCTION type FUNCTION|MANY +  * MANY many type return type +  * RING type type Reserved. +  * TUPLE type type Reserved. +  * MAPPING index type value type +  * OR type (not OR) type +  * AND type type +  * ARRAY type - +  * MULTISET type - +  * NOT type - +  * '0'-'9' - - +  * FLOAT - - +  * STRING ZERO, INT or OR - Range added in 7.7 +  * TYPE type - +  * PROGRAM type - +  * MIXED - - +  * VOID - - +  * ZERO - - +  * UNKNOWN - - +  * INT min (int) max (int) +  * OBJECT implements/is object id(int) +  * +  * Note that the cdr of a FUNCTION is a valid FUNCTION for the rest of +  * the arguments. +  * +  * Note also that functions that don't take any arguments, or just +  * a many argument just have a MANY node, and no FUNCTION node. +  * +  */ + static struct block_allocator type_allocator = BA_INIT(sizeof(struct pike_type), 128); +  + PMOD_EXPORT void really_free_pike_type(struct pike_type * t) { +  ba_free(&type_allocator, t); + } +  + ATTRIBUTE((malloc)) + PMOD_EXPORT struct pike_type * alloc_pike_type() { +  return ba_alloc(&type_allocator); + } +  + PMOD_EXPORT void count_memory_in_pike_types(size_t *n, size_t *s) { +  ba_count_all(&type_allocator, n, s); + } +  + struct pike_type **pike_type_hash = NULL; + size_t pike_type_hash_size = 0; +  + void debug_free_type(struct pike_type *t) + { + #ifdef DEBUG_MALLOC +  if (t == (struct pike_type *)(size_t)0x55555555) { +  Pike_fatal("Freeing dead type.\n"); +  } + #endif /* DEBUG_MALLOC */ +  loop: +  if (!sub_ref(t)) { +  unsigned INT32 hash = t->hash & pike_type_hash_size; +  struct pike_type **t2 = pike_type_hash + hash; +  struct pike_type *car, *cdr; +  unsigned INT32 type; + #ifdef PIKE_DEBUG +  /* PIKE_DEBUG code */ +  if (hash > pike_type_hash_size) { +  Pike_fatal("Modulo operation failed for hash:%u, index:%u, size:%u.\n", +  t->hash, hash, pike_type_hash_size); +  } +  /* End PIKE_DEBUG code */ + #endif +  while (*t2) { +  if (*t2 == t) { +  *t2 = t->next;    break; -  +  } +  t2 = &((*t2)->next); +  }    -  case T_SCOPE: -  case T_ASSIGN: -  t++; -  goto one_more_type; +  car = t->car; +  cdr = t->cdr; +  type = t->type;    -  case T_FUNCTION: -  while(EXTRACT_UCHAR(t)!=T_MANY) t+=type_length(t); /* skip arguments */ -  t++; +  really_free_pike_type((struct pike_type*)debug_malloc_pass(t));    -  +  /* FIXME: Recursion: Should we use a stack? */ +  switch(type) { +  case T_FUNCTION: +  case T_MANY:    case T_TUPLE:    case T_MAPPING:    case T_OR:    case T_AND: -  t+=type_length(t); +  case PIKE_T_RING: +  /* Free car & cdr */ +  free_type(car); +  t = (struct pike_type *) cdr; +  debug_free_type_preamble (t); +  goto loop;       case T_ARRAY:    case T_MULTISET:    case T_NOT: -  goto one_more_type; +  case T_TYPE: +  case T_PROGRAM: +  case T_STRING: +  /* Free car */ +  t = (struct pike_type *) car; +  debug_free_type_preamble (t); +  goto loop;    -  +  case T_SCOPE: +  case T_ASSIGN: +  /* Free cdr */ +  t = (struct pike_type *) cdr; +  debug_free_type_preamble (t); +  goto loop; +  +  case PIKE_T_ATTRIBUTE: +  case PIKE_T_NAME: +  free_string((struct pike_string *)car); +  t = (struct pike_type *) cdr; +  debug_free_type_preamble (t); +  goto loop; +  + #ifdef PIKE_DEBUG    case '0':    case '1':    case '2':    case '3':    case '4':    case '5':    case '6':    case '7':    case '8':    case '9':    case T_FLOAT: -  case T_STRING: +  case T_MIXED: +  case T_VOID: +  case T_ZERO: +  case PIKE_T_UNKNOWN: +  case T_INT: +  case T_OBJECT: +  break; +  +  default: +  Pike_fatal("free_type(): Unhandled type-node: %d\n", type); +  break; + #endif /* PIKE_DEBUG */ +  } +  } + } +  + static inline struct pike_type *debug_mk_type(unsigned INT32 type, +  struct pike_type *car, +  struct pike_type *cdr, +  int flag_method) + { +  /* FIXME: The hash ought to be based on the tree contents, regardless +  * of what the adresses of the type nodes are. +  */ +  struct pike_type *t; +  unsigned INT32 index, +  hash = DO_NOT_WARN((unsigned INT32) +  ((ptrdiff_t)type*0x10204081)^ +  (0x8003*PTR_TO_INT(car))^ +  ~(0x10001*PTR_TO_INT(cdr))); +  +  hash ^= (hash >> 20) ^ (hash >> 12); +  hash ^= (hash >> 7) ^ (hash >> 4); +  +  index = hash & pike_type_hash_size; + #ifdef PIKE_EXTRA_DEBUG +  static unsigned INT32 extra_debug_index = (unsigned INT32)~0; + #endif /* PIKE_EXTRA_DEBUG */ + #ifdef PIKE_DEBUG +  /* PIKE_DEBUG code */ +  if (type & ~255) { +  /* The bad type node on OSF/1 seems to be: +  * +  * type: 0xffff +  * car: valid pointer. +  * cdr: 0x400000000 +  * next: 0x100000000 +  */ +  Pike_fatal("Attempt to create an invalid type node: %d(%s)\n" +  " car: %p\n" +  " cdr: %p\n", +  type, get_name_of_type(type), +  car, cdr); +  } +  if (index > pike_type_hash_size) { +  Pike_fatal("Modulo operation failed for hash:%u, index:%u, " +  "size:%"PRINTSIZET"d.\n", +  hash, index, pike_type_hash_size); +  } +  /* End PIKE_DEBUG code */ + #endif + #ifdef PIKE_EXTRA_DEBUG +  if ((!~extra_debug_index) && +  (type == T_FUNCTION) && +  (car->type == T_STRING) && +  (cdr->type == T_FUNCTION) && +  (cdr->car->type == T_STRING) && +  (cdr->cdr->type == T_MANY) && +  (cdr->cdr->car->type == T_VOID) && +  (cdr->cdr->cdr->type == T_STRING)) { +  /* Attempt to detect why we get a core-dump on OSF/1 +  * when loading Unicode.so from test_resolv. +  * +  * The problem triggs when the type for normalize() is created. +  * function(string,string:string) +  * /grubba 2005-02-04 +  * +  * Load order: +  * Module Hashtable status Note +  * Nettle.so OK +  * ___Oracle.so - load_module() fails. +  * Image.so - loads ok. +  * Unicode.so FAIL +  * +  * pike_type node: +  * Field Before After +  * t 1404b5020 1404b5020 +  * t->type 4 (function) 65535 (unknown) +  * t->car 1404863f8 (1404863f8) 140557560 (1404863f8) +  * t->cdr 1404b43d8 (1404b43d8) 400000000 (1404b43d8) +  * t->next 0 100000000 +  * /grubba 2005-06-03 +  */ +  extra_debug_index = index; +  } + #endif /* PIKE_EXTRA_DEBUG */ +  for(t = pike_type_hash[index]; t; t = t->next) { + #ifdef PIKE_EXTRA_DEBUG +  if (index == extra_debug_index) { +  fprintf(stderr, +  " %s:%d:PIKE_EXTRA_DEBUG:\n" +  " t: %p\n", +  __FILE__, __LINE__, +  t); +  fprintf(stderr, +  " t->type:%d (%s)\n" +  " t->car: %p (%p)\n" +  " t->cdr: %p (%p)\n" +  " t->next:%p\n", +  t->type, get_name_of_type(t->type), +  t->car, car, +  t->cdr, cdr, +  t->next); +  } + #endif /* PIKE_EXTRA_DEBUG */ +  if ((t->hash == hash) && (t->type == type) && +  (t->car == car) && (t->cdr == cdr)) { +  /* Free car & cdr as appropriate. */ +  switch(type) { +  case T_FUNCTION: +  case T_MANY: +  case T_TUPLE: +  case T_MAPPING: +  case T_OR: +  case T_AND: +  case PIKE_T_RING: +  /* Free car & cdr */ +  free_type((struct pike_type *)debug_malloc_pass(car)); +  free_type((struct pike_type *)debug_malloc_pass(cdr)); +  break; +  +  case T_ARRAY: +  case T_MULTISET: +  case T_NOT:    case T_TYPE:    case T_PROGRAM: -  +  case T_STRING: +  /* Free car */ +  free_type((struct pike_type *)debug_malloc_pass(car)); +  break; +  +  case T_SCOPE: +  case T_ASSIGN: +  /* Free cdr */ +  free_type((struct pike_type *)debug_malloc_pass(cdr)); +  break; +  +  case PIKE_T_ATTRIBUTE: +  case PIKE_T_NAME: +  free_string((struct pike_string *)debug_malloc_pass(car)); +  free_type((struct pike_type *)debug_malloc_pass(cdr)); +  break; + #ifdef PIKE_DEBUG +  case '0': +  case '1': +  case '2': +  case '3': +  case '4': +  case '5': +  case '6': +  case '7': +  case '8': +  case '9': +  case T_FLOAT:    case T_MIXED:    case T_VOID:    case T_ZERO:    case PIKE_T_UNKNOWN: -  +  case T_INT: +  case T_OBJECT:    break;    -  case T_INT: -  t+=sizeof(INT32)*2; +  default: +  Pike_fatal("mk_type(): Unhandled type-node: %d\n", type);    break; -  + #endif /* PIKE_DEBUG */ +  } +  add_ref((struct pike_type *)debug_malloc_pass(t)); +  return t; +  } +  }    -  + #ifdef PIKE_DEBUG +  if ((type == T_OR) && (car->type == T_OR)) { +  Pike_fatal("Invalid CAR to OR node.\n"); +  } + #endif +  +  debug_malloc_pass(t = ba_alloc(&type_allocator)); +  + #ifdef ATOMIC_SVALUE +  t->ref_type = PIKE_T_TYPE; + #endif +  t->refs = 0; +  add_ref(t); /* For DMALLOC... */ +  t->type = type; +  t->flags = 0; +  t->car = car; +  t->cdr = cdr; +  +  t->hash = hash; +  t->next = pike_type_hash[index]; +  pike_type_hash[index] = t; +  +  if (flag_method) { +  if (flag_method == PT_IS_MARKER) { +  t->flags = PT_FLAG_MARKER_0 << (type-'0'); +  } else if (type == PIKE_T_SCOPE) { +  /* The scope blocks propagation of markers. */ +  t->flags = cdr->flags & ~(PT_FLAG_MARKER|PT_FLAG_ASSIGN); +  } else { +  if (car && (flag_method & PT_COPY_CAR)) { +  t->flags |= car->flags; +  } +  if (cdr && (flag_method & PT_COPY_CDR)) { +  t->flags |= cdr->flags; +  } +  } +  } +  + #ifdef DEBUG_MALLOC +  switch(type) { +  case T_FUNCTION: +  case T_MANY: +  case T_TUPLE: +  case T_MAPPING: +  case T_OR: +  case T_AND: +  case PIKE_T_RING: +  debug_malloc_pass(car); +  debug_malloc_pass(cdr); +  break; +  +  case T_ARRAY: +  case T_MULTISET: +  case T_NOT: +  case T_TYPE: +  case T_PROGRAM: +  case T_STRING: +  debug_malloc_pass(car); +  break; +  +  case T_ASSIGN: +  t->flags |= PT_FLAG_ASSIGN_0 << PTR_TO_INT(car); +  /* FALL_THROUGH */ +  case T_SCOPE: +  debug_malloc_pass(cdr); +  break; +  +  case PIKE_T_ATTRIBUTE: +  case PIKE_T_NAME: +  debug_malloc_pass(car); +  debug_malloc_pass(cdr); +  break; +  +  case '0': +  case '1': +  case '2': +  case '3': +  case '4': +  case '5': +  case '6': +  case '7': +  case '8': +  case '9': +  case T_FLOAT: +  case T_MIXED: +  case T_VOID: +  case T_ZERO: +  case PIKE_T_UNKNOWN: +  case T_INT:    case T_OBJECT: -  t++; -  t+=sizeof(INT32); +     break; -  +  +  default: +  Pike_fatal("mk_type(): Unhandled type-node: %d\n", type); +  break;    } -  return t-q; + #else /* !DEBUG_MALLOC */ +  if (type == T_ASSIGN) { +  t->flags |= PT_FLAG_ASSIGN_0 << PTR_TO_INT(car);    } -  + #endif /* DEBUG_MALLOC */    -  +  return t; + }    - unsigned char type_stack[PIKE_TYPE_STACK_SIZE]; - unsigned char *pike_type_mark_stack[PIKE_TYPE_STACK_SIZE/4]; + #ifdef DEBUG_MALLOC + #define mk_type(T,CAR,CDR,FLAG) ((struct pike_type *)debug_malloc_pass(debug_mk_type(T,CAR,CDR,FLAG))) + #else /* !DEBUG_MALLOC */ + #define mk_type debug_mk_type + #endif /* DEBUG_MALLOC */    -  + #ifdef PIKE_DEBUG + void debug_check_type_string(struct pike_type *s) + { +  /* FIXME: Add verification code here */ + }    -  + #endif /* PIKE_DEBUG */ +  + struct pike_type *type_stack[PIKE_TYPE_STACK_SIZE]; + struct pike_type **pike_type_mark_stack[PIKE_TYPE_STACK_SIZE/4]; +    ptrdiff_t pop_stack_mark(void)   {    Pike_compiler->pike_type_mark_stackp--;    if(Pike_compiler->pike_type_mark_stackp<pike_type_mark_stack) -  fatal("Type mark stack underflow\n"); +  Pike_fatal("Type mark stack underflow\n");    -  +  TYPE_STACK_DEBUG("pop_stack_mark"); +     return Pike_compiler->type_stackp - *Pike_compiler->pike_type_mark_stackp;   }    - void pop_type_stack(void) + void type_stack_pop_to_mark(void)   { -  Pike_compiler->type_stackp--; -  if(Pike_compiler->type_stackp<type_stack) -  fatal("Type stack underflow\n"); +  pop_stack_mark(); +  while(Pike_compiler->type_stackp > *Pike_compiler->pike_type_mark_stackp) { +  free_type(*(Pike_compiler->type_stackp--));    }    - void type_stack_pop_to_mark(void) +  TYPE_STACK_DEBUG("type_stack_pop_to_mark"); + } +  + struct pike_type *debug_peek_type_stack(void)   { -  Pike_compiler->type_stackp-=pop_stack_mark(); - #ifdef PIKE_DEBUG -  if(Pike_compiler->type_stackp<type_stack) -  fatal("Type stack underflow\n"); +  return *(Pike_compiler->type_stackp); + } +  + void debug_push_int_type(INT_TYPE min, INT_TYPE max) + { + #if SIZEOF_INT_TYPE > 4 + /* a bit kludgy: should maybe really allow 64 bit INT_TYPE */ + /* see also extract_type_int */ +  +  if (min<MIN_INT32) min=MIN_INT32; +  else if (min>MAX_INT32) min=MAX_INT32; +  if (max<MIN_INT32) max=MIN_INT32; +  else if (max>MAX_INT32) max=MAX_INT32; +  + #if 0 +  if (min!=(INT32)min || +  max!=(INT32)max) +  Pike_fatal("push_int_type(): int outside INT32 range (sorry)" +  " (%"PRINTPIKEINT"d..%"PRINTPIKEINT"d)\n", +  min,max);   #endif -  + #endif +  + #ifdef PIKE_DEBUG +  if (min > max) +  Pike_fatal("push_int_type(): Bad integer range:" +  " min:%"PRINTPIKEINT"d, max:%"PRINTPIKEINT"d.\n", +  min, max); + #endif /* PIKE_DEBUG */ +  +  if (!min && !max) { +  /* Special case... */ +  push_type(T_ZERO); +  } else { +  *(++Pike_compiler->type_stackp) = mk_type(T_INT, +  (void *)(ptrdiff_t)min, +  (void *)(ptrdiff_t)max, 0);    } -  +  TYPE_STACK_DEBUG("push_int_type"); + }    - void type_stack_reverse(void) + void debug_push_object_type(int flag, INT32 id)   { -  ptrdiff_t a; -  a=pop_stack_mark(); -  reverse((char *)(Pike_compiler->type_stackp-a),a,1); +  *(++Pike_compiler->type_stackp) = mk_type(T_OBJECT, +  (void *)(ptrdiff_t)flag, +  (void *)(ptrdiff_t)id, 0); +  +  TYPE_STACK_DEBUG("push_object_type");   }    - void push_type_int(INT32 i) + void debug_push_object_type_backwards(int flag, INT32 id)   { -  ptrdiff_t e; -  for(e = 0; e < (ptrdiff_t)sizeof(i); e++) -  push_type(DO_NOT_WARN((unsigned char)((i>>(e*8)) & 0xff))); +  push_object_type(flag, id);   }    - void push_type_int_backwards(INT32 i) + void debug_push_scope_type(int level)   { -  int e; -  for(e=(int)sizeof(i);e-->0;) -  push_type( (i>>(e*8)) & 0xff ); +  *Pike_compiler->type_stackp = mk_type(T_SCOPE, +  (void *)(ptrdiff_t)level, +  *Pike_compiler->type_stackp, +  PT_COPY_CDR); +  +  TYPE_STACK_DEBUG("push_scope_type");   }    - INT32 extract_type_int(char *p) + void debug_push_assign_type(int marker)   { -  int e; -  INT32 ret=0; -  for(e=0;e<(int)sizeof(INT32);e++) -  ret=(ret<<8) | EXTRACT_UCHAR(p+e); -  return ret; +  marker -= '0'; + #ifdef PIKE_DEBUG +  if ((marker < 0) || (marker > 9)) { +  Pike_fatal("Bad assign marker: %d\n", marker);    } -  + #endif /* PIKE_DEBUG */    - void push_unfinished_type(char *s) +  *Pike_compiler->type_stackp = mk_type(T_ASSIGN, +  (void *)(ptrdiff_t)marker, +  *Pike_compiler->type_stackp, +  PT_COPY_CDR); +  TYPE_STACK_DEBUG("push_assign_type"); + } +  + void debug_push_type_attribute(struct pike_string *attr)   { -  ptrdiff_t e; -  e=type_length(s); -  for(e--;e>=0;e--) push_type(s[e]); +  /* fprintf(stderr, "push_type_attribute(\"%s\")\n", attr->str); */ +  add_ref(attr); +  *Pike_compiler->type_stackp = mk_type(PIKE_T_ATTRIBUTE, +  (void *)attr, +  *Pike_compiler->type_stackp, +  PT_COPY_CDR); +  TYPE_STACK_DEBUG("push_type_name");   }    - static void push_unfinished_type_with_markers(char *s, -  struct pike_string **am) + void debug_push_type_name(struct pike_string *name)   { -  int d,e,c; -  ptrdiff_t len=type_length(s); +  /* fprintf(stderr, "push_type_name(\"%s\")\n", name->str); */ +  add_ref(name); +  *Pike_compiler->type_stackp = mk_type(PIKE_T_NAME, +  (void *)name, +  *Pike_compiler->type_stackp, +  PT_COPY_CDR); +  TYPE_STACK_DEBUG("push_type_name"); + }    -  type_stack_mark(); -  for(e=0;e<len;e++) + void debug_push_finished_type(struct pike_type *t)   { -  switch(c=EXTRACT_UCHAR(s+e)) +  copy_pike_type(*(++Pike_compiler->type_stackp), t); +  +  TYPE_STACK_DEBUG("push_finished_type"); + } +  + /* Only to be used from {or,and}_pike_types() et al! */ + static void push_joiner_type(unsigned int type)   { - #if 1 -  case '0': case '1': case '2': case '3': case '4': -  case '5': case '6': case '7': case '8': case '9': -  if(am[c-'0']) +  /* fprintf(stderr, "push_joiner_type(%d)\n", type); */ +  +  switch(type) { +  case T_OR: +  case T_AND: +  /* Special case: Check if the two top elements are equal. */ +  if (Pike_compiler->type_stackp[-1] == Pike_compiler->type_stackp[0]) { +  free_type(*(Pike_compiler->type_stackp--)); +  return; +  } +  /* Make a new type of the top two types. */ +  --Pike_compiler->type_stackp; + #ifdef PIKE_DEBUG +  if ((*Pike_compiler->type_stackp+1)->type == type) { +  Pike_fatal("Invalid CAR to push_joiner_type().\n"); +  } + #endif /* PIKE_DEBUG */ +  *Pike_compiler->type_stackp = mk_type(type, +  *(Pike_compiler->type_stackp+1), +  *Pike_compiler->type_stackp, +  PT_COPY_BOTH); +  break; +  default: +  Pike_fatal("Illegal joiner type: %d\n", type); +  } + } +  + static void push_reverse_joiner_type(unsigned int type)   { -  push_finished_type_backwards(am[c-'0']); -  }else{ -  push_type(T_ZERO); +  /* fprintf(stderr, "push_reverse_joiner_type(%d)\n", type); */ +  +  switch(type) { +  case T_OR: +  case T_AND: +  /* Special case: Check if the two top elements are equal. */ +  if (Pike_compiler->type_stackp[-1] == Pike_compiler->type_stackp[0]) { +  free_type(*(Pike_compiler->type_stackp--)); +  return;    } -  +  /* Make a new type of the top two types. */ +  --Pike_compiler->type_stackp; + #ifdef PIKE_DEBUG +  if ((*Pike_compiler->type_stackp)->type == type) { +  Pike_fatal("Invalid CAR to push_reverse_joiner_type().\n"); +  } + #endif /* PIKE_DEBUG */ +  *Pike_compiler->type_stackp = mk_type(type, +  *Pike_compiler->type_stackp, +  *(Pike_compiler->type_stackp+1), +  PT_COPY_BOTH);    break; - #endif -  case T_ASSIGN: - #if 1 -  e++; - #else -  push_type(c); -  push_type(EXTRACT_UCHAR(s+ ++e)); - #endif +  default: +  Pike_fatal("Illegal reverse joiner type: %d\n", type); +  } + } +  + static void low_or_pike_types(struct pike_type *t1, +  struct pike_type *t2, +  int zero_implied); +  + void debug_push_type(unsigned int type) + { +  /* fprintf(stderr, "push_type(%d)\n", type); */ +  +  switch(type) { +  case T_OR: +  case T_AND: +  /* Special case: Check if the two top elements are equal. */ +  if (Pike_compiler->type_stackp[-1] == Pike_compiler->type_stackp[0]) { +  free_type(*(Pike_compiler->type_stackp--)); +  return; +  } +  if (Pike_compiler->type_stackp[0]->type == type) { +  /* The top type is the same as our type. +  * Split it and join the parts with the other type. +  */ +  struct pike_type *top = *(Pike_compiler->type_stackp--); +  push_finished_type(top->cdr); +  push_type(type); +  push_finished_type(top->car); +  push_type(type); +  free_type(top); +  return; +  } +  if (type == T_OR) { +  struct pike_type *t1 = *(Pike_compiler->type_stackp--); +  struct pike_type *t2 = *(Pike_compiler->type_stackp--); +  low_or_pike_types(t1, t2, 0); +  free_type(t2); +  free_type(t1); +  return; +  } +  /* FALL_THROUGH */ +  case T_FUNCTION: +  case T_MANY: +  case T_TUPLE: +  case T_MAPPING: +  case PIKE_T_RING: +  /* Make a new type of the top two types. */ +  --Pike_compiler->type_stackp; +  *Pike_compiler->type_stackp = mk_type(type, +  *(Pike_compiler->type_stackp+1), +  *Pike_compiler->type_stackp, +  PT_COPY_BOTH);    break;    -  case T_INT: -  push_type(c); -  for(d=0;d<(int)sizeof(INT32)*2;d++) -  push_type(EXTRACT_UCHAR(s+ ++e)); +  case T_ARRAY: +  case T_MULTISET: +  case T_NOT: +  case T_TYPE: +  case T_PROGRAM: +  case T_STRING: +  /* Make a new type of the top type, and put it in car. */ +  *Pike_compiler->type_stackp = mk_type(type, +  *Pike_compiler->type_stackp, NULL, +  PT_COPY_CAR);    break;    -  +  case T_SCOPE: +  case T_ASSIGN: +  case T_INT:    case T_OBJECT: -  push_type(c); -  for(d=0;d<(int)sizeof(INT32)+1;d++) push_type(EXTRACT_UCHAR(s+ ++e)); +  case PIKE_T_ATTRIBUTE: +  case PIKE_T_NAME: +  default: +  /* Should not occur. */ +  Pike_fatal("Unsupported argument to push_type(): %d\n", type);    break;    -  +  case T_FLOAT: +  case T_MIXED: +  case T_VOID: +  case T_ZERO: +  case PIKE_T_UNKNOWN: +  /* Leaf type. */ +  *(++Pike_compiler->type_stackp) = mk_type(type, NULL, NULL, 0); +  break; +  +  case '0': +  case '1': +  case '2': +  case '3': +  case '4': +  case '5': +  case '6': +  case '7': +  case '8': +  case '9': +  /* Marker. */ +  *(++Pike_compiler->type_stackp) = mk_type(type, NULL, NULL, PT_IS_MARKER); +  break; +  } +  +  TYPE_STACK_DEBUG("push_type"); + } +  + /* Pop one level of types. This is the inverse of push_type() */ + void debug_pop_type_stack(unsigned int expected) + { +  struct pike_type *top; +  if(Pike_compiler->type_stackp<type_stack) +  Pike_fatal("Type stack underflow\n"); +  +  top = *(Pike_compiler->type_stackp); +  /* Special case... */ +  if (top->type == T_MIXED) return; /* Probably due to an earlier error */ +  +  Pike_compiler->type_stackp--; + #ifdef PIKE_DEBUG +  if ((top->type != expected) && +  (top->type != PIKE_T_NAME) && +  (top->type != PIKE_T_ATTRIBUTE)) { +  Pike_fatal("Unexpected type on stack: %d (expected %d)\n", top->type, expected); +  } + #endif /* PIKE_DEBUG */ +  /* OPTIMIZE: It looks like this function is always called with +  * expected == T_ARRAY. +  */ +  switch(top->type) { +  case T_FUNCTION: +  case T_MANY: +  case T_TUPLE: +  case T_MAPPING: +  case T_OR: +  case T_AND: +  case PIKE_T_RING: +  /* Both car & cdr. */ +  push_finished_type(top->cdr); +  push_finished_type(top->car); +  break; +  case T_ARRAY: +  case T_MULTISET: +  case T_NOT: +  case T_TYPE: +  case T_PROGRAM: +  case T_STRING: +  /* car */ +  push_finished_type(top->car); +  break; +  case T_SCOPE: +  case T_ASSIGN: +  /* cdr */ +  push_finished_type(top->cdr); +  break; +  case T_INT: +  case T_OBJECT: +  case T_FLOAT: +  case T_MIXED: +  case T_VOID: +  case T_ZERO: +  case PIKE_T_UNKNOWN: +  case '0': +  case '1': +  case '2': +  case '3': +  case '4': +  case '5': +  case '6': +  case '7': +  case '8': +  case '9': +  /* Leaf */ +  break; +  case PIKE_T_ATTRIBUTE: +  case PIKE_T_NAME: +  /* Pop the name and recurse. */ +  push_finished_type(top->cdr); +  pop_type_stack(expected); +  break;    default: -  push_type(c); +  Pike_error("pop_type_stack(): Unhandled node type: %d\n", top->type);    } -  +  free_type(top); +  +  TYPE_STACK_DEBUG("pop_type_stack");   } -  type_stack_reverse(); +  + void debug_push_reverse_type(unsigned int type) + { +  /* fprintf(stderr, "push_reverse_type(%d)\n", type); */ +  +  switch(type) { +  case T_FUNCTION: +  case T_MANY: +  case T_TUPLE: +  case T_MAPPING: +  case T_OR: +  case T_AND: +  case PIKE_T_RING: +  { +  /* Binary type-node. -- swap the types. */ +  struct pike_type *tmp = Pike_compiler->type_stackp[0]; +  Pike_compiler->type_stackp[0] = Pike_compiler->type_stackp[-1]; +  Pike_compiler->type_stackp[-1] = tmp; +  break;    } -  +  } +  push_type(type);    - void push_finished_type(struct pike_string *type) +  TYPE_STACK_DEBUG("push_reverse_type"); + } +  + /* The marker_set is used as follows: +  * +  * PT_FLAG_MARKER_n Indicates that marker #n should be kept after +  * expansion. +  * +  * PT_FLAG_ASSIGN_n Indicates that the assign to marker #n should +  * NOT be removed. +  */ + static void debug_push_finished_type_with_markers(struct pike_type *type, +  struct pike_type **markers, +  INT32 marker_set)   { -  ptrdiff_t e; -  check_type_string(type); -  for(e=type->len-1;e>=0;e--) push_type(type->str[e]); +  INT32 car_set, cdr_set; +  recurse: + #ifdef PIKE_TYPE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "push_finished_type_with_markers(("); +  simple_describe_type(type); +  fprintf(stderr, "),..., 0x%08x)...\n", marker_set);    } -  + #endif /* PIKE_TYPE_DEBUG */ +  /* We need to replace if there are any markers, or if there's a +  * non-masked assign. +  */ +  if (!(type->flags & (~marker_set | PT_FLAG_MARKER) & PT_FLAG_MARK_ASSIGN)) { +  /* Nothing to replace in this subtree. */ + #ifdef PIKE_TYPE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "Nothing to replace in this subtree.\n"); +  simple_describe_type(type); +  fprintf(stderr, "\n"); +  } + #endif /* PIKE_TYPE_DEBUG */ +  push_finished_type(type); +  return; +  } +  if ((type->type >= '0') && (type->type <= '9')) { +  /* Marker. */ +  unsigned int m = type->type - '0'; + #ifdef PIKE_TYPE_DEBUG +  if ((l_flag > 2) && m) { +  fprintf(stderr, "Marker %d: %p.\n", m, markers[m]); +  } + #endif /* PIKE_TYPE_DEBUG */ +  if (markers[m]) { +  /* The marker has a value. */ +  struct pike_type *type = dmalloc_touch(struct pike_type *, markers[m]); + #ifdef PIKE_TYPE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "Marker value.\n"); +  } + #endif +  /* FIXME: We probably ought to switch to the other marker set here. */ +  markers[m] = NULL; +  push_finished_type_with_markers(type, markers, 0); +  if (type->flags & (PT_FLAG_MARKER|PT_FLAG_ASSIGN)) { +  push_scope_type(0); +  } +  if (markers[m]) free_type(markers[m]); +  markers[m] = dmalloc_touch(struct pike_type *, type); +  } else { +  /* The marker has not been set. */ + #ifdef PIKE_TYPE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "No marker value.\n"); +  } + #endif +  } +  if (marker_set & (PT_FLAG_MARKER_0 << m)) { +  /* The marker should be kept. */ + #ifdef PIKE_TYPE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "Keep marker.\n"); +  } + #endif +  push_type(type->type); +  if (markers[m]) push_type(T_OR); +  } else if (!markers[m]) { +  push_type(T_ZERO); +  } +  TYPE_STACK_DEBUG("push_finished_type_with_markers"); +  return; +  } else if (type->type == T_ASSIGN) { +  /* Assign. */ +  int marker = PTR_TO_INT(type->car); + #ifdef PIKE_TYPE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "Assign to marker %"PRINTPTRDIFFT"d.\n", +  CAR_TO_INT(type)); +  } + #endif /* PIKE_TYPE_DEBUG */ +  if (marker_set & (PT_FLAG_ASSIGN_0 << marker)) { +  /* The assignment should be kept as-is. */ + #ifdef PIKE_TYPE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "Keep assignment.\n"); +  } + #endif /* PIKE_TYPE_DEBUG */ +  /* Clear the flag. */ +  push_finished_type_with_markers(type->cdr, markers, +  marker_set & +  ~(PT_FLAG_ASSIGN_0 << marker)); +  push_assign_type('0' + marker); +  TYPE_STACK_DEBUG("push_finished_type_with_markers"); +  return; +  } else { + #ifdef PIKE_TYPE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "Strip assignment.\n"); +  } + #endif /* PIKE_TYPE_DEBUG */ +  type = type->cdr; +  goto recurse; +  } +  } else if (type->type == PIKE_T_NAME) { +  /* Strip the name, since it won't be correct anymore. */ +  type = type->cdr; +  goto recurse; +  } else if (type->type == PIKE_T_ATTRIBUTE) { +  /* Keep the attribute. */ +  push_finished_type_with_markers(type->cdr, markers, marker_set); +  push_type_attribute((struct pike_string *)type->car); +  } +  /* FIXME: T_SCOPE */    - void push_finished_type_backwards(struct pike_string *type) +  if (type->car) { +  /* Keep markers for assigns in the car. */ +  cdr_set = marker_set | +  ((type->car->flags & PT_FLAG_ASSIGN)>>PT_ASSIGN_SHIFT); +  } else { +  cdr_set = marker_set; +  } +  if (type->cdr) { +  /* Keep assigns for markers in the cdr. */ +  car_set = marker_set | +  ((type->cdr->flags & PT_FLAG_MARKER)<<PT_ASSIGN_SHIFT); +  } else { +  car_set = marker_set; +  } +  +  if ((type->type == T_OR) || (type->type == T_AND)) { +  /* Special case handling for implicit zero. */ +  /* FIXME: Probably ought to use {or,and}_pike_types() here. +  * Problem is that they may mess with the markers... +  */ +  +  type_stack_mark(); +  /* We want to keep markers that have assigns in the car. */ +  push_finished_type_with_markers(type->cdr, markers, cdr_set); +  if (type->type == T_OR) { +  struct pike_type *first = pop_type(); +  struct pike_type *second; +  struct pike_type *res; +  push_finished_type_with_markers(type->car, markers, car_set); +  second = pop_unfinished_type(); +  push_finished_type(res = or_pike_types(first, second, 1)); +  free_type(second); +  free_type(first); +  free_type(res); +  } else if (peek_type_stack() == zero_type_string) { +  pop_stack_mark(); +  } else { +  type_stack_mark(); +  push_finished_type_with_markers(type->car, markers, car_set); +  if (peek_type_stack() == zero_type_string) { +  free_type(pop_unfinished_type()); +  free_type(pop_unfinished_type()); +  push_finished_type(zero_type_string); +  } else { +  pop_stack_mark(); +  pop_stack_mark(); +  push_type(T_AND); +  } +  } +  } else { +  if (type->cdr) { +  /* In all other cases type->cdr will be a valid node if is not NULL. */ +  push_finished_type_with_markers(type->cdr, markers, cdr_set); +  } +  /* In all other cases type->car will be a valid node. */ +  push_finished_type_with_markers(type->car, markers, car_set); +  /* push_type has sufficient magic to recreate the type. */ +  push_type(type->type); +  } +  TYPE_STACK_DEBUG("push_finished_type_with_markers"); + } +  + static void push_type_field(TYPE_FIELD field)   { -  int e; -  check_type_string(type); -  MEMCPY(Pike_compiler->type_stackp, type->str, type->len); -  Pike_compiler->type_stackp+=type->len; +  field &= (BIT_BASIC|BIT_COMPLEX); +  if (!field) { +  /* No values. */ +  push_type(T_ZERO); +  } else if (field == (BIT_BASIC|BIT_COMPLEX)) { +  /* All values. */ +  push_type(T_MIXED); +  } else { +  /* Check the bits... */ +  push_type(T_ZERO); +  +  if (field & BIT_COMPLEX) { +  if (field & BIT_ARRAY) { +  push_type(T_MIXED); +  push_type(T_ARRAY); +  push_type(T_OR);    } -  +  if (field & BIT_MAPPING) { +  push_type(T_MIXED); +  push_type(T_MIXED); +  push_type(T_MAPPING); +  push_type(T_OR); +  } +  if (field & BIT_MULTISET) { +  push_type(T_MIXED); +  push_type(T_MULTISET); +  push_type(T_OR); +  } +  if (field & BIT_OBJECT) { +  push_object_type(0, 0); +  push_type(T_OR); +  } +  if (field & BIT_FUNCTION) { +  push_type(T_ZERO); +  push_type(T_ZERO); +  push_type(T_MIXED); +  push_type(T_OR); +  push_type(T_MANY); +  push_type(T_OR); +  } +  if (field & BIT_PROGRAM) { +  push_object_type(0, 0); +  push_type(T_PROGRAM); +  push_type(T_OR); +  } +  } +  if (field & BIT_BASIC) { +  if (field & BIT_STRING) { +  push_int_type(MIN_INT32, MAX_INT32); +  push_type(T_STRING); +  push_type(T_OR); +  } +  if (field & BIT_TYPE) { +  push_type(T_MIXED); +  push_type(T_TYPE); +  push_type(T_OR); +  } +  if (field & BIT_INT) { +  push_int_type(MIN_INT32, MAX_INT32); +  push_type(T_OR); +  } +  if (field & BIT_FLOAT) { +  push_type(T_FLOAT); +  push_type(T_OR); +  } +  } +  } + }    - struct pike_string *debug_pop_unfinished_type(void) + INT32 extract_type_int(char *p)   { -  ptrdiff_t len, e; -  struct pike_string *s; -  len=pop_stack_mark(); -  s=begin_shared_string(len); -  Pike_compiler->type_stackp-=len; -  MEMCPY(s->str, Pike_compiler->type_stackp, len); -  reverse(s->str, len, 1); -  s=end_shared_string(s); -  check_type_string(s); -  return s; +  int e; +  INT32 ret=0; +  for(e=0;e<(int)sizeof(INT32);e++) +  ret=(ret<<8) | EXTRACT_UCHAR(p+e); +  return ret;   }    - struct pike_string *debug_pop_type(void) + struct pike_type *debug_pop_unfinished_type(void)   { -  struct pike_string *s; -  s=pop_unfinished_type(); -  type_stack_mark(); -  return s; +  ptrdiff_t len; +  +  len = pop_stack_mark(); +  +  if (len != 1) { +  Pike_fatal("pop_unfinished_type(): Unexpected len: %"PRINTPTRDIFFT"d\n", len);    }    - struct pike_string *debug_compiler_pop_type(void) +  TYPE_STACK_DEBUG("pop_unfinished_type"); +  +  return *(Pike_compiler->type_stackp--); + } +  + /******/ +  + static struct pike_string *internal_parse_type_string(const char **_s)   { -  if(Pike_compiler->num_parse_error) -  { -  /* This could be fixed to check if the type -  * is correct and then return it, I just didn't feel -  * like writing the checking code today. / Hubbe -  */ -  type_stack_pop_to_mark(); -  type_stack_mark(); -  reference_shared_string(mixed_type_string); -  return mixed_type_string; -  }else{ -  struct pike_string *s; -  s=pop_unfinished_type(); -  type_stack_mark(); -  return s; +  const unsigned char **s = (const unsigned char **)_s; +  const unsigned char *p; +  struct string_builder tmp; +  while(ISSPACE(**s)) ++*s; +  if(**s != '\"') yyerror("Expected '\"'."); +  else +  ++*s; +  init_string_builder(&tmp, 0); +  p = *s; +  while(1) { +  int c; +  do { +  c = *p++; +  } while ((c > '\\') || ((c != '\"') && (c != '\\') && (c != '\n'))); +  string_builder_binary_strcat(&tmp, *_s, p - (1 + *s)); +  if (c == '"') { +  *s = ++p; +  break; +  } else if (c == '\\') { +  p_wchar2 buf; +  ptrdiff_t len = 0; +  if (!parse_esc_seq0((p_wchar0 *)p, &buf, &len)) { +  string_builder_putchar(&tmp, buf); +  p += len; +  } else { +  yyerror("Invalid \\-escape.");    } -  +  } else { +  yyerror("Expected '\"'."); +  break;    } -  +  *s = p; +  } +  return finish_string_builder(&tmp); + }    - static void internal_parse_typeA(char **_s) + static void internal_parse_typeA(const char **_s)   {    char buf[80];    unsigned int len; -  unsigned char **s = (unsigned char **)_s; +  const unsigned char **s = (const unsigned char **)_s;       while(ISSPACE(**s)) ++*s;    -  len=0; +     for(len=0;isidchar(EXTRACT_UCHAR(s[0]+len));len++)    { -  if(len>=sizeof(buf)) Pike_error("Buffer overflow in parse_type\n"); +  if(len>=sizeof(buf)-1) { +  my_yyerror("Buffer overflow in parse_type(\"%s\") (limit %"PRINTSIZET"d).", +  *s, sizeof(buf)); +  push_type(T_MIXED); +  return; +  }    buf[len] = s[0][len];    }    buf[len]=0;    *s += len;       switch(buf[0])    {    case 'z':    if(!strcmp(buf,"zero")) { push_type(T_ZERO); break; }    goto bad_type;       case 'i':    if(!strcmp(buf,"int"))    {    while(ISSPACE(**s)) ++*s;    if(**s=='(')    {    INT32 min,max;    ++*s;    while(ISSPACE(**s)) ++*s; -  min=STRTOL((char *)*s,(char **)s,0); +  if (**s != '.') { +  min=STRTOL((const char *)*s,(char **)s,0);    while(ISSPACE(**s)) ++*s; -  +  } else { +  min = MIN_INT32; +  }    if(s[0][0]=='.' && s[0][1]=='.')    s[0]+=2; -  else -  Pike_error("Missing .. in integer type.\n"); +  else { +  yyerror("Missing .. in integer type."); +  }       while(ISSPACE(**s)) ++*s; -  max=STRTOL((char *)*s,(char **)s,0); +  if (**s != ')') { +  max=STRTOL((const char *)*s,(char **)s,0);    while(ISSPACE(**s)) ++*s; -  +  } else { +  max = MAX_INT32; +  }    -  if(**s != ')') Pike_error("Missing ')' in integer range.\n"); +  if(**s != ')') yyerror("Missing ')' in integer range."); +  else    ++*s; -  push_type_int(max); -  push_type_int(min); +  push_int_type(min, max);    }else{ -  push_type_int(MAX_INT32); -  push_type_int(MIN_INT32); +  push_int_type(MIN_INT32, MAX_INT32);    } -  push_type(T_INT); +     break;    }    goto bad_type;       case 'f':    if(!strcmp(buf,"function"))    {    while(ISSPACE(**s)) ++*s;    if(**s == '(')    { -  +  int nargs = 0;    ++*s;    while(ISSPACE(**s)) ++*s; -  type_stack_mark(); +     while(1)    {    if(**s == ':')    { -  push_type(T_MANY); +     push_type(T_VOID);    break;    } -  -  type_stack_mark(); -  type_stack_mark(); -  type_stack_mark(); +     internal_parse_type(_s); -  type_stack_reverse(); +     if(**s==',')    { -  +  nargs++;    ++*s;    while(ISSPACE(**s)) ++*s;    }    else if(s[0][0]=='.' && s[0][1]=='.' && s[0][2]=='.')    { -  type_stack_reverse(); -  push_type(T_MANY); -  type_stack_reverse(); +     *s+=3;    while(ISSPACE(**s)) ++*s; -  if(**s != ':') Pike_error("Missing ':' after ... in function type.\n"); +  if(**s != ':') { +  yyerror("Missing ':' after ... in function type."); +  --*s; +  }    break; -  +  } else { +  nargs++;    } -  pop_stack_mark(); -  pop_stack_mark(); +     } -  +  /* Skip the colon. */    ++*s; -  type_stack_mark(); +     internal_parse_type(_s); /* return type */ -  type_stack_reverse(); -  if(**s != ')') Pike_error("Missing ')' in function type.\n"); +  push_reverse_type(T_MANY); +  +  while (nargs-- > 0) { +  push_reverse_type(T_FUNCTION); +  } +  +  if(**s != ')') yyerror("Missing ')' in function type."); +  else    ++*s; -  type_stack_reverse(); +     }else{    push_type(T_VOID);    push_type(T_MIXED);    push_type(T_OR);    push_type(T_VOID);    push_type(T_ZERO);    push_type(T_OR);    push_type(T_MANY);    } -  push_type(T_FUNCTION); +     break;    }    if(!strcmp(buf,"float")) { push_type(T_FLOAT); break; }    goto bad_type;       case 'o':    if(!strcmp(buf,"object"))    { -  push_type_int(0); -  push_type(0); -  push_type(T_OBJECT); +  while(ISSPACE(**s)) ++*s; +  if(**s == '(') /* object({,is,implements} {id,this_program}) */ +  { +  int is = 0, id; +  ++*s; +  while(ISSPACE(**s)) ++*s; +  if( **s != 'i' ) +  goto no_is_implements; +  ++*s; +  if( **s == 's' ) { +  ++*s; +  if (**s != ' ') { +  goto bad_type; +  } +  is = 1; +  ++*s; +  } else { +  if (strncmp((const char *)*s, "mplements ", 10)) { +  goto bad_type; +  } +  *s += 10; +  } +  while(ISSPACE(**s)) ++*s; +  no_is_implements: +  if( !**s ) +  goto bad_type; +  if (!strncmp((const char *)*s, "this_program", 12)) { +  id = Pike_compiler->new_program->id; +  *s += 12; +  } else { +  id = atoi( (const char *)*s ); +  while( **s >= '0' && **s <= '9' ) +  ++*s; +  } +  while(ISSPACE(**s)) ++*s; +  if( !**s || **s != ')' ) +  goto bad_type; +  ++*s; +  push_object_type(is, id); +  } +  else +  push_object_type(0, 0);    break;    }    goto bad_type;          case 'p': -  if(!strcmp(buf,"program")) { push_type(T_PROGRAM); break; } +  if(!strcmp(buf,"program")) { +  push_object_type(0, 0); +  push_type(T_PROGRAM); +  break; +  }    goto bad_type;          case 's': -  if(!strcmp(buf,"string")) { push_type(T_STRING); break; } +  if(!strcmp(buf,"string")) { +  while(ISSPACE(**s)) ++*s; +  if(**s == '(') +  { +  INT32 min,max; +  ++*s; +  while(ISSPACE(**s)) ++*s; +  if (**s != '.') { +  min=STRTOL((const char *)*s,(char **)s,0); +  while(ISSPACE(**s)) ++*s; +  } else { +  min = MIN_INT32; +  } +  if(s[0][0]=='.' && s[0][1]=='.') +  s[0]+=2; +  else { +  yyerror("Missing .. in integer type."); +  } +  +  while(ISSPACE(**s)) ++*s; +  if (**s != ')') { +  max=STRTOL((const char *)*s,(char **)s,0); +  while(ISSPACE(**s)) ++*s; +  } else { +  max = MAX_INT32; +  } +  if(**s != ')') yyerror("Missing ')' in string width."); +  else +  ++*s; +  push_int_type(min, max); +  } else { +  push_finished_type(int_type_string); +  } +  push_type(T_STRING); +  break; +  }    goto bad_type;       case 'v':    if(!strcmp(buf,"void")) { push_type(T_VOID); break; }    goto bad_type;       case 't':    if (!strcmp(buf,"tuple"))    {    while(ISSPACE(**s)) ++*s;    if(**s == '(')    { -  type_stack_mark(); +     ++*s; -  type_stack_mark(); +     internal_parse_type(_s); -  type_stack_reverse(); -  if(**s != ',') Pike_error("Expecting ','.\n"); +  if(**s != ',') yyerror("Expected ','."); +  else    ++*s; -  type_stack_mark(); +     internal_parse_type(_s); -  type_stack_reverse(); -  if(**s != ')') Pike_error("Expecting ')'.\n"); +  if(**s != ')') yyerror("Expected ')'."); +  else    ++*s; -  type_stack_reverse(); +     }else{    push_type(T_MIXED);    push_type(T_MIXED);    } -  push_type(T_TUPLE); +  push_reverse_type(T_TUPLE);    break;    } -  if(!strcmp(buf,"type")) { push_type(T_TYPE); break; } +  /* FIXME: Handle type(T) */ +  if(!strcmp(buf,"type")) { push_type(T_MIXED); push_type(T_TYPE); break; }    goto bad_type;       case 'm':    if(!strcmp(buf,"mixed")) { push_type(T_MIXED); break; }    if(!strcmp(buf,"mapping"))    {    while(ISSPACE(**s)) ++*s;    if(**s == '(')    { -  type_stack_mark(); +     ++*s; -  type_stack_mark(); +     internal_parse_type(_s); -  type_stack_reverse(); -  if(**s != ':') Pike_error("Expecting ':'.\n"); +  if(**s != ':') yyerror("Expected ':'."); +  else    ++*s; -  type_stack_mark(); +     internal_parse_type(_s); -  type_stack_reverse(); -  if(**s != ')') Pike_error("Expecting ')'.\n"); +  if(**s != ')') yyerror("Expected ')'."); +  else    ++*s; -  type_stack_reverse(); +     }else{    push_type(T_MIXED);    push_type(T_MIXED);    } -  push_type(T_MAPPING); +  push_reverse_type(T_MAPPING);    break;    }    if(!strcmp(buf,"multiset"))    {    while(ISSPACE(**s)) ++*s;    if(**s == '(')    {    ++*s;    internal_parse_type(_s); -  if(**s != ')') Pike_error("Expecting ')'.\n"); +  if(**s != ')') yyerror("Expected ')'."); +  else    ++*s;    }else{    push_type(T_MIXED);    }    push_type(T_MULTISET);    break;    }    goto bad_type;       case 'u':
pike.git/src/pike_types.c:601:    goto bad_type;       case 'a':    if(!strcmp(buf,"array"))    {    while(ISSPACE(**s)) ++*s;    if(**s == '(')    {    ++*s;    internal_parse_type(_s); -  if(**s != ')') Pike_error("Expecting ')'.\n"); +  if(**s != ')') yyerror("Expected ')'."); +  else    ++*s;    }else{    push_type(T_MIXED);    }    push_type(T_ARRAY);    break;    }    goto bad_type;    -  +  case '_': +  if (!strcmp(buf, "__attribute__")) { +  while(ISSPACE(**s)) ++*s; +  if(**s == '(') +  { +  struct pike_string *attr; +  ++*s; +  attr = internal_parse_type_string(_s); +  while(ISSPACE(**s)) ++*s; +  if(**s != ',') yyerror("Expected ','."); +  else +  ++*s; +  internal_parse_type(_s); +  if(**s != ')') yyerror("Expected ')'."); +  else +  ++*s; +  push_type_attribute(attr); +  free_string(attr); +  }else{ +  push_type(T_MIXED); +  } +  break; +  } else if (!strcmp(buf, "__deprecated__")) { +  struct pike_string *deprecated_string; +  MAKE_CONST_STRING(deprecated_string, "deprecated"); +  while(ISSPACE(**s)) ++*s; +  if(**s == '(') +  { +  ++*s; +  internal_parse_type(_s); +  if(**s != ')') yyerror("Expected ')'."); +  else +  ++*s; +  }else{ +  push_type(T_MIXED); +  } +  push_type_attribute(deprecated_string); +  free_string(deprecated_string); +  break; +  } +  goto bad_type; +     case '0':    case '1':    case '2':    case '3':    case '4':    case '5':    case '6':    case '7':    case '8':    case '9':    if(atoi(buf)<10)    {    while(ISSPACE(**s)) ++*s;    if(**s=='=')    {    ++*s;    internal_parse_type(_s); -  push_type(buf[0]); -  push_type(T_ASSIGN); +  push_assign_type(buf[0]);    }else{    push_type(buf[0]);    }    break;    }       default:    bad_type: -  Pike_error("Couldn't parse type. (%s)\n",buf); +  push_type(T_MIXED); +  my_yyerror("Couldn't parse type. (%s).", buf);    }       while(ISSPACE(**s)) ++*s;   }       - static void internal_parse_typeB(char **s) + static void internal_parse_typeB(const char **s)   { -  while(ISSPACE(**((unsigned char **)s))) ++*s; +  while(ISSPACE(EXTRACT_UCHAR(*s))) ++*s;    switch(**s)    {    case '!':    ++*s;    internal_parse_typeB(s);    push_type(T_NOT);    break;       case '(':    ++*s;    internal_parse_type(s); -  while(ISSPACE(**((unsigned char **)s))) ++*s; -  if(**s != ')') Pike_error("Expecting ')'.\n"); +  while(ISSPACE(EXTRACT_UCHAR(*s))) ++*s; +  if(**s != ')') { +  yyerror("Expected ')' in type."); +  }    ++*s;    break;       default:       internal_parse_typeA(s);    }   }    - static void internal_parse_typeCC(char **s) + static void internal_parse_typeCC(const char **s)   {    internal_parse_typeB(s);    -  while(ISSPACE(**((unsigned char **)s))) ++*s; +  while(ISSPACE(EXTRACT_UCHAR(*s))) ++*s;       while(**s == '*')    {    ++*s; -  while(ISSPACE(**((unsigned char **)s))) ++*s; +  while(ISSPACE(EXTRACT_UCHAR(*s))) ++*s;    push_type(T_ARRAY);    }   }    - static void internal_parse_typeC(char **s) + static void internal_parse_typeC(const char **s)   { -  type_stack_mark(); -  -  type_stack_mark(); +     internal_parse_typeCC(s); -  type_stack_reverse(); +     -  while(ISSPACE(**((unsigned char **)s))) ++*s; -  +     if(**s == '&')    {    ++*s; -  type_stack_mark(); +     internal_parse_typeC(s); -  type_stack_reverse(); -  type_stack_reverse(); -  push_type(T_AND); -  }else{ -  type_stack_reverse(); +  push_reverse_type(T_AND);    }   }    - static void internal_parse_type(char **s) + static void internal_parse_type(const char **s)   {    internal_parse_typeC(s);    -  while(ISSPACE(**((unsigned char **)s))) ++*s; -  +     while(**s == '|')    {    ++*s;    internal_parse_typeC(s);    push_type(T_OR);    }   }      /* This function is used when adding simul efuns so that    * the types for the functions can be easily stored in strings.    * It takes a string on the exact same format as Pike and returns a type    * struct.    */ - struct pike_string *parse_type(char *s) + struct pike_type *parse_type(const char *s)   { -  struct pike_string *ret; +  struct pike_type *ret;   #ifdef PIKE_DEBUG -  unsigned char *ts=Pike_compiler->type_stackp; -  unsigned char **ptms=Pike_compiler->pike_type_mark_stackp; +  struct pike_type **ts=Pike_compiler->type_stackp; +  struct pike_type ***ptms=Pike_compiler->pike_type_mark_stackp;   #endif -  +  +  /* fprintf(stderr, "parse_type(\"%s\")...\n", s); */ +  +  TYPE_STACK_DEBUG("parse_type"); +     type_stack_mark(); -  +     internal_parse_type(&s);       if( *s ) -  fatal("Extra junk at end of type definition.\n"); +  yyerror("Extra junk at end of type definition.");       ret=pop_unfinished_type();      #ifdef PIKE_DEBUG    if(ts!=Pike_compiler->type_stackp || ptms!=Pike_compiler->pike_type_mark_stackp) -  fatal("Type stack whacked in parse_type.\n"); +  Pike_fatal("Type stack whacked in parse_type.\n");   #endif       return ret;   }      #ifdef PIKE_DEBUG - void stupid_describe_type(char *a, ptrdiff_t len) + /* FIXME: */ + void stupid_describe_type_string(char *a, ptrdiff_t len)   {    ptrdiff_t e;    for(e=0;e<len;e++)    { -  if(e) printf(" "); +  if(e) fprintf(stderr, " ");    switch(EXTRACT_UCHAR(a+e))    {    case '0': case '1': case '2': case '3': case '4':    case '5': case '6': case '7': case '8': case '9': -  printf("%c",EXTRACT_UCHAR(a+e)); +  fprintf(stderr, "%c",EXTRACT_UCHAR(a+e));    break;    -  case T_SCOPE: printf("scope"); break; -  case T_TUPLE: printf("tuple"); break; -  case T_ASSIGN: printf("="); break; +  case T_SCOPE: fprintf(stderr, "scope"); break; +  case T_TUPLE: fprintf(stderr, "tuple"); break; +  case T_ASSIGN: fprintf(stderr, "="); break;    case T_INT:    {    INT32 min=extract_type_int(a+e+1);    INT32 max=extract_type_int(a+e+1+sizeof(INT32)); -  printf("int"); +  fprintf(stderr, "int");    if(min!=MIN_INT32 || max!=MAX_INT32) -  printf("(%ld..%ld)",(long)min,(long)max); +  fprintf(stderr, "(%ld..%ld)",(long)min,(long)max);    e+=sizeof(INT32)*2;    break;    } -  case T_FLOAT: printf("float"); break; -  case T_STRING: printf("string"); break; -  case T_TYPE: printf("type"); break; -  case T_PROGRAM: printf("program"); break; +  case T_FLOAT: fprintf(stderr, "float"); break; +  case T_STRING: fprintf(stderr, "string"); break; +  case T_TYPE: fprintf(stderr, "type"); break; +  case T_PROGRAM: fprintf(stderr, "program"); break;    case T_OBJECT: -  printf("object(%s %ld)", +  fprintf(stderr, "object(%s %ld)",    EXTRACT_UCHAR(a+e+1)?"is":"implements",    (long)extract_type_int(a+e+2));    e+=sizeof(INT32)+1;    break; -  case T_FUNCTION: printf("function"); break; -  case T_ARRAY: printf("array"); break; -  case T_MAPPING: printf("mapping"); break; -  case T_MULTISET: printf("multiset"); break; +  case T_FUNCTION: fprintf(stderr, "function"); break; +  case T_ARRAY: fprintf(stderr, "array"); break; +  case T_MAPPING: fprintf(stderr, "mapping"); break; +  case T_MULTISET: fprintf(stderr, "multiset"); break;    -  case PIKE_T_UNKNOWN: printf("unknown"); break; -  case T_MANY: printf("many"); break; -  case T_OR: printf("or"); break; -  case T_AND: printf("and"); break; -  case T_NOT: printf("not"); break; -  case T_VOID: printf("void"); break; -  case T_ZERO: printf("zero"); break; -  case T_MIXED: printf("mixed"); break; +  case PIKE_T_UNKNOWN: fprintf(stderr, "unknown"); break; +  case T_MANY: fprintf(stderr, "many"); break; +  case T_OR: fprintf(stderr, "or"); break; +  case T_AND: fprintf(stderr, "and"); break; +  case T_NOT: fprintf(stderr, "not"); break; +  case T_VOID: fprintf(stderr, "void"); break; +  case T_ZERO: fprintf(stderr, "zero"); break; +  case T_MIXED: fprintf(stderr, "mixed"); break;    -  default: printf("%d",EXTRACT_UCHAR(a+e)); break; +  default: fprintf(stderr, "%d",EXTRACT_UCHAR(a+e)); break;    }    } -  printf("\n"); +  fprintf(stderr, "\n");   } -  + #endif    - void simple_describe_type(struct pike_string *s) + void simple_describe_type(struct pike_type *s)   { -  stupid_describe_type(s->str,s->len); +  if (s) { +  /* fprintf(stderr, "[[[%p]]]", s); */ +  switch(s->type) { +  case '0': case '1': case '2': case '3': case '4': +  case '5': case '6': case '7': case '8': case '9': +  fprintf(stderr, "%d", s->type-'0'); +  break; +  +  case PIKE_T_NAME: +  fprintf(stderr, "{ %s = ", ((struct pike_string *)s->car)->str); +  simple_describe_type(s->cdr); +  fprintf(stderr, " }"); +  break; +  +  case PIKE_T_ATTRIBUTE: +  { +  struct pike_string *deprecated; +  MAKE_CONST_STRING(deprecated, "deprecated"); +  if (((struct pike_string *)s->car) == deprecated) { +  fprintf(stderr, "__deprecated__("); +  } else { +  fprintf(stderr, "__attribute__(\"%s\", ", +  ((struct pike_string *)s->car)->str);    } -  +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  } +  break; +  +  case T_SCOPE: +  fprintf(stderr, "scope(%"PRINTPTRDIFFT"d, ", CAR_TO_INT(s)); +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  break; +  case T_TUPLE: +  fprintf(stderr, "tuple("); +  simple_describe_type(s->car); +  fprintf(stderr, ", "); +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  break; +  case T_ASSIGN: +  fprintf(stderr, "(%"PRINTPTRDIFFT"d = ", CAR_TO_INT(s)); +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  break; +  case T_INT: +  { +  INT32 min = CAR_TO_INT(s); +  INT32 max = CDR_TO_INT(s); +  fprintf(stderr, "int"); +  if(min!=MIN_INT32 || max!=MAX_INT32) +  fprintf(stderr, "(%ld..%ld)",(long)min,(long)max); +  break; +  } +  case T_FLOAT: fprintf(stderr, "float"); break; +  case T_STRING: +  { +  INT32 min; +  INT32 max; +  s = s->car; +  fprintf(stderr, "string"); +  if (s != int_type_string) { +  fprintf(stderr, "("); +  while (s->type == T_OR) { +  struct pike_type *char_type = s->car; +  while(char_type->type == T_ASSIGN) { +  char_type = char_type->cdr; +  } +  +  if (char_type->type == T_ZERO) { +  fprintf(stderr, "zero | "); +  s = s->cdr; +  continue; +  } + #ifdef PIKE_DEBUG +  if (char_type->type != T_INT) { +  Pike_fatal("Invalid node type (%d:%s) in string type.\n", +  char_type->type, get_name_of_type(char_type->type)); +  } + #endif /* PIKE_DEBUG */ +  min = CAR_TO_INT(char_type); +  max = CDR_TO_INT(char_type); +  if (min != MIN_INT32) { +  fprintf(stderr, "%d", min); +  } +  fprintf(stderr, ".."); +  if (max != MAX_INT32) { +  fprintf(stderr, "%d", max); +  } +  fprintf(stderr, " | "); +  s = s->cdr; +  } +  while(s->type == T_ASSIGN) { +  s = s->cdr; +  } +  if (s->type == T_ZERO) { +  fprintf(stderr, "zero"); +  } else { + #ifdef PIKE_DEBUG +  if (s->type != T_INT) { +  Pike_fatal("Invalid node type (%d:%s) in string type.\n", +  s->type, get_name_of_type(s->type)); +  } + #endif /* PIKE_DEBUG */ +  min = CAR_TO_INT(s); +  max = CDR_TO_INT(s); +  if (min != MIN_INT32) { +  fprintf(stderr, "%d", min); +  } +  fprintf(stderr, ".."); +  if (max != MAX_INT32) { +  fprintf(stderr, "%d", max); +  } +  } +  fprintf(stderr, ")"); +  } +  break; +  } +  case T_TYPE: +  fprintf(stderr, "type("); +  simple_describe_type(s->car); +  fprintf(stderr, ")"); +  break; +  case T_PROGRAM: +  fprintf(stderr, "program("); +  simple_describe_type(s->car); +  fprintf(stderr, ")"); +  break; +  case T_OBJECT: +  fprintf(stderr, "object(%s %"PRINTPTRDIFFT"d)", +  s->car?"is":"implements", +  CDR_TO_INT(s)); +  break; +  case T_FUNCTION: +  case T_MANY: +  fprintf(stderr, "function("); +  while(s->type == T_FUNCTION) { +  simple_describe_type(s->car); +  s = s->cdr; +  while(s->type == T_ASSIGN) { +  fprintf(stderr, "%"PRINTPTRDIFFT"d = ", CAR_TO_INT(s)); +  s = s->cdr; +  } +  if ((s->type == T_FUNCTION) || +  (s->car->type != T_VOID)) { +  fprintf(stderr, ", "); +  } +  } +  if (s->car->type != T_VOID) { +  simple_describe_type(s->car); +  fprintf(stderr, "..."); +  } +  fprintf(stderr, ":"); +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  break; +  case T_ARRAY: +  fprintf(stderr, "array("); +  simple_describe_type(s->car); +  fprintf(stderr, ")"); +  break; +  case T_MAPPING: +  fprintf(stderr, "mapping("); +  simple_describe_type(s->car); +  fprintf(stderr, ":"); +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  break; +  case T_MULTISET: +  fprintf(stderr, "multiset("); +  simple_describe_type(s->car); +  fprintf(stderr, ")"); +  break; +  +  case PIKE_T_UNKNOWN: fprintf(stderr, "unknown"); break; +  case PIKE_T_RING: +  fprintf(stderr, "ring("); +  simple_describe_type(s->car); +  fprintf(stderr, "\260"); +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  break; +  case T_OR: +  fprintf(stderr, "or("); +  simple_describe_type(s->car); +  fprintf(stderr, "|"); +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  break; +  case T_AND: +  fprintf(stderr, "and("); +  simple_describe_type(s->car); +  fprintf(stderr, "&"); +  simple_describe_type(s->cdr); +  fprintf(stderr, ")"); +  break; +  case T_NOT: +  fprintf(stderr, "not("); +  simple_describe_type(s->car); +  fprintf(stderr, ")"); +  break; +  case T_VOID: fprintf(stderr, "void"); break; +  case T_ZERO: fprintf(stderr, "zero"); break; +  case T_MIXED: fprintf(stderr, "mixed"); break; +  +  default: +  fprintf(stderr, "Unknown type node: %d, %p:%p", +  s->type, s->car, s->cdr); + #ifdef DEBUG_MALLOC +  debug_malloc_dump_references(s, 0, 2, 0);   #endif -  +  break; +  } +  if (s->flags) { +  fprintf(stderr, "[%06x]", s->flags); +  } +  } else { +  fprintf(stderr, "NULL"); +  } + }    - char *low_describe_type(char *t) + static void low_describe_type(struct pike_type *t)   { -  switch(EXTRACT_UCHAR(t++)) +  char buffer[100]; +  +  check_c_stack(1024); +  /**** FIXME: ****/ +  switch(t->type)    {    case '0': case '1': case '2': case '3': case '4':    case '5': case '6': case '7': case '8': case '9': -  my_putchar(EXTRACT_UCHAR(t-1)); +  my_putchar(t->type);    break;       case T_ASSIGN:    my_putchar('('); -  my_putchar(EXTRACT_UCHAR(t++)); +  my_putchar('0' + CAR_TO_INT(t));    my_putchar('='); -  t=low_describe_type(t); +  my_describe_type(t->cdr);    my_putchar(')');    break;       case T_SCOPE: -  my_putchar('{'); -  my_putchar(EXTRACT_UCHAR(t++)); +  my_strcat("scope("); +  my_putchar('0' + CAR_TO_INT(t));    my_putchar(','); -  t = low_describe_type(t); -  my_putchar('}'); +  my_describe_type(t->cdr); +  my_putchar(')');    break;       case T_TUPLE:    my_putchar('['); -  t = low_describe_type(t); +  my_describe_type(t->car);    my_putchar(','); -  t = low_describe_type(t); +  my_describe_type(t->cdr);    my_putchar(']');    break;       case T_VOID: my_strcat("void"); break;    case T_ZERO: my_strcat("zero"); break;    case T_MIXED: my_strcat("mixed"); break;    case PIKE_T_UNKNOWN: my_strcat("unknown"); break;    case T_INT:    { -  INT32 min=extract_type_int(t); -  INT32 max=extract_type_int(t+sizeof(INT32)); +  INT32 min=CAR_TO_INT(t); +  INT32 max=CDR_TO_INT(t);    my_strcat("int");       if(min!=MIN_INT32 || max!=MAX_INT32)    { -  char buffer[100]; +     sprintf(buffer,"(%ld..%ld)",(long)min,(long)max);    my_strcat(buffer);    } -  t+=sizeof(INT32)*2; -  +     break;    }    case T_FLOAT: my_strcat("float"); break; -  case T_PROGRAM: my_strcat("program"); break; +  case T_PROGRAM: +  if ((t->car->type == T_OBJECT) && +  (!t->car->cdr)) { +  my_strcat("program"); +  } else { +  my_strcat("program("); +  my_describe_type(t->car); +  my_strcat(")"); +  } +  break;    case T_OBJECT: -  if(extract_type_int(t+1)) +  if (t->cdr)    { -  +  dynamic_buffer save_buf; +  ONERROR err; +  struct svalue s; +  if (t->car) { +  my_strcat("object(is "); +  } else { +  my_strcat("object(implements "); +  } +  /* We need to save the global buffer, in case id_to_program() +  * starts running Pike code. */ +  save_buffer(&save_buf); +  SET_ONERROR(err, restore_buffer, &save_buf); +  s.u.program = id_to_program(CDR_TO_INT(t)); +  CALL_AND_UNSET_ONERROR(err); +  if (s.u.program) { +  SET_SVAL_TYPE(s, T_PROGRAM); +  SET_SVAL_SUBTYPE(s, 0); +  describe_svalue(&s, 0, NULL); +  my_strcat(")"); +  } else {    char buffer[100]; -  sprintf(buffer,"object(%s %ld)",*t?"is":"implements", -  (long)extract_type_int(t+1)); +  sprintf(buffer,"%"PRINTPTRDIFFT"d)", +  CDR_TO_INT(t));    my_strcat(buffer); -  +  }    }else{    my_strcat("object");    } -  +  break;    -  t+=sizeof(INT32)+1; -  /* Prog id */ +  case T_STRING: +  { +  INT32 min; +  INT32 max; +  t = t->car; +  my_strcat("string"); +  if (t->type == T_ZERO) { +  my_strcat("(zero)"); +  } else if (t != int_type_string) { +  my_strcat("("); +  while (t->type == T_OR) { +  struct pike_type *char_type = t->car; +  while(char_type->type == T_ASSIGN) { +  char_type = char_type->cdr; +  } + #ifdef PIKE_DEBUG +  if (char_type->type != T_INT) { +  Pike_fatal("Invalid node type (%d:%s) in string type.\n", +  char_type->type, get_name_of_type(char_type->type)); +  } + #endif /* PIKE_DEBUG */ +  min = CAR_TO_INT(char_type); +  max = CDR_TO_INT(char_type); +  if (min != MIN_INT32) { +  sprintf(buffer, "%d", min); +  my_strcat(buffer); +  } +  my_strcat(".."); +  if (max != MAX_INT32) { +  sprintf(buffer, "%d", max); +  my_strcat(buffer); +  } +  my_strcat(" | "); +  t = t->cdr; +  } +  while(t->type == T_ASSIGN) { +  t = t->cdr; +  } + #ifdef PIKE_DEBUG +  if (t->type != T_INT) { +  Pike_fatal("Invalid node type (%d:%s) in string type.\n", +  t->type, get_name_of_type(t->type)); +  } + #endif /* PIKE_DEBUG */ +  min = CAR_TO_INT(t); +  max = CDR_TO_INT(t); +  if (min != MIN_INT32) { +  sprintf(buffer, "%d", min); +  my_strcat(buffer); +  } +  my_strcat(".."); +  if (max != MAX_INT32) { +  sprintf(buffer, "%d", max); +  my_strcat(buffer); +  } +  my_strcat(")"); +  }    break; -  case T_STRING: my_strcat("string"); break; -  case T_TYPE: my_strcat("type"); break; +  } +  case T_TYPE: +  my_strcat("type("); +  my_describe_type(t->car); +  my_strcat(")"); +  break;    -  +  case PIKE_T_NAME: +  if (!((struct pike_string *)t->car)->size_shift) { +  my_strcat("{ "); +  my_binary_strcat(((struct pike_string *)t->car)->str, +  ((struct pike_string *)t->car)->len); +  my_strcat(" = "); +  my_describe_type(t->cdr); +  my_strcat(" }"); +  } else { +  my_describe_type(t->cdr); +  } +  break; +  +  case PIKE_T_ATTRIBUTE: +  if (!((struct pike_string *)t->car)->size_shift) { +  struct pike_string *deprecated; +  MAKE_CONST_STRING(deprecated, "deprecated"); +  if (((struct pike_string *)t->car) == deprecated) { +  my_strcat("__deprecated__("); +  } else { +  my_strcat("__attribute__(\""); +  my_binary_strcat(((struct pike_string *)t->car)->str, +  ((struct pike_string *)t->car)->len); +  my_strcat("\", "); +  } +  my_describe_type(t->cdr); +  my_strcat(")"); +  } else { +  my_describe_type(t->cdr); +  } +  break; +     case T_FUNCTION: -  +  case T_MANY:    {    int s;    my_strcat("function"); -  if(EXTRACT_UCHAR(t) == T_MANY && -  ((EXTRACT_UCHAR(t+1) == T_ZERO && -  EXTRACT_UCHAR(t+2) == T_OR && -  ((EXTRACT_UCHAR(t+3) == T_MIXED && EXTRACT_UCHAR(t+4) == T_VOID) || -  (EXTRACT_UCHAR(t+4) == T_MIXED && EXTRACT_UCHAR(t+3) == T_VOID))) -  || -  (EXTRACT_UCHAR(t+1) == T_OR -  && -  ((EXTRACT_UCHAR(t+2) == T_ZERO && EXTRACT_UCHAR(t+3) == T_VOID) || -  (EXTRACT_UCHAR(t+3) == T_ZERO && EXTRACT_UCHAR(t+2) == T_VOID)) -  && -  EXTRACT_UCHAR(t+4) == T_OR -  && -  ((EXTRACT_UCHAR(t+5) == T_MIXED && EXTRACT_UCHAR(t+6) == T_VOID) || -  (EXTRACT_UCHAR(t+6) == T_MIXED && EXTRACT_UCHAR(t+5) == T_VOID))))) +  if(t->type == T_MANY && +  t->cdr->type == T_OR && +  ((t->cdr->car->type == T_MIXED && t->cdr->cdr->type == T_VOID) || +  (t->cdr->cdr->type == T_MIXED && t->cdr->car->type == T_VOID)) && +  (t->car->type == T_ZERO || +  (t->car->type == T_OR && +  ((t->car->car->type == T_ZERO && t->car->cdr->type == T_VOID) || +  (t->car->cdr->type == T_ZERO && t->car->car->type == T_VOID)))))    { -  +  /* function == function(zero...:mixed|void) or +  * function(zero|void...:mixed|void) +  */    /* done */ -  if (EXTRACT_UCHAR(t+1) == T_ZERO) { -  /* function(zero...:mixed|void) */ -  t += 5; +     } else { -  /* function(zero|void...mixed|void) */ -  t += 7; -  } -  } else { +     my_strcat("(");    s=0; -  while(EXTRACT_UCHAR(t) != T_MANY) +  while(t->type != T_MANY)    {    if(s++) my_strcat(", "); -  t=low_describe_type(t); +  my_describe_type(t->car); +  t = t->cdr; +  while(t->type == T_ASSIGN) { +  my_putchar('0' + CAR_TO_INT(t)); +  my_putchar('='); +  t = t->cdr;    } -  t++; -  if(EXTRACT_UCHAR(t) == T_VOID) +  } +  if(t->car->type != T_VOID)    { -  t++; -  }else{ +     if(s++) my_strcat(", "); -  t=low_describe_type(t); +  my_describe_type(t->car);    my_strcat(" ...");    }    my_strcat(" : "); -  t=low_describe_type(t); +  my_describe_type(t->cdr);    my_strcat(")");    }    break;    }       case T_ARRAY:    my_strcat("array"); -  if(EXTRACT_UCHAR(t)==T_MIXED) -  { -  t++; -  }else{ +  if(t->car->type != T_MIXED) {    my_strcat("("); -  t=low_describe_type(t); +  my_describe_type(t->car);    my_strcat(")");    }    break;       case T_MULTISET:    my_strcat("multiset"); -  if(EXTRACT_UCHAR(t)!=T_MIXED) -  { +  if(t->car->type != T_MIXED) {    my_strcat("("); -  t=low_describe_type(t); +  my_describe_type(t->car);    my_strcat(")"); -  }else{ -  t++; +     }    break;       case T_NOT:    my_strcat("!"); -  if (EXTRACT_UCHAR(t) > T_NOT) { +  if (t->car->type > T_NOT) {    my_strcat("("); -  t=low_describe_type(t); +  my_describe_type(t->car);    my_strcat(")");    } else { -  t=low_describe_type(t); +  my_describe_type(t->car);    }    break;    -  +  case PIKE_T_RING: +  /* FIXME: Should be renumbered for correct parenthesing. */ +  my_strcat("("); +  my_describe_type(t->car); +  my_strcat(")°("); +  my_describe_type(t->cdr); +  my_strcat(")"); +  break; +     case T_OR: -  if (EXTRACT_UCHAR(t) > T_OR) { +  if (t->car->type > T_OR) {    my_strcat("("); -  t=low_describe_type(t); +  my_describe_type(t->car);    my_strcat(")");    } else { -  t=low_describe_type(t); +  my_describe_type(t->car);    }    my_strcat(" | "); -  if (EXTRACT_UCHAR(t) > T_OR) { +  if (t->cdr->type > T_OR) {    my_strcat("("); -  t=low_describe_type(t); +  my_describe_type(t->cdr);    my_strcat(")");    } else { -  t=low_describe_type(t); +  my_describe_type(t->cdr);    }    break;       case T_AND: -  if (EXTRACT_UCHAR(t) > T_AND) { +  if (t->car->type > T_AND) {    my_strcat("("); -  t=low_describe_type(t); +  my_describe_type(t->car);    my_strcat(")");    } else { -  t=low_describe_type(t); +  my_describe_type(t->car);    }    my_strcat(" & "); -  if (EXTRACT_UCHAR(t) > T_AND) { +  if (t->cdr->type > T_AND) {    my_strcat("("); -  t=low_describe_type(t); +  my_describe_type(t->cdr);    my_strcat(")");    } else { -  t=low_describe_type(t); +  my_describe_type(t->cdr);    }    break;       case T_MAPPING:    my_strcat("mapping"); -  if(EXTRACT_UCHAR(t)==T_MIXED && EXTRACT_UCHAR(t+1)==T_MIXED) -  { -  t+=2; -  }else{ +  if(t->car->type != T_MIXED || t->cdr->type != T_MIXED) {    my_strcat("("); -  t=low_describe_type(t); +  my_describe_type(t->car);    my_strcat(":"); -  t=low_describe_type(t); +  my_describe_type(t->cdr);    my_strcat(")");    }    break;    default:    {    char buf[20];    my_strcat("unknown code("); -  sprintf(buf, "%d", EXTRACT_UCHAR(t-1)); +  sprintf(buf, "%d", t->type);    my_strcat(buf);    my_strcat(")");    break;    }    } -  return t; +    }    - struct pike_string *describe_type(struct pike_string *type) + void my_describe_type(struct pike_type *type)   { -  +  low_describe_type(type); + } +  + struct pike_string *describe_type(struct pike_type *type) + { +  dynamic_buffer save_buf;    check_type_string(type);    if(!type) return make_shared_string("mixed"); -  init_buf(); -  low_describe_type(type->str); -  return free_buf(); +  init_buf(&save_buf); +  low_describe_type(type); +  return free_buf(&save_buf);   }    - static int low_is_same_type(char *a, char *b) +  + /******/ +  + static int low_is_same_type(struct pike_type *a, struct pike_type *b)   { -  if(type_length(a) != type_length(b)) return 0; -  return !MEMCMP(a,b,type_length(a)); +  return a == b;   }    - static TYPE_T low_compile_type_to_runtime_type(char *t) + TYPE_T compile_type_to_runtime_type(struct pike_type *t)   { -  TYPE_T tmp; -  switch(EXTRACT_UCHAR(t)) +  switch(t->type)    { -  +  case PIKE_T_RING: +  return compile_type_to_runtime_type(t->car); +     case T_OR: -  t++; -  tmp=low_compile_type_to_runtime_type(t); -  if(tmp == low_compile_type_to_runtime_type(t+type_length(t))) +  { +  TYPE_T tmp = compile_type_to_runtime_type(t->car); +  if(tmp == compile_type_to_runtime_type(t->cdr))    return tmp;    -  +  /* FALL_THROUGH */ +  }    case T_TUPLE:    /* FIXME: Shouldn't occur/should be converted to array? */    /* FALL_THROUGH */    default:    return T_MIXED;       case T_ZERO:    return T_INT;       case T_SCOPE: -  return low_compile_type_to_runtime_type(t+2); +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  return compile_type_to_runtime_type(t->cdr);    -  +  case T_MANY: +  return T_FUNCTION; +     case T_ARRAY:    case T_MAPPING:    case T_MULTISET:       case T_OBJECT:    case T_PROGRAM:    case T_FUNCTION:       case T_STRING:    case T_TYPE:    case T_INT:    case T_FLOAT: -  return EXTRACT_UCHAR(t); +  return t->type;    }   }    - TYPE_T compile_type_to_runtime_type(struct pike_string *s) - { -  return low_compile_type_to_runtime_type(s->str); - } +     -  - static int low_find_exact_type_match(char *needle, char *haystack, -  int separator) + static int low_find_exact_type_match(struct pike_type *needle, +  struct pike_type *haystack, +  unsigned int separator)   { -  while(EXTRACT_UCHAR(haystack) == separator) +  while(haystack->type == separator)    { -  haystack++; -  if(low_find_exact_type_match(needle, haystack, separator)) +  if(low_find_exact_type_match(needle, haystack->car, separator))    return 1; -  haystack+=type_length(haystack); +  haystack = haystack->cdr;    }    return low_is_same_type(needle, haystack);   }    - static void very_low_or_pike_types(char *to_push, char *not_push) + static void low_or_pike_types(struct pike_type *t1, +  struct pike_type *t2, +  int zero_implied); +  + /* Push either t1, t2 or the OR of t1 and t2. +  * Returns -1 if t1 was pushed. +  * 0 if the OR was pushed. (Successful join) +  * 1 if t2 was pushed. +  * +  * zero_implied: One of: +  * 0 the zero type (if any) must be explicit in the result. +  * 1 the zero type is implicit. +  * 3 zero is implicit and integers are regarded as masks (cf enums). +  */ + static int lower_or_pike_types(struct pike_type *t1, +  struct pike_type *t2, +  int zero_implied, +  int elem_on_stack)   { -  while(EXTRACT_UCHAR(to_push)==T_OR) +  int ret = 0; +  struct pike_type *t = NULL; +  struct pike_type *top = NULL; + #if 0 +  fprintf(stderr, " lower_or_pike_types("); +  simple_describe_type(t1); +  fprintf(stderr, ", "); +  simple_describe_type(t2); +  fprintf(stderr, ")\n"); + #endif +  if (t1 == t2) { +  t = t1; +  } else if (!t1) { +  t = t2; +  ret = 1; +  } else if (!t2) { +  t = t1; +  ret = -1; +  } else if (zero_implied && (t1->type == T_ZERO)) { +  t = t2; +  } else if (zero_implied && (t2->type == T_ZERO)) { +  t = t1; +  } else if ((t1->type ^ '0') < (t2->type ^ '0')) { +  /* Note: Adjusted order to get markers first. */ +  t = t1; +  ret = -1; +  } else if ((t1->type ^ '0') > (t2->type ^ '0')) { +  /* Note: Adjusted order to get markers first. */ +  t = t2; +  ret = 1; +  } else { + #ifdef PIKE_DEBUG +  if (t1->type != t2->type) { +  Pike_fatal("Lost track of types t1->type: %d, t2->type: %d\n", +  t1->type, t2->type); +  } + #endif /* PIKE_DEBUG */ +  switch(t1->type) { +  case T_INT: +  if (CAR_TO_INT(t1) < CAR_TO_INT(t2)) { +  t = t1; +  ret = -1; +  } else { +  t = t2; +  ret = 1; +  } +  break; +  case T_STRING:    { -  to_push++; -  very_low_or_pike_types(to_push, not_push); -  to_push+=type_length(to_push); +  low_or_pike_types(t1->car, t2->car, 1); +  push_type(T_STRING); +  return 0;    } -  /* FIXME: -  * this might use the 'le' operator +  break; +  case T_OBJECT: +  if (!CDR_TO_INT(t1)) { +  t = t1; +  } else if (!CDR_TO_INT(t2)) { +  t = t2; +  } else if (CDR_TO_INT(t1) < CDR_TO_INT(t2)) { +  t = t1; +  ret = -1; +  } else { +  t = t2; +  ret = 1; +  } +  break; +  case T_MAPPING: +  if (t1->car->type < t2->car->type) { +  t = t1; +  ret = -1; +  break; +  } +  if (t1->car->type > t2->car->type) { +  t = t2; +  ret = 1; +  break; +  } +  if (t1->cdr->type < t2->cdr->type) { +  t = t1; +  ret = -1; +  break; +  } +  if (t1->cdr->type > t2->cdr->type) { +  t = t2; +  ret = 1; +  break; +  } +  t = t1; +  ret = -1; +  break; +  case T_ARRAY: +  case T_MULTISET: +  if (t1->car->type < t2->car->type) { +  t = t1; +  ret = -1; +  break; +  } else if (t1->car->type > t2->car->type) { +  t = t2; +  ret = 1; +  break; +  } +  /* FALL_THOUGH */ +  default: + #if 0 +  if (pike_types_le(t1, t2)) { +  t = t2; +  } else if (pike_types_le(t2, t1)) { +  t = t1; +  } else + #endif /* 0 */ +  if (t1 < t2) { +  t = t1; +  ret = -1; +  } else { +  t = t2; +  ret = 1; +  } +  break; +  } +  } +  if (!elem_on_stack) { +  push_finished_type(t); +  } else if ((top = peek_type_stack())->type != t->type) { +  if (zero_implied && (top->type == T_ZERO)) { +  Pike_compiler->type_stackp--; +  free_type(top); +  push_finished_type(t); +  } else if (zero_implied && (t->type == T_ZERO)) { +  /* The zero is implied. */ +  } else { +  push_finished_type(t); +  } +  } else if (t == top) { +  /* No need to do anything. */ +  } else { +  switch(t->type) { +  case T_FLOAT: +  case T_MIXED: +  case T_VOID: +  case T_ZERO: +  /* There can only be one. */ +  break; +  case T_INT: +  { +  INT32 min1 = CAR_TO_INT(t); +  INT32 max1 = CDR_TO_INT(t); +  INT32 min2 = CAR_TO_INT(top); +  INT32 max2 = CDR_TO_INT(top); +  +  if (zero_implied) { +  if (min1 == 1) min1 = 0; +  if (min2 == 1) min2 = 0; +  if (max1 == -1) max1 = 0; +  if (max2 == -1) max2 = 0; +  +  if (zero_implied == 3) { +  /* Or between integer masks. +  * This is a bit more lenient than the default further below, +  * and is used for generating the type for enums.    */    -  if(!low_find_exact_type_match(to_push, not_push, T_OR)) +  /* Ensure that zero is always in the range. +  * This also ensures that there'll be an overlap. +  */ +  if (max1 < 0) max1 = 0; +  if (max2 < 0) max2 = 0; +  if (min1 > 0) min1 = 0; +  if (min2 > 0) min2 = 0; +  +  /* Both max values are now >= 0, so this or is safe. */ +  max1 |= max2; +  +  if ((min1 < 0) && (min2 < 0)) { +  min1 &= min2; +  } +  } +  } +  +  if ((min1 > max2) && (min1 > max2 + 1)) { +  /* No overlap. */ +  push_finished_type(t); + #ifdef PIKE_DEBUG +  } else if ((min2 > max1) && (min2 > max1 + 1)) { +  /* No overlap and wrong order! */ +  Pike_fatal("Bad integer ordering in lower_or_pike_types().\n"); + #endif +  } else { +  Pike_compiler->type_stackp--; +  free_type(top); +  /* Overlap */ +  min1 = MINIMUM(min1, min2); +  max1 = MAXIMUM(max1, max2); +  +  push_int_type(min1, max1); +  } +  } +  break; +  case T_STRING:    { -  push_unfinished_type(to_push); -  push_type(T_OR); +  Pike_compiler->type_stackp--; +  low_or_pike_types(t->car, top->car, 1); +  push_type(T_STRING); +  free_type(top);    } -  +  break; +  case T_OBJECT: +  if (CDR_TO_INT(top)) { +  push_finished_type(t);    } -  +  break; +  case T_ARRAY: +  case T_MULTISET: +  Pike_compiler->type_stackp--; +  low_or_pike_types(t->car, top->car, zero_implied); +  push_type(t->type); +  free_type(top); +  break; +  case T_MAPPING: +  if (t->car == top->car) { +  Pike_compiler->type_stackp--; +  push_finished_type(t->car); +  low_or_pike_types(t->cdr, top->cdr, zero_implied); +  push_reverse_type(T_MAPPING); +  free_type(top); +  break; +  } else if (t->cdr == top->cdr) { +  Pike_compiler->type_stackp--; +  push_finished_type(t->cdr); +  low_or_pike_types(t->car, top->car, zero_implied); +  push_type(T_MAPPING); +  free_type(top); +  break; +  } +  /* FALL_THROUGH */ +  default: +  if (t < top) { +  Pike_compiler->type_stackp--; +  push_finished_type(t); +  push_finished_type(top); +  free_type(top); +  } else { +  push_finished_type(t); +  } +  break; +  } +  } +  return ret; + }    - static void low_or_pike_types(char *t1, char *t2, int zero_implied) + static void low_or_pike_types(struct pike_type *t1, +  struct pike_type *t2, +  int zero_implied)   { -  + #ifdef PIKE_DEBUG +  struct pike_type *arg1 = t1; +  struct pike_type *arg2 = t2; + #endif + #if 0 +  fprintf(stderr, " low_or_pike_types("); +  simple_describe_type(t1); +  fprintf(stderr, ", "); +  simple_describe_type(t2); +  fprintf(stderr, ")\n"); + #endif    if(!t1)    {    if(!t2)    push_type(T_VOID);    else -  push_unfinished_type(t2); +  push_finished_type(t2);    }    else if((!t2) -  || (EXTRACT_UCHAR(t2) == T_ZERO && zero_implied) +  || (t2->type == T_ZERO && zero_implied)       )    { -  push_unfinished_type(t1); +  push_finished_type(t1);    } -  else if (EXTRACT_UCHAR(t1) == T_ZERO && zero_implied) +  else if (t1->type == T_ZERO && zero_implied)    { -  push_unfinished_type(t2); +  push_finished_type(t2);    } -  else if(EXTRACT_UCHAR(t1)==T_MIXED || EXTRACT_UCHAR(t2)==T_MIXED) -  { -  push_type(T_MIXED); +  else if (t1 == t2) { +  push_finished_type(t1);    } -  else if(EXTRACT_UCHAR(t1)==T_INT && EXTRACT_UCHAR(t2)==T_INT) -  { -  /* FIXME: -  * This should only be done if the ranges are -  * overlapping or adjecant to each other. /Hubbe -  */ -  INT32 i1,i2; -  i1=extract_type_int(t1+1+sizeof(INT32)); -  i2=extract_type_int(t2+1+sizeof(INT32)); -  push_type_int(MAXIMUM(i1,i2)); -  -  i1=extract_type_int(t1+1); -  i2=extract_type_int(t2+1); -  push_type_int(MINIMUM(i1,i2)); -  -  push_type(T_INT); +  else if ((t1->type == T_OR) || (t2->type == T_OR)) { +  int on_stack = 0; +  type_stack_mark(); +  while (t1 || t2) { +  struct pike_type *a = t1; +  struct pike_type *b = t2; +  struct pike_type *n1 = NULL; +  struct pike_type *n2 = NULL; +  int val; +  if (t1 && t1->type == T_OR) { +  a = t1->car; +  n1 = t1->cdr;    } -  else if (EXTRACT_UCHAR(t1) == T_SCOPE) -  { -  if (EXTRACT_UCHAR(t2) == T_SCOPE) { -  low_or_pike_types(t1+2, t2+2, zero_implied); -  if (EXTRACT_UCHAR(t1+1) > EXTRACT_UCHAR(t2+1)) -  push_type(EXTRACT_UCHAR(t1+1)); -  else -  push_type(EXTRACT_UCHAR(t2+1)); -  } else { -  low_or_pike_types(t1+2, t2, zero_implied); -  push_type(EXTRACT_UCHAR(t1+1)); +  if (t2 && t2->type == T_OR) { +  b = t2->car; +  n2 = t2->cdr;    } -  push_type(T_SCOPE); + #ifdef PIKE_DEBUG +  if (a && b && ((a->type == T_OR) || (b->type == T_OR))) { +  fprintf(stderr, " low_or_pike_types("); +  simple_describe_type(arg1); +  fprintf(stderr, ", "); +  simple_describe_type(arg2); +  fprintf(stderr, ")\n a:"); +  simple_describe_type(a); +  fprintf(stderr, "\n b:"); +  simple_describe_type(b); +  fprintf(stderr, ")\n"); +  Pike_fatal("Invalid type to lower_or_pike_types!\n");    } -  else if (EXTRACT_UCHAR(t2) == T_SCOPE) -  { -  low_or_pike_types(t1, t2+2, zero_implied); -  push_type(EXTRACT_UCHAR(t2+1)); -  push_type(T_SCOPE); + #endif +  val = lower_or_pike_types(a, b, zero_implied, on_stack); +  if (val <= 0) t1 = n1; +  if (val >= 0) t2 = n2; +  on_stack = 1;    } -  else -  { -  push_unfinished_type(t1); -  very_low_or_pike_types(t2,t1); +  on_stack = pop_stack_mark(); +  while (on_stack > 1) { +  push_reverse_joiner_type(T_OR); +  on_stack--;    }    } -  - static void medium_or_pike_types(struct pike_string *a, -  struct pike_string *b, -  int zero_implied) - { -  low_or_pike_types( a ? a->str : 0 , b ? b->str : 0 , zero_implied); +  else { +  int val; +  type_stack_mark(); +  val = lower_or_pike_types(t1, t2, zero_implied, 0); +  if (val < 0) { +  lower_or_pike_types(NULL, t2, zero_implied, 1); +  } else if (val > 0) { +  lower_or_pike_types(t1, NULL, zero_implied, 1); +  } else { +  pop_stack_mark(); +  return;    } -  +  for (val = pop_stack_mark(); val > 1; val--) { +  push_reverse_joiner_type(T_OR); +  } +  } + }    - struct pike_string *or_pike_types(struct pike_string *a, -  struct pike_string *b, + struct pike_type *or_pike_types(struct pike_type *a, +  struct pike_type *b,    int zero_implied)   { -  +  struct pike_type *res;    type_stack_mark(); -  medium_or_pike_types(a,b,1 /*zero_implied*/); -  return pop_unfinished_type(); +  low_or_pike_types(a,b,1|zero_implied); +  res = pop_unfinished_type(); + #if 0 +  fprintf(stderr, " ==> "); +  simple_describe_type(res); +  fprintf(stderr, "\n"); + #endif +  return res;   }    - static void very_low_and_pike_types(char *to_push, char *not_push) + static void even_lower_and_pike_types(struct pike_type *t1, +  struct pike_type *t2)   { -  while(EXTRACT_UCHAR(to_push)==T_AND) +  while(t2->type == T_OR)    { -  to_push++; -  very_low_and_pike_types(to_push, not_push); -  to_push+=type_length(to_push); +  even_lower_and_pike_types(t1, t2->car); +  t2 = t2->cdr;    } -  if(!low_find_exact_type_match(to_push, not_push, T_AND)) -  { -  push_unfinished_type(to_push); -  push_type(T_AND); -  } - } -  - static void even_lower_and_pike_types(char *t1, char *t2) - { -  while(EXTRACT_UCHAR(t2) == T_OR) -  { -  t2++; -  even_lower_and_pike_types(t1, t2); -  t2 += type_length(t2); -  } -  if (EXTRACT_UCHAR(t1) == EXTRACT_UCHAR(t2)) { -  if (EXTRACT_UCHAR(t1) == T_INT) { -  INT32 i1,i2; -  INT32 upper_bound,lower_bound; -  i1=extract_type_int(t1+1+sizeof(INT32)); -  i2=extract_type_int(t2+1+sizeof(INT32)); +  if (t1->type == t2->type) { +  if (t1->type == T_INT) { +  INT32 i1, i2; +  INT32 upper_bound, lower_bound; +  i1 = CDR_TO_INT(t1); +  i2 = CDR_TO_INT(t2);    upper_bound = MINIMUM(i1,i2);    -  i1=extract_type_int(t1+1); -  i2=extract_type_int(t2+1); +  i1 = CAR_TO_INT(t1); +  i2 = CAR_TO_INT(t2);    lower_bound = MAXIMUM(i1,i2);       if (upper_bound >= lower_bound) { -  push_type_int(upper_bound); -  push_type_int(lower_bound); -  push_type(T_INT); +  push_int_type(lower_bound, upper_bound);    push_type(T_OR);    } -  +  } else if (t1->type == T_STRING) { +  push_type(T_ZERO); +  even_lower_and_pike_types(t1->car, t2->car); +  push_type(T_STRING); +  push_type(T_OR);    } else { -  push_unfinished_type(t1); +  push_finished_type(t1);    push_type(T_OR);    }    }   }    - static int lower_and_pike_types(char *t1, char *t2) + static int lower_and_pike_types(struct pike_type *t1, struct pike_type *t2)   {    int is_complex = 0; -  while(EXTRACT_UCHAR(t1)==T_OR) +  while(t1->type == T_OR)    { -  t1++; -  is_complex |= lower_and_pike_types(t1, t2); -  t1 += type_length(t1); +  is_complex |= lower_and_pike_types(t1->car, t2); +  t1 = t1->cdr;    } -  switch(EXTRACT_UCHAR(t1)) { +  switch(t1->type) {    case T_ZERO:    case T_VOID:    break; -  case T_PROGRAM: +     case T_STRING: -  case T_TYPE: +     case T_FLOAT:    case T_INT:    even_lower_and_pike_types(t1, t2);    break;    default:    return 1;    }    return is_complex;   }    - static int low_and_push_complex_pike_type(char *type) + /* FIXME: T_STRING! */ + static int low_and_push_complex_pike_type(struct pike_type *type)   {    int is_complex = 0; -  while(EXTRACT_UCHAR(type) == T_OR) +  while(type->type == T_OR)    {    int new_complex; -  type++; -  new_complex = low_and_push_complex_pike_type(type); +  new_complex = low_and_push_complex_pike_type(type->car);    if (new_complex) {    if (is_complex) {    push_type(T_OR);    } else {    is_complex = 1;    }    } -  type += type_length(type); +  type = type->cdr;    } -  switch(EXTRACT_UCHAR(type)) { +  switch(type->type) {    case T_VOID:    case T_ZERO: -  case T_PROGRAM: +     case T_STRING: -  case T_TYPE: +     case T_FLOAT:    case T_INT:    /* Simple type. Already handled. */    break;    default: -  push_unfinished_type(type); +  push_finished_type(type);    if (is_complex) {    push_type(T_OR);    }    return 1;    }    return is_complex;   }    - static void low_and_pike_types(char *t1, char *t2) + /* FIXME: T_STRING! */ + static void low_and_pike_types(struct pike_type *t1, +  struct pike_type *t2)   { -  if(!t1 || EXTRACT_UCHAR(t1) == T_VOID || -  !t2 || EXTRACT_UCHAR(t2) == T_VOID) +  if(!t1 || t1->type == T_VOID || +  !t2 || t2->type == T_VOID)    {    push_type(T_VOID);    } -  else if(EXTRACT_UCHAR(t1) == T_ZERO || -  EXTRACT_UCHAR(t2) == T_ZERO) +  else if(t1->type == T_ZERO || +  t2->type == T_ZERO)    {    push_type(T_ZERO);    } -  else if(EXTRACT_UCHAR(t1)==T_MIXED) +  else if(t1->type == T_MIXED)    { -  push_unfinished_type(t2); +  push_finished_type(t2);    } -  else if(EXTRACT_UCHAR(t2)==T_MIXED) +  else if(t2->type == T_MIXED)    { -  push_unfinished_type(t1); +  push_finished_type(t1);    } -  else if(EXTRACT_UCHAR(t1)==T_INT && EXTRACT_UCHAR(t2)==T_INT) +  else if(t1->type == T_INT && t2->type == T_INT)    {    INT32 i1,i2; -  INT32 upper_bound,lower_bound; -  i1=extract_type_int(t1+1+sizeof(INT32)); -  i2=extract_type_int(t2+1+sizeof(INT32)); +  INT32 upper_bound, lower_bound; +  i1 = CDR_TO_INT(t1); +  i2 = CDR_TO_INT(t2);    upper_bound = MINIMUM(i1,i2);    -  i1=extract_type_int(t1+1); -  i2=extract_type_int(t2+1); +  i1 = CAR_TO_INT(t1); +  i2 = CAR_TO_INT(t2);    lower_bound = MAXIMUM(i1,i2);       if (upper_bound >= lower_bound) { -  push_type_int(upper_bound); -  push_type_int(lower_bound); -  push_type(T_INT); +  push_int_type(lower_bound, upper_bound);    } else {    /* No overlap! */    /* FIXME: Warn? */    push_type(T_VOID);    }    } -  else if (EXTRACT_UCHAR(t1) == T_SCOPE) +  else if (t1->type == T_SCOPE)    { -  if (EXTRACT_UCHAR(t2) == T_SCOPE) { -  low_and_pike_types(t1+2, t2+2); -  if (EXTRACT_UCHAR(t1+1) > EXTRACT_UCHAR(t2+1)) -  push_type(EXTRACT_UCHAR(t1+1)); +  if (t2->type == T_SCOPE) { +  low_and_pike_types(t1->cdr, t2->cdr); +  if (t1->car > t2->car) +  push_scope_type(CAR_TO_INT(t1));    else -  push_type(EXTRACT_UCHAR(t2+1)); +  push_scope_type(CAR_TO_INT(t2));    } else { -  low_and_pike_types(t1+2, t2); -  push_type(EXTRACT_UCHAR(t1+1)); +  low_and_pike_types(t1->cdr, t2); +  push_scope_type(CAR_TO_INT(t1));    } -  push_type(T_SCOPE); +     } -  else if (EXTRACT_UCHAR(t2) == T_SCOPE) +  else if (t2->type == T_SCOPE)    { -  low_and_pike_types(t1, t2+2); -  push_type(EXTRACT_UCHAR(t2+1)); -  push_type(T_SCOPE); +  low_and_pike_types(t1, t2->cdr); +  push_scope_type(CAR_TO_INT(t2));    } -  else if((EXTRACT_UCHAR(t1)==T_STRING && EXTRACT_UCHAR(t2)==T_STRING) || -  (EXTRACT_UCHAR(t1)==T_TYPE && EXTRACT_UCHAR(t2)==T_TYPE) || -  (EXTRACT_UCHAR(t1)==T_FLOAT && EXTRACT_UCHAR(t2)==T_FLOAT) || -  (EXTRACT_UCHAR(t1)==T_PROGRAM && EXTRACT_UCHAR(t2)==T_PROGRAM)) +  else if ((t1->type == T_STRING) && (t2->type == T_STRING)) { +  low_and_pike_types(t1->car, t2->car); +  push_type(T_STRING); +  } +  else if((t1->type == T_FLOAT) && (t2->type == T_FLOAT))    { -  push_unfinished_type(t1); +  push_finished_type(t1);    }    else if(low_pike_types_le(t1, t2, 0, 0))    { -  push_unfinished_type(t1); +  push_finished_type(t1);    }    else if(low_pike_types_le(t2, t1, 0, 0))    { -  push_unfinished_type(t2); +  push_finished_type(t2);    }    else    {    push_type(T_ZERO);       if (lower_and_pike_types(t1, t2)) {    /* t1 contains complex types. */    if (low_and_push_complex_pike_type(t2)) {    /* t2 also contains complex types. */    low_and_push_complex_pike_type(t1);    push_type(T_AND);    push_type(T_OR);    }    } -  /* push_unfinished_type(t1); */ +  /* push_finished_type(t1); */    /* very_low_and_pike_types(t2,t1); */    }   }    - static void medium_and_pike_types(struct pike_string *a, -  struct pike_string *b) + struct pike_type *and_pike_types(struct pike_type *a, +  struct pike_type *b)   { -  low_and_pike_types( a ? a->str : 0 , b ? b->str : 0 ); - } -  - struct pike_string *and_pike_types(struct pike_string *a, -  struct pike_string *b) - { +     type_stack_mark(); -  medium_and_pike_types(a,b); +  low_and_pike_types(a, b);    return pop_unfinished_type();   }    - static struct pike_string *low_object_lfun_type(char *t, short lfun) + static struct pike_type *low_object_lfun_type(struct pike_type *t, short lfun)   {    struct program *p;    int i; -  p=id_to_program(extract_type_int(t+2)); +  while ((t->type == PIKE_T_NAME) || (t->type == PIKE_T_ATTRIBUTE)) { +  t = t->cdr; +  } + #ifdef PIKE_DEBUG +  if (t->type != T_OBJECT) { +  fprintf(stderr, "Invalid type to low_object_lfun_type("); +  simple_describe_type(t); +  fprintf(stderr, ", \"%s\")\n", lfun_names[lfun]); +  Pike_fatal("Invalid type to low_object_lfun_type: %d (expected OBJECT).\n", +  t->type); +  } + #endif /* PIKE_DEBUG */ +  p = id_to_program(CDR_TO_INT(t));    if(!p) return 0;    i=FIND_LFUN(p, lfun);    if(i==-1) return 0;    return ID_FROM_INT(p, i)->type;   }    - #define A_EXACT 1 - #define B_EXACT 2 - #define NO_MAX_ARGS 4 - #define NO_SHORTCUTS 8 +        - #ifdef PIKE_TYPE_DEBUG - static int indent=0; - #endif + /******/      /*    * match two type strings, return zero if they don't match, and return    * the part of 'a' that _did_ match if it did.    */ - static char *low_match_types(char *a,char *b, int flags) +    #ifdef PIKE_TYPE_DEBUG -  + static struct pike_type *low_match_types2(struct pike_type *a, +  struct pike_type *b, +  int flags); + #endif + static struct pike_type *low_match_types(struct pike_type *a, +  struct pike_type *b, +  int flags) + #ifdef PIKE_TYPE_DEBUG   {    int e;    char *s; -  static char *low_match_types2(char *a,char *b, int flags); +        if (l_flag>2) { -  init_buf(); +  dynamic_buffer save_buf; +  init_buf(&save_buf);    for(e=0;e<indent;e++) my_strcat(" ");    my_strcat("low_match_types("); -  low_describe_type(a); -  if(type_length(a) + type_length(b) > 10) -  { +  my_describe_type(a);    my_strcat(",\n");    for(e=0;e<indent;e++) my_strcat(" ");    my_strcat(" "); -  low_describe_type(b); +  my_describe_type(b);    my_strcat(",\n");    for(e=0;e<indent;e++) my_strcat(" ");    my_strcat(" "); -  }else{ -  my_strcat(", "); -  low_describe_type(b); -  my_strcat(", "); -  } +     if (flags) {    int f = 0;    if (flags & A_EXACT) {    my_strcat("A_EXACT");    f = 1;    }    if (flags & B_EXACT) {    if (f) {    my_strcat(" | ");    }
pike.git/src/pike_types.c:1511: Inside #if defined(PIKE_TYPE_DEBUG)
   if (f) {    my_strcat(" | ");    }    my_strcat("NO_SHORTCUTS");    f = 1;    }    } else {    my_strcat("0");    }    my_strcat(");\n"); -  fprintf(stderr,"%s",(s=simple_free_buf())); +  fprintf(stderr,"%s",(s=simple_free_buf(&save_buf)));    free(s);    indent++;    }    -  a=low_match_types2(a,b,flags); +  a = low_match_types2(a, b, flags);       if (l_flag>2) { -  +  dynamic_buffer save_buf;    indent--; -  init_buf(); +  init_buf(&save_buf);    for(e=0;e<indent;e++) my_strcat(" ");    my_strcat("= ");    if(a) -  low_describe_type(a); +  my_describe_type(a);    else    my_strcat("NULL");    my_strcat("\n"); -  fprintf(stderr,"%s",(s=simple_free_buf())); +  fprintf(stderr,"%s",(s=simple_free_buf(&save_buf)));    free(s);    }    return a;   }    - static char *low_match_types2(char *a,char *b, int flags) + static struct pike_type *low_match_types2(struct pike_type *a, +  struct pike_type *b, +  int flags)   #endif -  +    {    int correct_args; -  char *ret; +  struct pike_type *ret;    if(a == b) return a;    -  switch(EXTRACT_UCHAR(a)) + #ifdef PIKE_DEBUG +  fatal_check_c_stack(1024); + #endif +  +  switch(a->type)    {    case T_AND: -  a++; -  ret=low_match_types(a,b,flags); +  ret = low_match_types(a->car, b, flags);    if(!ret) return 0; -  a+=type_length(a); -  return low_match_types(a,b,flags); +  return low_match_types(a->cdr, b, flags);       case T_OR: -  a++; -  ret=low_match_types(a,b,flags); +  ret = low_match_types(a->car, b, flags);    if(ret && !(flags & NO_SHORTCUTS)) return ret; -  a+=type_length(a); +     if(ret)    { -  low_match_types(a,b,flags); +  low_match_types(a->cdr, b, flags);    return ret;    }else{ -  return low_match_types(a,b,flags); +  return low_match_types(a->cdr, b, flags);    }    -  +  case PIKE_T_RING: +  return low_match_types(a->car, b, flags); +  +  case PIKE_T_SCOPE: +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  return low_match_types(a->cdr, b, flags); +     case T_NOT: -  if(low_match_types(a+1,b,(flags ^ B_EXACT ) | NO_MAX_ARGS)) +  if(low_match_types(a->car, b, (flags ^ B_EXACT ) | NO_MAX_ARGS))    return 0;    return a;       case T_ASSIGN: -  ret=low_match_types(a+2,b,flags); -  if(ret && EXTRACT_UCHAR(b)!=T_VOID) +     { -  int m=EXTRACT_UCHAR(a+1)-'0'; -  struct pike_string *tmp; +  int m = CAR_TO_INT(a); +  ret = low_match_types(a->cdr, b, flags); +  if(ret && (!a_markers[m] || b->type != T_VOID)) +  { +  struct pike_type *tmp; +  + #ifdef PIKE_DEBUG +  if ((m < 0) || (m > 9)) { +  Pike_fatal("marker out of range: %d\n", m); +  } + #endif /* PIKE_DEBUG */ +     type_stack_mark(); -  push_unfinished_type_with_markers(b, b_markers); -  tmp=pop_unfinished_type(); +  push_finished_type_with_markers(b, b_markers, 0); +  tmp = pop_unfinished_type();       type_stack_mark(); -  medium_or_pike_types(a_markers[m], tmp, 0); -  if(a_markers[m]) free_string(a_markers[m]); -  free_string(tmp); -  a_markers[m]=pop_unfinished_type(); +  low_or_pike_types(a_markers[m], tmp, 0); +  if(a_markers[m]) free_type(a_markers[m]); +  free_type(tmp); +  a_markers[m] = pop_unfinished_type();      #ifdef PIKE_TYPE_DEBUG    if (l_flag>2) { -  +  dynamic_buffer save_buf;    char *s;    int e; -  init_buf(); +  init_buf(&save_buf);    for(e=0;e<indent;e++) my_strcat(" ");    my_strcat("a_markers[");    my_putchar((char)(m+'0'));    my_strcat("]="); -  low_describe_type(a_markers[m]->str); +  my_describe_type(a_markers[m]);    my_strcat("\n"); -  fprintf(stderr,"%s",(s=simple_free_buf())); +  fprintf(stderr,"%s",(s=simple_free_buf(&save_buf)));    free(s);    }   #endif   #ifdef PIKE_DEBUG -  if(a_markers[m]->str[0] == m+'0') -  fatal("Cyclic type!\n"); +  if(a_markers[m]->type == m+'0') +  Pike_fatal("Cyclic type!\n");   #endif    }    return ret; -  +  }    case '0': case '1': case '2': case '3': case '4':    case '5': case '6': case '7': case '8': case '9':    { -  int m=EXTRACT_UCHAR(a)-'0'; +  int m = a->type - '0';    if(a_markers[m])    { -  +  struct pike_type *t = a_markers[m]; +  struct pike_type *res;   #ifdef PIKE_DEBUG -  if(a_markers[m]->str[0] == EXTRACT_UCHAR(a)) -  fatal("Cyclic type!\n"); -  if(EXTRACT_UCHAR(a_markers[m]->str) == T_OR && -  a_markers[m]->str[1] == EXTRACT_UCHAR(a)) -  fatal("Cyclic type!\n"); +  if(a_markers[m]->type == a->type) +  Pike_fatal("Cyclic type!\n"); +  if(a_markers[m]->type == T_OR && +  a_markers[m]->car->type == a->type) +  Pike_fatal("Cyclic type!\n");   #endif -  return low_match_types(a_markers[m]->str, b, flags); +  a_markers[m] = NULL; +  res = low_match_types(t, b, flags); +  if (a_markers[m]) { +  struct pike_type *tmp; +  a_markers[m] = or_pike_types(tmp = a_markers[m], t, 0); +  free_type(tmp); +  free_type(t); +  } else { +  a_markers[m] = t;    } -  +  return res; +  }    else -  return low_match_types(mixed_type_string->str, b, flags); +  return low_match_types(mixed_type_string, b, flags);    }    }    -  switch(EXTRACT_UCHAR(b)) +  switch(b->type)    {    case T_AND: -  b++; -  ret=low_match_types(a,b,flags); +  ret = low_match_types(a, b->car, flags);    if(!ret) return 0; -  b+=type_length(b); -  return low_match_types(a,b,flags); +  return low_match_types(a, b->cdr, flags);       case T_OR: -  b++; -  ret=low_match_types(a,b,flags); +  ret = low_match_types(a, b->car, flags);    if(ret && !(flags & NO_SHORTCUTS)) return ret; -  b+=type_length(b); +     if(ret)    { -  low_match_types(a,b,flags); +  low_match_types(a, b->cdr, flags);    return ret;    }else{ -  return low_match_types(a,b,flags); +  return low_match_types(a, b->cdr, flags);    }    -  +  case PIKE_T_RING: +  return low_match_types(a, b->car, flags); +  +  case PIKE_T_SCOPE: +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  return low_match_types(a, b->cdr, flags); +     case T_NOT: -  if(low_match_types(a,b+1, (flags ^ A_EXACT ) | NO_MAX_ARGS)) +  if(low_match_types(a, b->car, (flags ^ A_EXACT ) | NO_MAX_ARGS))    return 0;    return a;       case T_ASSIGN: -  ret=low_match_types(a,b+2,flags); -  if(ret && EXTRACT_UCHAR(a)!=T_VOID) +     { -  int m=EXTRACT_UCHAR(b+1)-'0'; -  struct pike_string *tmp; +  int m = CAR_TO_INT(b); +  ret = low_match_types(a, b->cdr, flags); +  if(ret && (!b_markers[m] || a->type != T_VOID)) +  { +  struct pike_type *tmp; +     type_stack_mark(); -  push_unfinished_type_with_markers(a, a_markers); +  push_finished_type_with_markers(a, a_markers, 0);    tmp=pop_unfinished_type();       type_stack_mark(); -  medium_or_pike_types(b_markers[m], tmp, 0); -  if(b_markers[m]) free_string(b_markers[m]); -  free_string(tmp); -  b_markers[m]=pop_unfinished_type(); +  low_or_pike_types(b_markers[m], tmp, 0); +  if(b_markers[m]) free_type(b_markers[m]); +  free_type(tmp); +  b_markers[m] = pop_unfinished_type();   #ifdef PIKE_TYPE_DEBUG    if (l_flag>2) { -  +  dynamic_buffer save_buf;    char *s;    int e; -  init_buf(); +  init_buf(&save_buf);    for(e=0;e<indent;e++) my_strcat(" ");    my_strcat("b_markers[");    my_putchar((char)(m+'0'));    my_strcat("]="); -  low_describe_type(b_markers[m]->str); +  my_describe_type(b_markers[m]);    my_strcat("\n"); -  fprintf(stderr,"%s",(s=simple_free_buf())); +  fprintf(stderr,"%s",(s=simple_free_buf(&save_buf)));    free(s);    }   #endif   #ifdef PIKE_DEBUG -  if(b_markers[m]->str[0] == m+'0') -  fatal("Cyclic type!\n"); +  if(b_markers[m]->type == m+'0') +  Pike_fatal("Cyclic type!\n");   #endif    }    return ret; -  +  }    case '0': case '1': case '2': case '3': case '4':    case '5': case '6': case '7': case '8': case '9':    { -  int m=EXTRACT_UCHAR(b)-'0'; +  int m = b->type - '0';    if(b_markers[m])    { -  +  struct pike_type *t = b_markers[m]; +  struct pike_type *res;   #ifdef PIKE_DEBUG -  if(b_markers[m]->str[0] == EXTRACT_UCHAR(b)) -  fatal("Cyclic type!\n"); +  if(b_markers[m]->type == b->type) +  Pike_fatal("Cyclic type!\n");   #endif -  return low_match_types(a, b_markers[m]->str, flags); +  b_markers[m] = NULL; +  res = low_match_types(a, t, flags); +  if (b_markers[m]) { +  struct pike_type *tmp; +  b_markers[m] = or_pike_types(tmp = b_markers[m], t, 0); +  free_type(tmp); +  free_type(t); +  } else { +  b_markers[m] = t;    } -  +  return res; +  }    else -  return low_match_types(a, mixed_type_string->str, flags); +  return low_match_types(a, mixed_type_string, flags);    }    }       /* 'mixed' matches anything */    -  if(((EXTRACT_UCHAR(a) == T_ZERO || EXTRACT_UCHAR(a) == T_MIXED) && +  if((a->type == T_ZERO || a->type == T_MIXED) &&    !(flags & (A_EXACT|B_EXACT)) && -  EXTRACT_UCHAR(b) != T_VOID)) +  (b->type != T_VOID))    {   #if 1 -  switch(EXTRACT_UCHAR(b)) +  switch(b->type)    {    /* These types can contain sub-types */    case T_ARRAY: -  low_match_types(array_type_string->str,b , flags); +  low_match_types(array_type_string, b, flags);    break;    case T_MAPPING: -  low_match_types(mapping_type_string->str,b, flags); +  low_match_types(mapping_type_string, b, flags);    break;    case T_FUNCTION: -  low_match_types(function_type_string->str,b, flags); +  case T_MANY: +  low_match_types(function_type_string, b, flags);    break;    case T_MULTISET: -  low_match_types(multiset_type_string->str,b, flags); +  low_match_types(multiset_type_string, b, flags);    break;    }   #endif    return a;    }    -  if((( EXTRACT_UCHAR(b) == T_ZERO || EXTRACT_UCHAR(b) == T_MIXED) && +  if((b->type == T_ZERO || b->type == T_MIXED) &&    !(flags & (A_EXACT|B_EXACT)) && -  EXTRACT_UCHAR(a) != T_VOID)) +  (a->type != T_VOID))    {   #if 1 -  switch(EXTRACT_UCHAR(a)) +  switch(a->type)    {    /* These types can contain sub-types */    case T_ARRAY: -  low_match_types(a , array_type_string->str, flags); +  low_match_types(a, array_type_string, flags);    break;    case T_MAPPING: -  low_match_types(a , mapping_type_string->str, flags); +  low_match_types(a, mapping_type_string, flags);    break;    case T_FUNCTION: -  low_match_types(a , function_type_string->str, flags); +  case T_MANY: +  low_match_types(a, function_type_string, flags);    break;    case T_MULTISET: -  low_match_types(a , multiset_type_string->str, flags); +  low_match_types(a, multiset_type_string, flags);    break;    }   #endif    return a;    }    -  /* Convert zero to int(0..0). */ -  if (EXTRACT_UCHAR(a) == T_ZERO) -  a = tInt0; -  if (EXTRACT_UCHAR(b) == T_ZERO) -  b = tInt0; -  +     /* Special cases (tm) */ -  switch(EXTRACT_TWOT(a,b)) +  switch(TWOT(a->type, b->type))    {    case TWOT(T_PROGRAM, T_FUNCTION):    case TWOT(T_FUNCTION, T_PROGRAM): -  +  case TWOT(T_PROGRAM, T_MANY): +  case TWOT(T_MANY, T_PROGRAM): +  /* FIXME: Should look at the sub-type of the program +  * to determine the prototype to use. +  */    return a;    -  +  case TWOT(PIKE_T_TYPE, T_FUNCTION): +  case TWOT(PIKE_T_TYPE, T_MANY): +  /* Convert the type to a casting function. */ +  type_stack_mark(); +  push_finished_type(a->car); +  push_type(T_VOID); +  push_type(T_MANY); +  push_type(T_MIXED); +  push_type(T_FUNCTION); +  ret = a; +  a = pop_unfinished_type(); +  if (low_match_types(a, b, flags)) { +  free_type(a); +  return ret; +  } +  free_type(a); +  return NULL; +  +  case TWOT(T_FUNCTION, PIKE_T_TYPE): +  case TWOT(T_MANY, PIKE_T_TYPE): +  /* Convert the type to a casting function. */ +  type_stack_mark(); +  push_finished_type(b->car); +  push_type(T_VOID); +  push_type(T_MANY); +  push_type(T_MIXED); +  push_type(T_FUNCTION); +  b = pop_unfinished_type(); +  ret = low_match_types(a, b, flags); +  free_type(b); +  return ret; +  +  case TWOT(PIKE_T_TYPE, T_PROGRAM): +  case TWOT(T_PROGRAM, PIKE_T_TYPE): +  return low_match_types(a->car, b->car, flags); +     case TWOT(T_OBJECT, T_FUNCTION): -  +  case TWOT(T_OBJECT, T_MANY):    { -  struct pike_string *s; -  if((s=low_object_lfun_type(a, LFUN_CALL))) -  return low_match_types(s->str,b,flags); +  struct pike_type *s; +  if((s = low_object_lfun_type(a, LFUN_CALL))) +  return low_match_types(s, b, flags);    if (flags & B_EXACT) {    /* A function isn't an object */    return 0;    }    return a;    }       case TWOT(T_FUNCTION, T_OBJECT): -  +  case TWOT(T_MANY, T_OBJECT):    { -  struct pike_string *s; +  struct pike_type *s;    if((s=low_object_lfun_type(b, LFUN_CALL))) -  return low_match_types(a,s->str,flags); +  return low_match_types(a, s, flags);    if (flags & A_EXACT) {    /* A function isn't an object */    return 0;    }    return a;    } -  +  case TWOT(T_INT, T_ZERO): +  { +  if ((CAR_TO_INT(a) > 0) || (CDR_TO_INT(a) < 0)) { +  return 0;    } -  -  if(EXTRACT_UCHAR(a) != EXTRACT_UCHAR(b)) return 0; -  -  ret=a; -  switch(EXTRACT_UCHAR(a)) +  return a; +  } +  case TWOT(T_ZERO, T_INT):    { -  case T_FUNCTION: +  if ((CAR_TO_INT(b) > 0) || (CDR_TO_INT(b) < 0)) { +  return 0; +  } +  return a; +  } +  case TWOT(T_FUNCTION, T_FUNCTION): +  case TWOT(T_FUNCTION, T_MANY): +  case TWOT(T_MANY, T_FUNCTION): +  case TWOT(T_MANY, T_MANY): +  ret = a;    correct_args=0; -  a++; -  b++; -  while(EXTRACT_UCHAR(a)!=T_MANY || EXTRACT_UCHAR(b)!=T_MANY) +  while ((a->type != T_MANY) || (b->type != T_MANY))    { -  char *a_tmp,*b_tmp; -  if(EXTRACT_UCHAR(a)==T_MANY) +  struct pike_type *a_tmp, *b_tmp; +  +  a_tmp = a->car; +  if (a->type == T_FUNCTION)    { -  a_tmp=a+1; -  }else{ -  a_tmp=a; -  a+=type_length(a); +  a = a->cdr;    }    -  if(EXTRACT_UCHAR(b)==T_MANY) +  b_tmp = b->car; +  if (b->type == T_FUNCTION)    { -  b_tmp=b+1; -  }else{ -  b_tmp=b; -  b+=type_length(b); +  b = b->cdr;    }       if(!low_match_types(a_tmp, b_tmp,    (flags | NO_MAX_ARGS) & ~(A_EXACT|B_EXACT)))    return 0;    if(++correct_args > max_correct_args)    if(!(flags & NO_MAX_ARGS))    max_correct_args=correct_args;    }    /* check the 'many' type */ -  a++; -  b++; -  if(EXTRACT_UCHAR(b)==T_VOID || EXTRACT_UCHAR(a)==T_VOID) +  if(b->car->type != T_VOID && +  a->car->type != T_VOID)    { -  a+=type_length(a); -  b+=type_length(b); -  }else{ -  if(!low_match_types(a,b, (flags | NO_MAX_ARGS) & ~(A_EXACT|B_EXACT))) +  if(!low_match_types(a->car, b->car, +  (flags | NO_MAX_ARGS) & ~(A_EXACT|B_EXACT)))    return 0;    }    if(!(flags & NO_MAX_ARGS)) -  max_correct_args=0x7fffffff; +  max_correct_args=MAX_INT32;    /* check the returntype */ -  if ((EXTRACT_UCHAR(b) == T_VOID) && (EXTRACT_UCHAR(a) != T_VOID)) { +  a = a->cdr; +  b = b->cdr; +  if ((b->type == T_VOID) && (a->type != T_VOID)) {    /* Promote b to a function returning zero. */ -  if (!low_match_types(a, tZero, flags & ~(A_EXACT|B_EXACT))) return 0; -  } else if ((EXTRACT_UCHAR(a) == T_VOID) && (EXTRACT_UCHAR(b) != T_VOID)) { +  if (!low_match_types(a, zero_type_string, flags & ~(A_EXACT|B_EXACT))) +  return 0; +  } else if ((a->type == T_VOID) && (b->type != T_VOID)) {    /* Promote a to a function returning zero. */ -  if(!low_match_types(tZero,b,flags & ~(A_EXACT|B_EXACT))) return 0; -  } else if(!low_match_types(a,b,flags & ~(A_EXACT|B_EXACT))) return 0; -  break; +  if(!low_match_types(zero_type_string, b, flags & ~(A_EXACT|B_EXACT))) +  return 0; +  } else if(!low_match_types(a, b, flags & ~(A_EXACT|B_EXACT))) return 0; +  return ret; +  }    -  +  if(a->type != b->type) return 0; +  +  ret=a; +  switch(a->type) +  {    case T_MAPPING: -  if(!low_match_types(++a,++b,flags & ~(A_EXACT|B_EXACT))) return 0; -  if(!low_match_types(a+type_length(a),b+type_length(b), +  if(!low_match_types(a->car, b->car,    flags & ~(A_EXACT|B_EXACT))) return 0; -  +  if(!low_match_types(a->cdr, b->cdr, +  flags & ~(A_EXACT|B_EXACT))) return 0;    break;       case T_OBJECT:   #if 0 -  if(extract_type_int(a+2) || extract_type_int(b+2)) +  if(a->cdr || b->cdr)    {    fprintf(stderr,"Type match1: ");    stupid_describe_type(a,type_length(a));    fprintf(stderr,"Type match2: ");    stupid_describe_type(b,type_length(b));    }   #endif       /* object(* 0) matches any object */ -  if(!extract_type_int(a+2) || !extract_type_int(b+2)) break; +  if(!a->cdr || !b->cdr) break;    -  +  /* object(* x) =? object(* x) */ +  if (a->cdr == b->cdr) break; +     /* object(x *) =? object(x *) */ -  if(EXTRACT_UCHAR(a+1) == EXTRACT_UCHAR(b+1)) +  if(TEST_COMPAT(7,4) && a->car == b->car)    {    /* x? */ -  if(EXTRACT_UCHAR(a+1)) +  if(a->car)    {    /* object(1 x) =? object(1 x) */ -  if(extract_type_int(a+2) != extract_type_int(b+2)) return 0; +  return 0;    }else{    /* object(0 *) =? object(0 *) */ -  /* FIXME: Ought to check the implements relation */ +     break;    }    }    -  +  /* Note: In Pike 7.4 and earlier the following was only done +  * when a->car != b->car. +  */    {    struct program *ap,*bp; -  ap=id_to_program(extract_type_int(a+2)); -  bp=id_to_program(extract_type_int(b+2)); +  ap = id_to_program(CDR_TO_INT(a)); +  bp = id_to_program(CDR_TO_INT(b));       if(!ap || !bp) break;    - #if 0 -  /* FIXME: Temporary kludge. -  * match_types() currently seems to need to be symetric. -  */ -  if (!implements(ap,bp) && !implements(bp,ap)) +  implements_mode = 0; +  +  if (!is_compatible(implements_a=ap,implements_b=bp))    return 0; - #else /* !1 */ -  if(EXTRACT_UCHAR(a+1)) -  { -  if(!implements(implements_a=ap,implements_b=bp)) -  return 0; -  }else{ -  if(!implements(implements_a=bp,implements_b=ap)) -  return 0; +     } - #endif /* 1 */ -  } -  +     break;       case T_INT:    { -  INT32 amin=extract_type_int(a+1); -  INT32 amax=extract_type_int(a+1+sizeof(INT32)); +  INT32 amin = CAR_TO_INT(a); +  INT32 amax = CDR_TO_INT(a);    -  INT32 bmin=extract_type_int(b+1); -  INT32 bmax=extract_type_int(b+1+sizeof(INT32)); +  INT32 bmin = CAR_TO_INT(b); +  INT32 bmax = CDR_TO_INT(b);       if(amin > bmax || bmin > amax) return 0;    break;    }       -  +  case T_PROGRAM: +  case T_TYPE:    case T_MULTISET:    case T_ARRAY: -  if(!low_match_types(++a,++b,flags & ~(A_EXACT|B_EXACT))) return 0; +  case T_STRING: +  if(!low_match_types(a->car, b->car, +  flags & ~(A_EXACT|B_EXACT))) return 0;       case T_FLOAT: -  case T_STRING: -  case T_TYPE: -  case T_PROGRAM: +     case T_ZERO:    case T_VOID:    case T_MIXED:    break; -  + #ifdef PIKE_DEBUG    default: -  fatal("Error in type string.\n"); +  Pike_fatal("Error in type string.\n"); + #endif    }    return ret;   }      /* -  * Flags used by pike_types_le() -  */ - #define LE_WEAK_OBJECTS 1 /* Perform weaker checking of objects. */ -  -  - /* +     * Check the partial ordering relation.    *    * mixed    *    * int float string program function object    *    * zero    *    * void    *    * Note that non-destructive operations are assumed.    * ie it's assumed that calling a function(mapping(string|int:string|int):void)    * with a mapping(int:int) won't change the type of the mapping after the    * operation.    */ - static int low_pike_types_le(char *a, char *b, + #ifdef PIKE_TYPE_DEBUG + static int low_pike_types_le2(struct pike_type *a, struct pike_type *b, +  int array_cnt, unsigned int flags); + #endif /* PIKE_TYPE_DEBUG */ + static int low_pike_types_le(struct pike_type *a, struct pike_type *b,    int array_cnt, unsigned int flags)   #ifdef PIKE_TYPE_DEBUG   { -  int e; -  char *s; -  static int low_pike_types_le2(char *a, char *b, -  int array_cnt, unsigned int flags); +     int res; -  char buf[50]; +        if (l_flag>2) { -  init_buf(); -  for(e=0;e<indent;e++) my_strcat(" "); -  my_strcat("low_pike_types_le("); -  low_describe_type(a); -  if(type_length(a) + type_length(b) > 10) -  { -  my_strcat(",\n"); -  for(e=0;e<indent;e++) my_strcat(" "); -  my_strcat(" "); -  low_describe_type(b); -  }else{ -  my_strcat(", "); -  low_describe_type(b); -  } -  if(type_length(a) + type_length(b) > 10) -  { -  my_strcat(",\n"); -  for(e=0;e<indent;e++) my_strcat(" "); -  my_strcat(" "); -  }else{ -  my_strcat(", "); -  } -  sprintf(buf, "%d", array_cnt); -  my_strcat(buf); -  my_strcat(", "); -  sprintf(buf, "0x%08x", flags); -  my_strcat(buf); -  my_strcat(");\n"); -  fprintf(stderr,"%s",(s=simple_free_buf())); -  free(s); + #if 0 +  struct compilation *c = MAYBE_THIS_COMPILATION; +  if (c && c->lex.current_file) +  fprintf (stderr, "%*s%s:%d:\n", indent * 2, "", +  c->lex.current_file->str, c->lex.current_line); + #endif +  fprintf(stderr, "%*slow_pike_types_le(", indent*2, ""); +  simple_describe_type(a); +  fprintf(stderr, ",\n%*s", indent*2 + 18, ""); +  simple_describe_type(b); +  fprintf(stderr, ",\n%*s%d, 0x%08x);\n", +  indent*2 + 18, "", array_cnt, flags);    indent++;    }    -  res=low_pike_types_le2(a, b, array_cnt, flags); +  res = low_pike_types_le2(a, b, array_cnt, flags);       if (l_flag>2) {    indent--;    -  for(e=0;e<indent;e++) fprintf(stderr, " "); -  fprintf(stderr, "= %d\n", res); +  fprintf(stderr, "%*s= %d\n", indent*2, "", res);    }    return res;   }    - static int low_pike_types_le2(char *a, char *b, + static int low_pike_types_le2(struct pike_type *a, struct pike_type *b,    int array_cnt, unsigned int flags)   #endif /* PIKE_TYPE_DEBUG */ -  +    { -  +  struct compilation *c = MAYBE_THIS_COMPILATION;    int ret; -  +  +  recurse: + #if 0 +  fprintf(stderr, "low_pike_types_le(%d, %d, %d, 0x%08x)\n", +  a->type, b->type, array_cnt, flags); + #endif /* 0 */ +     if(a == b) return 1;    -  switch(EXTRACT_UCHAR(a)) + #ifdef TYPE_GROUPING +  if (a->type != T_OR) { +  flags &= ~LE_A_GROUPED; +  } + #endif +  +  switch(a->type)    {    case T_AND:    /* OK if either of the parts is a subset. */    /* FIXME: What if b also contains an AND? */ -  a++; -  ret = low_pike_types_le(a, b, array_cnt, flags); -  if(ret) return ret; -  a += type_length(a); -  return low_pike_types_le(a, b, array_cnt, flags); +  ret = low_pike_types_le(a->car, b, array_cnt, flags); +  if(!ret) { +  a = a->cdr; +  goto recurse; +  } +  if ((a->flags | b->flags) & PT_FLAG_ASSIGN) { +  /* Note that we need to recurse, since there are T_ASSIGN nodes +  * in the cdr that need to be executed. +  */ +  low_pike_types_le(a->cdr, b, array_cnt, flags); +  } +  return 1;       case T_OR: -  /* OK, if both of the parts are a subset */ -  a++; -  if (EXTRACT_UCHAR(a) == T_VOID) { +  /* OK, if both of the parts are a subset, +  * unless we are grouped, in which case +  * only one part needs to be a subset. +  */ +  if (a->car->type == T_VOID) {    /* Special case for T_VOID */    /* FIXME: Should probably be handled as T_ZERO. */ -  a += type_length(a); -  return low_pike_types_le(a, b, array_cnt, flags); + #ifdef TYPE_GROUPING +  if (flags & LE_A_GROUPED) return 1; + #endif +  a = a->cdr; +  goto recurse;    } else { -  ret=low_pike_types_le(a, b, array_cnt, flags); +  ret = low_pike_types_le(a->car, b, array_cnt, flags); + #ifdef TYPE_GROUPING +  if (!ret == !(flags & LE_A_GROUPED)) { +  if ((a->flags | b->flags) & PT_FLAG_ASSIGN) { +  /* Note: Needed for side effects... */ +  low_pike_types_le(a->cdr, b, array_cnt, flags); +  } +  return ret; +  } + #else    if (!ret) return 0; -  a+=type_length(a); -  if (EXTRACT_UCHAR(a) == T_VOID) { + #endif +  if (a->cdr->type == T_VOID) {    /* Special case for T_VOID */    /* FIXME: Should probably be handled as T_ZERO. */    return 1;    } else { -  return low_pike_types_le(a, b, array_cnt, flags); +  a = a->cdr; +  goto recurse;    }    }    -  +  case PIKE_T_RING: +  a = a->car; +  goto recurse; +  +  case PIKE_T_SCOPE: + #ifdef TYPE_GROUPING +  flags |= LE_A_GROUPED; + #endif +  /* FALL_THROUGH */ +  case PIKE_T_NAME: +  a = a->cdr; +  goto recurse; +  case PIKE_T_ATTRIBUTE: +  if ((b->type == PIKE_T_ATTRIBUTE) && (a->car == b->car)) { +  a = a->cdr; +  b = b->cdr; +  goto recurse; +  } +  if (!c) { +  a = a->cdr; +  goto recurse; +  } +  if (!low_pike_types_le(a->cdr, b, array_cnt, flags)) return 0; +  ref_push_string((struct pike_string *)a->car); +  ref_push_type_value(a->cdr); +  ref_push_type_value(b); +  safe_apply_current2(PC_POP_TYPE_ATTRIBUTE_FUN_NUM, 3, +  "pop_type_attribute"); +  if ((TYPEOF(Pike_sp[-1]) == T_INT) && +  (SUBTYPEOF(Pike_sp[-1]) == NUMBER_NUMBER) && +  (!Pike_sp[-1].u.integer)) { +  pop_stack(); +  return 0; +  } +  pop_stack(); +  return 1; +     case T_NOT: -  if (EXTRACT_UCHAR(b) == T_NOT) { -  return low_pike_types_le(b+1, a+1, -array_cnt, flags); +  if (b->type == T_NOT) { +  struct pike_type *tmp = a->car; +  a = b->car; +  b = tmp; +  array_cnt = -array_cnt; +  flags ^= LE_A_B_SWAPPED; + #if 0 + #ifdef TYPE_GROUPING +  if (flags & LE_A_B_GROUPED) { +  if ((flags & LE_A_B_GROUPED) == LE_A_B_GROUPED) { +  flags ^= LE_A_B_GROUPED;    } -  if (EXTRACT_UCHAR(a+1) == T_NOT) { -  return low_pike_types_le(a+2, b, array_cnt, flags); +  } else { +  flags |= LE_A_B_GROUPED;    } -  if (low_pike_types_le(a+1, b, array_cnt, flags)) { + #endif + #endif +  goto recurse; +  } +  /* Some common cases. */ +  switch(a->car->type) { +  case T_NOT: +  a = a->car->car; +  goto recurse; +  case T_MIXED: +  a = zero_type_string; +  goto recurse; +  case T_ZERO: +  case T_VOID: +  a = mixed_type_string; +  goto recurse; +  } +  if (low_pike_types_le(a->car, b, array_cnt, flags)) {    return 0;    } -  +  flags ^= LE_A_B_SWAPPED; + #if 0 + #ifdef TYPE_GROUPING +  if (flags & LE_A_B_GROUPED) { +  if ((flags & LE_A_B_GROUPED) == LE_A_B_GROUPED) { +  flags ^= LE_A_B_GROUPED; +  } +  } else { +  flags |= LE_A_B_GROUPED; +  } + #endif + #endif    /* FIXME: This is wrong... */ -  return !low_pike_types_le(b, a+1, -array_cnt, flags); +  return !low_pike_types_le(b, a->car, -array_cnt, flags);    -  case T_ASSIGN: -  ret=low_pike_types_le(a+2, b, array_cnt, flags); -  if(ret && EXTRACT_UCHAR(b)!=T_VOID) +  case T_ASSIGN: { +  struct pike_type **aa_markers = a_markers; +  struct pike_type **bb_markers = b_markers; +  int m = CAR_TO_INT(a); +  ret = low_pike_types_le(a->cdr, b, array_cnt, flags); +  +  if (flags & LE_A_B_SWAPPED) { +  aa_markers = b_markers; +  bb_markers = a_markers; +  } +  +  if(ret && (!aa_markers[m] || (b->type != T_VOID)))    { -  int m=EXTRACT_UCHAR(a+1)-'0'; -  struct pike_string *tmp; +  struct pike_type *tmp;    int i; -  +     type_stack_mark(); -  push_unfinished_type_with_markers(b, b_markers); +  push_finished_type_with_markers(b, bb_markers, 0);    for(i=array_cnt; i > 0; i--)    push_type(T_ARRAY);    tmp=pop_unfinished_type();       type_stack_mark(); -  medium_or_pike_types(a_markers[m], tmp, 0); -  if(a_markers[m]) free_string(a_markers[m]); -  free_string(tmp); -  a_markers[m]=pop_unfinished_type(); +  low_or_pike_types(aa_markers[m], tmp, 0); +  if(aa_markers[m]) free_type(aa_markers[m]); +  free_type(tmp); +  aa_markers[m] = pop_unfinished_type();   #ifdef PIKE_TYPE_DEBUG    if (l_flag>2) { -  char *s; -  int e; -  init_buf(); -  for(e=0;e<indent;e++) my_strcat(" "); -  my_strcat("a_markers["); -  my_putchar((char)(m+'0')); -  my_strcat("]="); -  low_describe_type(a_markers[m]->str); -  my_strcat("\n"); -  fprintf(stderr,"%s",(s=simple_free_buf())); -  free(s); +  if (flags & LE_A_B_SWAPPED) { +  fprintf(stderr, "%*sb_markers[%c]=", +  indent * 2, "", (char)(m+'0')); +  simple_describe_type(b_markers[m]); +  } else { +  fprintf(stderr, "%*sa_markers[%c]=", +  indent * 2, "", (char)(m+'0')); +  simple_describe_type(a_markers[m]);    } -  +  fprintf(stderr, "\n"); +  }   #endif    }    return ret; -  +  }    case '0': case '1': case '2': case '3': case '4':    case '5': case '6': case '7': case '8': case '9':    { -  int m=EXTRACT_UCHAR(a)-'0'; -  if(a_markers[m]) -  return low_pike_types_le(a_markers[m]->str, b, array_cnt, flags); -  else -  return low_pike_types_le(mixed_type_string->str, b, array_cnt, flags); +  int m = a->type - '0'; +  if (flags & LE_A_B_SWAPPED) { +  if(b_markers[m]) { +  a = b_markers[m]; +  } else { +  a = mixed_type_string;    } -  +  } else { +  if(a_markers[m]) { +  a = a_markers[m]; +  } else { +  a = mixed_type_string;    } -  +  } +  goto recurse; +  } +  }    -  switch(EXTRACT_UCHAR(b)) + #ifdef TYPE_GROUPING +  if (b->type != T_OR) { +  flags &= ~LE_B_GROUPED; +  } + #endif +  +  switch(b->type)    {    case T_AND:    /* OK, if a is a subset of both parts. */ -  b++; -  ret = low_pike_types_le(a, b, array_cnt, flags); +  ret = low_pike_types_le(a, b->car, array_cnt, flags);    if(!ret) return 0; -  b+=type_length(b); -  return low_pike_types_le(a, b, array_cnt, flags); +  b = b->cdr; +  goto recurse;       case T_OR: -  /* OK if a is a subset of either of the parts. */ -  b++; -  ret=low_pike_types_le(a, b, array_cnt, flags); +  /* OK if a is a subset of either of the parts, +  * unless we are grouped, in which case both +  * parts need to be a subset. +  */ +  ret = low_pike_types_le(a, b->car, array_cnt, flags); + #ifdef TYPE_GROUPING +  if (!ret != !(flags & LE_B_GROUPED)) { +  if ((a->flags | b->flags) & PT_FLAG_ASSIGN) { +  /* Note: Needed for side effects... */ +  low_pike_types_le(a, b->cdr, array_cnt, flags); +  } +  return ret; +  } + #else    if (ret) return ret; -  b+=type_length(b); -  return low_pike_types_le(a, b, array_cnt, flags); + #endif +  b = b->cdr; +  goto recurse;    -  +  case PIKE_T_RING: +  b = b->car; +  goto recurse; +  +  case PIKE_T_ATTRIBUTE: +  if (!c) { +  b = b->cdr; +  goto recurse; +  } +  if (!low_pike_types_le(a, b->cdr, array_cnt, flags)) return 0; +  ref_push_string((struct pike_string *)b->car); +  ref_push_type_value(a); +  ref_push_type_value(b->cdr); +  safe_apply_current2(PC_PUSH_TYPE_ATTRIBUTE_FUN_NUM, 3, +  "push_type_attribute"); +  if ((TYPEOF(Pike_sp[-1]) == T_INT) && +  (SUBTYPEOF(Pike_sp[-1]) == NUMBER_NUMBER) && +  (!Pike_sp[-1].u.integer)) { +  pop_stack(); +  return 0; +  } +  pop_stack(); +  return 1; +  case PIKE_T_SCOPE: + #ifdef TYPE_GROUPING +  flags |= LE_B_GROUPED; + #endif +  /* FALL_THROUGH */ +  case PIKE_T_NAME: +  b = b->cdr; +  goto recurse; +     case T_NOT: -  if (EXTRACT_UCHAR(b+1) == T_NOT) { -  return low_pike_types_le(a, b+2, array_cnt, flags); +  /* Some common cases. */ +  switch(b->car->type) { +  case T_NOT: +  b = b->car->car; +  goto recurse; +  case T_MIXED: +  b = zero_type_string; +  goto recurse; +  case T_ZERO: +  case T_VOID: +  b = mixed_type_string; +  goto recurse;    } -  if (low_pike_types_le(a, b+1, array_cnt, flags)) { +  if (low_pike_types_le(a, b->car, array_cnt, flags)) {    return 0;    } -  +  flags ^= LE_A_B_SWAPPED; + #ifdef TYPE_GROUPING +  if (flags & LE_A_B_GROUPED) { +  if ((flags & LE_A_B_GROUPED) == LE_A_B_GROUPED) { +  flags ^= LE_A_B_GROUPED; +  } +  } else { +  flags |= LE_A_B_GROUPED; +  } + #endif    /* FIXME: This is wrong... */ -  return !low_pike_types_le(b+1, a, -array_cnt, flags); +  return !low_pike_types_le(b->car, a, -array_cnt, flags);    -  case T_ASSIGN: -  ret=low_pike_types_le(a, b+2, array_cnt, flags); -  if(ret && EXTRACT_UCHAR(a)!=T_VOID) +  case T_ASSIGN: { +  struct pike_type **aa_markers = a_markers; +  struct pike_type **bb_markers = b_markers; +  int m = CAR_TO_INT(b); +  ret = low_pike_types_le(a, b->cdr, array_cnt, flags); +  +  if (flags & LE_A_B_SWAPPED) { +  aa_markers = b_markers; +  bb_markers = a_markers; +  } +  +  if(ret && (!bb_markers[m] || a->type != T_VOID))    { -  int m=EXTRACT_UCHAR(b+1)-'0'; -  struct pike_string *tmp; +  int m = CAR_TO_INT(b); +  struct pike_type *tmp;    int i; -  +     type_stack_mark(); -  push_unfinished_type_with_markers(a, a_markers); +  push_finished_type_with_markers(a, aa_markers, 0);    for(i = array_cnt; i < 0; i++)    push_type(T_ARRAY);    tmp=pop_unfinished_type();       type_stack_mark(); -  medium_or_pike_types(b_markers[m], tmp, 0); -  if(b_markers[m]) free_string(b_markers[m]); -  free_string(tmp); -  b_markers[m]=pop_unfinished_type(); +  low_or_pike_types(bb_markers[m], tmp, 0); +  if(bb_markers[m]) free_type(bb_markers[m]); +  free_type(tmp); +  bb_markers[m] = pop_unfinished_type();   #ifdef PIKE_TYPE_DEBUG    if (l_flag>2) { -  char *s; -  int e; -  init_buf(); -  for(e=0;e<indent;e++) my_strcat(" "); -  my_strcat("b_markers["); -  my_putchar((char)(m+'0')); -  my_strcat("]="); -  low_describe_type(b_markers[m]->str); -  my_strcat("\n"); -  fprintf(stderr,"%s",(s=simple_free_buf())); -  free(s); +  if (flags & LE_A_B_SWAPPED) { +  fprintf(stderr, "%*sa_markers[%c]=", +  indent * 2, "", (char)(m+'0')); +  simple_describe_type(a_markers[m]); +  } else { +  fprintf(stderr, "%*sb_markers[%c]=", +  indent * 2, "", (char)(m+'0')); +  simple_describe_type(b_markers[m]);    } -  +  fprintf(stderr, "\n"); +  }   #endif    }    return ret; -  +  }    case '0': case '1': case '2': case '3': case '4':    case '5': case '6': case '7': case '8': case '9':    { -  int m=EXTRACT_UCHAR(b)-'0'; -  if(b_markers[m]) -  return low_pike_types_le(a, b_markers[m]->str, array_cnt, flags); -  else -  return low_pike_types_le(a, mixed_type_string->str, array_cnt, flags); +  int m = b->type - '0'; +  if (flags & LE_A_B_SWAPPED) { +  if(a_markers[m]) { +  b = a_markers[m]; +  } else { +  b = mixed_type_string;    } -  +  } else { +  if(b_markers[m]) { +  b = b_markers[m]; +  } else { +  b = mixed_type_string;    } -  +  } +  goto recurse; +  } +  }    -  if ((array_cnt < 0) && (EXTRACT_UCHAR(b) == T_ARRAY)) { -  while (EXTRACT_UCHAR(b) == T_ARRAY) { -  b++; +  if ((array_cnt < 0) && (b->type == T_ARRAY)) { +  while (b->type == T_ARRAY) { +  b = b->car;    if (!++array_cnt) break;    } -  return low_pike_types_le(a, b, array_cnt, flags); -  } else if ((array_cnt > 0) && (EXTRACT_UCHAR(a) == T_ARRAY)) { -  while (EXTRACT_UCHAR(a) == T_ARRAY) { -  a++; +  goto recurse; +  } else if ((array_cnt > 0) && (a->type == T_ARRAY)) { +  while (a->type == T_ARRAY) { +  a = a->car;    if (!--array_cnt) break;    } -  return low_pike_types_le(a, b, array_cnt, flags); +  goto recurse;    }       /* NOTE: void only matches void. */ -  if (EXTRACT_UCHAR(a) == T_VOID) { +  if (a->type == T_VOID) {    /* void <= any_type */    if (array_cnt >= 0) {    /* !array(void) */ -  if (!array_cnt && (EXTRACT_UCHAR(b) == T_VOID)) { +  if (!array_cnt && (b->type == T_VOID)) {    return 1;    }    return 0;    }    }    -  if (EXTRACT_UCHAR(b) == T_VOID) { +  if (b->type == T_VOID) {    if (array_cnt <= 0) {    /* !array(void) */    return 0;    }    }    -  if (EXTRACT_UCHAR(b) == T_MIXED) { +  if (b->type == T_MIXED) {    /* any_type <= 'mixed' */    if (array_cnt <= 0) {    /* !array(mixed) */    return 1;    }    }    -  if (EXTRACT_UCHAR(a) == T_MIXED) { +  if (a->type == T_MIXED) {    if (array_cnt >= 0) {    /* !array(mixed) */    return 0;    }    }    -  if (EXTRACT_UCHAR(a) == T_ZERO) { +  if (a->type == T_ZERO) {    /* void <= zero <= any_type */    if (array_cnt >= 0) {    /* !array(zero) */ -  +  if (!(flags & LE_EXPLICIT_ZERO) || +  ((b->type == T_INT) && !array_cnt)) {    return 1;    }    } -  +  }    -  if (EXTRACT_UCHAR(b) == T_ZERO) { +  if (b->type == T_ZERO) {    if (array_cnt <= 0) {    /* !array(zero) */    return 0;    }    }       /* Special cases (tm) */ -  switch(EXTRACT_TWOT(a,b)) +  switch(TWOT(a->type, b->type))    {    case TWOT(T_PROGRAM, T_FUNCTION):    case TWOT(T_FUNCTION, T_PROGRAM): -  +  case TWOT(T_PROGRAM, T_MANY): +  case TWOT(T_MANY, T_PROGRAM):    /* FIXME: Not really... Should check the return value. */ -  +  /* FIXME: Should also look at the subtype of the program. */    return 1;    -  +  case TWOT(PIKE_T_TYPE, T_FUNCTION): +  case TWOT(PIKE_T_TYPE, T_MANY): +  /* Convert the type to a casting function. */ +  type_stack_mark(); +  push_finished_type(a->car); +  push_type(T_VOID); +  push_type(T_MANY); +  push_type(T_MIXED); +  push_type(T_FUNCTION); +  a = pop_unfinished_type(); +  if (low_pike_types_le(a, b, array_cnt, flags)) { +  free_type(a); +  return 1; +  } +  free_type(a); +  return 0; +  +  case TWOT(T_FUNCTION, PIKE_T_TYPE): +  case TWOT(T_MANY, PIKE_T_TYPE): +  /* Convert the type to a casting function. */ +  type_stack_mark(); +  push_finished_type(b->car); +  push_type(T_VOID); +  push_type(T_MANY); +  push_type(T_MIXED); +  push_type(T_FUNCTION); +  b = pop_unfinished_type(); +  if (low_pike_types_le(a, b, array_cnt, flags)) { +  free_type(b); +  return 1; +  } +  free_type(b); +  return 0; +  +  case TWOT(PIKE_T_TYPE, T_PROGRAM): +  case TWOT(T_PROGRAM, PIKE_T_TYPE): +  return low_pike_types_le(a->car, b->car, array_cnt, flags); +     case TWOT(T_OBJECT, T_FUNCTION): -  +  case TWOT(T_OBJECT, T_MANY):    { -  struct pike_string *s; -  if((s=low_object_lfun_type(a, LFUN_CALL))) -  return low_pike_types_le(s->str, b, array_cnt, flags); +  if((a = low_object_lfun_type(a, LFUN_CALL))) { +  goto recurse; +  }    return 1;    }       case TWOT(T_FUNCTION, T_OBJECT): -  +  case TWOT(T_MANY, T_OBJECT):    { -  struct pike_string *s; -  if((s=low_object_lfun_type(b, LFUN_CALL))) -  return low_pike_types_le(a, s->str, array_cnt, flags); +  if((b=low_object_lfun_type(b, LFUN_CALL))) { +  goto recurse; +  }    return 1;    }       case TWOT(T_FUNCTION, T_ARRAY): -  +  case TWOT(T_MANY, T_ARRAY):    { -  while (EXTRACT_UCHAR(b) == T_ARRAY) { -  b++; +  while (b->type == T_ARRAY) { +  b = b->car;    array_cnt++;    } -  return low_pike_types_le(a, b, array_cnt, flags); +  goto recurse;    }       case TWOT(T_ARRAY, T_FUNCTION): -  +  case TWOT(T_ARRAY, T_MANY):    { -  while (EXTRACT_UCHAR(a) == T_ARRAY) { -  a++; +  while (a->type == T_ARRAY) { +  a = a->car;    array_cnt--;    } -  return low_pike_types_le(a, b, array_cnt, flags); +  goto recurse;    } -  } +     -  if(EXTRACT_UCHAR(a) != EXTRACT_UCHAR(b)) return 0; -  -  if (EXTRACT_UCHAR(a) == T_FUNCTION) { +  case TWOT(T_FUNCTION, T_FUNCTION): +  case TWOT(T_FUNCTION, T_MANY): +  case TWOT(T_MANY, T_FUNCTION):    /*    * function(A...:B) <= function(C...:D) iff C <= A && B <= D    */    /*    * function(:int) <= function(int:int)    * function(int|string:int) <= function(int:int)    * function(:int) <= function(:void)    * function(string:int) != function(int:int)    * function(int:int) != function(:int)    *    * FIXME: Enforcing of all required arguments?    */ -  a++; -  b++; -  while(EXTRACT_UCHAR(a)!=T_MANY || EXTRACT_UCHAR(b)!=T_MANY) +  while((a->type != T_MANY) || (b->type != T_MANY))    { -  char *a_tmp,*b_tmp; -  if(EXTRACT_UCHAR(a)==T_MANY) +  struct pike_type *a_tmp, *b_tmp; +  +  a_tmp = a->car; +  if (a->type == T_FUNCTION)    { -  a_tmp=a+1; -  }else{ -  a_tmp=a; -  a+=type_length(a); +  a = a->cdr;    }    -  if(EXTRACT_UCHAR(b)==T_MANY) +  b_tmp = b->car; +  if (b->type == T_FUNCTION)    { -  b_tmp=b+1; -  }else{ -  b_tmp=b; -  b+=type_length(b); +  b = b->cdr;    }    -  if (EXTRACT_UCHAR(a_tmp) != T_VOID) { -  if (!low_pike_types_le(b_tmp, a_tmp, 0, flags)) { +  if (a_tmp->type != T_VOID) { +  /* Note: flags never has grouping at this point. */ +  if (!low_pike_types_le(b_tmp, a_tmp, 0, flags ^ LE_A_B_SWAPPED)) {    return 0;    }    }    } -  +  /* FALL_THROUGH */ +  case TWOT(T_MANY, T_MANY):    /* check the 'many' type */ -  a++; -  b++; -  if ((EXTRACT_UCHAR(a) != T_VOID) && (EXTRACT_UCHAR(b) != T_VOID)) { -  if (!low_pike_types_le(b, a, 0, flags)) { +  if ((a->car->type != T_VOID) && (b->car->type != T_VOID)) { +  /* Note: flags never has grouping at this point. */ +  if (!low_pike_types_le(b->car, a->car, 0, flags ^ LE_A_B_SWAPPED)) {    return 0;    }    }    -  a+=type_length(a); -  b+=type_length(b); +  a = a->cdr; +  b = b->cdr;       /* check the returntype */    /* FIXME: Check array_cnt */ -  if ((EXTRACT_UCHAR(b) != T_VOID) && (EXTRACT_UCHAR(a) != T_VOID)) { +  if ((b->type != T_VOID) && (a->type != T_VOID)) {    if(!low_pike_types_le(a, b, array_cnt, flags)) return 0;    }    return 1;    }    -  +  if(a->type != b->type) return 0; +     if (array_cnt) return 0;    -  switch(EXTRACT_UCHAR(a)) +  switch(a->type)    {    case T_MAPPING:    /*    * mapping(A:B) <= mapping(C:D) iff A <= C && B <= D.    */ -  if(!low_pike_types_le(++a, ++b, 0, flags)) return 0; -  return low_pike_types_le(a+type_length(a), b+type_length(b), 0, flags); +  if(!low_pike_types_le(a->car, b->car, 0, flags)) return 0; +  array_cnt = 0; +  a = a->cdr; +  b = b->cdr; +  goto recurse;       case T_OBJECT:   #if 0 -  if(extract_type_int(a+2) || extract_type_int(b+2)) +  if(a->cdr || b->cdr)    {    fprintf(stderr,"Type match1: ");    stupid_describe_type(a,type_length(a));    fprintf(stderr,"Type match2: ");    stupid_describe_type(b,type_length(b));    }   #endif       /*    * object(0|1 x) <= object(0|1 0)
pike.git/src/pike_types.c:2406:    * object(1 x) <= object(0|1 x)    * object(1 x) <= object(1 y) iff x == y    * object(1 x) <= object(0 y) iff x implements y    * Not WEAK_OBJECTS:    * object(0 x) <= object(0 y) iff x implements y    * WEAK_OBJECTS:    * object(0 x) <= object(0 y) iff x is_compatible y    */       /* object(* 0) matches any object */ -  if(!extract_type_int(b+2)) +  if(!b->cdr)    return 1;    -  if(!extract_type_int(a+2)) +  if(!a->cdr)    return 0;    -  if ((EXTRACT_UCHAR(a+1) || !EXTRACT_UCHAR(b+1)) && -  (extract_type_int(a+2) == extract_type_int(b+2))) +  /* The 'is' flag is now ignored. +  * /grubba 2003-11-11 +  */ +  +  if (TEST_COMPAT(7,4)) { +  if ((a->car || !b->car) && +  (a->cdr == b->cdr))    return 1;    -  if (EXTRACT_UCHAR(b+1)) { +  if (b->car) {    return 0;    } -  +  } +  else { +  if (a->cdr == b->cdr) +  return 1; +  }       { -  struct program *ap = id_to_program(extract_type_int(a+2)); -  struct program *bp = id_to_program(extract_type_int(b+2)); +  struct program *ap = id_to_program(CDR_TO_INT(a)); +  struct program *bp = id_to_program(CDR_TO_INT(b));    -  + #if 0 +  fprintf(stderr, +  "id_to_program(%d) ==> %p\n" +  "id_to_program(%d) ==> %p\n", +  CDR_TO_INT(a), ap, +  CDR_TO_INT(b), bp); + #endif /* 0 */ +     if (!ap || !bp) {    /* Shouldn't happen... */ -  +  /* fprintf(stderr, "ap:%p bp:%p\n", ap, bp); */    return 0;    } -  if ((flags & LE_WEAK_OBJECTS) && (!EXTRACT_UCHAR(a+1))) { +  if ((flags & LE_WEAK_OBJECTS) && +  (!TEST_COMPAT(7,4) || (!a->car))) { +  implements_mode = 0; + #if 0 +  fprintf(stderr, " is_compat(%p(%d), %p(%d))\n", +  ap, ap->id, bp, bp->id); + #endif /* 0 */    return is_compatible(implements_a=ap, implements_b=bp);    } -  +  implements_mode = 1; + #if 0 +  fprintf(stderr, " implements(%p(%d), %p(%d))\n", +  ap, ap->id, bp, bp->id); + #endif /* 0 */    return implements(implements_a=ap, implements_b=bp);    }    break;       case T_INT:    { -  INT32 amin=extract_type_int(a+1); -  INT32 amax=extract_type_int(a+1+sizeof(INT32)); +  INT32 amin = CAR_TO_INT(a); +  INT32 amax = CDR_TO_INT(a);    -  INT32 bmin=extract_type_int(b+1); -  INT32 bmax=extract_type_int(b+1+sizeof(INT32)); +  INT32 bmin = CAR_TO_INT(b); +  INT32 bmax = CDR_TO_INT(b);    -  +  /* Handle implicit zero... */ +  if (amin == 1) amin = 0; +  if (bmin == 1) bmin = 0; +  if (amax == -1) amax = 0; +  if (bmax == -1) bmax = 0; +     if(amin < bmin || amax > bmax) return 0;    break;    }       -  +  case T_TYPE: +  case T_PROGRAM:    case T_MULTISET:    case T_ARRAY: -  if(!low_pike_types_le(++a, ++b, 0, flags)) return 0; +  case T_STRING: +  a = a->car; +  b = b->car; +  array_cnt = 0; +  goto recurse;       case T_FLOAT: -  case T_STRING: -  case T_TYPE: -  case T_PROGRAM: +     case T_ZERO:    case T_VOID:    case T_MIXED:    break;    -  + #ifdef PIKE_DEBUG    default: -  fatal("Error in type string.\n"); +  Pike_fatal("Error in type string.\n"); + #endif    }    return 1;   }      /*    * Check the function parameters.    * Note: The difference between this function, and pike_types_le()    * is the more lenient check for T_OR, and the handling of T_ARRAY.    */ - int strict_check_call(char *fun_type, char *arg_type) + int strict_check_call(struct pike_type *fun_type, +  struct pike_type *arg_type)   { -  while ((EXTRACT_UCHAR(fun_type) == T_OR) || -  (EXTRACT_UCHAR(fun_type) == T_ARRAY)) { -  if (EXTRACT_UCHAR(fun_type++) == T_OR) { -  int res = strict_check_call(fun_type, arg_type); +  while ((fun_type->type == T_OR) || +  (fun_type->type == T_ARRAY) || +  (fun_type->type == PIKE_T_SCOPE)) { +  if (fun_type->type == T_OR) { +  int res = strict_check_call(fun_type->car, arg_type);    if (res) return res; -  fun_type += type_length(fun_type); +  fun_type = fun_type->cdr; +  } else if (fun_type->type == PIKE_T_SCOPE) { +  fun_type = fun_type->cdr; +  } else { +  fun_type = fun_type->car;    }    }    return low_pike_types_le(fun_type, arg_type, 0, 0);   }      /*    * Check validity of soft-cast.    * Note: This uses a weaker check of function arguments, since    * people get confused otherwise.    */ - int check_soft_cast(struct pike_string *to, struct pike_string *from) + int check_soft_cast(struct pike_type *to, struct pike_type *from)   { -  return low_pike_types_le(to->str, from->str, 0, LE_WEAK_OBJECTS); +  return low_pike_types_le(to, from, 0, LE_WEAK_OBJECTS);   }      /*    * Return the return type from a function call.    */ - static int low_get_return_type(char *a,char *b) + static int low_get_return_type(struct pike_type *a, struct pike_type *b)   { -  +  struct compilation *c = THIS_COMPILATION;    int tmp; -  switch(EXTRACT_UCHAR(a)) +  CHECK_COMPILER(); +  switch(a->type)    {    case T_OR:    { -  struct pike_string *o1,*o2; -  a++; +  struct pike_type *o1, *o2;    o1=o2=0;       type_stack_mark(); -  if(low_get_return_type(a,b)) +  if(low_get_return_type(a->car, b))    {    o1=pop_unfinished_type();    type_stack_mark();    }    -  if(low_get_return_type(a+type_length(a),b)) +  if(low_get_return_type(a->cdr, b))    o2=pop_unfinished_type();    else    pop_stack_mark();       if(!o1 && !o2) return 0;    -  medium_or_pike_types(o1,o2, 0); +  low_or_pike_types(o1, o2, 0);    -  if(o1) free_string(o1); -  if(o2) free_string(o2); +  if(o1) free_type(o1); +  if(o2) free_type(o2);       return 1;    }       case T_AND: -  a++; +     type_stack_mark(); -  tmp=low_get_return_type(a,b); +  tmp = low_get_return_type(a->car, b);    type_stack_pop_to_mark();    if(!tmp) return 0; -  return low_get_return_type(a+type_length(a),b); +  return low_get_return_type(a->cdr, b);    -  +  case PIKE_T_RING: +  return low_get_return_type(a->car, b); +  +  case PIKE_T_SCOPE: +  case PIKE_T_NAME: +  return low_get_return_type(a->cdr, b); +  +  case PIKE_T_ATTRIBUTE: +  if (low_get_return_type(a->cdr, b)) { +  push_type_attribute((struct pike_string *)a->car); +  return 1; +  } +  return 0; +     case T_ARRAY: -  a++; -  tmp=low_get_return_type(a,b); +  tmp = low_get_return_type(a->car, b);    if(!tmp) return 0;    push_type(T_ARRAY);    return 1;    }    -  a=low_match_types(a,b,NO_SHORTCUTS); +  a = low_match_types(a, b, NO_SHORTCUTS);    if(a)    {   #if 0 -  if ((lex.pragmas & ID_STRICT_TYPES) && +  if ((c->lex.pragmas & ID_STRICT_TYPES) &&    !low_pike_types_le(a, b, 0, 0)) { -  yywarning("Type mismatch"); +  yyreport_type(REPORT_WARNING, NULL, 0, b, NULL, 0, a, 0, "Type mismatch");    }   #endif /* 0 */ -  switch(EXTRACT_UCHAR(a)) +  switch(a->type)    {    case T_FUNCTION: -  a++; -  while(EXTRACT_UCHAR(a)!=T_MANY) a+=type_length(a); -  a++; -  a+=type_length(a); -  push_unfinished_type_with_markers(a, a_markers ); +  a = a->cdr; +  while(a->type == T_FUNCTION) { +  a = a->cdr; +  } +  /* FALL_THROUGH */ +  case T_MANY: +  a = a->cdr; +  push_finished_type_with_markers(a, a_markers, 0);    return 1;    -  +  case T_TYPE:    case T_PROGRAM: -  push_type_int(0); -  push_type(0); -  push_type(T_OBJECT); +  push_finished_type(a->car);    return 1;       default:    push_type(T_MIXED);    return 1;    }    }    return 0;   }       - int match_types(struct pike_string *a,struct pike_string *b) + int match_types(struct pike_type *a, struct pike_type *b)   {    check_type_string(a);    check_type_string(b);    clear_markers(); -  return 0!=low_match_types(a->str, b->str,0); +  return !!low_match_types(a, b, 0);   }    - int pike_types_le(struct pike_string *a,struct pike_string *b) + int pike_types_le(struct pike_type *a,struct pike_type *b)   {    check_type_string(a);    check_type_string(b);    clear_markers(); -  return low_pike_types_le(a->str, b->str, 0, 0); +  return low_pike_types_le(a, b, 0, 0);   }         #ifdef DEBUG_MALLOC - #define low_index_type(X,Y,Z) ((struct pike_string *)debug_malloc_pass(debug_low_index_type((X),(Y),(Z)))) + #define low_index_type(X,Y,Z) ((struct pike_type *)debug_malloc_pass(debug_low_index_type((X),(Y),(Z))))   #else   #define low_index_type debug_low_index_type   #endif      /* FIXME, add the index */ - static struct pike_string *debug_low_index_type(char *t, -  char *index_type, + static struct pike_type *debug_low_index_type(struct pike_type *t, +  struct pike_type *index_type,    node *n)   { -  struct pike_string *tmp; +  struct pike_type *tmp;    struct program *p; -  +  int pragmas = 0;    -  +  if (n) { +  struct compilation *c = THIS_COMPILATION; +  CHECK_COMPILER(); +  pragmas = c->lex.pragmas; +  } +     switch(low_check_indexing(t, index_type, n))    {    case 0: return 0;    case -1: -  reference_shared_string(zero_type_string); +  add_ref(zero_type_string);    return zero_type_string;    }    -  switch(EXTRACT_UCHAR(t++)) +  while((t->type == PIKE_T_NAME) || +  (t->type == PIKE_T_ATTRIBUTE)) { +  t = t->cdr; +  } +  while((index_type->type == PIKE_T_NAME) || +  (index_type->type == PIKE_T_ATTRIBUTE)) { +  index_type = index_type->cdr; +  } +  +  switch(t->type)    {    case T_OBJECT:    { -  p=id_to_program(extract_type_int(t+1)); +  p = id_to_program(CDR_TO_INT(t));       comefrom_int_index:    if(p && n)    {    INT32 i;    if(n->token == F_ARROW)    { -  /* FIXME: make this stricter */ +     if((i=FIND_LFUN(p,LFUN_ARROW))!=-1)    { -  /* FIXME: function_type_string should be replaced with something -  * derived from type_string -  */ -  if(i!=-1 && -  (tmp=check_call(function_type_string, ID_FROM_INT(p, i)->type, -  0))) -  return tmp; +  INT32 args = 0; +  add_ref(tmp = ID_FROM_INT(p, i)->type); +  if ((tmp = new_check_call(lfun_strings[LFUN_ARROW], tmp, CDR(n), +  &args, 0))) { +  struct pike_type *ret = new_get_return_type(tmp, 0); +  free_type(tmp); +  if (ret) return ret; +  }    -  reference_shared_string(mixed_type_string); +  /* Invalid type for lfun::`->(). */ +  add_ref(mixed_type_string);    return mixed_type_string;    }    }else{    if((i=FIND_LFUN(p,LFUN_INDEX)) != -1)    { -  /* FIXME: function_type_string should be replaced with something -  * derived from type_string -  */ -  if(i!=-1 && -  (tmp=check_call(function_type_string, ID_FROM_INT(p, i)->type, -  0))) -  return tmp; +  INT32 args = 0; +  add_ref(tmp = ID_FROM_INT(p, i)->type); +  if ((tmp = new_check_call(lfun_strings[LFUN_INDEX], tmp, CDR(n), +  &args, 0))) { +  struct pike_type *ret = new_get_return_type(tmp, 0); +  free_type(tmp); +  if (ret) return ret; +  }    -  reference_shared_string(mixed_type_string); +  /* Invalid type for lfun::`[](). */ +  add_ref(mixed_type_string);    return mixed_type_string;    }    } -  if(CDR(n)->token == F_CONSTANT && CDR(n)->u.sval.type==T_STRING) +  if(CDR(n)->token == F_CONSTANT && TYPEOF(CDR(n)->u.sval) == T_STRING)    { -  i=find_shared_string_identifier(CDR(n)->u.sval.u.string, p); +  i = find_shared_string_identifier(CDR(n)->u.sval.u.string, p);    if(i==-1)    { -  reference_shared_string(mixed_type_string); +  add_ref(mixed_type_string);    return mixed_type_string;    }else{ - #if 0 -  if(EXTRACT_UCHAR(t) || -  (p->identifier_references[i].id_flags & ID_NOMASK) || -  (ID_FROM_INT(p, i)->identifier_flags & IDENTIFIER_PROTOTYPED)) -  { - #endif -  reference_shared_string(ID_FROM_INT(p, i)->type); +  add_ref(ID_FROM_INT(p, i)->type);    return ID_FROM_INT(p, i)->type; - #if 0 -  }else{ -  reference_shared_string(mixed_type_string); -  return mixed_type_string; +     } - #endif +     }    }    } -  } +  /* FALL_THROUGH */ +     default: -  reference_shared_string(mixed_type_string); +  add_ref(mixed_type_string);    return mixed_type_string;       case T_MIXED: -  if (lex.pragmas & ID_STRICT_TYPES) { +  if (pragmas & ID_STRICT_TYPES) {    yywarning("Indexing mixed.");    } -  reference_shared_string(mixed_type_string); +  add_ref(mixed_type_string);    return mixed_type_string;       case T_INT: - #ifdef AUTO_BIGNUM +     /* Don't force Gmp.mpz to be loaded here since this function    * is called long before the master object is compiled...    * /Hubbe    */    p=get_auto_bignum_program_or_zero();    goto comefrom_int_index; - #endif +     case T_ZERO:    case T_TYPE: -  +  case PIKE_T_RING:    case T_VOID:    case T_FLOAT:    return 0;       case T_OR:    { -  struct pike_string *a,*b; -  a=low_index_type(t,index_type,n); -  t+=type_length(t); -  b=low_index_type(t,index_type,n); +  struct pike_type *a,*b; +  a = low_index_type(t->car, index_type, n); +  b = low_index_type(t->cdr, index_type,n);    if(!b) return a;    if(!a) return b;    type_stack_mark(); -  medium_or_pike_types(a,b,1); -  free_string(a); -  free_string(b); +  low_or_pike_types(a,b,1); +  free_type(a); +  free_type(b);    return pop_unfinished_type();    }       case T_AND: -  return low_index_type(t+type_length(t),index_type,n); +  /* FIXME: Shouldn't both branches be looked at? */ +  return low_index_type(t->cdr, index_type, n);       case T_STRING: /* always int */ -  +  { +  if (t->car->type == T_ZERO) { +  yywarning("Indexing the empty string."); +  } +  add_ref(t->car); +  return t->car; +  } +     case T_MULTISET: /* always int */ -  reference_shared_string(int_type_string); +  add_ref(int_type_string);    return int_type_string;       case T_MAPPING: -  t+=type_length(t); -  return make_shared_binary_string(t, type_length(t)); +  add_ref(t = t->cdr); +  return t;       case T_ARRAY:    { -  struct pike_string *a; +  struct pike_type *a;    -  if(low_pike_types_le(tString, index_type, 0, 0) && -  (a = low_index_type(t, tString, n))) { +  if(low_pike_types_le(string0_type_string, index_type, 0, 0) && +  (a = low_index_type(t->car, string0_type_string, n))) {    /* Possible to index the array with a string. */    type_stack_mark();    push_finished_type(a); -  free_string(a); +  free_type(a);    push_type(T_ARRAY);    -  if (low_match_types(tInt, index_type, 0)) { +  if (low_match_types(int_type_string, index_type, 0)) {    /* Also possible to index the array with an int. */ -  push_unfinished_type(t); +  push_finished_type(t->car);    push_type(T_OR);    }    return pop_unfinished_type();    } -  if (low_match_types(tInt, index_type, 0)) { +  if (low_match_types(int_type_string, index_type, 0)) {    /* Possible to index the array with an int. */ -  return make_shared_binary_string(t, type_length(t)); +  add_ref(t->car); +  return t->car;    }    /* Bad index type. */    return 0;    }    }   }    - struct pike_string *index_type(struct pike_string *type, -  struct pike_string *index_type, + struct pike_type *index_type(struct pike_type *type, +  struct pike_type *index_type,    node *n)   { -  struct pike_string *t; +  struct pike_type *t;    clear_markers(); -  t=low_index_type(type->str,index_type->str,n); -  if(!t) copy_shared_string(t,mixed_type_string); +  t = low_index_type(type, index_type, n); +  if(!t) { +  copy_pike_type(t, mixed_type_string); +  }    return t;   }    -  + #ifdef DEBUG_MALLOC + #define low_range_type(X,Y,Z) ((struct pike_type *)debug_malloc_pass(debug_low_range_type((X),(Y),(Z)))) + #else + #define low_range_type debug_low_range_type + #endif    - static struct pike_string *low_array_value_type(char *arr_t) + /* FIXME, add the index +  * +  * FIXME: Is the above fixme valid for this function too? +  */ + static struct pike_type *debug_low_range_type(struct pike_type *t, +  struct pike_type *index1_type, +  struct pike_type *index2_type)   { -  struct pike_string *res = NULL; -  struct pike_string *sub_t; +  struct compilation *c = THIS_COMPILATION; +  struct pike_type *tmp; +  struct program *p;    -  while (EXTRACT_UCHAR(arr_t) == T_OR) { -  arr_t++; -  sub_t = low_array_value_type(arr_t); -  arr_t += type_length(arr_t); +  CHECK_COMPILER(); +  +  while((t->type == PIKE_T_NAME) || +  (t->type == PIKE_T_ATTRIBUTE)) { +  t = t->cdr; +  } +  if (index1_type) +  while((index1_type->type == PIKE_T_NAME) || +  (index1_type->type == PIKE_T_ATTRIBUTE)) { +  index1_type = index1_type->cdr; +  } +  if (index2_type) +  while((index2_type->type == PIKE_T_NAME) || +  (index2_type->type == PIKE_T_ATTRIBUTE)) { +  index2_type = index2_type->cdr; +  } +  +  switch(t->type) +  { +  case T_OBJECT: +  { +  p = id_to_program(CDR_TO_INT(t)); +  +  if(p) +  { +  INT32 i; +  +  if((i = FIND_LFUN(p, LFUN_RANGE)) != -1) +  { +  struct pike_type *call_type = NULL; +  type_stack_mark(); +  push_finished_type(mixed_type_string); +  push_finished_type(void_type_string); +  push_type(T_OR); /* Return type */ +  push_finished_type(void_type_string); /* Many type */ +  push_type(T_MANY); +  push_int_type (INDEX_FROM_BEG, OPEN_BOUND); /* arg4 type */ +  push_type(T_FUNCTION); +  if (index2_type) /* arg3 type */ +  push_finished_type(index2_type); +  else +  push_type (T_ZERO); +  push_type(T_FUNCTION); +  push_int_type (INDEX_FROM_BEG, OPEN_BOUND); /* arg2 type */ +  push_type(T_FUNCTION); +  if (index1_type) /* arg1 type */ +  push_finished_type(index1_type); +  else +  push_type (T_ZERO); +  push_type(T_FUNCTION); +  call_type = pop_unfinished_type(); +  +  if((tmp = check_call(call_type, ID_FROM_INT(p, i)->type, 0))) { +  free_type(call_type); +  return tmp; +  } +  free_type(call_type); +  +  add_ref(mixed_type_string); +  return mixed_type_string; +  } +  +  if((i = FIND_LFUN(p, LFUN_INDEX)) != -1) +  { +  /* FIXME: Should check for a _sizeof operator if from-the-end +  * indexing is done. */ +  +  struct pike_type *call_type = NULL; +  /* FIXME: function_type_string should be replaced with something +  * derived from type_string +  */ +  type_stack_mark(); +  push_finished_type(mixed_type_string); +  push_finished_type(void_type_string); +  push_type(T_OR); /* Return type */ +  push_finished_type(void_type_string); /* Many type */ +  push_type(T_MANY); +  if (index2_type) /* arg2 type */ +  push_finished_type(index2_type); +  else +  push_int_type (MAX_INT_TYPE, MAX_INT_TYPE); +  push_type(T_FUNCTION); +  if (index1_type) /* arg1 type */ +  push_finished_type(index1_type); +  else +  push_type (T_ZERO); +  push_type(T_FUNCTION); +  call_type = pop_unfinished_type(); +  +  if((tmp = check_call(call_type, ID_FROM_INT(p, i)->type, 0))) { +  free_type(call_type); +  return tmp; +  } +  free_type(call_type); +  +  add_ref(mixed_type_string); +  return mixed_type_string; +  } +  +  yywarning("Ranging object without index operator."); +  return 0; +  } +  if (c->lex.pragmas & ID_STRICT_TYPES) { +  yywarning("Ranging generic object."); +  } +  add_ref(mixed_type_string); +  return mixed_type_string; +  } +  +  case T_MIXED: +  if (c->lex.pragmas & ID_STRICT_TYPES) { +  yywarning("Ranging mixed."); +  } +  add_ref(mixed_type_string); +  return mixed_type_string; +  +  case T_INT: +  case T_ZERO: +  case T_TYPE: +  case PIKE_T_RING: +  case T_VOID: +  case T_FLOAT: +  case T_MULTISET: +  case T_MAPPING: +  /* Illegal range operation. */ +  /* FIXME: Strict type warning. */ +  return 0; +  +  case T_ARRAY: +  case T_STRING: +  /* Check that the index types are compatible with int. */ +  { +  if (index1_type && !low_match_types(int_type_string, index1_type, 0)) { +  ref_push_type_value(t); +  yytype_report(REPORT_WARNING, NULL, 0, int_type_string, +  NULL, 0, index1_type, +  1, "Bad argument 1 to range operator on %O."); +  /* Bad index1 type. */ +  return 0; +  } +  if (index2_type && !low_match_types(int_type_string, index2_type, 0)) { +  ref_push_type_value(t); +  yytype_report(REPORT_WARNING, NULL, 0, int_type_string, +  NULL, 0, index2_type, +  1, "Bad argument 2 to range operator on %O."); +  /* Bad index2 type. */ +  return 0; +  } +  } +  /* FALLTHROUGH */ +  default: +  /* Identity. */ +  add_ref(t); +  return t; +  +  case T_OR: +  { +  struct pike_type *a,*b; +  a = low_range_type(t->car, index1_type, index2_type); +  b = low_range_type(t->cdr, index1_type, index2_type); +  if(!b) return a; +  if(!a) return b; +  type_stack_mark(); +  low_or_pike_types(a,b,1); +  free_type(a); +  free_type(b); +  return pop_unfinished_type(); +  } +  +  case T_AND: +  /* FIXME: Shouldn't both branches be looked at? */ +  return low_range_type(t->cdr, index1_type, index2_type); +  } + } +  + struct pike_type *range_type(struct pike_type *type, +  struct pike_type *index1_type, +  struct pike_type *index2_type) + { +  struct pike_type *t; +  clear_markers(); +  t = low_range_type(type, index1_type, index2_type); +  if(!t) { +  yytype_report(REPORT_ERROR, NULL, 0, NULL, NULL, 0, NULL, +  0, "Invalid range operation."); +  copy_pike_type(t, type); +  } +  return t; + } +  +  + static struct pike_type *low_array_value_type(struct pike_type *arr_t) + { +  struct pike_type *res = NULL; +  struct pike_type *sub_t; +  +  while (arr_t->type == T_OR) { +  sub_t = low_array_value_type(arr_t->car); +  arr_t = arr_t->cdr;    if (sub_t) {    if (res) { -  struct pike_string *new = or_pike_types(res, sub_t, 1); -  free_string(res); -  free_string(sub_t); +  struct pike_type *new = or_pike_types(res, sub_t, 1); +  free_type(res); +  free_type(sub_t);    res = new;    } else {    res = sub_t;    }    }    } -  if (EXTRACT_UCHAR(arr_t) != T_ARRAY) +  if (arr_t->type != T_ARRAY)    return res; -  arr_t++; -  sub_t = make_shared_binary_string(arr_t, type_length(arr_t)); +  +  copy_pike_type(sub_t, arr_t->car); +     if (res) { -  struct pike_string *new = or_pike_types(res, sub_t, 1); -  free_string(res); -  free_string(sub_t); +  struct pike_type *new = or_pike_types(res, sub_t, 1); +  free_type(res); +  free_type(sub_t);    return new;    }    return sub_t;   }    - struct pike_string *array_value_type(struct pike_string *array_type) + struct pike_type *array_value_type(struct pike_type *array_type)   { -  struct pike_string *t = low_array_value_type(array_type->str); -  if (!t) copy_shared_string(t, mixed_type_string); +  struct pike_type *t = low_array_value_type(array_type); +  if (!t) { +  copy_pike_type(t, mixed_type_string); +  }    return t;   }         #ifdef DEBUG_MALLOC - #define low_key_type(X,Y) ((struct pike_string *)debug_malloc_pass(debug_low_key_type((X),(Y)))) + #define low_key_type(X,Y) ((struct pike_type *)debug_malloc_pass(debug_low_key_type((X),(Y))))   #else   #define low_key_type debug_low_key_type   #endif      /* FIXME, add the index */ - static struct pike_string *debug_low_key_type(char *t, node *n) + static struct pike_type *debug_low_key_type(struct pike_type *t, node *n)   { -  switch(EXTRACT_UCHAR(t++)) +  switch(t->type)    {    case T_OBJECT:    { -  struct program *p=id_to_program(extract_type_int(t+1)); +  struct program *p = id_to_program(CDR_TO_INT(t));    if(p && n)    {    if(n->token == F_ARROW)    { -  if(FIND_LFUN(p,LFUN_ARROW)!=-1 || FIND_LFUN(p,LFUN_ASSIGN_ARROW)!=-1) +  int i; +  if((i = FIND_LFUN(p,LFUN_ARROW))!=-1 || +  (i = FIND_LFUN(p,LFUN_ASSIGN_ARROW))!=-1)    { -  reference_shared_string(mixed_type_string); -  return mixed_type_string; +  /* Get the type of the first argument of the function. */ +  struct pike_type *res = +  get_first_arg_type(ID_FROM_INT(p, i)->type, CALL_NOT_LAST_ARG); +  if (res) return res; +  /* FIXME: Warn? */ +  add_ref(string_type_string); +  return string_type_string;    }    }else{ -  if(FIND_LFUN(p,LFUN_INDEX) != -1 || FIND_LFUN(p,LFUN_ASSIGN_INDEX) != -1) +  int i; +  if((i = FIND_LFUN(p,LFUN_INDEX)) != -1 || +  (i = FIND_LFUN(p,LFUN_ASSIGN_INDEX)) != -1)    { -  reference_shared_string(mixed_type_string); +  /* Get the type of the first argument of the function. */ +  struct pike_type *res = +  get_first_arg_type(ID_FROM_INT(p, i)->type, CALL_NOT_LAST_ARG); +  if (res) return res; +  /* FIXME: Warn? */ +  add_ref(mixed_type_string);    return mixed_type_string;    }    }    } -  reference_shared_string(string_type_string); +  add_ref(string_type_string);    return string_type_string;    }    default: -  reference_shared_string(mixed_type_string); +  add_ref(mixed_type_string);    return mixed_type_string;       case T_VOID:    case T_ZERO:    case T_TYPE: -  +  case PIKE_T_RING:    case T_FLOAT:    case T_INT:    return 0;       case T_OR:    { -  struct pike_string *a,*b; -  a=low_key_type(t,n); -  t+=type_length(t); -  b=low_key_type(t,n); +  struct pike_type *a,*b; +  a = low_key_type(t->car, n); +  b = low_key_type(t->cdr, n);    if(!b) return a;    if(!a) return b;    type_stack_mark(); -  medium_or_pike_types(a,b,1); -  free_string(a); -  free_string(b); +  low_or_pike_types(a,b,1); +  free_type(a); +  free_type(b);    return pop_unfinished_type();    }       case T_AND: -  return low_key_type(t+type_length(t),n); +  /* FIXME: Shouldn't this look at both branches? */ +  return low_key_type(t->cdr, n);    -  +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  return low_key_type(t->cdr, n); +     case T_ARRAY:    case T_STRING: /* always int */ -  reference_shared_string(int_type_string); +  add_ref(int_type_string);    return int_type_string;       case T_MAPPING:    case T_MULTISET: -  return make_shared_binary_string(t, type_length(t)); +  copy_pike_type(t, t->car); +  return t;    }   }    - struct pike_string *key_type(struct pike_string *type, node *n) + struct pike_type *key_type(struct pike_type *type, node *n)   { -  struct pike_string *t; +  struct pike_type *t;    clear_markers(); -  t=low_key_type(type->str,n); -  if(!t) copy_shared_string(t,mixed_type_string); +  t = low_key_type(type,n); +  if(!t) { +  copy_pike_type(t, mixed_type_string); +  }    return t;   }       -  - static int low_check_indexing(char *type, char *index_type, node *n) + /* Returns whether a value of type 'type' may be indexed with a value +  * of type 'index_type'. Returns -1 if the indexing operation is valid, +  * but will always fail. +  * The node 'n' is the node with the indexing operator. +  */ + static int low_check_indexing(struct pike_type *type, +  struct pike_type *index_type, +  node *n)   { -  switch(EXTRACT_UCHAR(type++)) +  switch(type->type)    {    case T_OR: -  return low_check_indexing(type,index_type,n) || -  low_check_indexing(type+type_length(type),index_type,n); +  return low_check_indexing(type->car, index_type, n) || +  low_check_indexing(type->cdr, index_type, n);       case T_AND: -  return low_check_indexing(type,index_type,n) && -  low_check_indexing(type+type_length(type),index_type,n); +  return low_check_indexing(type->car, index_type, n) && +  low_check_indexing(type->cdr, index_type, n);       case T_NOT: -  return low_check_indexing(type,index_type,n)!=1; +  return low_check_indexing(type->car, index_type, n) != 1;    -  +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  return low_check_indexing(type->cdr, index_type, n); +     case T_ARRAY: -  if(low_match_types(string_type_string->str, index_type,0) && -  low_check_indexing(type, index_type,n)) +  if(low_match_types(string_type_string, index_type, 0) && +  low_check_indexing(type->car, index_type, n))    return 1; -  +  /* FALL_THROUGH */    case T_STRING: -  return !!low_match_types(int_type_string->str, index_type,0); +  return !!low_match_types(int_type_string, index_type, 0);       case T_OBJECT:    { -  struct program *p=id_to_program(extract_type_int(type+1)); +  struct program *p = id_to_program(CDR_TO_INT(type));    if(p)    { -  if(n->token == F_ARROW) +  int i = -1; +  /* Check against the LFUN types. */ +  if(n && (n->token == F_ARROW))    { -  if(FIND_LFUN(p,LFUN_ARROW)!=-1 || FIND_LFUN(p,LFUN_ASSIGN_ARROW)!=-1) -  return 1; +  (i = FIND_LFUN(p,LFUN_ARROW))!=-1 || +  (i = FIND_LFUN(p,LFUN_ASSIGN_ARROW));    }else{ -  if(FIND_LFUN(p,LFUN_INDEX)!=-1 || FIND_LFUN(p,LFUN_ASSIGN_INDEX)!=-1) +  (i = FIND_LFUN(p,LFUN_INDEX))!=-1 || +  (i = FIND_LFUN(p,LFUN_ASSIGN_INDEX)); +  } +  if (i != -1) { +  if ((type = low_new_check_call(ID_FROM_INT(p, i)->type, index_type, +  CALL_NOT_LAST_ARG, NULL))) { +  free_type(type);    return 1;    } -  return !!low_match_types(string_type_string->str, index_type,0); +  return 0; +  } +  return !!low_match_types(string_type_string, index_type,0);    }else{    return 1;    }    }       case T_MULTISET:    case T_MAPPING: -  return low_match_types(type,index_type,0) ? 1 : -1; +  /* FIXME: Why -1 and not 0? +  * +  * - There were complaints when people got compilation errors +  * for indexing operations that would always fail. +  */ +  return low_match_types(type->car, index_type, 0) ? 1 : -1;    - #ifdef AUTO_BIGNUM +     case T_INT: - #endif +     case T_PROGRAM: -  return !!low_match_types(string_type_string->str, index_type,0); +  return !!low_match_types(string_type_string, index_type, 0);       case T_MIXED:    return 1;       default:    return 0;    }   }    - int check_indexing(struct pike_string *type, -  struct pike_string *index_type, + int check_indexing(struct pike_type *type, +  struct pike_type *index_type,    node *n)   {    check_type_string(type);    check_type_string(index_type);    -  return low_check_indexing(type->str, index_type->str, n); +  return low_check_indexing(type, index_type, n);   }    - static int low_count_arguments(char *q) + static int low_count_arguments(struct pike_type *q)   { -  int num,num2; +  int num=0, num2;    -  switch(EXTRACT_UCHAR(q++)) +  switch(q->type)    {    case T_OR: -  num=low_count_arguments(q); -  num2=low_count_arguments(q+type_length(q)); +  num = low_count_arguments(q->car); +  num2 = low_count_arguments(q->cdr);    if(num<0 && num2>0) return num;    if(num2<0 && num>0) return num2;    if(num2<0 && num<0) return ~num>~num2?num:num2;    return num>num2?num:num2;       case T_AND: -  num=low_count_arguments(q); -  num2=low_count_arguments(q+type_length(q)); +  num = low_count_arguments(q->car); +  num2 = low_count_arguments(q->cdr);    if(num<0 && num2>0) return num2;    if(num2<0 && num>0) return num;    if(num2<0 && num<0) return ~num<~num2?num:num2;    return num<num2?num:num2;    -  default: return 0x7fffffff; +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  return low_count_arguments(q->cdr);    -  +  default: return MAX_INT32; +     case T_FUNCTION: -  num=0; -  while(EXTRACT_UCHAR(q)!=T_MANY) +  while(q->type == T_FUNCTION)    {    num++; -  q+=type_length(q); +  q = q->cdr;    } -  q++; -  if(EXTRACT_UCHAR(q)!=T_VOID) return ~num; +  /* FALL_THROUGH */ +  case T_MANY: +  q = q->car; +  if(q->type != T_VOID) return ~num;    return num;    }   }      /* Count the number of arguments for a funciton type.    * return -1-n if the function can take number of arguments    * >= n (varargs)    */ - int count_arguments(struct pike_string *s) + int count_arguments(struct pike_type *s)   {    check_type_string(s);    -  return low_count_arguments(s->str); +  return low_count_arguments(s);   }       - static int low_minimum_arguments(char *q) + static int low_minimum_arguments(struct pike_type *q)   {    int num;    -  switch(EXTRACT_UCHAR(q++)) +  switch(q->type)    {    case T_OR:    case T_AND: -  return MAXIMUM(low_count_arguments(q), -  low_count_arguments(q+type_length(q))); +  return MAXIMUM(low_count_arguments(q->car), +  low_count_arguments(q->cdr));       default: return 0;    -  +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  return low_minimum_arguments(q->cdr); +     case T_FUNCTION: -  num=0; -  while(EXTRACT_UCHAR(q)!=T_MANY) +  num = 0; +  while(q->type == T_FUNCTION)    { -  if(low_match_types(void_type_string->str, q, B_EXACT)) +  if(low_match_types(void_type_string, q->car, B_EXACT))    return num;       num++; -  q+=type_length(q); +  q = q->cdr;    }    return num; -  +  case T_MANY: +  return 0;    }   }    - /* Count the minimum number of arguments for a funciton type. + /* Count the minimum number of arguments for a function type.    */ - int minimum_arguments(struct pike_string *s) + int minimum_arguments(struct pike_type *s)   {    int ret;    check_type_string(s);    -  ret=low_minimum_arguments(s->str); +  ret = low_minimum_arguments(s);      #if 0    fprintf(stderr,"minimum_arguments(");    simple_describe_type(s);    fprintf(stderr," ) -> %d\n",ret);   #endif       return ret;   }    - struct pike_string *check_call(struct pike_string *args, -  struct pike_string *type, + struct pike_type *check_call(struct pike_type *args, +  struct pike_type *type,    int strict)   {    check_type_string(args);    check_type_string(type);    clear_markers();    type_stack_mark();    max_correct_args=0;    -  if(low_get_return_type(type->str,args->str)) +  if(low_get_return_type(type, args))    {    if (strict) { -  if (!strict_check_call(type->str, args->str)) { -  struct pike_string *type_t = describe_type(type); +  if (!strict_check_call(type, args)) { +  struct pike_type *func_zero_type;    -  if (!low_pike_types_le(type->str, tFuncV(tNone,tZero,tMix), 0, 0)) { -  yywarning("Calling non-function value."); -  yywarning("Type called: %s", type_t->str); +  MAKE_CONSTANT_TYPE(func_zero_type, tFuncV(tNone,tZero,tMix)); +  +  if (!low_pike_types_le(type, func_zero_type, 0, 0)) { +  yytype_report(REPORT_WARNING, NULL, 0, function_type_string, +  NULL, 0, type, +  0, "Calling non-function value.");    } else { -  struct pike_string *arg_t = describe_type(args); -  yywarning("Arguments not strictly compatible."); -  yywarning("Expected: %s", type_t->str); -  yywarning("Got : %s", arg_t->str); -  free_string(arg_t); +  yytype_report(REPORT_WARNING, NULL, 0, type, +  NULL, 0, args, +  0, "Arguments not strictly compatible.");    }    -  free_string(type_t); +  free_type(func_zero_type);    }    }    return pop_unfinished_type();    }else{    pop_stack_mark();    return 0;    }   }    - INT32 get_max_args(struct pike_string *type) + /* Get the type for the specified argument in a function type. +  * Argument number -1 is the return type. +  * True arguments are counted from zero. +  */ + struct pike_type *get_argument_type(struct pike_type *fun, int arg_no)   { -  INT32 ret,tmp=max_correct_args; -  check_type_string(type); -  clear_markers(); -  type = check_call(function_type_string, type, 0); -  if(type) free_string(type); -  ret=max_correct_args; -  max_correct_args=tmp; -  return tmp; +  loop: +  switch(fun->type) { +  case T_OR: +  return or_pike_types(get_argument_type(fun->car, arg_no), +  get_argument_type(fun->cdr, arg_no), +  1); +  case T_FUNCTION: +  if (arg_no > 0) { +  arg_no--; +  fun = fun->cdr; +  goto loop;    } -  +  /* FALL_THROUGH */ +  case T_MANY: +  if (arg_no < 0) { +  add_ref(fun->cdr); +  return fun->cdr; +  } +  add_ref(fun->car); +  return fun->car;    -  +  case T_MIXED: +  add_ref(fun); +  return fun;    - struct pike_string *zzap_function_return(char *a, INT32 id) +  case T_ARRAY: +  if (arg_no < 0) { +  type_stack_mark(); +  push_finished_type(fun = get_argument_type(fun->car, arg_no)); +  push_type(T_ARRAY); +  free_type(fun); +  return pop_unfinished_type(); +  } +  return get_argument_type(fun->car, arg_no); +  +  default: +  add_ref(zero_type_string); +  return zero_type_string; +  } + } +  + /* Get the resulting type from a soft cast. +  * +  * Flags: +  * 1 SOFT_WEAKER Weaker type. +  */ + struct pike_type *soft_cast(struct pike_type *soft_type, +  struct pike_type *orig_type, +  int flags)   { -  switch(EXTRACT_UCHAR(a)) +  struct pike_type *res = NULL; +  struct pike_type *tmp = NULL; +  struct pike_type *tmp2 = NULL; +  struct pike_type *tmp3 = NULL; +  +  if (soft_type == orig_type) { +  copy_pike_type(res, soft_type); +  return res; +  } +  +  loop: +  switch(soft_type->type) { +  case T_OR: +  tmp = soft_cast(soft_type->car, orig_type, flags); +  if (tmp == orig_type) return tmp; +  tmp2 = soft_cast(soft_type->cdr, orig_type, flags); +  if (tmp2 == orig_type) { +  res = tmp2; +  tmp2 = NULL; +  } else { +  res = or_pike_types(tmp, tmp2, 1); +  } +  break; +  case T_AND: +  /* FIXME: Make stricter analogous to OR above. */ +  res = and_pike_types(tmp = soft_cast(soft_type->car, orig_type, flags), +  tmp2 = soft_cast(soft_type->cdr, orig_type, flags)); +  break; +  case T_SCOPE: +  case T_ASSIGN: +  case PIKE_T_NAME: +  soft_type = soft_type->cdr; +  goto loop; +  /* FIXME: TUPLE, RING */ +  case PIKE_T_ATTRIBUTE: +  if ((res = soft_cast(soft_type->cdr, orig_type, flags))) { +  type_stack_mark(); +  push_finished_type(res); +  push_type_attribute((struct pike_string *)soft_type->car); +  free_type(res); +  res = pop_unfinished_type(); +  } +  return res; +  case T_MIXED: +  if (flags & SOFT_WEAKER) { +  copy_pike_type(res, soft_type); +  } else if (orig_type->type == T_VOID) { +  copy_pike_type(res, zero_type_string); +  } else { +  copy_pike_type(res, orig_type); +  } +  break; +  case T_ZERO: +  if (!(flags & SOFT_WEAKER) || (orig_type->type == T_VOID)) { +  copy_pike_type(res, soft_type); +  } else { +  copy_pike_type(res, orig_type); +  } +  break; +  } +  if (!res) { +  loop2: +  switch(orig_type->type) { +  case T_OR: +  tmp = soft_cast(soft_type, orig_type->car, flags); +  if (tmp == soft_type) return tmp; +  tmp2 = soft_cast(soft_type, orig_type->cdr, flags); +  if (tmp2 == soft_type) { +  res = tmp2; +  tmp2 = NULL; +  } else { +  res = or_pike_types(tmp, tmp2, 1); +  } +  break; +  case T_AND: +  /* Note: We need to handle T_NOT here. */ +  if (orig_type->car->type != T_NOT) { +  tmp = soft_cast(soft_type, orig_type->car, flags); +  if (!tmp) return NULL; +  if (tmp == orig_type->car) { +  /* The original type is stricter than the soft type. */ +  free_type(tmp); +  add_ref(orig_type); +  return orig_type; +  } +  } +  if (orig_type->cdr->type != T_NOT) { +  tmp2 = soft_cast(soft_type, orig_type->cdr, flags); +  if (!tmp2) { +  if (tmp) free_type(tmp); +  return NULL; +  } +  if (tmp2 == orig_type->cdr) { +  /* The original type is stricter than the soft type. */ +  if (tmp) free_type(tmp); +  free_type(tmp2); +  add_ref(orig_type); +  return orig_type; +  } +  } +  res = and_pike_types(tmp?tmp:orig_type->car, tmp2?tmp2:orig_type->cdr); +  break; +  case T_SCOPE: +  if ((res = soft_cast(soft_type, orig_type->cdr, flags))) { +  type_stack_mark(); +  push_finished_type(res); +  push_scope_type(CAR_TO_INT(orig_type)); +  free_type(res); +  res = pop_unfinished_type(); +  } +  return res; +  case T_ASSIGN: +  case PIKE_T_NAME: +  orig_type = orig_type->cdr; +  goto loop2; +  case PIKE_T_ATTRIBUTE: +  if ((res = soft_cast(soft_type, orig_type->cdr, flags))) { +  type_stack_mark(); +  push_finished_type(res); +  push_type_attribute((struct pike_string *)orig_type->car); +  free_type(res); +  res = pop_unfinished_type(); +  } +  return res; +  case T_MIXED: +  if (flags & SOFT_WEAKER) { +  copy_pike_type(res, orig_type); +  } else { +  copy_pike_type(res, soft_type); +  } +  break; +  case T_VOID: +  case T_ZERO: +  if (flags & SOFT_WEAKER) { +  copy_pike_type(res, soft_type); +  } else { +  copy_pike_type(res, zero_type_string); +  } +  break; +  } +  } +  if (!res) { +  switch(soft_type->type) { +  case T_VOID: +  if (orig_type->type == T_VOID) { +  copy_pike_type(res, soft_type); +  } else { +  return NULL; +  } +  break; +  case T_TYPE: +  /* Convert to a function returning the subtype and retry. */ +  type_stack_mark(); +  push_finished_type(soft_type->car); +  push_type(T_VOID); +  push_type(T_MANY); +  push_type(T_MIXED); +  push_type(T_FUNCTION); +  tmp = pop_unfinished_type(); +  res = soft_cast(tmp, orig_type, flags); +  break; +  +  case T_PROGRAM: +  /* Convert to a function returning an object. */ +  copy_pike_type(tmp3, soft_type->car); /* Return type */ +  if ((tmp2 = low_object_lfun_type(tmp3, LFUN_CREATE))) { +  soft_type = tmp2; +  tmp2 = NULL; +  } else { +  /* FIXME: Multiple cases. */ +  soft_type = function_type_string; +  } +  /* FALL_THROUGH */ +  case T_FUNCTION: +  case T_MANY:    { -  +  int array_cnt = 0; +  int loop_cnt = 0; +  while(orig_type->type == T_ARRAY) { +  array_cnt++; +  orig_type = orig_type->car; +  } +  if (orig_type->type == T_PROGRAM) { +  copy_pike_type(tmp, orig_type->car); /* Return type */ +  if ((tmp2 = low_object_lfun_type(tmp, LFUN_CREATE))) { +  orig_type = tmp2; +  tmp2 = NULL; +  } else { +  /* FIXME: Multiple cases. */ +  tmp2 = soft_type; +  while(tmp2->type == T_FUNCTION) tmp2 = tmp2->cdr; +  if (tmp2->type == T_MANY) { +  if ((tmp2 = soft_cast(tmp2->car, tmp, flags ^ SOFT_WEAKER))) { +  /* FIXME: Adjust the return type to tmp2! */ +  copy_pike_type(res, soft_type); +  } +  } else { +  tmp2 = NULL; +  copy_pike_type(res, soft_type); +  } +  break; +  } +  } else if (orig_type->type == T_OBJECT) { +  if ((tmp = low_object_lfun_type(orig_type, LFUN_CALL))) { +  orig_type = tmp; +  tmp = NULL; +  } else { +  /* FIXME: Multiple cases. */ +  copy_pike_type(res, orig_type); +  break; +  } +  } +  /* FIXME: Loop above until function? */ +  if ((orig_type->type != T_FUNCTION) && +  (orig_type->type != T_MANY)) { +  /* Failure. */ +  break; +  } +  type_stack_mark(); +  while((soft_type->type == T_FUNCTION) || +  (orig_type->type == T_FUNCTION)) { +  if (!(tmp2 = soft_cast(soft_type->car, orig_type->car, +  flags ^ SOFT_WEAKER))) { +  goto function_cast_fail; +  } +  if (tmp2 != void_type_string) { +  push_finished_type(tmp2); +  loop_cnt++; +  } +  free_type(tmp2); +  tmp2 = NULL; +  if (soft_type->type == T_FUNCTION) soft_type = soft_type->cdr; +  if (orig_type->type == T_FUNCTION) orig_type = orig_type->cdr; +  } + #ifdef PIKE_DEBUG +  if ((soft_type->type != T_MANY) || (orig_type->type != T_MANY)) { +  fprintf(stderr, +  "Strange function type (expected MANY node).\n" +  "Orig type: "); +  simple_describe_type(orig_type); +  fprintf(stderr, "\n" +  "Soft type: "); +  simple_describe_type(soft_type); +  fprintf(stderr, "\n"); +  Pike_fatal("Strange function type in soft cast.\n"); +  } + #endif /* PIKE_DEBUG */ +  if (!(tmp2 = soft_cast(soft_type->car, orig_type->car, +  flags ^ SOFT_WEAKER))) { +  goto function_cast_fail; +  } +  push_finished_type(tmp2); +  free_type(tmp2); +  tmp2 = NULL; +  /* Note: Special case for the return type in case of create(). */ +  if (tmp) { +  orig_type = tmp; +  } else { +  orig_type = orig_type->cdr; +  } +  if (tmp3) { +  soft_type = tmp3; +  } else { +  soft_type = soft_type->cdr; +  } +  if (!(tmp2 = soft_cast(soft_type, orig_type, flags))) { +  goto function_cast_fail; +  } +  push_finished_type(tmp2); +  free_type(tmp2); +  tmp2 = NULL; +  while(array_cnt--) push_type(T_ARRAY); +  push_reverse_type(T_MANY); +  while(loop_cnt--) push_reverse_type(T_FUNCTION); +  res = pop_unfinished_type(); +  break; +  } +  function_cast_fail: +  type_stack_pop_to_mark(); +  break; +  case T_NOT: /* FIXME. */ +  default: +  if (soft_type->type != orig_type->type) break; +  switch(soft_type->type) { +  case T_MAPPING: +  type_stack_mark(); +  if ((tmp = soft_cast(soft_type->car, orig_type->car, +  flags ^ SOFT_WEAKER))) { +  push_finished_type(tmp); +  } else { +  push_finished_type(zero_type_string); +  } +  if ((tmp2 = soft_cast(soft_type->cdr, orig_type->cdr, flags))) { +  push_finished_type(tmp2); +  } else { +  push_finished_type(zero_type_string); +  } +  push_reverse_type(T_MAPPING); +  res = pop_unfinished_type(); +  break; +  case T_ARRAY: +  case T_MULTISET: +  case T_TYPE: +  type_stack_mark(); +  if ((tmp = soft_cast(soft_type->car, orig_type->car, flags))) { +  push_finished_type(tmp); +  } else if (flags & SOFT_WEAKER) { +  push_finished_type(mixed_type_string); +  } else { +  push_finished_type(zero_type_string); +  } +  push_type(soft_type->type); +  res = pop_unfinished_type(); +  break; +  case T_FLOAT: +  copy_pike_type(res, soft_type); +  break; +  case T_STRING: +  res = soft_cast(soft_type->car, orig_type->car, flags); +  if (!res) return NULL; +  type_stack_mark(); +  push_finished_type(res); +  free_type(res); +  push_type(T_STRING); +  res = pop_unfinished_type(); +  break; +  case T_INT: +  { +  INT32 min, max; +  if (flags & SOFT_WEAKER) { +  if ((min = CAR_TO_INT(soft_type)) > CAR_TO_INT(orig_type)) { +  min = CAR_TO_INT(orig_type); +  } +  if ((max = CDR_TO_INT(soft_type)) < CDR_TO_INT(orig_type)) { +  max = CDR_TO_INT(orig_type); +  } +  } else { +  if ((min = CAR_TO_INT(soft_type)) < CAR_TO_INT(orig_type)) { +  min = CAR_TO_INT(orig_type); +  } +  if ((max = CDR_TO_INT(soft_type)) > CDR_TO_INT(orig_type)) { +  max = CDR_TO_INT(orig_type); +  } +  if (min > max) break; +  } +  type_stack_mark(); +  push_int_type(min, max); +  res = pop_unfinished_type(); +  break; +  } +  case T_OBJECT: +  if (flags & SOFT_WEAKER) { +  if (!CDR_TO_INT(orig_type)) { +  copy_pike_type(res, orig_type); +  } else if (!CDR_TO_INT(soft_type)) { +  copy_pike_type(res, soft_type); +  } else if (CDR_TO_INT(soft_type) == CDR_TO_INT(orig_type)) { +  if (!CAR_TO_INT(orig_type)) { +  copy_pike_type(res, orig_type); +  } else { +  copy_pike_type(res, soft_type); +  } +  } else if (pike_types_le(soft_type, orig_type)) { +  copy_pike_type(res, orig_type); +  } else if (pike_types_le(orig_type, soft_type)) { +  copy_pike_type(res, soft_type); +  } else { +  copy_pike_type(res, object_type_string); +  } +  } else { +  if (!CDR_TO_INT(orig_type)) { +  copy_pike_type(res, soft_type); +  } else if (!CDR_TO_INT(soft_type)) { +  copy_pike_type(res, orig_type); +  } else if (CDR_TO_INT(soft_type) == CDR_TO_INT(orig_type)) { +  if (CAR_TO_INT(orig_type)) { +  copy_pike_type(res, orig_type); +  } else { +  copy_pike_type(res, soft_type); +  } +  } else if (pike_types_le(soft_type, orig_type)) { +  copy_pike_type(res, soft_type); +  } else if (pike_types_le(orig_type, soft_type)) { +  copy_pike_type(res, orig_type); +  } +  } +  break; +  } +  break; +  } +  } +  if (tmp) free_type(tmp); +  if (tmp2) free_type(tmp2); +  if (tmp3) free_type(tmp3); +  return res; + } +  + /** +  * Check whether sval is a valid value for a variable of +  * type type. +  * +  * Returns 1 if ok, and 0 (zero) otherwise. +  */ + static int match_type_svalue(struct pike_type *type, +  int flags, +  struct svalue *sval) + { +  int res = 0; +  struct pike_type *sub; +  loop: +  switch(type->type) { +  case T_SCOPE: +  case T_ASSIGN: +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  type = type->cdr; +  goto loop;    case T_OR: -  +  res = match_type_svalue(type->car, 0, sval) || +  match_type_svalue(type->cdr, 0, sval); +  break; +  case T_AND: +  res = match_type_svalue(type->car, 0, sval) || +  match_type_svalue(type->cdr, 0, sval); +  case T_NOT: +  flags ^= CALL_INVERTED_TYPES; +  type = type->car; +  goto loop; +  case T_VOID: +  /* Allow UNDEFINED for voidable arguments. */ +  res = (TYPEOF(*sval) == T_INT) && !sval->u.integer && SUBTYPEOF(*sval); +  break; +  case T_ZERO: +  res = SAFE_IS_ZERO(sval); +  break; +  case PIKE_T_TYPE: +  res = 1; +  break; +  case PIKE_T_PROGRAM: +  case PIKE_T_FUNCTION: +  case T_MANY: +  /* FIXME: Identify if sval is callable. */ +  /* FIXME: Check arguments */ +  /* FIXME: Check return type */ +  res = 1; +  break; +  case PIKE_T_MIXED: +  res = 1; +  break; +  case PIKE_T_OBJECT: +  if( TYPEOF( *sval ) == PIKE_T_OBJECT )    { -  struct pike_string *ar, *br, *ret=0; -  a++; -  ar=zzap_function_return(a,id); -  br=zzap_function_return(a+type_length(a),id); -  if(ar && br) ret=or_pike_types(ar,br,0); -  if(ar) free_string(ar); -  if(br) free_string(br); -  return ret; +  struct object *o = sval->u.object; +  if( o->prog ) +  { +  if( !type->cdr ) +  { +  res = 1;    } -  +  else +  { +  struct program *mark = id_to_program( CDR_TO_INT( type ) ); +  if( mark == o->prog ) +  res = 1; +  else if( type->car ) +  res = is_compatible( mark, o->prog ); +  else +  res = implements( mark, o->prog ); +  } +  } +  } +  break; +  case PIKE_T_STRING: +  if( TYPEOF( *sval ) == PIKE_T_STRING ) +  { +  sub = type->car; +  if (sub->type == T_ZERO) +  { +  res = sval->u.string->len == 0; +  } +  else if( sub->type == PIKE_T_INT ) +  { +  struct pike_string *s = sval->u.string; +  INT32 min = CAR_TO_INT( sub ), max = CDR_TO_INT( sub ); +  INT32 string_min, string_max; +  int checked;    -  case T_FUNCTION: +  check_string_range( s, 1, &string_min, &string_max ); +  +  if( min != MIN_INT32 ) +  { +  if( string_min < min ) +  { +  if( s->size_shift ) +  check_string_range( s, 0, &string_min, &string_max ); +  if( string_min < min ) +  goto do_return; +  checked = 1; +  } +  } +  +  if( max != MIN_INT32 ) +  { +  if( string_max > max ) +  { +  if( s->size_shift && !checked ) +  check_string_range( s, 0, NULL, &string_max ); +  +  if( string_max > max ) +  goto do_return; +  } +  } +  } +  res = 1; +  } +  break; +  case PIKE_T_INT: +  if( TYPEOF( *sval ) == PIKE_T_INT ) +  { +  INT_TYPE current = sval->u.integer; +  INT32 min, max; +  min = CAR_TO_INT( type ); +  max = CDR_TO_INT( type ); +  if( min != MIN_INT32 ) +  { +  if( current < min ) +  break; +  } +  if( max != MAX_INT32 ) +  { +  if( current > max ) +  break; +  } +  res = 1; +  } +  /* FIXME: Objects that emulate integers? */ +  else if( TYPEOF(*sval) == PIKE_T_OBJECT ) +  { +  if( is_bignum_object(sval->u.object) ) +  { +  INT32 min = CAR_TO_INT( type ); +  INT32 max = CDR_TO_INT( type ); +  if( min != MIN_INT32 && max != MAX_INT32 ) +  { +  struct svalue tmp; +  TYPEOF(tmp)=PIKE_T_INT; +  if( min != MIN_INT32 ) +  { +  tmp.u.integer = min; +  if( is_lt( sval, &tmp ) ) +  break; +  } +  if( max != MAX_INT32 ) +  { +  tmp.u.integer = max; +  if( is_gt( sval, &tmp ) ) +  break; +  } +  } +  res = 1; +  } +  } +  break; +  default: +  res = (type->type == TYPEOF(*sval)); +  break; +  } +  do_return: +  if (flags & CALL_INVERTED_TYPES) return !res; +  return res; + } +  + /** +  * Check whether sval is a valid first argument to fun_type. +  * +  * Returns NULL on failure. +  * +  * Returns continuation function type on success. +  */ + struct pike_type *check_call_svalue(struct pike_type *fun_type, +  INT32 flags, +  struct svalue *sval) + { +  struct pike_type *res = NULL; +  struct pike_type *tmp; +  struct pike_type *tmp2; +  INT32 array_cnt = 0; +  int indent = 2; +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "%*scheck_call_svalue(", indent*2, ""); +  simple_describe_type(fun_type); +  fprintf(stderr, ", 0x%08x, %p)...\n", flags, sval); +  } + #endif /* PIKE_DEBUG */ +  +  loop: +  /* Count the number of array levels. */ +  while(fun_type->type == PIKE_T_ARRAY) { +  array_cnt++; +  fun_type = fun_type->car; +  } +  +  switch(fun_type->type) { +  case T_SCOPE: +  /* FIXME: Save and restore the corresponding marker set. */ +  case T_ASSIGN: +  case PIKE_T_NAME: +  fun_type = fun_type->cdr; +  goto loop; +  +  case PIKE_T_ATTRIBUTE: +  fun_type = fun_type->cdr; +  goto loop; +  +  case T_OR: +  res = check_call_svalue(fun_type->car, flags, sval); +  if (!res) { +  fun_type = fun_type->cdr; +  goto loop; +  } +  tmp = check_call_svalue(fun_type->cdr, flags, sval); +  if (!tmp) break; +  res = or_pike_types(tmp2 = res, tmp, 1); +  free_type(tmp); +  free_type(tmp2); +  break; +  +  case T_AND: +  res = check_call_svalue(fun_type->car, flags, sval); +  if (!res) break; +  tmp = check_call_svalue(fun_type->cdr, flags, sval); +  if (!tmp) { +  free_type(res); +  res = NULL; +  break; +  } +  if (res == tmp) { +  /* Common case. */ +  free_type(tmp); +  break; +  } +  /* and_pike_types() doesn't handle and of functions +  * in the way we want here. +  */    type_stack_mark(); -  push_type_int(id); -  push_type(1); -  push_type(T_OBJECT); +  push_finished_type(tmp); +  push_finished_type(res); +  push_type(T_AND); +  free_type(tmp); +  free_type(res); +  res = pop_unfinished_type(); +  break;    -  +  case T_NOT: +  fun_type = fun_type->car; +  flags ^= CALL_INVERTED_TYPES; +  goto loop; +  +  case PIKE_T_TYPE: +  /* FIXME: Check that the cast is valid. */    type_stack_mark(); -  a++; -  while(EXTRACT_UCHAR(a)!=T_MANY) +  push_finished_type(fun_type->car); +  push_type(T_VOID); +  push_type(T_MANY); +  res = pop_unfinished_type(); +  break; +  +  case PIKE_T_PROGRAM: +  tmp = low_object_lfun_type(fun_type->car, LFUN_CREATE); +  if (!tmp) { +  /* No create() -- No arguments. */ +  /* FIXME: Multiple cases: +  * Untyped object. function(mixed|void...:obj) +  * Failed to lookup program id. function(mixed|void...:obj) +  * Program does not have a create(). function(:obj) +  * +  * We simply ignore the args. +  */ +  +  type_stack_mark(); +  push_finished_type(fun_type->car); +  push_type(T_MIXED); +  push_type(T_VOID); +  push_type(T_OR); +  push_type(T_MANY); +  fun_type = pop_unfinished_type(); +  } else { +  fun_type = zzap_function_return(tmp, fun_type->car); +  } +  res = check_call_svalue(fun_type, flags, sval); +  free_type(fun_type); +  break; +  +  case PIKE_T_OBJECT: +  fun_type = low_object_lfun_type(fun_type, LFUN_CALL); +  if (fun_type) goto loop; +  +  /* FIXME: Multiple cases: +  * Untyped object. mixed +  * Failed to lookup program id. mixed +  * Program does not have the lfun `()(). NULL +  */ +  +  /* FALL_THROUGH */ +  case PIKE_T_MIXED: +  copy_pike_type(res, mixed_type_string); +  break; +  +  case PIKE_T_FUNCTION: +  /* Note: Use the low variants of pike_types_le and match_types, +  * so that markers get set and kept. */ +  if (match_type_svalue(fun_type->car, flags, sval)) { +  add_ref(res = fun_type->cdr); +  break; +  } +  res = NULL; +  break; +  case T_MANY: +  /* Note: Use the low variants of pike_types_le and match_types, +  * so that markers get set and kept. */ +  if (match_type_svalue(fun_type->car, flags, sval)) { +  add_ref(res = fun_type); +  break; +  } +  res = NULL; +  break; +  default: +  /* Not a callable. */ +  break; +  } +  +  if (!array_cnt || !res) { + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  if (res) { +  fprintf(stderr, "%*s==> ", indent*2, ""); +  simple_describe_type(res); +  } else { +  fprintf(stderr, "%*s==> NULL", indent*2, ""); +  } +  fprintf(stderr, "\n"); +  } + #endif /* PIKE_DEBUG */ +  return res; +  } +  +  type_stack_mark(); +  push_finished_type(res); +  free_type(res); +  while(array_cnt--) { +  push_type(PIKE_T_ARRAY); +  } +  res = pop_type(); +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "%*s==> ", indent*2, ""); +  simple_describe_type(res); +  fprintf(stderr, "\n"); +  } + #endif /* PIKE_DEBUG */ +  +  return res; + } +  + /* Check whether arg_type may be used as the type of the first argument +  * in a call to fun_type. +  * +  * The first argument has no OR or AND nodes. +  * +  * Returns NULL on failure. +  * +  * Returns continuation function type on success. +  */ + static struct pike_type *lower_new_check_call(struct pike_type *fun_type, +  struct pike_type *arg_type, +  INT32 flags, +  struct svalue *sval + #ifdef PIKE_TYPE_DEBUG +  , INT32 indent + #define CHECK_CALL_ARGS , indent+1 + #else + #define CHECK_CALL_ARGS + #endif /* PIKE_TYPE_DEBUG */ +  )   { -  +  struct compilation *c = MAYBE_THIS_COMPILATION; +  struct pike_type *res = NULL; +  struct pike_type *tmp; +  struct pike_type *tmp2; +  INT32 array_cnt = 0; +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "%*slower_new_check_call(", indent*2, ""); +  simple_describe_type(fun_type); +  fprintf(stderr, ", "); +  simple_describe_type(arg_type); +  fprintf(stderr, ", 0x%04x, %p)...\n", flags, sval); +  } + #endif /* PIKE_DEBUG */ +  +  loop: +  /* Count the number of array levels. */ +  while(fun_type->type == PIKE_T_ARRAY) { +  array_cnt++; +  fun_type = fun_type->car; +  } +  +  switch(fun_type->type) { +  case T_SCOPE: +  /* FIXME: Save and restore the corresponding marker set. */ +  case T_ASSIGN: +  case PIKE_T_NAME: +  fun_type = fun_type->cdr; +  goto loop; +  +  case PIKE_T_ATTRIBUTE: +  res = lower_new_check_call(fun_type->cdr, arg_type, flags, sval CHECK_CALL_ARGS); +  if (!res) return NULL; +  if (c) { +  ref_push_string((struct pike_string *)fun_type->car); +  ref_push_type_value(fun_type->cdr); +  ref_push_type_value(arg_type); +  safe_apply_current2(PC_APPLY_TYPE_ATTRIBUTE_FUN_NUM, 3, +  "apply_type_attribute"); +  if ((TYPEOF(Pike_sp[-1]) == T_INT) && +  (SUBTYPEOF(Pike_sp[-1]) == NUMBER_NUMBER) && +  (!Pike_sp[-1].u.integer)) { +  pop_stack(); +  free_type(res); +  return NULL; +  } +  pop_stack(); +  }    type_stack_mark(); -  push_unfinished_type(a); -  type_stack_reverse(); -  a+=type_length(a); +  push_finished_type(res); +  push_type_attribute((struct pike_string *)fun_type->car); +  free_type(res); +  return pop_unfinished_type(); +  +  case T_OR: +  res = lower_new_check_call(fun_type->car, arg_type, flags, sval CHECK_CALL_ARGS); +  if (!res) { +  res = lower_new_check_call(fun_type->cdr, arg_type, flags, sval CHECK_CALL_ARGS); +  break;    } -  a++; +  tmp = lower_new_check_call(fun_type->cdr, arg_type, flags, sval CHECK_CALL_ARGS); +  if (!tmp) break; +  res = or_pike_types(tmp2 = res, tmp, 1); +  free_type(tmp); +  free_type(tmp2); +  break; +  +  case T_AND: +  res = lower_new_check_call(fun_type->car, arg_type, flags, sval CHECK_CALL_ARGS); +  if (!res) break; +  tmp = lower_new_check_call(fun_type->cdr, arg_type, flags, sval CHECK_CALL_ARGS); +  if (!tmp) { +  free_type(res); +  res = NULL; +  break; +  } +  if (res == tmp) { +  /* Common case. */ +  free_type(tmp); +  break; +  } +  /* and_pike_types() doesn't handle and of functions +  * in the way we want here. +  */ +  type_stack_mark(); +  push_finished_type(tmp); +  push_finished_type(res); +  push_type(T_AND); +  free_type(tmp); +  free_type(res); +  res = pop_unfinished_type(); +  break; +  +  case T_NOT: +  if (arg_type->type == T_NOT) { +  /* Both sides are inverted. Pop both inversions. */ +  arg_type = arg_type->car; +  fun_type = fun_type->car; +  flags ^= CALL_INVERTED_TYPES; +  goto loop; +  } else { +  /* Move the inversion to the argument type. */ +  type_stack_mark(); +  push_finished_type(arg_type); +  push_type(T_NOT); +  arg_type = pop_unfinished_type(); +  res = lower_new_check_call(fun_type->car, arg_type, +  flags ^ CALL_INVERTED_TYPES, +  sval CHECK_CALL_ARGS); +  free_type(arg_type); +  if (res) { +  /* Move the inversion back to the function type. */ +  if (res->type == T_NOT) { +  tmp = res->car; +  free_type(res); +  res = tmp; +  } else { +  type_stack_mark(); +  if ((res->type == T_MANY) && +  (fun_type->car->type == T_MANY) && +  (res->car->type == T_NOT)) { +  /* Exist criteria is fulfilled. +  * Reduce !function(!type...:type) to function(mixed...:type). +  * FIXME: Probably ought to move the inner inversion +  * to the result type, but that is incompatible +  * with current types. +  * FIXME: What about the limited number of args case? +  */ +  push_finished_type(mixed_type_string); +  free_type(res); +  } else { +  /* More arguments to check. */ +  push_finished_type(res); +  free_type(res); +  push_type(T_NOT); +  } +  res = pop_unfinished_type(); +  } +  } else if ((flags & CALL_NOT_LAST_ARG) && +  (fun_type->car->type == T_MANY)) { +  /* The next argument might match. */ +  add_ref(fun_type); +  res = fun_type; +  } +  } +  break; +  +  case PIKE_T_TYPE: +  /* FIXME: Check that the cast is valid. */ +  type_stack_mark(); +  push_finished_type(fun_type->car); +  push_type(T_VOID);    push_type(T_MANY); -  +  res = pop_unfinished_type(); +  break; +  +  case PIKE_T_PROGRAM: +  tmp = low_object_lfun_type(fun_type->car, LFUN_CREATE); +  if (!tmp) { +  /* No create() -- No arguments. */ +  /* FIXME: Multiple cases: +  * Untyped object. function(mixed|void...:obj) +  * Failed to lookup program id. function(mixed|void...:obj) +  * Program does not have a create(). function(:obj) +  * +  * We simply ignore the args. +  */ +     type_stack_mark(); -  push_unfinished_type(a); -  type_stack_reverse(); -  type_stack_reverse(); -  push_type(T_FUNCTION); +  push_finished_type(fun_type->car); +  push_type(T_MIXED); +  push_type(T_VOID); +  push_type(T_OR); +  push_type(T_MANY); +  fun_type = pop_unfinished_type(); +  } else { +  fun_type = zzap_function_return(tmp, fun_type->car); +  } +  res = lower_new_check_call(fun_type, arg_type, flags, sval CHECK_CALL_ARGS); +  free_type(fun_type); +  break; +  +  case PIKE_T_OBJECT: +  fun_type = low_object_lfun_type(fun_type, LFUN_CALL); +  if (fun_type) goto loop; +  +  /* FIXME: Multiple cases: +  * Untyped object. mixed +  * Failed to lookup program id. mixed +  * Program does not have the lfun `()(). NULL +  */ +  +  /* FALL_THROUGH */ +  case PIKE_T_MIXED: +  copy_pike_type(res, mixed_type_string); +  break; +  +  case PIKE_T_FUNCTION: +  case T_MANY: +  /* Special case to detect workarounds for the old +  * function call checker. +  */ +  tmp = NULL; +  if (((arg_type->type != T_NOT) || +  (arg_type->car->type != T_MIXED)) && +  (fun_type->car->type == T_NOT) && +  (fun_type->car->car->type == T_OR) && +  ((fun_type->car->car->car->type == T_MIXED) || +  (fun_type->car->car->cdr->type == T_MIXED))) { +  /* Rebuild the function type without the negated mixed +  * in the first argument. +  */ +  type_stack_mark(); +  push_finished_type(fun_type->cdr); +  if (fun_type->car->car->car->type == T_MIXED) { +  push_finished_type(fun_type->car->car->cdr); +  } else { +  push_finished_type(fun_type->car->car->car); +  } +  push_type(T_NOT); +  push_type(fun_type->type); +  tmp = fun_type = pop_unfinished_type(); +  } +  /* Note: Use the low variants of pike_types_le and match_types, +  * so that markers get set and kept. */ + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "%*sChecking argument type ", indent*2+2, ""); +  simple_describe_type(arg_type); +  fprintf(stderr, " against function type "); +  simple_describe_type(fun_type); +  fprintf(stderr, ".\n"); +  } + #endif /* PIKE_DEBUG */ +  /* No need to perform advanced checking in the trivial case... */ +  if (arg_type != (tmp2 = fun_type->car)) { +  if ((flags & CALL_7_6) && (arg_type == void_type_string)) { +  /* Compat with Pike 7.6 and earlier. */ +  arg_type = zero_type_string; +  } +  +  if (!((flags & CALL_INVERTED_TYPES)? +  low_pike_types_le(tmp2, arg_type, 0, +  LE_A_B_SWAPPED|LE_EXPLICIT_ZERO): +  low_pike_types_le(arg_type, tmp2, 0, 0)) && +  ((flags & CALL_STRICT) || +  !low_match_types(arg_type, tmp2, NO_SHORTCUTS))) { +  /* No match. */ + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "%*sNo match.\n", indent*2+2, ""); +  } + #endif /* PIKE_DEBUG */ +  res = NULL; +  if (tmp) free_type(tmp); +  break; +  } +  } +  /* Match. */ +  if (fun_type->type == PIKE_T_FUNCTION) { +  /* Advance to the next argument. */ +  fun_type = fun_type->cdr; + #if 0 +  /* This test is too strict, and causes the type checker +  * to complain about the last argument (even if correct) +  * when there are too few arguments to the function. +  */ +  if (!(flags & CALL_NOT_LAST_ARG) && +  (fun_type->type == PIKE_T_FUNCTION) && +  !low_match_types(fun_type->car, void_type_string, 0)) { +  /* There are more required arguments. */ + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "%*sMore arguments required.\n", indent*2+2, ""); +  } + #endif /* PIKE_DEBUG */ +  res = NULL; +  if (tmp) free_type(tmp); +  break; +  } + #endif /* 0 */ +  } +  type_stack_mark(); +  push_finished_type_with_markers(fun_type, b_markers, 0); +  res = pop_unfinished_type(); +  if (tmp) free_type(tmp); +  +  if ((Pike_compiler->compiler_pass == 2) && sval) { +  while (tmp2->type == PIKE_T_NAME) { +  tmp2 = tmp2->cdr; +  } +  +  if (tmp2->type == PIKE_T_ATTRIBUTE) { +  struct compilation *c = MAYBE_THIS_COMPILATION; +  if (c) { +  /* Perform extra argument checking based on the attribute. */ +  ref_push_string((struct pike_string *)tmp2->car); +  push_svalue(sval); +  ref_push_type_value(tmp2->cdr); +  ref_push_type_value(res); +  safe_apply_current(PC_APPLY_ATTRIBUTE_CONSTANT_FUN_NUM, 4); +  if (TYPEOF(Pike_sp[-1]) == PIKE_T_TYPE) { +  type_stack_mark(); +  push_finished_type(Pike_sp[-1].u.type); +  push_finished_type(res); +  push_type(T_AND); +  free_type(res); +  res = pop_unfinished_type(); +  } +  pop_stack(); +  } +  } +  } + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "%*sSuccess.\n", indent*2+2, ""); +  } + #endif /* PIKE_DEBUG */ +  break; +  default: +  /* Not a callable. */ +  break; +  } +  if (!array_cnt || !res) { + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  if (res) { +  fprintf(stderr, "%*s==> ", indent*2, ""); +  simple_describe_type(res); +  } else { +  fprintf(stderr, "%*s==> NULL", indent*2, ""); +  } +  fprintf(stderr, "\n"); +  } + #endif /* PIKE_DEBUG */ +  return res; +  } +  +  type_stack_mark(); +  push_finished_type(res); +  free_type(res); +  while(array_cnt--) { +  push_type(PIKE_T_ARRAY); +  } +  res = pop_type(); +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "%*s==> ", indent*2, ""); +  simple_describe_type(res); +  fprintf(stderr, "\n"); +  } + #endif /* PIKE_DEBUG */ +  +  return res; + } +  + /* Check whether arg_type may be used as the type of the first argument +  * in a call to fun_type. +  * +  * If the argument is a constant, sval will contain a pointer to it. +  * +  * Returns NULL on failure. +  * +  * Returns continuation function type on success. +  */ + struct pike_type *low_new_check_call(struct pike_type *fun_type, +  struct pike_type *arg_type, +  INT32 flags, +  struct svalue *sval) + { +  struct pike_type *tmp; +  struct pike_type *tmp2; +  struct pike_type *res; +  +  /* FIXME: In strict mode we need to differentiate between +  * two different kinds of OR: +  * * Complex types, eg +  * function(int:int)|function(float:float) +  * or +  * mapping(string:int)|mapping(int:string) +  * where a value can have both types at the +  * same time. +  * * Alternate types, eg +  * int|string +  * where a value only can have one of the +  * types at a time. +  * In strict mode the former should be split here, +  * and the latter kept. +  * In non-strict mode both should be split here. +  * Suggestion: +  * Introduce a new operator (UNION?) for the former case. +  */ +  +  loop: +  clear_markers(); +  /* First split the argument type into basic types. */ +  switch(arg_type->type) { +  case T_ASSIGN: +  case PIKE_T_NAME: +  arg_type = arg_type->cdr; +  goto loop; +  +  /* FIXME: PIKE_T_ATTRIBUTE's ought to propagate out to the basic types. +  */ +  +  case T_OR: +  if (!(tmp = low_new_check_call(fun_type, arg_type->car, +  flags | CALL_WEAK_VOID, sval))) { +  if (flags & CALL_STRICT) { +  return NULL; +  } +  arg_type = arg_type->cdr; +  goto loop; +  } +  if (!(tmp2 = low_new_check_call(fun_type, arg_type->cdr, +  flags | CALL_WEAK_VOID, sval))) { +  if (flags & CALL_STRICT) { +  free_type(tmp); +  return NULL; +  } +  return tmp; +  } +  res = or_pike_types(tmp, tmp2, 1); +  free_type(tmp); +  free_type(tmp2); +  return res; +  +  case T_AND: +  if (!(tmp = low_new_check_call(fun_type, arg_type->car, +  flags & ~CALL_WEAK_VOID, sval))) { +  return NULL; +  } +  if (!(tmp2 = low_new_check_call(fun_type, arg_type->cdr, +  flags & ~CALL_WEAK_VOID, sval))) { +  free_type(tmp); +  return NULL; +  } +  res = and_pike_types(tmp, tmp2); +  free_type(tmp); +  free_type(tmp2); +  return res; +  +  case T_VOID: +  if (!(flags & CALL_7_6)) { +  if ((flags & (CALL_WEAK_VOID|CALL_STRICT)) == CALL_STRICT) { +  return NULL; +  } +  /* Promote void arguments to zero. */ +  arg_type = zero_type_string; +  } +  break; +  } +  +  if (!(tmp = lower_new_check_call(fun_type, arg_type, +  flags & ~CALL_WEAK_VOID, sval + #ifdef PIKE_TYPE_DEBUG +  , 0 + #endif +  ))) { +  return NULL; +  } +  return tmp; + } +  + /* Return the return type for the function type fun_type, if +  * no further arguments are passed. +  * +  * Returns NULL if more arguments are required. +  * +  * Returns a the type of the return value otherwise. +  */ + struct pike_type *new_get_return_type(struct pike_type *fun_type, +  INT32 flags) + { +  struct compilation *c = MAYBE_THIS_COMPILATION; +  struct pike_type *res = NULL; +  struct pike_type *tmp; +  struct pike_type *tmp2; +  INT32 array_cnt = 0; +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, " Getting return type for "); +  simple_describe_type(fun_type); +  fprintf(stderr, "... "); +  } + #endif /* PIKE_DEBUG */ +  +  loop: +  /* Count the number of array levels. */ +  while(fun_type->type == PIKE_T_ARRAY) { +  array_cnt++; +  fun_type = fun_type->car; +  } +  +  switch(fun_type->type) { +  case PIKE_T_SCOPE: +  case T_ASSIGN: +  case PIKE_T_NAME: +  fun_type = fun_type->cdr; +  goto loop; +  +  case PIKE_T_ATTRIBUTE: +  tmp = new_get_return_type(fun_type->cdr, flags); +  if (!tmp) break; +  if (c) { +  ref_push_string((struct pike_string *)fun_type->car); +  ref_push_type_value(fun_type->cdr); +  safe_apply_current2(PC_APPLY_TYPE_ATTRIBUTE_FUN_NUM, 2, +  "apply_type_attribute"); +  if ((TYPEOF(Pike_sp[-1]) == T_INT) && +  (SUBTYPEOF(Pike_sp[-1]) == NUMBER_NUMBER) && +  (!Pike_sp[-1].u.integer)) { +  free_type(tmp); +  pop_stack(); +  break; +  } +  pop_stack(); +  } +  type_stack_mark(); +  push_finished_type(tmp); +  push_type_attribute((struct pike_string *)fun_type->car); +  res = pop_unfinished_type(); +  free_type(tmp); +  break; +  +  case PIKE_T_RING: +  fun_type = fun_type->car; +  goto loop; +  +  case T_OR: +  if (!(res = new_get_return_type(fun_type->car, flags))) { +  fun_type = fun_type->cdr; +  goto loop; +  } +  if (!(tmp = new_get_return_type(fun_type->cdr, flags))) { +  break; +  } +  if ((res == void_type_string) || (tmp == void_type_string)) { +  /* Note: Promote void to zero in the return value +  * when there's another non-void result. +  */ +  if (tmp == void_type_string) { +  /* Keep res as is. */ +  free_type(tmp); +  } else { +  free_type(res); +  res = tmp; +  } +  break; +  } +  res = or_pike_types(tmp2 = res, tmp, 1); +  free_type(tmp2); +  free_type(tmp); +  break; +  case T_AND: +  if (!(res = new_get_return_type(fun_type->car, flags))) { +  break; +  } +  if (!(tmp = new_get_return_type(fun_type->cdr, flags))) { +  free_type(res); +  res = NULL; +  break; +  } +  res = and_pike_types(tmp2 = res, tmp); +  free_type(tmp); +  free_type(tmp2); +  break; +  case T_NOT: +  if (!(res = new_get_return_type(fun_type->car, flags))) { +  copy_pike_type(res, mixed_type_string); +  } else if (res->type == T_INT) { +  tmp = res; +  copy_pike_type(res, tmp->car); +  free_type(tmp); +  } else { +  type_stack_mark(); +  push_finished_type(res); +  push_type(T_NOT); +  free_type(res); +  res = pop_unfinished_type(); +  } +  break; +  case PIKE_T_TYPE: +  /* Casting requires an argument... */ +  res = NULL; +  break; +  case PIKE_T_PROGRAM: +  tmp = low_object_lfun_type(fun_type->car, LFUN_CREATE); +  if (!tmp) { +  /* No create(). */ +  add_ref(fun_type->car); +  res = fun_type->car; +  break; +  } else { +  fun_type = zzap_function_return(tmp, fun_type->car); +  } +  res = new_get_return_type(fun_type, flags); +  free_type(fun_type); +  break; +  case PIKE_T_OBJECT: +  fun_type = low_object_lfun_type(fun_type, LFUN_CALL); +  if (fun_type) goto loop; +  /* FIXME: Multiple cases: +  * Untyped object. +  * Failed to lookup program id. +  * Program does not have the lfun `()(). +  */ +  +  /* FALL_THROUGH */ +  case PIKE_T_MIXED: +  copy_pike_type(res, mixed_type_string); +  break; +  +  case PIKE_T_FUNCTION: +  do { +  if (!match_types(fun_type->car, void_type_string)) { +  /* Too few arguments. */ +  break; +  } +  fun_type = fun_type->cdr; +  } while(fun_type->type == PIKE_T_FUNCTION); +  if (fun_type->type != T_MANY) { +  /* Still too few arguments. */ +  break; +  } +  case T_MANY: +  copy_pike_type(res, fun_type->cdr); +  break; +  +  default: +  /* Not a callable. */ +  break; +  } +  +  if (!res) { + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "Failed.\n"); +  } + #endif /* PIKE_DEBUG */ +  return NULL; +  } +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "Ok, cleaning up markers... "); +  } + #endif /* PIKE_DEBUG */ +  +  type_stack_mark(); +  +  /* Get rid of any remaining markers. */ +  clear_markers(); +  push_finished_type_with_markers(res, a_markers, 0); +  +  free_type(res); +  +  while(array_cnt--) { +  push_type(PIKE_T_ARRAY); +  } +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "Done.\n"); +  } + #endif /* PIKE_DEBUG */ +     return pop_unfinished_type(); -  + }    -  + /* Adjust the argument type. +  * +  * Get rid of void and setvar. +  */ + static struct pike_type *low_get_first_arg_type(struct pike_type *arg_type, +  INT32 flags) + { +  struct pike_type *tmp; +  struct pike_type *tmp2; +  struct pike_type *res; +  +  if (!arg_type) return NULL; +  +  loop: +  if (!(flags & FILTER_KEEP_VOID) || +  (arg_type->flags & (PT_FLAG_MARKER|PT_FLAG_ASSIGN))) { +  /* There's markers, assigns or void's to to take care of. */ +  switch(arg_type->type) { +  case T_OR: +  if ((tmp = low_get_first_arg_type(arg_type->cdr, flags))) { +  res = +  or_pike_types(tmp, +  tmp2 = low_get_first_arg_type(arg_type->car, flags), +  1); +  if (tmp2) free_type(tmp2); +  free_type(tmp); +  return res; +  } +  arg_type = arg_type->car; +  goto loop; +  +  case T_ASSIGN: +  arg_type = arg_type->cdr; +  goto loop; +  +  case T_NOT: +  /* Recognize some common workarounds for the old function +  * call checker. +  */ +  if ((arg_type->car->type == T_OR) && +  ((arg_type->car->car->type == T_MIXED) || +  (arg_type->car->cdr->type == T_MIXED))) { +  /* Workaround used for some operators; typically +  * +  * function(mixed...:mixed) & !function(!(object|mixed):mixed) +  * +  * In this case we only want the object, and not the mixed. +  */ +  if (arg_type->car->car->type == T_MIXED) { +  tmp = low_get_first_arg_type(arg_type->car->cdr, +  flags|FILTER_KEEP_VOID); +  } else { +  tmp = low_get_first_arg_type(arg_type->car->car, +  flags|FILTER_KEEP_VOID); +  } +  type_stack_mark(); +  push_finished_type(tmp); +  free_type(tmp); +  push_type(arg_type->type); +  return pop_unfinished_type(); +  } +  /* FALL_THROUGH */ +     case T_ARRAY: -  return zzap_function_return(a+1,id); +  case T_MULTISET: +  /* Keep void! */ +  tmp = low_get_first_arg_type(arg_type->car, flags|FILTER_KEEP_VOID); +  type_stack_mark(); +  push_finished_type(tmp); +  free_type(tmp); +  push_type(arg_type->type); +  return pop_unfinished_type();    -  +  case T_MAPPING: +  case T_TUPLE: +  /* Keep void! */ +  type_stack_mark(); +  tmp = low_get_first_arg_type(arg_type->cdr, flags|FILTER_KEEP_VOID); +  push_finished_type(tmp); +  free_type(tmp); +  tmp = low_get_first_arg_type(arg_type->car, flags|FILTER_KEEP_VOID); +  push_finished_type(tmp); +  free_type(tmp); +  push_type(arg_type->type); +  return pop_unfinished_type(); +  +  case T_VOID: +  if (!(flags & FILTER_KEEP_VOID)) { +  return NULL; +  } +  /* FALL_THROUGH */ +  default: +  break; +  } +  } +  add_ref(arg_type); +  return arg_type; + } +  + /* Return the type of the first argument to a function of the type fun_type +  * +  * Returns NULL on failure. Eg not callable or no more args accepted. +  * +  * Returns the argument type on success. +  */ + struct pike_type *get_first_arg_type(struct pike_type *fun_type, +  INT32 flags) + { +  struct pike_type *res = NULL; +  struct pike_type *tmp; +  struct pike_type *tmp2; +  loop: +  /* Get rid of the array levels. */ +  while(fun_type->type == PIKE_T_ARRAY) { +  fun_type = fun_type->car; +  } +  + #ifdef PIKE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "get_first_arg_type("); +  simple_describe_type(fun_type); +  fprintf(stderr, ", 0x%04x)\n", flags); +  } + #endif +  +  switch(fun_type->type) { +  case PIKE_T_SCOPE: +  case T_ASSIGN: +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  case PIKE_T_RING: +  fun_type = fun_type->cdr; +  goto loop; +  +  case T_OR: +  if (!(res = get_first_arg_type(fun_type->car, flags))) { +  fun_type = fun_type->cdr; +  goto loop; +  } +  if (!(tmp = get_first_arg_type(fun_type->cdr, flags))) { +  break; +  } +  res = or_pike_types(tmp2 = res, tmp, 1); +  free_type(tmp); +  free_type(tmp2); +  break; +  case T_AND: +  if (!(res = get_first_arg_type(fun_type->car, flags))) { +  break; +  } +  if (!(tmp = get_first_arg_type(fun_type->cdr, flags))) { +  free_type(res); +  res = NULL; +  break; +  } +  /* NOTE: OR and not AND in some cases! +  * +  * !function(!string:mixed)&function(string|int:string) +  * ==> +  * string | string|int +  * +  * This is however not true in the case where neither is inverted: +  * +  * function(attribute(sprintf_args, mixed)...:string) & +  * function(object|string:string) +  * ==> +  * attribute(sprintf_args, mixed) & object|string +  */ +  if (!(flags & CALL_NOT_LAST_ARG) || +  ((fun_type->car->type == T_NOT) == (fun_type->cdr->type == T_NOT))) { +  res = and_pike_types(tmp2 = res, tmp); +  } else { +  res = or_pike_types(tmp2 = res, tmp, 1); +  } +  free_type(tmp); +  free_type(tmp2); +  break; +  case T_NOT: +  if (!(res = get_first_arg_type(fun_type->car, flags))) { +  break; +  } +  if (res->type == T_NOT) { +  copy_pike_type(tmp, res->car); +  free_type(res); +  res = tmp; +  } else { +  type_stack_mark(); +  push_finished_type(res); +  free_type(res); +  push_type(T_NOT); +  res = pop_unfinished_type(); +  } +  break; +  case PIKE_T_TYPE: +  /* FIXME: Limit to valid cast operations. */ +  copy_pike_type(res, mixed_type_string); +  break; +  case PIKE_T_PROGRAM: +  if ((fun_type = low_object_lfun_type(fun_type->car, LFUN_CREATE))) { +  /* No need to adjust the return type, since we're only +  * looking at the arguments. +  */ +  goto loop; +  } +  /* FIXME: Multiple cases: +  * Untyped object. function(mixed...:object) +  * Failed to lookup program id. function(mixed...:object) +  * Program does not have create(). function(:object) +  */ +  /* No create() ==> no arguments. */ +  copy_pike_type(res, mixed_type_string); +  break; +  case PIKE_T_OBJECT: +  fun_type = low_object_lfun_type(fun_type, LFUN_CALL); +  if (fun_type) { +  goto loop; +  } +  /* FIXME: Multiple cases: +  * Untyped object. +  * Failed to lookup program id. +  * Program does not have the lfun `()(). +  */ +  +  /* FALL_THROUGH */ +  case PIKE_T_MIXED: +  copy_pike_type(res, mixed_type_string); +  break; +  +  case PIKE_T_FUNCTION: +  if (!(flags & CALL_NOT_LAST_ARG) && +  (fun_type->cdr->type == PIKE_T_FUNCTION) && +  !low_match_types(fun_type->cdr->car, void_type_string, 0)) { +  /* Last argument and more arguments required. */ +  res = NULL; +  break; +  } +  /* FALL_THROUGH */ +  case T_MANY: +  if ((res = fun_type->car)->type == T_VOID) { +  res = NULL; +  break; +  } +  res = low_get_first_arg_type(res, 0); +  break; +  +  default: +  /* Not a callable. */ +  break; +  } +  + #ifdef PIKE_DEBUG +  if (l_flag > 2) { +  fprintf(stderr, "get_first_arg_type("); +  simple_describe_type(fun_type); +  fprintf(stderr, ", 0x%04x) ==> ", flags); +  simple_describe_type(res); +  fprintf(stderr, "\n"); +  } + #endif +  +  return res; + } +  + /* NOTE: fun_type loses a reference. */ + struct pike_type *check_splice_call(struct pike_string *fun_name, +  struct pike_type *fun_type, +  INT32 argno, +  struct pike_type *arg_type, +  struct svalue *sval, +  INT32 flags) + { +  struct compilation *c = THIS_COMPILATION; +  struct pike_type *tmp = NULL; +  struct pike_type *res = NULL; +  struct pike_type *prev = fun_type; +  int cnt = 256; +  /* This argument can expand to anything between zero and MAX_ARGS args. */ +  +  copy_pike_type(res, fun_type); +  +  /* Loop until we get a stable fun_type, or it's an invalid argument. */ +  while ((fun_type = low_new_check_call(debug_malloc_pass(prev), +  debug_malloc_pass(arg_type), +  flags|CALL_NOT_LAST_ARG, sval)) && +  (fun_type != prev) && --cnt) { +  + #ifdef PIKE_DEBUG +  if (l_flag>4) { +  fprintf(stderr, "\n sub_result_type: "); +  simple_describe_type(fun_type); +  } + #endif /* PIKE_DEBUG */ +  +  res = dmalloc_touch(struct pike_type *, +  or_pike_types(debug_malloc_pass(tmp = res), +  debug_malloc_pass(fun_type), 1)); + #ifdef PIKE_DEBUG +  if (l_flag>4) { +  fprintf(stderr, "\n joined_type: "); +  simple_describe_type(res); +  } + #endif /* PIKE_DEBUG */ +  +  if ((res == tmp) || (res == fun_type)) { +  free_type(tmp); +  break; +  } +  free_type(tmp); +  +  free_type(prev); +  prev = fun_type; +  } +  free_type(prev); +  if (fun_type) { +  /* Max args reached or stable type. */ +  free_type(fun_type); +  } else if (!(flags & CALL_INHIBIT_WARNINGS)) { +  /* The splice values are invalid for later arguments. */ +  if (cnt == 256) { +  yywarning("In argument %d to %S: The @-operator argument must be an empty array.", +  argno, fun_name); +  } else if (c->lex.pragmas & ID_STRICT_TYPES) { +  yywarning("In argument %d to %S: The @-operator argument has a max length of %d.", +  argno, fun_name, 256-cnt); +  } +  } +  +  return res; + } +  + /* NOTE: fun_type loses a reference. */ + static struct pike_type *new_check_call_arg(struct pike_string *fun_name, +  struct pike_type *fun_type, +  node *args, INT32 *argno, +  INT32 flags) + { +  struct compilation *c = THIS_COMPILATION; +  struct pike_type *tmp = NULL; +  struct pike_type *res = NULL; +  struct svalue *sval = NULL; +  +  CHECK_COMPILER(); +  +  debug_malloc_touch(fun_type); +  +  if (!args || !fun_type) { +  debug_malloc_touch(fun_type); +  return fun_type; +  } +  +  (*argno)++; +  +  if (args->token == F_CONSTANT) { +  sval = &args->u.sval; +  } +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, " Checking argument #%d... ", *argno); +  simple_describe_type(args->type); +  if (sval) { +  fprintf(stderr, "\n Constant of type %s", +  get_name_of_type(TYPEOF(*sval))); +  } +  fprintf(stderr, "\n fun_type: "); +  simple_describe_type(fun_type); +  } + #endif /* PIKE_DEBUG */ +  +  if (TEST_COMPAT(7, 6)) { +  /* Attempt to reduce strictness to Pike 7.6 levels. */ +  flags |= CALL_7_6; +  } +  +  if (args->token == F_PUSH_ARRAY) { + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "\n The argument is a splice operator.\n"); +  } + #endif /* PIKE_DEBUG */ +  +  res = check_splice_call(fun_name, fun_type, *argno, +  args->type, sval, flags); +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "\n result: "); +  simple_describe_type(res); +  fprintf(stderr, " OK.\n"); +  } + #endif /* PIKE_DEBUG */ +  +  return res; +  } else { + #ifdef PIKE_DEBUG +  if (l_flag>2) fputc ('\n', stderr); + #endif +  if ((res = low_new_check_call(fun_type, args->type, flags, sval))) { +  /* OK. */ + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, " OK.\n"); +  } + #endif /* PIKE_DEBUG */ +  if ((c->lex.pragmas & ID_STRICT_TYPES) && +  /* FIXME: Strict types not supported for lvalues yet. */ +  !(flags & CALL_ARG_LVALUE)){ +  if (!(tmp = low_new_check_call(fun_type, args->type, +  flags|CALL_STRICT, sval))) { +  tmp = get_first_arg_type(fun_type, flags); +  yytype_report(REPORT_WARNING, NULL, 0, tmp, +  NULL, 0, args->type, +  0, "Type mismatch in argument %d to %S.", +  *argno, fun_name); +  if (tmp) free_type(tmp); +  } else { +  free_type(tmp); +  } +  } +  free_type(fun_type); +  return res; +  } +  } +  +  if ((tmp = get_first_arg_type(fun_type, flags|CALL_NOT_LAST_ARG))) { +  struct pike_type *tmp2; +  + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, " Bad argument.\n"); +  } + #endif /* PIKE_DEBUG */ +  yytype_report(REPORT_ERROR, NULL, 0, tmp, NULL, 0, args->type, +  0, "Bad argument %d to %S.", *argno, fun_name); +  +  /* Try advancing with the suggested type, so that we can check +  * the rest of the arguments. +  */ +  if ((tmp2 = low_new_check_call(fun_type, tmp, flags, NULL))) { +  /* Succeeded. */ +  free_type(fun_type); +  free_type(tmp); + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, " Created continuation type: "); +  simple_describe_type(tmp2); +  fprintf(stderr, " OK.\n"); +  } + #endif /* PIKE_DEBUG */ +  return tmp2; +  } + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, "\n Failed to create continuation type.\n"); +  } + #endif /* PIKE_DEBUG */ +  free_type(tmp); +  } else { + #ifdef PIKE_DEBUG +  if (l_flag>2) { +  fprintf(stderr, " Too many arguments.\n"); +  } + #endif /* PIKE_DEBUG */ +  yytype_report(REPORT_ERROR, NULL, 0, NULL, +  NULL, 0, args->type, +  0, "Too many arguments to %S (expected %d arguments).", +  fun_name, *argno - 1); +  } +  free_type(fun_type); +  return NULL; + } +  + /* NOTE: fun_type loses a reference. */ + struct pike_type *new_check_call(struct pike_string *fun_name, +  struct pike_type *fun_type, +  node *args, INT32 *argno, INT32 flags) + { +  node *orig_arg_parent = NULL; +  INT32 orig_flags = flags; +  int num_cdr = 0; +  int num_lvalue = 0; +  +  if (!args || !fun_type) { +  debug_malloc_touch(fun_type); +  return fun_type; +  } +  +  orig_arg_parent = args->parent; +  args->parent = NULL; /* End marker. */ +  +  debug_malloc_touch(fun_type); +  +  while (args && fun_type) { +  if ((args->token == F_ARG_LIST) || (args->token == F_LVALUE_LIST)) { +  if (CDR(args)) { +  num_cdr++; +  flags |= CALL_NOT_LAST_ARG; +  } +  if (args->token == F_LVALUE_LIST) { +  num_lvalue++; +  flags |= CALL_ARG_LVALUE; +  } +  if (CAR(args)) { +  CAR(args)->parent = args; +  args = CAR(args); +  continue; +  } else if (CDR(args)) { +  CDR(args)->parent = args; +  args = CDR(args); +  if (!--num_cdr) { +  flags = orig_flags | (num_lvalue?CALL_ARG_LVALUE:0); +  } +  continue; +  } +  } else { +  fun_type = new_check_call_arg(fun_name, fun_type, args, argno, flags); +  debug_malloc_touch(fun_type); +  +  if (!fun_type) return NULL; +  } +  +  do { +  node *prev = args; +  if (args->token == F_LVALUE_LIST) { +  if (!--num_lvalue) { +  flags = orig_flags | (num_cdr?CALL_NOT_LAST_ARG:0); +  } +  } +  args = args->parent; +  if (!args) { +  prev->parent = orig_arg_parent; +  break; +  } +  if ((CAR(args) == prev) && CDR(args)) { +  if (!--num_cdr) { +  flags = orig_flags | (num_lvalue?CALL_ARG_LVALUE:0); +  } +  if (CDR(args) != prev) { +  CDR(args)->parent = args; +  args = CDR(args); +  break; +  } +  /* CAR(args) == CDR(args), so we need to recurse +  * since we can't differentiate otherwise. +  * +  * This should be a quite rare case, and the tree is +  * most likely very shallow, so this should be safe. +  */ +  fun_type = new_check_call(fun_name, fun_type, prev, argno, flags); +  debug_malloc_touch(fun_type); +  +  if (!fun_type) return NULL; +  } +  } while(args); +  } +  +  return fun_type; + } +  + struct pike_type *zzap_function_return(struct pike_type *a, +  struct pike_type *fun_ret) + { +  struct pike_type *ret = NULL; +  switch(a->type) +  { +  case T_SCOPE: +  ret = zzap_function_return(a->cdr, fun_ret); +  if (!ret) return NULL; +  type_stack_mark(); +  push_finished_type(ret); +  free_type(ret); +  push_scope_type(CAR_TO_INT(a)); +  return pop_unfinished_type(); +  +  case T_OR: +  { +  struct pike_type *ar, *br; +  ar = zzap_function_return(a->car, fun_ret); +  br = zzap_function_return(a->cdr, fun_ret); +  if(ar && br) ret = or_pike_types(ar, br, 0); +  if(ar) free_type(ar); +  if(br) free_type(br); +  return ret; +  } +  +  case T_FUNCTION: +  case T_MANY: +  { +  int nargs=0; +  type_stack_mark(); +  +  while(a->type == T_FUNCTION) +  { +  push_finished_type(a->car); +  nargs++; +  a = a->cdr; +  } +  push_finished_type(a->car); +  push_finished_type(fun_ret); +  push_reverse_type(T_MANY); +  while(nargs-- > 0) { +  push_reverse_type(T_FUNCTION); +  } +  return pop_unfinished_type(); +  } +  +  case T_ARRAY: +  return zzap_function_return(a->car, fun_ret); +  +  case PIKE_T_NAME: +  return zzap_function_return(a->cdr, fun_ret); +  +  case PIKE_T_ATTRIBUTE: +  { +  struct pike_type *res; +  if ((res = zzap_function_return(a->cdr, fun_ret))) { +  type_stack_mark(); +  push_finished_type(res); +  push_type_attribute((struct pike_string *)a->car); +  free_type(res); +  res = pop_unfinished_type(); +  } +  return res; +  } +     case T_MIXED:    /* I wonder when this occurrs, but apparently it does... */ -  return zzap_function_return(tFuncV(tVoid,tOr(tMix,tVoid),tObj), id); +  /* FIXME: */ +  type_stack_mark(); +  push_finished_type(fun_ret); +  push_type(T_VOID); +  push_type(T_MIXED); +  push_type(T_OR); +  push_type(T_MANY); +  return pop_unfinished_type();    }   /* This error is bogus /Hubbe -  fatal("zzap_function_return() called with unexpected value: %d\n", +  Pike_fatal("zzap_function_return() called with unexpected value: %d\n",    EXTRACT_UCHAR(a));   */    return NULL;   }    - struct pike_string *get_type_of_svalue(struct svalue *s) + struct pike_type *get_lax_type_of_svalue( const struct svalue *c )   { -  struct pike_string *ret; -  switch(s->type) +  struct pike_type *res; +  if (TYPEOF(*c) == T_INT)    { -  +  if (c->u.integer) +  copy_pike_type(res, int_type_string); +  else +  copy_pike_type(res, zero_type_string); +  } +  else if (TYPEOF(*c) == T_STRING ) +  copy_pike_type(res, string_type_string); +  else +  return get_type_of_svalue(c); +  +  return res; + } +  + struct pike_type *get_type_of_svalue(const struct svalue *s) + { +  struct pike_type *ret; +  switch(TYPEOF(*s)) +  {    case T_FUNCTION: -  if(s->subtype == FUNCTION_BUILTIN) +  if(SUBTYPEOF(*s) == FUNCTION_BUILTIN)    { -  ret=s->u.efun->type; +  copy_pike_type(ret, s->u.efun->type);    }else{    struct program *p;       p=s->u.object->prog;    if(!p)    { -  ret=zero_type_string; -  }else{ -  ret=ID_FROM_INT(p,s->subtype)->type; +  copy_pike_type(ret, zero_type_string); +  } else if (p == pike_trampoline_program) { +  struct pike_trampoline *t = +  (struct pike_trampoline *) s->u.object->storage; +  if ((p = t->frame->current_object->prog)) { +  copy_pike_type(ret, ID_FROM_INT(p, t->func)->type); +  } else { +  copy_pike_type(ret, zero_type_string);    } -  +  } else { +  copy_pike_type(ret, ID_FROM_INT(p,SUBTYPEOF(*s))->type);    } -  reference_shared_string(ret); +  }    return ret;    -  case T_MULTISET: +     case T_ARRAY:    { -  struct pike_string *arg_type; -  struct array *a; +  struct array *a = s->u.array;    -  if (s->type == T_MULTISET) { -  a = s->u.multiset->ind; -  } else { -  a = s->u.array; -  } +  type_stack_mark();   #if 0 -  +  { +  struct pike_type *arg_type;    int i;       /* FIXME: Circular structures? */ -  copy_shared_string(arg_type, zero_type_string); +  copy_pike_type(arg_type, zero_type_string);    for (i = 0; i < a->size; i++) { -  struct pike_string *tmp1 = get_type_of_svalue(a->item+i); -  struct pike_string *tmp2 = or_pike_types(arg_type, tmp1, 1); -  free_string(arg_type); -  free_string(tmp1); +  struct pike_type *tmp1 = get_type_of_svalue(a->item+i); +  struct pike_type *tmp2 = or_pike_types(arg_type, tmp1, 1); +  free_type(arg_type); +  free_type(tmp1);    arg_type = tmp2;    } -  +  push_finished_type(arg_type); +  free_type(arg_type); +  }   #else /* !0 */ -  if (a->size) -  copy_shared_string(arg_type, mixed_type_string); -  else -  copy_shared_string(arg_type, zero_type_string); +  if (a->size) { +  push_type_field(a->type_field); +  }else +  push_finished_type(zero_type_string);   #endif /* 0 */ -  type_stack_mark(); -  push_unfinished_type(arg_type->str); -  free_string(arg_type); -  push_type(s->type); +  push_type(T_ARRAY);    return pop_unfinished_type();    }    -  +  case T_MULTISET: +  type_stack_mark(); +  if (multiset_sizeof(s->u.multiset)) { +  push_type(T_MIXED); +  } +  else { +  push_type(T_ZERO); +  } +  push_type(T_MULTISET); +  return pop_unfinished_type();       case T_MAPPING:    type_stack_mark();    if (m_sizeof(s->u.mapping)) { -  push_type(T_MIXED); -  push_type(T_MIXED); +  push_type_field(s->u.mapping->data->val_types); +  push_type_field(s->u.mapping->data->ind_types);    }    else {    push_type(T_ZERO);    push_type(T_ZERO);    }    push_type(T_MAPPING);    return pop_unfinished_type();       case T_OBJECT:    type_stack_mark();    if(s->u.object->prog)    { - #ifdef AUTO_BIGNUM +     if(is_bignum_object(s->u.object))    { -  push_type_int(MAX_INT32); -  push_type_int(MIN_INT32); -  push_type(T_INT); +  push_int_type(MIN_INT32, MAX_INT32);    }    else - #endif +     { -  push_type_int(s->u.object->prog->id); -  push_type(1); -  push_type(T_OBJECT); +  push_object_type(1, s->u.object->prog->id);    }    }else{    /* Destructed object */    push_type(T_ZERO);    }    return pop_unfinished_type();       case T_INT: -  if(s->u.integer) -  { +  if(s->u.integer) {    type_stack_mark();    /* Fixme, check that the integer is in range of MIN_INT32 .. MAX_INT32!    */ -  push_type_int(s->u.integer); -  push_type_int(s->u.integer); -  push_type(T_INT); +  push_int_type(s->u.integer, s->u.integer);    return pop_unfinished_type();    }else{ -  ret=zero_type_string; -  } -  reference_shared_string(ret); +  copy_pike_type(ret, zero_type_string);    return ret; -  +  }       case T_PROGRAM:    { -  char *a; -  struct pike_string *tmp; +  /* FIXME: An alternative would be to push program(object(1,p->id)). */ +  struct pike_type *a; +  struct pike_type *ret_type;    int id;    -  +  type_stack_mark(); +  push_object_type(1, s->u.program->id); +  ret_type = pop_unfinished_type(); +     if(s->u.program->identifiers)    {    id=FIND_LFUN(s->u.program,LFUN_CREATE);    if(id>=0)    { -  a=ID_FROM_INT(s->u.program, id)->type->str; -  if((tmp=zzap_function_return(a, s->u.program->id))) -  return tmp; -  tmp=describe_type(ID_FROM_INT(s->u.program, id)->type); -  /* yywarning("Failed to zzap function return for type: %s.", tmp->str);*/ +  a = ID_FROM_INT(s->u.program, id)->type; +  if((a = zzap_function_return(a, ret_type))) { +  free_type(ret_type); +  return a; +  } + #if 0 +  { +  struct pike_string *tmp = +  describe_type(ID_FROM_INT(s->u.program, id)->type); +  yywarning("Failed to zzap function return for type: %s.", tmp->str);    free_string(tmp);    } -  + #endif /* 0 */ +  } +  if (!(s->u.program->flags & PROGRAM_PASS_1_DONE)) { +  /* We haven't added all identifiers in s->u.program yet, +  * so we might find a create() later. +  */ +  if((a = zzap_function_return(function_type_string, ret_type))) { +  free_type(ret_type); +  return a; +  } +  }    } else { -  a=function_type_string->str; -  if((tmp=zzap_function_return(a, s->u.program->id))) -  return tmp; +  if((a = zzap_function_return(function_type_string, ret_type))) { +  free_type(ret_type); +  return a;    } -  +  }    -  a=tFunc( tNone ,tObj); -  if((tmp=zzap_function_return(a, s->u.program->id))) -  return tmp; +  type_stack_mark(); +  push_finished_type(ret_type); +  push_type(T_VOID); +  push_type(T_MANY); +  free_type(ret_type); +  return pop_unfinished_type(); +  }    -  fatal("Completely failed to zzap function return!\n"); +  case T_TYPE: +  type_stack_mark(); +  push_finished_type(s->u.type); +  push_type(T_TYPE); +  return pop_unfinished_type(); +  +  case T_STRING: +  type_stack_mark(); +  if (s->u.string->len) { +  INT32 min, max; +  check_string_range( s->u.string, 0, &min, &max ); +  push_int_type(min, max); +  } else { +  push_type(T_ZERO);    } -  +  push_type(T_STRING); +  return pop_unfinished_type();       default:    type_stack_mark(); -  push_type(s->type); +  push_type(TYPEOF(*s));    return pop_unfinished_type();    }   }    - static struct pike_string *low_object_type_to_program_type(char *obj_t) +  + static struct pike_type *low_object_type_to_program_type(struct pike_type *obj_t)   { -  struct pike_string *res = NULL; -  struct pike_string *sub; +  struct pike_type *res = NULL; +  struct pike_type *sub;    struct svalue sval;    int id;    -  while(EXTRACT_UCHAR(obj_t) == T_OR) { -  obj_t++; -  sub = low_object_type_to_program_type(obj_t); +  while(obj_t->type == T_OR) { +  sub = low_object_type_to_program_type(obj_t->car);    if (!sub) {    if (res) { -  free_string(res); +  free_type(res);    }    return NULL;    }    if (res) { -  struct pike_string *tmp = or_pike_types(res, sub, 1); -  free_string(res); -  free_string(sub); +  struct pike_type *tmp = or_pike_types(res, sub, 1); +  free_type(res); +  free_type(sub);    res = tmp;    } else {    res = sub;    } -  obj_t += type_length(obj_t); +  obj_t = obj_t->cdr;    } -  sval.type = T_PROGRAM; -  if ((EXTRACT_UCHAR(obj_t) != T_OBJECT) || -  (!(id = extract_type_int(obj_t + 2))) || +  SET_SVAL_TYPE(sval, T_PROGRAM); +  if ((obj_t->type != T_OBJECT) || +  (!(id = CDR_TO_INT(obj_t))) ||    (!(sval.u.program = id_to_program(id))) ||    (!(sub = get_type_of_svalue(&sval)))) {    if (res) { -  free_string(res); +  free_type(res);    }    return NULL;    } -  /* FIXME: obj_t + 1 should propagate to the return-type in sub. */ +  /* FIXME: obj_t->car should propagate to the return-type in sub. */    if (res) { -  struct pike_string *tmp = or_pike_types(res, sub, 1); -  free_string(res); -  free_string(sub); +  struct pike_type *tmp = or_pike_types(res, sub, 1); +  free_type(res); +  free_type(sub);    return tmp;    }    return sub;   }      /* Used by fix_object_program_type() */ - struct pike_string *object_type_to_program_type(struct pike_string *obj_t) + struct pike_type *object_type_to_program_type(struct pike_type *obj_t)   { -  return low_object_type_to_program_type(obj_t->str); +  return low_object_type_to_program_type(obj_t);   }    - char *get_name_of_type(int t) - { -  switch(t) -  { -  case T_ARRAY: return "array"; -  case T_FLOAT: return "float"; -  case T_FUNCTION: return "function"; -  case T_INT: return "int"; -  case T_LVALUE: return "lvalue"; -  case T_MAPPING: return "mapping"; -  case T_MULTISET: return "multiset"; -  case T_OBJECT: return "object"; -  case T_PROGRAM: return "program"; -  case T_STRING: return "string"; -  case T_TYPE: return "type"; -  case T_ZERO: return "zero"; -  case T_VOID: return "void"; -  case T_MAPPING_DATA: return "mapping_data"; -  default: return "unknown"; -  } - } +     - void cleanup_pike_types(void) - { -  free_string(string_type_string); -  free_string(int_type_string); -  free_string(float_type_string); -  free_string(function_type_string); -  free_string(object_type_string); -  free_string(program_type_string); -  free_string(array_type_string); -  free_string(multiset_type_string); -  free_string(mapping_type_string); -  free_string(type_type_string); -  free_string(mixed_type_string); -  free_string(void_type_string); -  free_string(zero_type_string); -  free_string(any_type_string); -  free_string(weak_type_string); - } +     -  - int type_may_overload(char *type, int lfun) + int type_may_overload(struct pike_type *type, int lfun)   { -  switch(EXTRACT_UCHAR(type++)) +  switch(type->type)    {    case T_ASSIGN: -  return type_may_overload(type+1,lfun); +  return type_may_overload(type->cdr, lfun);       case T_FUNCTION: -  +  case T_MANY:    case T_ARRAY:    /* might want to check for `() */       default:    return 0;    -  +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  return type_may_overload(type->cdr, lfun); +  +  case PIKE_T_RING: +  return type_may_overload(type->car, lfun); +     case T_OR: -  return type_may_overload(type,lfun) || -  type_may_overload(type+type_length(type),lfun); +  return type_may_overload(type->car, lfun) || +  type_may_overload(type->cdr, lfun);       case T_AND: -  return type_may_overload(type,lfun) && -  type_may_overload(type+type_length(type),lfun); +  return type_may_overload(type->car, lfun) && +  type_may_overload(type->cdr, lfun);       case T_NOT: -  return !type_may_overload(type,lfun); +  return !type_may_overload(type->car, lfun);       case T_MIXED:    return 1;       case T_OBJECT:    { -  struct program *p=id_to_program(extract_type_int(type+1)); +  struct program *p = id_to_program(CDR_TO_INT(type));    if(!p) return 1;    return FIND_LFUN(p, lfun)!=-1;    }    }   }       - void yyexplain_nonmatching_types(struct pike_string *type_a, -  struct pike_string *type_b, -  int flags) + void yyexplain_nonmatching_types(int severity_level, +  struct pike_string *a_file, +  INT32 a_line, +  struct pike_type *type_a, +  struct pike_string *b_file, +  INT32 b_line, +  struct pike_type *type_b)   { -  +  DECLARE_CYCLIC(); +     implements_a=0;    implements_b=0; -  +  implements_mode=0;    -  match_types(type_a,type_b); +  /* Note the argument order. */ +  pike_types_le(type_b, type_a);      #if 0    if(!(implements_a && implements_b &&    type_a->str[0]==T_OBJECT &&    type_b->str[0]==T_OBJECT))   #endif /* 0 */    { -  struct pike_string *s1,*s2; -  s1=describe_type(type_a); -  s2=describe_type(type_b); -  if(flags & YYTE_IS_WARNING) +  ref_push_type_value(type_a); +  yytype_report(severity_level, NULL, 0, NULL, a_file, a_line, NULL, +  1, "Expected: %O."); +  ref_push_type_value(type_b); +  yytype_report(severity_level, NULL, 0, NULL, b_file, b_line, NULL, +  1, "Got : %O."); +  } +  +  /* Protect against circularities. */ +  if (BEGIN_CYCLIC(type_a, type_b)) { +  END_CYCLIC(); +  return; +  } +  SET_CYCLIC_RET(1); +  +  if(implements_a && implements_b) { +  if (implements_mode) { +  yyexplain_not_implements(severity_level, implements_a, implements_b); +  } else { +  yyexplain_not_compatible(severity_level, implements_a, implements_b); +  } +  } +  END_CYCLIC(); + } +  + /* FIXME: Code duplication! */ + void string_builder_explain_nonmatching_types(struct string_builder *s, +  struct pike_type *type_a, +  struct pike_type *type_b)   { -  yywarning("Expected: %s",s1->str); -  yywarning("Got : %s",s2->str); -  }else{ -  my_yyerror("Expected: %s",s1->str); -  my_yyerror("Got : %s",s2->str); +  DECLARE_CYCLIC(); +  +  implements_a=0; +  implements_b=0; +  implements_mode=0; +  +  /* Note the argument order. */ +  pike_types_le(type_b, type_a); +  + #if 0 +  if(!(implements_a && implements_b && +  type_a->str[0]==T_OBJECT && +  type_b->str[0]==T_OBJECT)) + #endif /* 0 */ +  { +  ref_push_type_value(type_a); +  ref_push_type_value(type_b); +  string_builder_sprintf(s, +  "Expected: %O.\n" +  "Got : %O.\n", +  Pike_sp-2, Pike_sp-1);    } -  free_string(s1); -  free_string(s2); +  +  /* Protect against circularities. */ +  if (BEGIN_CYCLIC(type_a, type_b)) { +  END_CYCLIC(); +  return;    } -  +  SET_CYCLIC_RET(1);    -  if(implements_a && implements_b) -  yyexplain_not_implements(implements_a,implements_b,flags); +  if(implements_a && implements_b) { +  if (implements_mode) { +  string_builder_explain_not_implements(s, implements_a, implements_b); +  } else { +  string_builder_explain_not_compatible(s, implements_a, implements_b);    } -  +  } +  END_CYCLIC(); + }    -  + /******/    - struct pike_string *make_pike_type(char *t) + static void low_make_pike_type(unsigned char *type_string, +  unsigned char **cont); +  + static void low_make_function_type(unsigned char *type_string, +  unsigned char **cont)   { -  return make_shared_binary_string(t, type_length(t)); +  if (*type_string == T_MANY) { +  low_make_pike_type(type_string+1, cont); +  low_make_pike_type(*cont, cont); +  push_reverse_type(T_MANY); +  return;    } -  +  low_make_pike_type(type_string, cont); +  low_make_function_type(*cont, cont); +  push_reverse_type(T_FUNCTION); + } +  + static void low_make_pike_type(unsigned char *type_string, +  unsigned char **cont) + { +  unsigned INT32 type = *type_string; +  +  if (type <= MAX_TYPE) { +  /* Remap from old type enumeration to +  * keep compat with output from __parse_pike_type(). +  */ +  type ^= MIN_REF_TYPE; +  } +  +  switch(type) { + #ifdef PIKE_DEBUG +  case T_SCOPE: +  Pike_fatal("Not supported yet.\n"); + #endif +  case T_ASSIGN: +  if ((type_string[1] < '0') || (type_string[1] > '9')) { +  Pike_fatal("low_make_pike_type(): Bad marker: %d\n", type_string[1]); +  } +  low_make_pike_type(type_string+2, cont); +  push_assign_type(type_string[1]); +  break; +  case T_OR: +  case T_AND: +  /* Order independant */ +  /* FALL_THROUGH */ +  +  case T_MANY: +  case T_TUPLE: +  case T_MAPPING: +  case PIKE_T_RING: +  /* Order dependant */ +  low_make_pike_type(type_string+1, cont); +  low_make_pike_type(*cont, cont); +  push_reverse_type(type); +  break; +  case T_FUNCTION: +  low_make_function_type(type_string+1, cont); +  break; +  case T_ARRAY: +  case T_MULTISET: +  case T_TYPE: +  case T_NOT: +  case T_PROGRAM: +  low_make_pike_type(type_string+1, cont); +  push_reverse_type(type); +  break; +  case '0': +  case '1': +  case '2': +  case '3': +  case '4': +  case '5': +  case '6': +  case '7': +  case '8': +  case '9': +  /* Marker type */ +  /* FALL_THROUGH */ +  case T_FLOAT: +  case T_MIXED: +  case T_VOID: +  case T_ZERO: +  case PIKE_T_UNKNOWN: +  /* Leaf type */ +  *cont = type_string+1; +  push_type(type); +  break; +  +  case T_STRING: +  *cont = type_string + 1; +  push_finished_type(int_type_string); +  push_type(T_STRING); +  break; +  +  case PIKE_T_NSTRING: +  low_make_pike_type(type_string + 1, cont); +  /* FIXME: Add check for valid subtype. */ +  push_type(T_STRING); +  break; +  +  case T_INT: +  { +  INT32 min = extract_type_int((char *)type_string+1); +  INT32 max = extract_type_int((char *)type_string+5); +  +  *cont = type_string + 9; /* 2*sizeof(INT32) + 1 */ +  push_int_type(min, max); +  break; +  } +  +  case PIKE_T_INT_UNTYPED: +  *cont = type_string + 1; +  push_int_type(MIN_INT32, MAX_INT32); +  break; +  +  case T_OBJECT: +  *cont = type_string + 6; /* 1 + sizeof(INT32) + 1 */ +  push_object_type(type_string[1], extract_type_int((char *)type_string+2)); +  break; +  +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  { +  int size_shift = type_string[1] & 0x3; +  struct pike_string *str; +  INT32 bytes; +  /* bit 0 & 1: size_shift +  * bit 2 ==> little endian. +  * +  * The loops check the lsb first, since it's most likely to +  * be non-zero. +  */ +  switch(type_string[1]) { +  default: /* will not happen? */ + #ifdef PIKE_DEBUG +  Pike_fatal("unexpected case in make_pike_type (%d)\n", +  type_string[1]); + #endif +  case 0: case 4: +  bytes = strlen((char *)type_string+2); +  break; +  case 1: +  for(bytes=0; ; bytes+=2) +  if(!type_string[bytes+3] && !type_string[bytes+2]) +  break; +  break; +  case 5: +  for(bytes=0; ; bytes+=2) +  if(!type_string[bytes+2] && !type_string[bytes+3]) +  break; +  break; +  case 2: +  for(bytes=0; ; bytes+=4) +  if(!type_string[bytes+5] && !type_string[bytes+4] && +  !type_string[bytes+3] && !type_string[bytes+2]) +  break; +  break; +  case 6: +  for(bytes=0; ; bytes+=4) +  if(!type_string[bytes+2] && !type_string[bytes+3] && +  !type_string[bytes+4] && !type_string[bytes+5]) +  break; +  break; +  } +  str = begin_wide_shared_string(bytes>>size_shift, size_shift); +  MEMCPY(str->str, type_string+2, bytes); +  if (size_shift && + #if (PIKE_BYTEORDER == 1234) +  /* Little endian */ +  !(type_string[1] & 0x04) + #else /* PIKE_BYTEORDER != 1234 */ +  /* Big endian */ +  (type_string[1] & 0x04) + #endif /* PIKE_BYTEORDER == 1234 */ +  ) { +  int len; +  char tmp; +  if (size_shift == 1) { +  for (len = 0; len < bytes; len += 2) { +  tmp = str->str[len]; +  str->str[len] = str->str[len+1]; +  str->str[len+1] = tmp; +  } +  } else { +  for (len = 0; len < bytes; len += 4) { +  tmp = str->str[len]; +  str->str[len] = str->str[len+3]; +  str->str[len+3] = tmp; +  tmp = str->str[len+1]; +  str->str[len+1] = str->str[len+2]; +  str->str[len+2] = tmp; +  } +  } +  } +  low_make_pike_type(type_string + 2 + bytes + (1<<size_shift), cont); +  if (type_string[0] == PIKE_T_NAME) { +  push_type_name(str = end_shared_string(str)); +  } else { +  push_type_attribute(str = end_shared_string(str)); +  } +  free_string(str); +  break; +  } + #ifdef PIKE_DEBUG +  default: +  Pike_fatal("compile_type_string(): Error in type string %d.\n", type); +  /* NOT_REACHED */ +  break; + #endif +  } + } +  + /* Make a pike-type from a serialized (old-style) type. */ + struct pike_type *debug_make_pike_type(const char *serialized_type) + { +  unsigned char *dummy; +  type_stack_mark(); +  low_make_pike_type((unsigned char *)serialized_type, &dummy); + #if 1 +  if ((Pike_compiler->type_stackp[0]->flags & +  (PT_FLAG_MARKER|PT_FLAG_ASSIGN)) || +  (((Pike_compiler->type_stackp[0]->type == T_OR) || +  (Pike_compiler->type_stackp[0]->type == T_AND)) && +  (Pike_compiler->type_stackp[0]->car->type == PIKE_T_FUNCTION))) { +  push_scope_type(0); +  } + #endif /* 1 */ +  return pop_unfinished_type(); + } +  + int pike_type_allow_premature_toss(struct pike_type *type) + { +  again: + #if 0 +  fprintf(stderr, "pike_type_allow_premature_toss(): Type: %d\n", +  type->type); + #endif /* 0 */ +  switch(type->type) +  { +  default: + #ifdef PIKE_DEBUG +  Pike_fatal("pike_type_allow_premature_toss: Unknown type (code: %d)\n", +  type->type); +  /* NOT_REACHED */ +  return 0; + #endif +  case T_NOT: +  return !pike_type_allow_premature_toss(type->car); +  +  case T_OBJECT: +  case T_MIXED: +  case T_FUNCTION: +  case T_MANY: +  return 0; +  +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  case T_SCOPE: +  case T_ASSIGN: +  type = type->cdr; +  goto again; +  +  case PIKE_T_RING: +  type = type->car; +  goto again; +  +  case T_OR: +  case T_MAPPING: +  if(!pike_type_allow_premature_toss(type->car)) return 0; +  type = type->cdr; +  goto again; +  +  case T_AND: +  /* FIXME: Should probably look at both branches. */ +  type = type->cdr; +  goto again; +  +  case T_ARRAY: +  case T_MULTISET: +  type = type->car; +  goto again; +  +  case T_PROGRAM: +  case T_TYPE: +  case T_INT: +  case T_FLOAT: +  case T_STRING: +  case PIKE_T_ZERO: +  case T_VOID: +  return 1; +  } + } +  + static void low_type_to_string(struct pike_type *t) + { +  recurse: +  switch(t->type) { +  case T_ARRAY: +  case T_MULTISET: +  case T_TYPE: +  case T_PROGRAM: +  my_putchar(t->type ^ MIN_REF_TYPE); +  t = t->car; +  goto recurse; +  +  case T_NOT: +  my_putchar(t->type); +  t = t->car; +  goto recurse; +  +  case T_MAPPING: +  my_putchar(t->type ^ MIN_REF_TYPE); +  low_type_to_string(t->car); +  t = t->cdr; +  goto recurse; +  +  case PIKE_T_RING: +  case T_TUPLE: +  case T_OR: +  case T_AND: +  my_putchar(t->type); +  low_type_to_string(t->car); +  t = t->cdr; +  goto recurse; +  +  case T_FLOAT: +  case T_ZERO: +  my_putchar(t->type ^ MIN_REF_TYPE); +  break; +  +  case '0': +  case '1': +  case '2': +  case '3': +  case '4': +  case '5': +  case '6': +  case '7': +  case '8': +  case '9': +  case T_VOID: +  case T_MIXED: +  my_putchar(t->type); +  break; +  +  case T_OBJECT: +  { +  INT32 i; +  my_putchar(T_OBJECT ^ MIN_REF_TYPE); +  i = (INT32)CAR_TO_INT(t); +  my_putchar( i ); +  i = (INT32)CDR_TO_INT(t); +  +  if( i > 65535 ) i = 0; /* Not constant between recompilations */ +  +  my_putchar((i >> 24) & 0xff); +  my_putchar((i >> 16) & 0xff); +  my_putchar((i >> 8) & 0xff); +  my_putchar(i & 0xff); +  } +  break; +  +  case T_STRING: +  { +  if (t->car == int_type_string) { +  my_putchar(T_STRING ^ MIN_REF_TYPE); +  } else { +  my_putchar(PIKE_T_NSTRING); +  low_type_to_string(t->car); +  } +  } +  break; +  +  case T_INT: +  { +  INT32 i; +  my_putchar(T_INT ^ MIN_REF_TYPE); +  i = (INT32)CAR_TO_INT(t); +  my_putchar((i >> 24) & 0xff); +  my_putchar((i >> 16) & 0xff); +  my_putchar((i >> 8) & 0xff); +  my_putchar(i & 0xff); +  i = (INT32)CDR_TO_INT(t); +  my_putchar((i >> 24) & 0xff); +  my_putchar((i >> 16) & 0xff); +  my_putchar((i >> 8) & 0xff); +  my_putchar(i & 0xff); +  } +  break; +  +  case T_FUNCTION: +  case T_MANY: +  my_putchar(T_FUNCTION ^ MIN_REF_TYPE); +  while(t->type == T_FUNCTION) { +  low_type_to_string(t->car); +  t = t->cdr; +  } +  my_putchar(T_MANY); +  low_type_to_string(t->car); +  t = t->cdr; +  goto recurse; +  +  case T_SCOPE: +  case T_ASSIGN: +  my_putchar(t->type); +  my_putchar('0' + CAR_TO_INT(t)); +  t = t->cdr; +  goto recurse; +  +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  my_putchar(t->type); +  my_putchar(0); +  my_strcat(((struct pike_string *)t->car)->str); +  my_putchar(0); +  t = t->cdr; +  goto recurse; +  +  default: +  Pike_error("low_type_to_string(): Unsupported node: %d\n", t->type); +  break; +  } + } +  + struct pike_string *type_to_string(struct pike_type *t) + { +  ONERROR err; +  dynamic_buffer save_buf; +  init_buf(&save_buf); +  SET_ONERROR(err, abandon_buf, &save_buf); +  low_type_to_string(t); +  UNSET_ONERROR(err); +  return free_buf(&save_buf); + } +  + #ifdef PIKE_DEBUG + static void gc_mark_external_types(struct callback *cb, void *a, void *b); + static struct callback *pike_type_gc_callback = NULL; + #endif /* PIKE_DEBUG */ +  + void init_types(void) + { +  /* Initialize hashtable here. */ +  pike_type_hash = (struct pike_type **)xalloc(sizeof(struct pike_type *) * +  (PIKE_TYPE_HASH_SIZE+1)); +  MEMSET(pike_type_hash, 0, sizeof(struct pike_type *) * (PIKE_TYPE_HASH_SIZE+1)); +  pike_type_hash_size = PIKE_TYPE_HASH_SIZE; +  +  int_type_string = CONSTTYPE(tInt); /* MUST come before string! */ +  string0_type_string = CONSTTYPE(tStr0); +  string_type_string = CONSTTYPE(tStr32); +  object_type_string = CONSTTYPE(tObj); +  program_type_string = CONSTTYPE(tPrg(tObj)); +  float_type_string = CONSTTYPE(tFloat); +  mixed_type_string = CONSTTYPE(tMix); +  array_type_string = CONSTTYPE(tArray); +  multiset_type_string = CONSTTYPE(tMultiset); +  mapping_type_string = CONSTTYPE(tMapping); +  function_type_string = CONSTTYPE(tFunction); +  type_type_string = CONSTTYPE(tType(tMix)); +  void_type_string = CONSTTYPE(tVoid); +  zero_type_string = CONSTTYPE(tZero); +  any_type_string = CONSTTYPE(tOr(tVoid,tMix)); +  weak_type_string = CONSTTYPE(tOr4(tArray,tMultiset,tMapping, +  tFuncV(tNone,tZero,tOr(tMix,tVoid)))); +  sscanf_type_string = CONSTTYPE(tFuncV(tStr tAttr("sscanf_format", tStr), +  tAttr("sscanf_args", tMix), tIntPos)); +  sscanf_76_type_string = CONSTTYPE(tFuncV(tStr tAttr("sscanf_76_format", tStr), +  tAttr("sscanf_args", tMix), tIntPos)); +  /* add_ref(weak_type_string); *//* LEAK */ +  + #ifdef PIKE_DEBUG +  pike_type_gc_callback = add_gc_callback(gc_mark_external_types, NULL, NULL); + #endif + } +  + void cleanup_pike_types(void) + { + #ifdef DO_PIKE_CLEANUP +  while (all_pike_type_locations) { +  free_type(all_pike_type_locations->t); +  all_pike_type_locations = all_pike_type_locations->next; +  } + #endif /* DO_PIKE_CLEANUP */ +  +  clear_markers(); +  +  free_type(string0_type_string); +  string0_type_string = NULL; +  free_type(string_type_string); +  string_type_string = NULL; +  free_type(int_type_string); +  int_type_string = NULL; +  free_type(float_type_string); +  float_type_string = NULL; +  free_type(function_type_string); +  function_type_string = NULL; +  free_type(object_type_string); +  object_type_string = NULL; +  free_type(program_type_string); +  program_type_string = NULL; +  free_type(array_type_string); +  array_type_string = NULL; +  free_type(multiset_type_string); +  multiset_type_string = NULL; +  free_type(mapping_type_string); +  mapping_type_string = NULL; +  free_type(type_type_string); +  type_type_string = NULL; +  free_type(mixed_type_string); +  mixed_type_string = NULL; +  free_type(void_type_string); +  void_type_string = NULL; +  free_type(zero_type_string); +  zero_type_string = NULL; +  free_type(any_type_string); +  any_type_string = NULL; +  free_type(weak_type_string); +  weak_type_string = NULL; +  free_type(sscanf_type_string); +  sscanf_type_string = NULL; +  free_type(sscanf_76_type_string); +  sscanf_76_type_string = NULL; + #ifdef PIKE_DEBUG +  remove_callback(pike_type_gc_callback); + #endif + } +  + void cleanup_pike_type_table(void) + { +  /* Free the hashtable here. */ +  if (pike_type_hash) { +  free(pike_type_hash); +  /* Don't do this, it messes up stuff... +  * +  * It's needed for dmalloc to survive. +  */ +  pike_type_hash = NULL; +  } +  /* Don't do this, it messes up stuff... +  * +  * It's needed for dmalloc to survive. +  */ +  pike_type_hash_size = 0; +  + #ifdef DO_PIKE_CLEANUP +  ba_destroy(&type_allocator); + #endif /* DO_PIKE_CLEANUP */ + } +  + PMOD_EXPORT void *find_type(struct pike_type *t, +  void *(*cb)(struct pike_type *)) + { +  void *res; +  if (!t) return NULL; +  +  res = cb(t); +  if (res) return res; +  +  switch(t->type) { +  case T_FUNCTION: +  case T_MANY: +  case T_TUPLE: +  case T_MAPPING: +  case T_OR: +  case T_AND: +  case PIKE_T_RING: +  res = find_type(t->car, cb); +  if (res) return res; +  /* FALL_THROUGH */ +  case T_SCOPE: +  case T_ASSIGN: +  case PIKE_T_ATTRIBUTE: +  case PIKE_T_NAME: +  return find_type(t->cdr, cb); +  +  case T_ARRAY: +  case T_MULTISET: +  case T_NOT: +  case T_TYPE: +  case T_PROGRAM: +  case T_STRING: +  return find_type(t->car, cb); +  + #ifdef PIKE_DEBUG +  case '0': +  case '1': +  case '2': +  case '3': +  case '4': +  case '5': +  case '6': +  case '7': +  case '8': +  case '9': +  case T_FLOAT: +  case T_MIXED: +  case T_VOID: +  case T_ZERO: +  case PIKE_T_UNKNOWN: +  case T_INT: +  case T_OBJECT: +  break; +  default: +  Pike_fatal("find_type: Unhandled type-node: %d\n", t->type); +  break; + #endif /* PIKE_DEBUG */ +  } +  return NULL; + } +  + PMOD_EXPORT void visit_type (struct pike_type *t, int action) + { +  switch (action) { + #ifdef PIKE_DEBUG +  default: +  Pike_fatal ("Unknown visit action %d.\n", action); +  case VISIT_NORMAL: +  break; + #endif +  case VISIT_COMPLEX_ONLY: +  return; +  case VISIT_COUNT_BYTES: +  mc_counted_bytes += sizeof (struct pike_type); +  break; +  } +  +  switch (t->type) { +  case T_FUNCTION: +  case T_MANY: +  case T_TUPLE: +  case T_MAPPING: +  case T_OR: +  case T_AND: +  case PIKE_T_RING: +  visit_type_ref (t->car, REF_TYPE_INTERNAL); +  /* FALL_THROUGH */ +  case T_SCOPE: +  case T_ASSIGN: +  visit_type_ref (t->cdr, REF_TYPE_INTERNAL); +  break; +  case T_ARRAY: +  case T_MULTISET: +  case T_NOT: +  case T_TYPE: +  case T_PROGRAM: +  case T_STRING: +  visit_type_ref (t->car, REF_TYPE_INTERNAL); +  break; +  case PIKE_T_ATTRIBUTE: +  case PIKE_T_NAME: +  visit_string_ref ((struct pike_string *) t->car, REF_TYPE_INTERNAL); +  visit_type_ref (t->cdr, REF_TYPE_INTERNAL); +  break; + #ifdef PIKE_DEBUG +  case '0': +  case '1': +  case '2': +  case '3': +  case '4': +  case '5': +  case '6': +  case '7': +  case '8': +  case '9': +  case T_FLOAT: +  case T_MIXED: +  case T_VOID: +  case T_ZERO: +  case PIKE_T_UNKNOWN: +  case T_INT: +  case T_OBJECT: +  break; +  default: +  Pike_fatal("visit_type: Unhandled type-node: %d\n", t->type); +  break; + #endif /* PIKE_DEBUG */ +  } + } +  + #if defined (PIKE_DEBUG) || defined (DO_PIKE_CLEANUP) +  + /* This is only enough gc stuff to detect leaking pike_type structs +  * and to locate references to them. More is needed if types are +  * extended to contain pointers to other memory objects or if they +  * might contain cycles. */ +  + void gc_mark_type_as_referenced(struct pike_type *t) + { +  if (gc_mark(t, PIKE_T_TYPE)) { +  GC_ENTER(t, PIKE_T_TYPE) { +  switch(t->type) { +  case PIKE_T_SCOPE: +  case T_ASSIGN: +  case PIKE_T_NAME: +  case PIKE_T_ATTRIBUTE: +  if (t->cdr) gc_mark_type_as_referenced(t->cdr); +  break; +  case PIKE_T_FUNCTION: +  case T_MANY: +  case PIKE_T_RING: +  case PIKE_T_TUPLE: +  case PIKE_T_MAPPING: +  case T_OR: +  case T_AND: +  if (t->cdr) gc_mark_type_as_referenced(t->cdr); +  /* FALL_THOUGH */ +  case PIKE_T_ARRAY: +  case PIKE_T_MULTISET: +  case T_NOT: +  case PIKE_T_TYPE: +  case PIKE_T_PROGRAM: +  if (t->car) gc_mark_type_as_referenced(t->car); +  break; +  } +  } GC_LEAVE; +  } + } +  + #ifdef PIKE_DEBUG + static void gc_mark_external_types(struct callback *cb, void *a, void *b) + { +  unsigned int e; +  for (e = 0; e < NELEM (a_markers); e++) { +  if (a_markers[e]) +  gc_mark_external (a_markers[e], " in a_markers"); +  if (b_markers[e]) +  gc_mark_external (b_markers[e], " in b_markers"); +  } +  +  if (string0_type_string) +  gc_mark_external(string0_type_string, " as string0_type_string"); +  if (string_type_string) +  gc_mark_external(string_type_string, " as string_type_string"); +  if (int_type_string) +  gc_mark_external(int_type_string, " as int_type_string"); +  if (object_type_string) +  gc_mark_external(object_type_string, " as object_type_string"); +  if (program_type_string) +  gc_mark_external(program_type_string, " as program_type_string"); +  if (float_type_string) +  gc_mark_external(float_type_string, " as float_type_string"); +  if (mixed_type_string) +  gc_mark_external(mixed_type_string, " as mixed_type_string"); +  if (array_type_string) +  gc_mark_external(array_type_string, " as array_type_string"); +  if (multiset_type_string) +  gc_mark_external(multiset_type_string, " as multiset_type_string"); +  if (mapping_type_string) +  gc_mark_external(mapping_type_string, " as mapping_type_string"); +  if (function_type_string) +  gc_mark_external(function_type_string, " as function_type_string"); +  if (type_type_string) +  gc_mark_external(type_type_string, " as type_type_string"); +  if (void_type_string) +  gc_mark_external(void_type_string, " as void_type_string"); +  if (zero_type_string) +  gc_mark_external(zero_type_string, " as zero_type_string"); +  if (any_type_string) +  gc_mark_external(any_type_string, " as any_type_string"); +  if (weak_type_string) +  gc_mark_external(weak_type_string, " as weak_type_string"); +  + #ifdef DO_PIKE_CLEANUP +  { +  struct pike_type_location *t = all_pike_type_locations; +  while(t) { +  gc_mark_external (t->t, " as constant type"); +  t = t->next; +  } +  } + #endif + } + #endif +  + void gc_check_type (struct pike_type *t) + { +  debug_malloc_touch (t); +  +  GC_ENTER (t, T_TYPE) { +  switch (t->type) { +  case T_FUNCTION: +  case T_MANY: +  case T_TUPLE: +  case T_MAPPING: +  case T_OR: +  case T_AND: +  case PIKE_T_RING: +  case PIKE_T_ATTRIBUTE: +  case PIKE_T_NAME: +  debug_gc_check (t->car, " as car in a type"); +  debug_gc_check (t->cdr, " as cdr in a type"); +  break; +  case T_ARRAY: +  case T_MULTISET: +  case T_NOT: +  case T_TYPE: +  case T_PROGRAM: +  case T_STRING: +  debug_gc_check (t->car, " as car in a type"); +  break; +  case T_SCOPE: +  case T_ASSIGN: +  debug_gc_check (t->cdr, " as cdr in a type"); +  break; + #ifdef PIKE_DEBUG +  case '0': +  case '1': +  case '2': +  case '3': +  case '4': +  case '5': +  case '6': +  case '7': +  case '8': +  case '9': +  case T_FLOAT: +  case T_MIXED: +  case T_VOID: +  case T_ZERO: +  case PIKE_T_UNKNOWN: +  case T_INT: +  case T_OBJECT: +  break; +  default: +  Pike_fatal("gc_check_type: " +  "Unhandled type-node: %d\n", t->type); +  break; + #endif /* PIKE_DEBUG */ +  } +  } GC_LEAVE; + } +  + void gc_check_all_types (void) + { +  unsigned INT32 e; +  for(e=0;e<pike_type_hash_size;e++) +  { +  struct pike_type *t; +  for(t = pike_type_hash[e]; t; t=t->next) gc_check_type (t); +  } + } +  + #endif /* PIKE_DEBUG || DO_PIKE_CLEANUP */