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 / cmpintmd / vax.h < prev   
C/C++ Source or Header  |  1999-01-02  |  17KB  |  475 lines
  1. /* -*-C-*-
  2.  
  3. $Id: vax.h,v 1.9 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1991-1999 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. /*
  23.  *
  24.  * Compiled code interface macros.
  25.  *
  26.  * See cmpint.txt for a description of these fields.
  27.  *
  28.  * Specialized for the Vax architecture.
  29.  */
  30.  
  31. #ifndef CMPNTMD_H_INCLUDED
  32. #define CMPNTMD_H_INCLUDED
  33.  
  34. #include "cmptype.h"
  35.  
  36. /* Machine parameters to be set by the user. */
  37.  
  38. /* Until cmpaux-vax.m4 is updated. */
  39. #define CMPINT_USE_STRUCS
  40.  
  41. /* Processor type.  Choose a number from the above list, or allocate your own. */
  42.  
  43. #define COMPILER_PROCESSOR_TYPE            COMPILER_VAX_TYPE
  44.  
  45. /* Size (in long words) of the contents of a floating point register if
  46.    different from a double.  Default is fine.
  47.  
  48.    #define COMPILER_TEMP_SIZE            2
  49.  
  50. */
  51.  
  52. /* Descriptor size.
  53.    This is the size of the offset field, and of the format field.
  54.    This definition probably does not need to be changed.
  55.  */
  56.  
  57. typedef unsigned short format_word;
  58.  
  59. /* PC alignment constraint.
  60.    Change PC_ZERO_BITS to be how many low order bits of the pc are
  61.    guaranteed to be 0 always because of PC alignment constraints.
  62. */
  63.  
  64. #define PC_ZERO_BITS                    0
  65.  
  66. /* The length of the GC recovery code that precedes an entry.
  67.    On the Vax a "movl s^code,r0; jsb b^n(r10)" sequence.
  68.  */
  69.  
  70. #define ENTRY_PREFIX_LENGTH        6
  71.  
  72. /* Multi-closure magic
  73.    On the Vax, when closures are invoked, the closure corresponding
  74.    to the first entry point is what's needed on the top of the stack.
  75.    Note that it is needed for environment only, not for code.
  76.    The closure code does an
  77.    ADDL2    &magic-constant,(SP)
  78.    on entry, to bump the current entry point (after the JSB instruction)
  79.    to the correct place.
  80.    This code emulates that operation by extracting the magic constant
  81.    from the closure code, and adjusting the address by 6 as if the
  82.    JSB instruction had just been executed.
  83.    It is used when interrupts are disabled, in order not to get into a loop.
  84.    Note that if closure entry points were always longword-aligned, there
  85.    would be no need for this nonsense.
  86.  */
  87.  
  88. #define ADJUST_CLOSURE_AT_CALL(entry_point, location)            \
  89. do {                                    \
  90.   long magic_constant;                            \
  91.                                     \
  92.   magic_constant = (* ((long *) (((char *) (entry_point)) + 2)));    \
  93.   (location) = ((SCHEME_OBJECT)                        \
  94.         ((((long) (OBJECT_ADDRESS (location))) + 6) +        \
  95.          magic_constant));                    \
  96. } while (0)
  97.  
  98. /* Manifest closure entry block size. 
  99.    Size in bytes of a compiled closure's header excluding the
  100.    TC_MANIFEST_CLOSURE header.
  101.  
  102.    On the Vax, this is the format word and gc offset word and 6 bytes
  103.    more for the jsb instruction.  
  104. */
  105.  
  106. #define COMPILED_CLOSURE_ENTRY_SIZE                    \
  107. ((2 * (sizeof (format_word))) + 6)
  108.  
  109. /* Manifest closure entry destructuring.
  110.  
  111.    Given the entry point of a closure, extract the `real entry point'
  112.    (the address of the real code of the procedure, ie. one indirection)
  113.    from the closure.
  114.    Note that on some machines this address may be "smeared out" over
  115.    multiple instructions.
  116. */
  117.  
  118. #define EXTRACT_CLOSURE_ENTRY_ADDRESS(real_entry_point, entry_point)    \
  119. {                                    \
  120.   (real_entry_point) =                            \
  121.     (* ((SCHEME_OBJECT *) (((char *) (entry_point)) + 2)));        \
  122. }
  123.  
  124. /* This is the inverse of EXTRACT_CLOSURE_ENTRY_ADDRESS.
  125.    Given a closure's entry point and a code entry point, store the
  126.    code entry point in the closure.
  127.  */
  128.  
  129. #define STORE_CLOSURE_ENTRY_ADDRESS(real_entry_point, entry_point)    \
  130. {                                    \
  131.   (* ((SCHEME_OBJECT *) (((char *) (entry_point)) + 2))) =        \
  132.     ((SCHEME_OBJECT) (real_entry_point));                \
  133. }
  134.  
  135. /* Execute cache entry size size in longwords.  The cache itself
  136.    contains both the number of arguments provided by the caller and
  137.    code to jump to the destination address.  Before linkage, the cache
  138.    contains the callee's name instead of the jump code.
  139.  */
  140.  
  141. #define EXECUTE_CACHE_ENTRY_SIZE        2
  142.  
  143. /* Execute cache destructuring. */
  144.  
  145. /* Given a target location and the address of the first word of an
  146.    execute cache entry, extract from the cache cell the number of
  147.    arguments supplied by the caller and store it in target. */
  148.  
  149. /* For the Vax, addresses in bytes from start of cache:
  150.    Before linking
  151.      +0: TC_FIXNUM || arity
  152.      +4: TC_SYMBOL || symbol address
  153.    After linking
  154.      +0: arity
  155.      +2: jmp @&
  156.      +4: xxx
  157.    Note that arity stays in the same place since Vaxen are little-endian.
  158. */
  159.  
  160. #define EXTRACT_EXECUTE_CACHE_ARITY(target, address)            \
  161. {                                    \
  162.   (target) = ((long) (* ((unsigned short *) (address))));        \
  163. }
  164.  
  165. #define EXTRACT_EXECUTE_CACHE_SYMBOL(target, address)            \
  166. {                                    \
  167.   (target) = (* (((SCHEME_OBJECT *) (address)) + 1));            \
  168. }
  169.  
  170. /* Extract the target address (not the code to get there) from an
  171.    execute cache cell.
  172.  */
  173.  
  174. #define EXTRACT_EXECUTE_CACHE_ADDRESS(target, address)            \
  175. {                                    \
  176.   (target) = (* (((SCHEME_OBJECT *) (address)) + 1));            \
  177. }
  178.  
  179. /* This is the inverse of EXTRACT_EXECUTE_CACHE_ADDRESS. */
  180.  
  181. #define STORE_EXECUTE_CACHE_ADDRESS(address, entry_address)        \
  182. {                                    \
  183.   (* (((SCHEME_OBJECT *) (address)) + 1)) =                \
  184.     ((SCHEME_OBJECT) (entry_address));                    \
  185. }
  186.  
  187. /* This stores the fixed part of the instructions leaving the
  188.    destination address and the number of arguments intact.  These are
  189.    split apart so the GC can call EXTRACT/STORE...ADDRESS but it does
  190.    NOT need to store the instructions back.  On some architectures the
  191.    instructions may change due to GC and then STORE_EXECUTE_CACHE_CODE
  192.    should become a no-op and all of the work is done by
  193.    STORE_EXECUTE_CACHE_ADDRESS instead.
  194.  */
  195.  
  196. #define STORE_EXECUTE_CACHE_CODE(address)                \
  197. {                                    \
  198.   (* (((unsigned short *) (address)) + 1)) =                \
  199.     ((unsigned short) 0x9f17);                        \
  200. }
  201.  
  202. /* This overrides the definition in cmpint.c because the code below
  203.    depends on knowing it, and is inserted before the definition in
  204.    cmpint.c
  205.  */
  206.  
  207. #define COMPILER_REGBLOCK_N_FIXED    16
  208.  
  209. #define COMPILER_REGBLOCK_N_HOOKS    40
  210. #define COMPILER_HOOK_SIZE        2    /* jsb @& + pad */
  211.  
  212. #define COMPILER_REGBLOCK_EXTRA_SIZE                    \
  213. (COMPILER_REGBLOCK_N_HOOKS * COMPILER_HOOK_SIZE)
  214.  
  215. #define R10_TRAMPOLINE_TO_INTERFACE_OFFSET                \
  216. ((COMPILER_REGBLOCK_N_FIXED + (2 * COMPILER_HOOK_SIZE)) *        \
  217.  (sizeof (SCHEME_OBJECT)))
  218.  
  219. #ifdef IN_CMPINT_C
  220.  
  221. #define ASM_RESET_HOOK vax_reset_hook
  222.  
  223. #ifdef CAST_FUNCTION_TO_INT_BUG
  224.  
  225. #define SETUP_REGISTER(hook)                        \
  226. {                                    \
  227.   extern unsigned long hook;                        \
  228.   (* ((unsigned short *) (r10_value + offset))) =            \
  229.     ((unsigned short) 0x9f17);                        \
  230.   (* ((unsigned long *)                            \
  231.       (((unsigned short *) (r10_value + offset)) + 1))) =        \
  232.     ((unsigned long) (&hook));                        \
  233.   offset += (COMPILER_HOOK_SIZE * (sizeof (SCHEME_OBJECT)));        \
  234. }
  235.  
  236. #else /* not CAST_FUNCTION_TO_INT_BUG */
  237.  
  238. #define SETUP_REGISTER(hook)                        \
  239. {                                    \
  240.   extern void EXFUN (hook, (void));                    \
  241.   (* ((unsigned short *) (r10_value + offset))) =            \
  242.     ((unsigned short) 0x9f17);                        \
  243.   (* ((unsigned long *)                            \
  244.       (((unsigned short *) (r10_value + offset)) + 1))) =        \
  245.     ((unsigned long) hook);                        \
  246.   offset += (COMPILER_HOOK_SIZE * (sizeof (SCHEME_OBJECT)));        \
  247. }
  248.  
  249. #endif
  250.  
  251. void
  252. DEFUN_VOID (vax_reset_hook)
  253. {
  254.   unsigned char * r10_value = ((unsigned char *) (&Registers[0]));
  255.   int offset = (COMPILER_REGBLOCK_N_FIXED * (sizeof (SCHEME_OBJECT)));
  256.  
  257.   /* These must match machines/vax/lapgen.scm */
  258.   SETUP_REGISTER (asm_scheme_to_interface);        /* 0 */
  259.   SETUP_REGISTER (asm_scheme_to_interface_jsb);        /* 1 */
  260.   SETUP_REGISTER (asm_trampoline_to_interface);        /* 2 */
  261. #if 0
  262.   /* Not yet written for the Vax */
  263.   SETUP_REGISTER (asm_shortcircuit_apply);        /* 3 */
  264.   SETUP_REGISTER (asm_shortcircuit_apply_size_1);    /* 4 */
  265.   SETUP_REGISTER (asm_shortcircuit_apply_size_2);    /* 5 */
  266.   SETUP_REGISTER (asm_shortcircuit_apply_size_3);    /* 6 */
  267.   SETUP_REGISTER (asm_shortcircuit_apply_size_4);    /* 7 */
  268.   SETUP_REGISTER (asm_shortcircuit_apply_size_5);    /* 8 */
  269.   SETUP_REGISTER (asm_shortcircuit_apply_size_6);    /* 9 */
  270.   SETUP_REGISTER (asm_shortcircuit_apply_size_7);    /* 10 */
  271.   SETUP_REGISTER (asm_shortcircuit_apply_size_8);    /* 11 */
  272.   SETUP_REGISTER (asm_primitive_apply);            /* 12 */
  273.   SETUP_REGISTER (asm_primitive_lexpr_apply);        /* 13 */
  274.   SETUP_REGISTER (asm_error);                /* 14 */
  275.   SETUP_REGISTER (asm_link);                /* 15 */
  276.   SETUP_REGISTER (asm_interrupt_closure);        /* 16 */
  277.   SETUP_REGISTER (asm_interrupt_dlink);            /* 17 */
  278.   SETUP_REGISTER (asm_interrupt_procedure);        /* 18 */
  279.   SETUP_REGISTER (asm_interrupt_continuation);        /* 19 */
  280.   SETUP_REGISTER (asm_assignment_trap);            /* 20 */
  281.   SETUP_REGISTER (asm_reference_trap);            /* 21 */
  282.   SETUP_REGISTER (asm_safe_reference_trap);        /* 22 */
  283.   SETUP_REGISTER (asm_generic_add);            /* 23 */
  284.   SETUP_REGISTER (asm_generic_subtract);        /* 24 */
  285.   SETUP_REGISTER (asm_generic_multiply);        /* 25 */
  286.   SETUP_REGISTER (asm_generic_divide);            /* 26 */
  287.   SETUP_REGISTER (asm_generic_equal);            /* 27 */
  288.   SETUP_REGISTER (asm_generic_less);            /* 28 */
  289.   SETUP_REGISTER (asm_generic_greater);            /* 29 */
  290.   SETUP_REGISTER (asm_generic_increment);        /* 30 */
  291.   SETUP_REGISTER (asm_generic_decrement);        /* 31 */
  292.   SETUP_REGISTER (asm_generic_zero);            /* 32 */
  293.   SETUP_REGISTER (asm_generic_positive);        /* 33 */
  294.   SETUP_REGISTER (asm_generic_negative);        /* 34 */
  295.   SETUP_REGISTER (asm_primitive_error);            /* 35 */
  296. #endif /* 0 */
  297.   return;
  298. }
  299.  
  300. #endif /* IN_CMPINT_C */
  301.  
  302. /* On the Vax, here's a  picture of a trampoline (offset in bytes from
  303.    entry point)
  304.      -12: MANIFEST vector header
  305.      - 8: NON_MARKED header
  306.      - 4: Format word
  307.      - 2: 0x12 (GC Offset to start of block from .+2)
  308.        0: movl    S^code,r0
  309.        3: jsb    B^R10_TRAMPOLINE_TO_INTERFACE_OFFSET(r10)
  310.        6: 0
  311.        8: trampoline dependent storage (0 - 3 longwords)
  312.  
  313.    TRAMPOLINE_ENTRY_SIZE is the size in longwords of the machine
  314.    dependent portion of a trampoline, including the GC and format
  315.    headers.  The code in the trampoline must store an index (used to
  316.    determine which C SCHEME_UTILITY procedure to invoke) in a
  317.    register, jump to "scheme_to_interface" and leave the address of
  318.    the storage following the code in a standard location.
  319.  
  320.    TRAMPOLINE_ENTRY_POINT returns the address of the entry point of a
  321.    trampoline when given the address of the word containing
  322.    the manifest vector header.  According to the above picture,
  323.    it would add 12 bytes to its argument.
  324.  
  325.    TRAMPOLINE_STORAGE takes the address of the first instruction in a
  326.    trampoline (not the start of the trampoline block) and returns the
  327.    address of the first storage word in the trampoline.
  328.  
  329.    STORE_TRAMPOLINE_ENTRY gets the address of the first instruction in
  330.    the trampoline and stores the instructions.  It also receives the
  331.    index of the C SCHEME_UTILITY to be invoked.
  332. */
  333.  
  334. #define TRAMPOLINE_ENTRY_SIZE        3
  335. #define TRAMPOLINE_BLOCK_TO_ENTRY    3 /* longwords from MNV to MOVL */
  336.  
  337. #define TRAMPOLINE_ENTRY_POINT(tramp_block)                \
  338.   (((SCHEME_OBJECT *) (tramp_block)) + TRAMPOLINE_BLOCK_TO_ENTRY)
  339.  
  340. #define TRAMPOLINE_STORAGE(tramp_entry)                    \
  341.   ((((SCHEME_OBJECT *) tramp_entry) - TRAMPOLINE_BLOCK_TO_ENTRY) +    \
  342.    (2 + TRAMPOLINE_ENTRY_SIZE)) 
  343.  
  344. #define STORE_TRAMPOLINE_ENTRY(entry_address, code)            \
  345. {                                    \
  346.   unsigned long *PC;                            \
  347.   /* r0 will get the code.  JSB will be used to call the assembly    \
  348.      language to C SCHEME_UTILITY handler:                \
  349.         movl    S^code,r0                        \
  350.     jsb    B^R10_TRAMPOLINE_TO_INTERFACE_OFFSET(R10)        \
  351.   */                                    \
  352.   PC = ((unsigned long *) entry_address);                \
  353.   *PC++ = (((unsigned long) 0x165000d0) +                \
  354.        (((unsigned long) (code)) << 8));                \
  355.   *PC++ = (((unsigned long) 0x000000aa) +                \
  356.        (((unsigned long) R10_TRAMPOLINE_TO_INTERFACE_OFFSET)    \
  357.         << 8));                            \
  358. }
  359.  
  360. /* Derived parameters and macros.
  361.    These macros expect the above definitions to be meaningful.
  362.    If they are not, the macros below may have to be changed as well.
  363.  */
  364.  
  365. #define COMPILED_ENTRY_OFFSET_WORD(entry)                               \
  366.   (((format_word *) (entry))[-1])
  367. #define COMPILED_ENTRY_FORMAT_WORD(entry)                               \
  368.   (((format_word *) (entry))[-2])
  369.  
  370. /* The next one assumes 2's complement integers....*/
  371. #define CLEAR_LOW_BIT(word)                     ((word) & ((unsigned long) -2))
  372. #define OFFSET_WORD_CONTINUATION_P(word)        (((word) & 1) != 0)
  373.  
  374. #if (PC_ZERO_BITS == 0)
  375. /* Instructions aligned on byte boundaries */
  376. #define BYTE_OFFSET_TO_OFFSET_WORD(offset)      ((offset) << 1)
  377. #define OFFSET_WORD_TO_BYTE_OFFSET(offset_word)                         \
  378.   ((CLEAR_LOW_BIT(offset_word)) >> 1)
  379. #endif
  380.  
  381. #if (PC_ZERO_BITS == 1)
  382. /* Instructions aligned on word (16 bit) boundaries */
  383. #define BYTE_OFFSET_TO_OFFSET_WORD(offset)      (offset)
  384. #define OFFSET_WORD_TO_BYTE_OFFSET(offset_word)                         \
  385.   (CLEAR_LOW_BIT(offset_word))
  386. #endif
  387.  
  388. #if (PC_ZERO_BITS >= 2)
  389. /* Should be OK for =2, but bets are off for >2 because of problems
  390.    mentioned earlier!
  391. */
  392. #define SHIFT_AMOUNT                            (PC_ZERO_BITS - 1)
  393. #define BYTE_OFFSET_TO_OFFSET_WORD(offset)      ((offset) >> (SHIFT_AMOUNT))
  394. #define OFFSET_WORD_TO_BYTE_OFFSET(offset_word)                         \
  395.   ((CLEAR_LOW_BIT(offset_word)) << (SHIFT_AMOUNT))
  396. #endif
  397.  
  398. #define MAKE_OFFSET_WORD(entry, block, continue)                        \
  399.   ((BYTE_OFFSET_TO_OFFSET_WORD(((char *) (entry)) -                     \
  400.                                ((char *) (block)))) |                   \
  401.    ((continue) ? 1 : 0))
  402.  
  403. #if (EXECUTE_CACHE_ENTRY_SIZE == 2)
  404. #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count)                           \
  405.   ((count) >> 1)
  406. #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries)                \
  407.   ((entries) << 1)
  408. #endif
  409.  
  410. #if (EXECUTE_CACHE_ENTRY_SIZE == 4)
  411. #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count)                           \
  412.   ((count) >> 2)
  413. #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries)                \
  414.   ((entries) << 2)
  415. #endif
  416.  
  417. #if (!defined(EXECUTE_CACHE_COUNT_TO_ENTRIES))
  418. #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count)                           \
  419.   ((count) / EXECUTE_CACHE_ENTRY_SIZE)
  420. #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries)                \
  421.   ((entries) * EXECUTE_CACHE_ENTRY_SIZE)
  422. #endif
  423.  
  424. /* The first entry in a cc block is preceeded by 2 headers (block and nmv),
  425.    a format word and a gc offset word.   See the early part of the
  426.    TRAMPOLINE picture, above.
  427.  */
  428.  
  429. #define CC_BLOCK_FIRST_ENTRY_OFFSET                                     \
  430.   (2 * ((sizeof(SCHEME_OBJECT)) + (sizeof(format_word))))
  431.  
  432. /* Format words */
  433.  
  434. #define FORMAT_BYTE_EXPR                0xFF
  435. #define FORMAT_BYTE_COMPLR              0xFE
  436. #define FORMAT_BYTE_CMPINT              0xFD
  437. #define FORMAT_BYTE_DLINK               0xFC
  438. #define FORMAT_BYTE_RETURN              0xFB
  439.  
  440. #define FORMAT_WORD_EXPR        (MAKE_FORMAT_WORD(0xFF, FORMAT_BYTE_EXPR))
  441. #define FORMAT_WORD_CMPINT      (MAKE_FORMAT_WORD(0xFF, FORMAT_BYTE_CMPINT))
  442. #define FORMAT_WORD_RETURN      (MAKE_FORMAT_WORD(0xFF, FORMAT_BYTE_RETURN))
  443.  
  444. /* This assumes that a format word is at least 16 bits,
  445.    and the low order field is always 8 bits.
  446.  */
  447.  
  448. #define MAKE_FORMAT_WORD(field1, field2)                                \
  449.   (((field1) << 8) | ((field2) & 0xff))
  450.  
  451. #define SIGN_EXTEND_FIELD(field, size)                                  \
  452.   (((field) & ((1 << (size)) - 1)) |                                    \
  453.    ((((field) & (1 << ((size) - 1))) == 0) ? 0 :                        \
  454.     ((-1) << (size))))
  455.  
  456. #define FORMAT_WORD_LOW_BYTE(word)                                      \
  457.   (SIGN_EXTEND_FIELD((((unsigned long) (word)) & 0xff), 8))
  458.  
  459. #define FORMAT_WORD_HIGH_BYTE(word)                    \
  460.   (SIGN_EXTEND_FIELD((((unsigned long) (word)) >> 8),            \
  461.              (((sizeof (format_word)) * CHAR_BIT) - 8)))
  462.  
  463. #define COMPILED_ENTRY_FORMAT_HIGH(addr)                                \
  464.   (FORMAT_WORD_HIGH_BYTE(COMPILED_ENTRY_FORMAT_WORD(addr)))
  465.  
  466. #define COMPILED_ENTRY_FORMAT_LOW(addr)                                 \
  467.   (FORMAT_WORD_LOW_BYTE(COMPILED_ENTRY_FORMAT_WORD(addr)))
  468.  
  469. #define FORMAT_BYTE_FRAMEMAX            0x7f
  470.  
  471. #define COMPILED_ENTRY_MAXIMUM_ARITY    COMPILED_ENTRY_FORMAT_LOW
  472. #define COMPILED_ENTRY_MINIMUM_ARITY    COMPILED_ENTRY_FORMAT_HIGH
  473.  
  474. #endif /* CMPNTMD_H_INCLUDED */
  475.