home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / lookup.h < prev    next >
C/C++ Source or Header  |  2000-12-05  |  9KB  |  318 lines
  1. /* -*-C-*-
  2.  
  3. $Id: lookup.h,v 9.52 2000/12/05 21:23:45 cph Exp $
  4.  
  5. Copyright (c) 1988-2000 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* Macros and declarations for the variable lookup code. */
  23.  
  24. extern SCHEME_OBJECT
  25.   * EXFUN (deep_lookup, (SCHEME_OBJECT, SCHEME_OBJECT, SCHEME_OBJECT *)),
  26.   * EXFUN (lookup_fluid, (SCHEME_OBJECT)),
  27.   * EXFUN (force_definition, (SCHEME_OBJECT, SCHEME_OBJECT, long *));
  28.  
  29. extern long
  30.   EXFUN (deep_lookup_end, (SCHEME_OBJECT *, SCHEME_OBJECT *)),
  31.   EXFUN (deep_assignment_end,
  32.      (SCHEME_OBJECT *, SCHEME_OBJECT *, SCHEME_OBJECT, Boolean));
  33.  
  34. extern long EXFUN (recache_uuo_links, (SCHEME_OBJECT, SCHEME_OBJECT));
  35.  
  36. extern SCHEME_OBJECT
  37.   unbound_trap_object[],
  38.   uncompiled_trap_object[],
  39.   illegal_trap_object[],
  40.   fake_variable_object[];
  41.  
  42. #define GC_allocate_test(N)        GC_Check(N)
  43.  
  44. #define AUX_LIST_TYPE            TC_VECTOR
  45.  
  46. #define AUX_CHUNK_SIZE            20
  47. #define AUX_LIST_COUNT            ENV_EXTENSION_COUNT
  48. #define AUX_LIST_FIRST            ENV_EXTENSION_MIN_SIZE
  49. #define AUX_LIST_INITIAL_SIZE        (AUX_LIST_FIRST + AUX_CHUNK_SIZE)
  50.  
  51. /* Variable compilation types. */
  52.  
  53. #define LOCAL_REF            TC_NULL
  54. #define GLOBAL_REF            TC_UNINTERNED_SYMBOL
  55. #define FORMAL_REF            TC_CHARACTER
  56. #define AUX_REF                TC_FIXNUM
  57. #define UNCOMPILED_REF            TC_CONSTANT
  58.  
  59. /* Common constants. */
  60.  
  61. #if (SIZEOF_UNSIGNED_LONG == 4)    /* 32 bit objects */
  62. #  if (TYPE_CODE_LENGTH == 8)
  63. #    define UNCOMPILED_VARIABLE        0x08000000
  64. #  endif
  65. #  if (TYPE_CODE_LENGTH == 6)
  66. #    define UNCOMPILED_VARIABLE        0x20000000
  67. #  endif
  68. #  if (TC_CONSTANT != 0x08)
  69. #    include "error:lookup.h and types.h are inconsistent"
  70. #  endif
  71. #endif
  72.  
  73. #ifndef UNCOMPILED_VARIABLE        /* Safe version */
  74. #define UNCOMPILED_VARIABLE        MAKE_OBJECT (UNCOMPILED_REF, 0)
  75. #endif
  76.  
  77. /* Macros for speedy variable reference. */
  78.  
  79. #if (LOCAL_REF == 0)
  80.  
  81. #define Lexical_Offset(Ind)        ((long) (Ind))
  82. #define Make_Local_Offset(Ind)        ((SCHEME_OBJECT) (Ind))
  83.  
  84. #else
  85.  
  86. #define Lexical_Offset(Ind)        OBJECT_DATUM (Ind)
  87. #define Make_Local_Offset(Ind)        MAKE_OBJECT (LOCAL_REF, Ind)
  88.  
  89. #endif
  90.  
  91. /* The code below depends on the following. */
  92.  
  93. /* Done as follows because of VMS. */
  94.  
  95. #define lookup_inconsistency_p                        \
  96.   ((VARIABLE_OFFSET == VARIABLE_COMPILED_TYPE) ||            \
  97.    (VARIABLE_FRAME_NO != VARIABLE_COMPILED_TYPE))
  98.  
  99. #if (lookup_inconsistency_p)
  100. #include "error: lookup.h inconsistency detected."
  101. #endif
  102.  
  103. #define get_offset(hunk) Lexical_Offset(MEMORY_FETCH (hunk[VARIABLE_OFFSET]))
  104.  
  105. #ifdef PARALLEL_PROCESSOR
  106.  
  107. #define verify(type_code, variable, code, label)            \
  108. {                                    \
  109.   variable = code;                            \
  110.   if (OBJECT_TYPE (MEMORY_FETCH (hunk[VARIABLE_COMPILED_TYPE])) !=    \
  111.       type_code)                            \
  112.     goto label;                                \
  113. }
  114.  
  115. #define verified_offset(variable, code)        variable
  116.  
  117. /* Unlike Lock_Cell, cell must be (SCHEME_OBJECT *).  This currently does
  118.    not matter, but might on a machine with address mapping.
  119.  */
  120.  
  121. #define DECLARE_LOCK(name) Lock_Handle name
  122. #define setup_lock(handle, cell)        handle = Lock_Cell(cell)
  123. #define remove_lock(handle)            Unlock_Cell(handle)
  124.  
  125. /* This should prevent a deadly embrace if whole contiguous
  126.    regions are locked, rather than individual words.
  127.  */
  128.  
  129. #define setup_locks(hand1, cel1, hand2, cel2)                \
  130. {                                    \
  131.   if (LOCK_FIRST(cel1, cel2))                        \
  132.   {                                    \
  133.     setup_lock(hand1, cel1);                        \
  134.     setup_lock(hand2, cel2);                        \
  135.   }                                    \
  136.   else                                    \
  137.   {                                    \
  138.     setup_lock(hand2, cel2);                        \
  139.     setup_lock(hand1, cel1);                        \
  140.   }                                    \
  141. }
  142.  
  143. #define remove_locks(hand1, hand2)                    \
  144. {                                    \
  145.   remove_lock(hand2);                            \
  146.   remove_lock(hand1);                            \
  147. }
  148.  
  149. #else /* not PARALLEL_PROCESSOR */
  150.  
  151. #define verify(type_code, variable, code, label)
  152. #define verified_offset(variable, code)        code
  153. /* #undef DECLARE_LOCK */
  154. #define setup_lock(handle, cell)
  155. #define remove_lock(ignore)
  156. #define setup_locks(hand1, cel1, hand2, cel2)
  157. #define remove_locks(ign1, ign2)
  158.  
  159. #endif /* PARALLEL_PROCESSOR */
  160.  
  161. /* This is provided as a separate macro so that it can be made
  162.    atomic if necessary.
  163.  */
  164.  
  165. #define update_lock(handle, cell)                    \
  166. {                                    \
  167.   remove_lock(handle);                            \
  168.   setup_lock(handle, cell);                        \
  169. }
  170.  
  171. #ifndef Future_Variable_Splice
  172. /* Parameter list (Vbl, Ofs, Value) displeased some compilers */
  173. #define Future_Variable_Splice(a, b, c) 
  174. #endif
  175.  
  176. /* SCHEME_OBJECT *cell, env, *hunk; */
  177.  
  178. #define lookup(cell, env, hunk, label)                    \
  179. {                                    \
  180.   fast SCHEME_OBJECT frame;                        \
  181.                                     \
  182. /* Deleted this label to eliminate compiler warnings: */        \
  183. /* label: */                                \
  184.                                     \
  185.   frame = (MEMORY_FETCH (hunk [VARIABLE_COMPILED_TYPE]));        \
  186.                                     \
  187.   switch (OBJECT_TYPE (frame))                        \
  188.   {                                    \
  189.     case GLOBAL_REF:                            \
  190.       /* frame is a pointer to the same symbol. */            \
  191.       cell = MEMORY_LOC (frame, SYMBOL_GLOBAL_VALUE);            \
  192.       break;                                \
  193.                                     \
  194.     case LOCAL_REF:                            \
  195.       cell = MEMORY_LOC (env, Lexical_Offset(frame));            \
  196.       break;                                \
  197.                                     \
  198.     case FORMAL_REF:                            \
  199.       lookup_formal(cell, env, hunk, label);                \
  200.                                     \
  201.     case AUX_REF:                            \
  202.       lookup_aux(cell, env, hunk, label);                \
  203.                                     \
  204.     default:                                \
  205.       /* Done here rather than in a separate case because of        \
  206.      peculiarities of the bobcat compiler.                \
  207.        */                                \
  208.       cell = ((OBJECT_TYPE (frame) == UNCOMPILED_REF) ?            \
  209.           uncompiled_trap_object :                    \
  210.           illegal_trap_object);                    \
  211.       break;                                \
  212.  }                                    \
  213. }
  214.  
  215. #define lookup_formal(cell, env, hunk, label)                \
  216. {                                    \
  217.   fast long depth;                            \
  218.                                     \
  219.   verify(FORMAL_REF, offset, get_offset(hunk), label);            \
  220.   depth = (OBJECT_DATUM (frame));                    \
  221.   frame = env;                                \
  222.   while(--depth >= 0)                            \
  223.   {                                    \
  224.     frame = FAST_MEMORY_REF (MEMORY_REF (frame, ENVIRONMENT_FUNCTION),    \
  225.                 PROCEDURE_ENVIRONMENT);            \
  226.   }                                    \
  227.                                     \
  228.   cell = MEMORY_LOC (frame,                        \
  229.             verified_offset(offset, get_offset(hunk)));    \
  230.                                     \
  231.   break;                                \
  232. }
  233.  
  234. #define lookup_aux(cell, env, hunk, label)                \
  235. {                                    \
  236.   fast long depth;                            \
  237.                                     \
  238.   verify(AUX_REF, offset, get_offset(hunk), label);            \
  239.   depth = (OBJECT_DATUM (frame));                    \
  240.   frame = env;                                \
  241.   while(--depth >= 0)                            \
  242.   {                                    \
  243.     frame = FAST_MEMORY_REF (MEMORY_REF (frame, ENVIRONMENT_FUNCTION),    \
  244.                 PROCEDURE_ENVIRONMENT);            \
  245.   }                                    \
  246.                                     \
  247.   frame = MEMORY_REF (frame, ENVIRONMENT_FUNCTION);            \
  248.   if (OBJECT_TYPE (frame) != AUX_LIST_TYPE)                \
  249.   {                                    \
  250.     cell = uncompiled_trap_object;                    \
  251.     break;                                \
  252.   }                                    \
  253.   depth = verified_offset(offset, get_offset(hunk));            \
  254.   if (depth > ((long) (VECTOR_LENGTH (frame))))                \
  255.   {                                    \
  256.     cell = uncompiled_trap_object;                    \
  257.     break;                                \
  258.   }                                    \
  259.   frame = MEMORY_REF (frame, depth);                    \
  260.   if ((frame == SHARP_F) ||                        \
  261.       (FAST_PAIR_CAR (frame) != hunk[VARIABLE_SYMBOL]))            \
  262.   {                                    \
  263.     cell = uncompiled_trap_object;                    \
  264.     break;                                \
  265.   }                                    \
  266.   cell = PAIR_CDR_LOC (frame);                        \
  267.   break;                                \
  268. }
  269.  
  270. /* Macros and exports for incremental definition and hooks. */
  271.  
  272. extern long
  273.   EXFUN (extend_frame,
  274.      (SCHEME_OBJECT, SCHEME_OBJECT, SCHEME_OBJECT,
  275.       SCHEME_OBJECT, Boolean));
  276.  
  277. /* Definition recaches eagerly by default. */
  278.  
  279. #ifndef DEFINITION_RECACHES_LAZILY
  280. # ifndef DEFINITION_RECACHES_EAGERLY
  281. #  define DEFINITION_RECACHES_EAGERLY
  282. # endif
  283. #endif
  284.  
  285. #ifndef DEFINITION_RECACHES_EAGERLY
  286.  
  287. extern long
  288.   EXFUN (compiler_uncache, (SCHEME_OBJECT *, SCHEME_OBJECT));
  289.  
  290. #define simple_uncache(cell, sym)        PRIM_DONE
  291.  
  292. #define shadowing_recache(cell, env, sym, value, shadowed_p)        \
  293.   definition(cell, value, shadowed_p)
  294.  
  295. #define compiler_recache(old, new, env, sym, val, shadowed_p, link_p)    \
  296.   PRIM_DONE
  297.  
  298. #else /* DEFINITION_RECACHES_EAGERLY */
  299.  
  300. extern long
  301.   EXFUN (compiler_recache,
  302.      (SCHEME_OBJECT *, SCHEME_OBJECT *, SCHEME_OBJECT, SCHEME_OBJECT,
  303.       SCHEME_OBJECT, Boolean, Boolean));
  304.  
  305. extern SCHEME_OBJECT * shadowed_value_cell;
  306.  
  307. #define compiler_uncache(cell, sym)                    \
  308.   (shadowed_value_cell = cell, PRIM_DONE)
  309.  
  310. #define simple_uncache(cell, sym)                    \
  311.   compiler_uncache(cell, sym)
  312.  
  313. #define shadowing_recache(cell, env, sym, value, shadowed_p)        \
  314.   compiler_recache(shadowed_value_cell, cell, env, sym, value,        \
  315.              shadowed_p, false)
  316.  
  317. #endif /* DEFINITION_RECACHES_EAGERLY */
  318.