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 / hppa.h < prev    next >
C/C++ Source or Header  |  1999-01-02  |  41KB  |  1,381 lines
  1. /* -*-C-*-
  2.  
  3. $Id: hppa.h,v 1.51 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1989-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 HP Precision Architecture (Spectrum)
  29.  */
  30.  
  31. #ifndef CMPINTMD_H_INCLUDED
  32. #define CMPINTMD_H_INCLUDED
  33.  
  34. #include "cmptype.h"
  35. #include "hppacach.h"
  36.  
  37. /* Machine parameters to be set by the user. */
  38.  
  39. /* Until cmpaux-hppa.m4 is updated. */
  40. #define CMPINT_USE_STRUCS
  41.  
  42. /* Processor type.  Choose a number from the above list, or allocate your own. */
  43.  
  44. #define COMPILER_PROCESSOR_TYPE            COMPILER_SPECTRUM_TYPE
  45.  
  46. /* Size (in long words) of the contents of a floating point register if
  47.    different from a double.  For example, an MC68881 saves registers
  48.    in 96 bit (3 longword) blocks.
  49.    Default is fine for PA.
  50.    define COMPILER_TEMP_SIZE            3
  51. */
  52.  
  53. /* Descriptor size.
  54.    This is the size of the offset field, and of the format field.
  55.    This definition probably does not need to be changed.
  56.  */
  57.  
  58. typedef unsigned short format_word;
  59.  
  60. /* PC alignment constraint.
  61.    Change PC_ZERO_BITS to be how many low order bits of the pc are
  62.    guaranteed to be 0 always because of PC alignment constraints.
  63. */
  64.  
  65. #define PC_ZERO_BITS                    2
  66.  
  67. /* C function pointers are pairs of instruction addreses and data segment
  68.    pointers.  We don't want that for the assembly language entry points.
  69.  */
  70.  
  71. #define C_FUNC_PTR_IS_CLOSURE
  72.  
  73. #ifndef C_FUNC_PTR_IS_CLOSURE
  74. #  define interface_to_C ep_interface_to_C
  75. #  define interface_to_scheme ep_interface_to_scheme
  76. #endif
  77.  
  78. /* Utilities for manipulating absolute subroutine calls.
  79.    On the PA the absolute address is "smeared out" over two
  80.    instructions, an LDIL and a BLE instruction.
  81.  */
  82.  
  83. extern unsigned long
  84.   EXFUN (hppa_extract_absolute_address, (unsigned long *));
  85.  
  86. extern void
  87.   EXFUN (hppa_store_absolute_address,
  88.      (unsigned long *, unsigned long, unsigned long));
  89.  
  90. #define EXTRACT_ABSOLUTE_ADDRESS(target, address)            \
  91. {                                    \
  92.   (target) =                                \
  93.     ((SCHEME_OBJECT)                            \
  94.      (hppa_extract_absolute_address ((unsigned long *) (address))));    \
  95. }
  96.  
  97. #define STORE_ABSOLUTE_ADDRESS(entry_point, address, nullify_p)        \
  98. {                                    \
  99.   hppa_store_absolute_address (((unsigned long *) (address)),        \
  100.                    ((unsigned long) (entry_point)),        \
  101.                    ((unsigned long) (nullify_p)));        \
  102. }
  103.  
  104. /* Interrupt/GC polling. */
  105.  
  106. /* The length of the GC recovery code that precedes an entry.
  107.    On the HP-PA a "ble, ldi" instruction sequence.
  108.  */
  109.  
  110. #define ENTRY_PREFIX_LENGTH        8
  111.  
  112. /*
  113.   The instructions for a normal entry should be something like
  114.  
  115.   COMBT,>=,N    Rfree,Rmemtop,interrupt
  116.   LDW        0(0,Regs),Rmemtop
  117.  
  118.   For a closure
  119.  
  120.   DEPI        tc_closure>>1,4,5,25        ; set type code
  121.   STWM        25,-4(0,Rstack)            ; push on stack
  122.   COMB,>=    Rfree,Rmemtop,interrupt        ; GC/interrupt check
  123.   LDW        0(0,Regs),Rmemtop        ; Recache memtop
  124.  
  125.   Notes:
  126.  
  127.   The LDW can be eliminated once the C interrupt handler is changed to
  128.   update Rmemtop directly.  At that point, the instruction following the
  129.   COMB instruction will have to be nullified whenever the interrupt
  130.   branch is processed.
  131.  
  132.  */
  133.  
  134. /* Compiled closures */
  135.  
  136. /* Manifest closure entry block size.
  137.    Size in bytes of a compiled closure's header excluding the
  138.    TC_MANIFEST_CLOSURE header.
  139.  
  140.    On the PA this is 2 format_words for the format word and gc
  141.    offset words, and 12 more bytes for 3 instructions:
  142.  
  143.    LDIL        L'target,26
  144.    BLE        R'target(5,26)
  145.    ADDI        -15,31,25        ; handle privilege bits
  146.  */
  147.  
  148. #define COMPILED_CLOSURE_ENTRY_SIZE     16
  149.  
  150. /* Manifest closure entry destructuring.
  151.  
  152.    Given the entry point of a closure, extract the `real entry point'
  153.    (the address of the real code of the procedure, ie. one indirection)
  154.    from the closure.
  155.    On the PA, the real entry point is "smeared out" over the LDIL and
  156.    the BLE instructions.
  157. */
  158.  
  159. #define EXTRACT_CLOSURE_ENTRY_ADDRESS(real_entry_point, entry_point)    \
  160. {                                    \
  161.   EXTRACT_ABSOLUTE_ADDRESS (real_entry_point, entry_point);        \
  162. }
  163.  
  164. /* This is the inverse of EXTRACT_CLOSURE_ENTRY_ADDRESS.
  165.    Given a closure's entry point and a code entry point, store the
  166.    code entry point in the closure.
  167.  */
  168.  
  169. #define STORE_CLOSURE_ENTRY_ADDRESS(real_entry_point, entry_point)    \
  170. {                                    \
  171.   STORE_ABSOLUTE_ADDRESS (real_entry_point, entry_point, false);    \
  172. }
  173.  
  174. /* Trampolines
  175.  
  176.    Here's a picture of a trampoline on the PA (offset in bytes from
  177.    entry point)
  178.  
  179.      -12: MANIFEST vector header
  180.      - 8: NON_MARKED header
  181.      - 4: Format word
  182.      - 2: 0xC (GC Offset to start of block from .+2)
  183.        0: BLE    4(4,3)        ; call trampoline_to_interface
  184.        4: LDI    index,28
  185.        8: trampoline dependent storage (0 - 3 longwords)
  186.  
  187.    TRAMPOLINE_ENTRY_SIZE is the size in longwords of the machine
  188.    dependent portion of a trampoline, including the GC and format
  189.    headers.  The code in the trampoline must store an index (used to
  190.    determine which C SCHEME_UTILITY procedure to invoke) in a
  191.    register, jump to "scheme_to_interface" and leave the address of
  192.    the storage following the code in a standard location.
  193.  
  194.    TRAMPOLINE_ENTRY_POINT returns the address of the entry point of a
  195.    trampoline when given the address of the word containing
  196.    the manifest vector header.  According to the above picture,
  197.    it would add 12 bytes to its argument.
  198.  
  199.    TRAMPOLINE_STORAGE takes the address of the first instruction in a
  200.    trampoline (not the start of the trampoline block) and returns the
  201.    address of the first storage word in the trampoline.
  202.  
  203.    STORE_TRAMPOLINE_ENTRY gets the address of the first instruction in
  204.    the trampoline and stores the instructions.  It also receives the
  205.    index of the C SCHEME_UTILITY to be invoked.
  206.  
  207.    Note: this flushes both caches because the words may fall in a cache
  208.    line that already has an association in the i-cache because a different
  209.    trampoline or a closure are in it.
  210. */
  211.  
  212. #define TRAMPOLINE_ENTRY_SIZE        3
  213. #define TRAMPOLINE_BLOCK_TO_ENTRY    3 /* longwords from MNV to BLE */
  214.  
  215. #define TRAMPOLINE_ENTRY_POINT(tramp_block)                \
  216.   (((SCHEME_OBJECT *) (tramp_block)) + TRAMPOLINE_BLOCK_TO_ENTRY)
  217.  
  218. #define TRAMPOLINE_STORAGE(tramp_entry)                    \
  219.   ((((SCHEME_OBJECT *) (tramp_entry)) - TRAMPOLINE_BLOCK_TO_ENTRY) +    \
  220.    (2 + TRAMPOLINE_ENTRY_SIZE)) 
  221.  
  222. #define STORE_TRAMPOLINE_ENTRY(entry_address, index) do            \
  223. {                                    \
  224.   extern void                                \
  225.     EXFUN (cache_flush_region, (PTR, long, unsigned int));        \
  226.                                     \
  227.   unsigned long *PC;                            \
  228.                                     \
  229.   PC = ((unsigned long *) (entry_address));                \
  230.                                     \
  231.   /*    BLE    4(4,3)        */                    \
  232.                                     \
  233.   *PC = ((unsigned long) 0xe4602008);                    \
  234.                                     \
  235.   /*    LDO    index(0),28    */                    \
  236.   /*    This assumes that index is >= 0. */                \
  237.                                     \
  238.   *(PC + 1) = (((unsigned long) 0x341c0000) +                \
  239.            (((unsigned long) (index)) << 1));            \
  240.   cache_flush_region (PC, (TRAMPOLINE_ENTRY_SIZE - 1),            \
  241.               (I_CACHE | D_CACHE));                \
  242. } while (0)
  243.  
  244. /* Execute cache entries.
  245.  
  246.    Execute cache entry size size in longwords.  The cache itself
  247.    contains both the number of arguments provided by the caller and
  248.    code to jump to the destination address.  Before linkage, the cache
  249.    contains the callee's name instead of the jump code.
  250.  
  251.    On PA: 2 instructions, and a fixnum representing the number of arguments.
  252.  */
  253.  
  254. #define EXECUTE_CACHE_ENTRY_SIZE        3
  255.  
  256. /* For the HPPA, addresses in bytes from the start of the cache:
  257.  
  258.    Before linking
  259.  
  260.      +0: TC_SYMBOL || symbol address
  261.      +4: #F
  262.      +8: TC_FIXNUM || 0
  263.     +10: number of supplied arguments, +1
  264.  
  265.    After linking
  266.  
  267.      +0: LDIL    L'target,26
  268.      +4: BLE,n    R'target(5,26)
  269.      +8: (unchanged)
  270.     +10: (unchanged)
  271.  
  272.    Important:
  273.  
  274.      Currently the code below unconditionally nullifies the delay-slot
  275.      instruction for the BLE instruction.  This is wasteful and
  276.      unnecessary.  An EXECUTE_CACHE_ENTRY could be one word longer to
  277.      accomodate a delay-slot instruction, and the linker could do the
  278.      following:
  279.  
  280.      - If the target instruction is not a branch instruction, use 4 +
  281.      the address of the target instruction, and copy the target
  282.      instruction to the delay slot.  Note that branch instructions are
  283.      those with opcodes (6 bits) in the range #b1xy0zw, for any bit
  284.      value for x, y, z, w.
  285.  
  286.      - If the target instruction is the COMBT instruction of an
  287.      interrupt/gc check, use 4 + the address of the target
  288.      instruction, and insert a similar COMBT instruction in the delay
  289.      slot.  This COMBT instruction would then branch to an instruction
  290.      shared by all the cache cells in the same block.  This shared
  291.      instruction would be a BE instruction used to jump to an assembly
  292.      language handler.  This handler would recover the target address
  293.      from the link address left in register 31 by the BLE instruction
  294.      in the execute cache cell, and use it to compute the address of
  295.      and branch to the interrupt code for the entry.
  296.  
  297.      - Otherwise use the address of the target instruction and insert
  298.      a NOP in the delay slot.
  299. */
  300.  
  301. /* Execute cache destructuring. */
  302.  
  303. /* Given a target location and the address of the first word of an
  304.    execute cache entry, extract from the cache cell the number of
  305.    arguments supplied by the caller and store it in target.
  306.  */
  307.  
  308. #define EXTRACT_EXECUTE_CACHE_ARITY(target, address)            \
  309. {                                    \
  310.   (target) = ((long) (* (((unsigned short *) (address)) + 5)));        \
  311. }
  312.  
  313. /* Given a target location and the address of the first word of an
  314.    execute cache entry, extract from the cache cell the name
  315.    of the variable whose value is being invoked.
  316.    This is valid only before linking.
  317.  */
  318.  
  319. #define EXTRACT_EXECUTE_CACHE_SYMBOL(target, address)            \
  320. {                                    \
  321.   (target) = (* (((SCHEME_OBJECT *) (address))));            \
  322. }
  323.  
  324. /* Extract the target address (not the code to get there) from an
  325.    execute cache cell.
  326.  */
  327.  
  328. #define EXTRACT_EXECUTE_CACHE_ADDRESS(target, address)            \
  329. {                                    \
  330.   EXTRACT_ABSOLUTE_ADDRESS(target, address);                \
  331. }
  332.  
  333. /* This is the inverse of EXTRACT_EXECUTE_CACHE_ADDRESS. */
  334.  
  335. #define STORE_EXECUTE_CACHE_ADDRESS(address, entry)            \
  336. {                                    \
  337.   STORE_ABSOLUTE_ADDRESS(entry, address, true);                \
  338. }
  339.  
  340. /* This stores the fixed part of the instructions leaving the
  341.    destination address and the number of arguments intact.  These are
  342.    split apart so the GC can call EXTRACT/STORE...ADDRESS but it does
  343.    NOT need to store the instructions back.  On some architectures the
  344.    instructions may change due to GC and then STORE_EXECUTE_CACHE_CODE
  345.    should become a no-op and all of the work is done by
  346.    STORE_EXECUTE_CACHE_ADDRESS instead.
  347.    On PA this is a NOP.
  348.  */
  349.  
  350. #define STORE_EXECUTE_CACHE_CODE(address) do                \
  351. {                                    \
  352. } while (0)
  353.  
  354. /* This is supposed to flush the Scheme portion of the I-cache.
  355.    It flushes the entire I-cache instead, since it is easier.
  356.    It is used after a GC or disk-restore.
  357.    It's needed because the GC has moved code around, and closures
  358.    and execute cache cells have absolute addresses that the
  359.    processor might have old copies of.
  360.  */
  361.  
  362. #define FLUSH_I_CACHE() do                        \
  363. {                                    \
  364.   extern void                                \
  365.     EXFUN (flush_i_cache, (void));                    \
  366.                                     \
  367.   flush_i_cache ();                            \
  368. } while (0)
  369.  
  370. /* This flushes a region of the I-cache.
  371.    It is used after updating an execute cache while running.
  372.    Not needed during GC because FLUSH_I_CACHE will be used.
  373.  */   
  374.  
  375. #define FLUSH_I_CACHE_REGION(address, nwords) do            \
  376. {                                    \
  377.   extern void                                \
  378.     EXFUN (cache_flush_region, (PTR, long, unsigned int));        \
  379.                                     \
  380.   cache_flush_region (((PTR) (address)), ((long) (nwords)),        \
  381.               (D_CACHE | I_CACHE));                \
  382. } while (0)
  383.  
  384. /* This pushes a region of the D-cache back to memory.
  385.    It is (typically) used after loading (and relocating) a piece of code
  386.    into memory.
  387.  */   
  388.  
  389. #define PUSH_D_CACHE_REGION(address, nwords) do                \
  390. {                                    \
  391.   extern void                                \
  392.     EXFUN (push_d_cache_region, (PTR, unsigned long));            \
  393.                                     \
  394.   push_d_cache_region (((PTR) (address)),                \
  395.                ((unsigned long) (nwords)));            \
  396. } while (0)
  397.  
  398. extern void EXFUN (hppa_update_primitive_table, (int, int));
  399. extern Boolean EXFUN (hppa_grow_primitive_table, (int));
  400.  
  401. #define UPDATE_PRIMITIVE_TABLE_HOOK hppa_update_primitive_table
  402. #define GROW_PRIMITIVE_TABLE_HOOK hppa_grow_primitive_table
  403.  
  404. /* This is not completely true.  Some models (eg. 850) have combined caches,
  405.    but we have to assume the worst.
  406.  */
  407.  
  408. #define SPLIT_CACHES
  409.  
  410. /* Derived parameters and macros.
  411.  
  412.    These macros expect the above definitions to be meaningful.
  413.    If they are not, the macros below may have to be changed as well.
  414.  */
  415.  
  416. #define COMPILED_ENTRY_OFFSET_WORD(entry)                               \
  417.   (((format_word *) (entry))[-1])
  418. #define COMPILED_ENTRY_FORMAT_WORD(entry)                               \
  419.   (((format_word *) (entry))[-2])
  420.  
  421. /* The next one assumes 2's complement integers....*/
  422. #define CLEAR_LOW_BIT(word)                     ((word) & ((unsigned long) -2))
  423. #define OFFSET_WORD_CONTINUATION_P(word)        (((word) & 1) != 0)
  424.  
  425. #if (PC_ZERO_BITS == 0)
  426. /* Instructions aligned on byte boundaries */
  427. #define BYTE_OFFSET_TO_OFFSET_WORD(offset)      ((offset) << 1)
  428. #define OFFSET_WORD_TO_BYTE_OFFSET(offset_word)                         \
  429.   ((CLEAR_LOW_BIT(offset_word)) >> 1)
  430. #endif
  431.  
  432. #if (PC_ZERO_BITS == 1)
  433. /* Instructions aligned on word (16 bit) boundaries */
  434. #define BYTE_OFFSET_TO_OFFSET_WORD(offset)      (offset)
  435. #define OFFSET_WORD_TO_BYTE_OFFSET(offset_word)                         \
  436.   (CLEAR_LOW_BIT(offset_word))
  437. #endif
  438.  
  439. #if (PC_ZERO_BITS >= 2)
  440. /* Should be OK for =2, but bets are off for >2 because of problems
  441.    mentioned earlier!
  442. */
  443. #define SHIFT_AMOUNT                            (PC_ZERO_BITS - 1)
  444. #define BYTE_OFFSET_TO_OFFSET_WORD(offset)      ((offset) >> (SHIFT_AMOUNT))
  445. #define OFFSET_WORD_TO_BYTE_OFFSET(offset_word)                         \
  446.   ((CLEAR_LOW_BIT(offset_word)) << (SHIFT_AMOUNT))
  447. #endif
  448.  
  449. #define MAKE_OFFSET_WORD(entry, block, continue)                        \
  450.   ((BYTE_OFFSET_TO_OFFSET_WORD(((char *) (entry)) -                     \
  451.                                ((char *) (block)))) |                   \
  452.    ((continue) ? 1 : 0))
  453.  
  454. #if (EXECUTE_CACHE_ENTRY_SIZE == 2)
  455. #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count)                           \
  456.   ((count) >> 1)
  457. #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries)                \
  458.   ((entries) << 1)
  459. #endif
  460.  
  461. #if (EXECUTE_CACHE_ENTRY_SIZE == 4)
  462. #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count)                           \
  463.   ((count) >> 2)
  464. #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries)                \
  465.   ((entries) << 2)
  466. #endif
  467.  
  468. #if (!defined(EXECUTE_CACHE_COUNT_TO_ENTRIES))
  469. #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count)                           \
  470.   ((count) / EXECUTE_CACHE_ENTRY_SIZE)
  471. #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries)                \
  472.   ((entries) * EXECUTE_CACHE_ENTRY_SIZE)
  473. #endif
  474.  
  475. /* The first entry in a cc block is preceeded by 2 headers (block and nmv),
  476.    a format word and a gc offset word.   See the early part of the
  477.    TRAMPOLINE picture, above.
  478.  */
  479.  
  480. #define CC_BLOCK_FIRST_ENTRY_OFFSET                                     \
  481.   (2 * ((sizeof(SCHEME_OBJECT)) + (sizeof(format_word))))
  482.  
  483. #ifndef FORMAT_BYTE_CLOSURE
  484. #define FORMAT_BYTE_CLOSURE            0xFA
  485. #endif
  486.  
  487. #ifndef FORMAT_WORD_CLOSURE
  488. #define FORMAT_WORD_CLOSURE    (MAKE_FORMAT_WORD (0xFF, FORMAT_BYTE_CLOSURE))
  489. #endif
  490.  
  491. /* This assumes that a format word is at least 16 bits,
  492.    and the low order field is always 8 bits.
  493.  */
  494.  
  495. #define MAKE_FORMAT_WORD(field1, field2)                                \
  496.   (((field1) << 8) | ((field2) & 0xff))
  497.  
  498. #define SIGN_EXTEND_FIELD(field, size)                                  \
  499.   (((field) & ((1 << (size)) - 1)) |                                    \
  500.    ((((field) & (1 << ((size) - 1))) == 0) ? 0 :                        \
  501.     ((-1) << (size))))
  502.  
  503. #define FORMAT_WORD_LOW_BYTE(word)                                      \
  504.   (SIGN_EXTEND_FIELD((((unsigned long) (word)) & 0xff), 8))
  505.  
  506. #define FORMAT_WORD_HIGH_BYTE(word)                    \
  507.   (SIGN_EXTEND_FIELD((((unsigned long) (word)) >> 8),            \
  508.              (((sizeof (format_word)) * CHAR_BIT) - 8)))
  509.  
  510. #define COMPILED_ENTRY_FORMAT_HIGH(addr)                                \
  511.   (FORMAT_WORD_HIGH_BYTE(COMPILED_ENTRY_FORMAT_WORD(addr)))
  512.  
  513. #define COMPILED_ENTRY_FORMAT_LOW(addr)                                 \
  514.   (FORMAT_WORD_LOW_BYTE(COMPILED_ENTRY_FORMAT_WORD(addr)))
  515.  
  516. #define COMPILED_ENTRY_MAXIMUM_ARITY    COMPILED_ENTRY_FORMAT_LOW
  517. #define COMPILED_ENTRY_MINIMUM_ARITY    COMPILED_ENTRY_FORMAT_HIGH
  518.  
  519. #ifdef IN_CMPINT_C
  520.  
  521. /* Definitions of the utility procedures.
  522.    Procedure calls of leaf procedures on the HPPA are pretty fast,
  523.    so there is no reason not to do this out of line.
  524.    In this way compiled code can use them too.
  525.  */
  526.  
  527. union ldil_inst
  528. {
  529.   unsigned long inst;
  530.   struct
  531.   {
  532.     unsigned opcode    : 6;
  533.     unsigned base    : 5;
  534.     unsigned D        : 5;
  535.     unsigned C        : 2;
  536.     unsigned E        : 2;
  537.     unsigned B        : 11;
  538.     unsigned A        : 1;
  539.   } fields;
  540. };
  541.  
  542. union branch_inst
  543. {
  544.   unsigned long inst;
  545.   struct
  546.   {
  547.     unsigned opcode    : 6;
  548.     unsigned t_or_b    : 5;
  549.     unsigned x_or_w1    : 5;
  550.     unsigned s        : 3;
  551.     unsigned w2b    : 10;
  552.     unsigned w2a    : 1;
  553.     unsigned n        : 1;
  554.     unsigned w0        : 1;
  555.   } fields;
  556. };
  557.  
  558. union short_pointer
  559. {
  560.   unsigned long address;
  561.   struct
  562.   {
  563.     unsigned A        : 1;
  564.     unsigned B        : 11;
  565.     unsigned C        : 2;
  566.     unsigned D        : 5;
  567.     unsigned w2a    : 1;
  568.     unsigned w2b    : 10;
  569.     unsigned pad    : 2;
  570.   } fields;
  571. };
  572.  
  573. union assemble_17_u
  574. {
  575.   long value;
  576.   struct
  577.   {
  578.     int sign_pad    : 13;
  579.     unsigned w0        : 1;
  580.     unsigned w1        : 5;
  581.     unsigned w2a    : 1;
  582.     unsigned w2b    : 10;
  583.     unsigned pad    : 2;
  584.   } fields;
  585. };
  586.  
  587. union assemble_12_u
  588. {
  589.   long value;
  590.   struct
  591.   {
  592.     int sign_pad    : 18;
  593.     unsigned w0        : 1;
  594.     unsigned w2a    : 1;
  595.     unsigned w2b    : 10;
  596.     unsigned pad    : 2;
  597.   } fields;
  598. };
  599.  
  600. long
  601. DEFUN (assemble_17, (inst), union branch_inst inst)
  602. {
  603.   union assemble_17_u off;
  604.  
  605.   off.fields.pad = 0;
  606.   off.fields.w2b = inst.fields.w2b;
  607.   off.fields.w2a = inst.fields.w2a;
  608.   off.fields.w1  = inst.fields.x_or_w1;
  609.   off.fields.w0  = inst.fields.w0;
  610.   off.fields.sign_pad = ((inst.fields.w0 == 0) ? 0 : -1);
  611.   return (off.value);
  612. }
  613.  
  614. long
  615. DEFUN (assemble_12, (inst), union branch_inst inst)
  616. {
  617.   union assemble_12_u off;
  618.  
  619.   off.fields.pad = 0;
  620.   off.fields.w2b = inst.fields.w2b;
  621.   off.fields.w2a = inst.fields.w2a;
  622.   off.fields.w0  = inst.fields.w0;
  623.   off.fields.sign_pad = ((inst.fields.w0 == 0) ? 0 : -1);
  624.   return (off.value);
  625. }
  626.  
  627. static unsigned long hppa_closure_hook = 0;
  628.  
  629. static unsigned long
  630. DEFUN (C_closure_entry_point, (C_closure), unsigned long C_closure)
  631. {
  632.   if ((C_closure & 0x3) != 0x2)
  633.     return (C_closure);
  634.   else
  635.   {
  636.     long offset;
  637.     extern int etext;
  638.     unsigned long entry_point;
  639.     char * blp = (* ((char **) (C_closure - 2)));
  640.  
  641.     blp = ((char *) (((unsigned long) blp) & ~3));
  642.     offset = (assemble_17 (* ((union branch_inst *) blp)));
  643.     entry_point = ((unsigned long) ((blp + 8) + offset));
  644.     return ((entry_point < ((unsigned long) &etext))
  645.         ? entry_point
  646.         : hppa_closure_hook);
  647.   }
  648. }
  649.  
  650. #define HAVE_BKPT_SUPPORT
  651.  
  652. static unsigned short branch_opcodes[] =
  653. {
  654.   0x20, 0x21, 0x22, 0x23, 0x28, 0x29, 0x2a, 0x2b,
  655.   0x30, 0x31, 0x32, 0x33, 0x38, 0x39, 0x3a
  656. };
  657.  
  658. static Boolean
  659.   branch_opcode_table[64];
  660.  
  661. static unsigned long
  662.   bkpt_instruction,
  663.   closure_bkpt_instruction,
  664.   closure_entry_bkpt_instruction,
  665.   * bkpt_normal_proceed_thunk,
  666.   * bkpt_plus_proceed_thunk,
  667.   * bkpt_minus_proceed_thunk_start,
  668.   * bkpt_minus_proceed_thunk,
  669.   * bkpt_closure_proceed_thunk,
  670.   * bkpt_closure_proceed_thunk_end,
  671.   * bkpt_proceed_buffer = ((unsigned long *) NULL);
  672.  
  673. #define FAHRENHEIT 451
  674.  
  675. static void
  676. DEFUN_VOID (bkpt_init)
  677. {
  678.   int i, this_size, max_size;
  679.   union branch_inst instr;
  680.   extern void EXFUN (bkpt_normal_proceed, (void));
  681.   extern void EXFUN (bkpt_plus_proceed, (void));
  682.   extern void EXFUN (bkpt_minus_proceed_start, (void));
  683.   extern void EXFUN (bkpt_minus_proceed, (void));
  684.   extern void EXFUN (bkpt_closure_proceed, (void));
  685.   extern void EXFUN (bkpt_closure_proceed_end, (void));
  686.  
  687.   for (i = 0;
  688.        i < ((sizeof (branch_opcode_table)) / (sizeof (Boolean)));
  689.        i++)
  690.     branch_opcode_table[i] = FALSE;
  691.  
  692.   for (i = 0;
  693.        i < ((sizeof (branch_opcodes)) / (sizeof (short)));
  694.        i++)
  695.     branch_opcode_table[branch_opcodes[i]] = TRUE;
  696.  
  697.   instr.fields.opcode    = 0x39;    /* BLE opcode */
  698.   instr.fields.t_or_b    = 03;    /* scheme_to_interface_ble */
  699.   instr.fields.n          = 01;    /* nullify */
  700.   instr.fields.s          = 01;    /* C code space, rotated illegibly */
  701.   instr.fields.w0         = 00;
  702.   instr.fields.x_or_w1    = 00;
  703.   instr.fields.w2a    = 00;
  704.   instr.fields.w2b    = ((FAHRENHEIT + 1) >> 2);
  705.  
  706.   bkpt_instruction = instr.inst;
  707.  
  708.   instr.fields.w2b    = ((FAHRENHEIT + 33) >> 2);
  709.   closure_entry_bkpt_instruction = instr.inst;
  710.  
  711.   instr.fields.opcode    = 0x38;    /* BE opcode */
  712.   instr.fields.w2b    = ((FAHRENHEIT + 9) >> 2);
  713.   closure_bkpt_instruction = instr.inst;
  714.  
  715.   bkpt_normal_proceed_thunk
  716.     = ((unsigned long *)
  717.        (C_closure_entry_point ((unsigned long) bkpt_normal_proceed)));
  718.   bkpt_plus_proceed_thunk
  719.     = ((unsigned long *)
  720.        (C_closure_entry_point ((unsigned long) bkpt_plus_proceed)));
  721.   bkpt_minus_proceed_thunk_start
  722.     = ((unsigned long *)
  723.        (C_closure_entry_point ((unsigned long) bkpt_minus_proceed_start)));
  724.   bkpt_minus_proceed_thunk
  725.     = ((unsigned long *)
  726.        (C_closure_entry_point ((unsigned long) bkpt_minus_proceed)));
  727.   bkpt_closure_proceed_thunk
  728.     = ((unsigned long *)
  729.        (C_closure_entry_point ((unsigned long) bkpt_closure_proceed)));
  730.   bkpt_closure_proceed_thunk_end
  731.     = ((unsigned long *)
  732.        (C_closure_entry_point ((unsigned long) bkpt_closure_proceed_end)));
  733.  
  734.   max_size = (bkpt_closure_proceed_thunk_end - bkpt_closure_proceed_thunk);
  735.   this_size = (bkpt_plus_proceed_thunk - bkpt_normal_proceed_thunk);
  736.   if (this_size > max_size)
  737.     max_size = this_size;
  738.   this_size = (bkpt_closure_proceed_thunk - bkpt_minus_proceed_thunk_start);
  739.   if (this_size > max_size)
  740.     max_size = this_size;
  741.   this_size = (bkpt_minus_proceed_thunk_start - bkpt_plus_proceed_thunk);
  742.   if (this_size > max_size)
  743.     max_size = this_size;
  744.   
  745.   bkpt_proceed_buffer = ((unsigned long *)
  746.              (malloc (max_size * (sizeof (unsigned long)))));
  747.   if (bkpt_proceed_buffer == ((unsigned long *) NULL))
  748.   {
  749.     outf_fatal ("Unable to allocate the breakpoint buffer.\n");
  750.     termination_init_error ();
  751.   }
  752.   return;
  753. }
  754.  
  755. #define BKPT_KIND_CLOSURE        0
  756. #define BKPT_KIND_NORMAL        1
  757. #define BKPT_KIND_PC_REL_BRANCH        2
  758. #define BKPT_KIND_BL_INST        3
  759. #define BKPT_KIND_BLE_INST        4
  760. #define BKPT_KIND_CLOSURE_ENTRY        5
  761.  
  762. extern void EXFUN (cache_flush_region, (PTR, long, unsigned int));
  763.  
  764. static SCHEME_OBJECT
  765. DEFUN (alloc_bkpt_handle, (kind, first_instr, entry_point),
  766.        int kind AND unsigned long first_instr AND PTR entry_point)
  767. {
  768.   SCHEME_OBJECT * handle;
  769.   Primitive_GC_If_Needed (5);
  770.   handle = Free;
  771.   Free += 5;
  772.  
  773.   handle[0] = (MAKE_OBJECT (TC_MANIFEST_VECTOR, 4));
  774.   handle[1] = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 2));
  775.   handle[2] = ((SCHEME_OBJECT) (FIXNUM_ZERO + kind));
  776.   handle[3] = ((SCHEME_OBJECT) first_instr);
  777.   handle[4] = (ENTRY_TO_OBJECT (entry_point));
  778.   
  779.   return (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, handle));
  780. }
  781.  
  782. SCHEME_OBJECT
  783. DEFUN (bkpt_install, (entry_point), PTR entry_point)
  784. {
  785.   unsigned long kind;
  786.   SCHEME_OBJECT handle;
  787.   unsigned long first_instr = (* ((unsigned long *) entry_point));
  788.   unsigned short opcode = ((first_instr >> 26) & 0x3f);
  789.   unsigned long new_instr = bkpt_instruction;
  790.  
  791.   if ((COMPILED_ENTRY_FORMAT_WORD (entry_point)) == FORMAT_WORD_CLOSURE)
  792.   {
  793.     /* This assumes that the first instruction is normal */ 
  794.     kind = BKPT_KIND_CLOSURE_ENTRY;
  795.     new_instr = closure_entry_bkpt_instruction;
  796.   }
  797.   else if ((! (branch_opcode_table[opcode])) || (opcode == 0x38))
  798.     kind = BKPT_KIND_NORMAL;    /* BE instr included */
  799.   else if (opcode == 0x39)
  800. #if 0
  801.     kind = BKPT_KIND_BLE_INST;
  802. #else /* for now */
  803.     return (SHARP_F);
  804. #endif
  805.   else if (opcode != 0x3a)
  806.   {
  807.     unsigned long second_instr = (* (((unsigned long *) entry_point) + 1));
  808.     unsigned long second_opcode = ((second_instr >> 26) & 0x3f);
  809.  
  810.     /* We can't handle breakpoints to a branch instruction
  811.        with another branch instruction in its delay slot.
  812.        This could be nullification sensitive, but not
  813.        currently worthwhile.
  814.      */
  815.  
  816.     if (branch_opcode_table[second_opcode])
  817.       return (SHARP_F);
  818.  
  819.     kind = BKPT_KIND_PC_REL_BRANCH;
  820.   }
  821.  
  822.   else
  823.   {
  824.     union branch_inst finstr;
  825.  
  826.     finstr.inst = first_instr;
  827.     switch (finstr.fields.s)    /* minor opcode */
  828.     {
  829.       case 0:            /* BL instruction */
  830. #if 0
  831.         kind = BKPT_KIND_BL_INST;
  832.     break;
  833. #endif /* for now, fall through */
  834.  
  835.       case 1:            /* GATE instruction */
  836.       case 2:            /* BLR  instruction */
  837.       default:            /* ?? */
  838.     return (SHARP_F);
  839.  
  840.       case 6:
  841.     kind = BKPT_KIND_NORMAL;
  842.     break;
  843.     }
  844.   }
  845.  
  846.   handle = (alloc_bkpt_handle (kind, first_instr, entry_point));
  847.  
  848.   (* ((unsigned long *) entry_point)) = new_instr;
  849.   cache_flush_region (((PTR) entry_point), 1, (D_CACHE | I_CACHE));
  850.  
  851.   return (handle);
  852. }
  853.  
  854. SCHEME_OBJECT
  855. DEFUN (bkpt_closure_install, (entry_point), PTR entry_point)
  856. {
  857.   unsigned long * instrs = ((unsigned long *) entry_point);
  858.   SCHEME_OBJECT handle;
  859.  
  860.   handle = (alloc_bkpt_handle (BKPT_KIND_CLOSURE, instrs[2], entry_point));
  861.   instrs[2] = closure_bkpt_instruction;
  862.   cache_flush_region (((PTR) &instrs[2]), 1, (D_CACHE | I_CACHE));
  863.   return (handle);
  864. }
  865.  
  866. void
  867. DEFUN (bkpt_remove, (entry_point, handle),
  868.        PTR entry_point AND SCHEME_OBJECT handle)
  869. {
  870.   int offset;
  871.   unsigned long * instrs = ((unsigned long *) entry_point);
  872.  
  873.   if ((instrs[0] == bkpt_instruction)
  874.       || (instrs[0] == closure_entry_bkpt_instruction))
  875.     offset = 0;
  876.   else if (instrs[2] == closure_bkpt_instruction)
  877.     offset = 2;
  878.   else
  879.     error_external_return ();
  880.  
  881.   instrs[offset] = ((unsigned long) (FAST_MEMORY_REF (handle, 3)));
  882.   cache_flush_region (((PTR) &instrs[offset]), 1, (D_CACHE | I_CACHE));
  883.   return;
  884. }
  885.  
  886. Boolean
  887. DEFUN (bkpt_p, (entry_point), PTR entry_point)
  888. {
  889.   unsigned long * instrs = ((unsigned long *) entry_point);
  890.  
  891.   return ((instrs[0] == bkpt_instruction)
  892.       || (instrs[0] == closure_entry_bkpt_instruction)
  893.       || (instrs[2] == closure_bkpt_instruction));
  894. }
  895.  
  896. Boolean
  897. DEFUN (do_bkpt_proceed, (value), unsigned long * value)
  898. {
  899.   unsigned long * buffer = ((unsigned long *) bkpt_proceed_buffer);
  900.   SCHEME_OBJECT ep = (STACK_POP ());
  901.   SCHEME_OBJECT handle = (STACK_POP ());
  902.   SCHEME_OBJECT state = (STACK_POP ());
  903.  
  904.   STACK_POP ();            /* Pop duplicate entry point. */
  905.  
  906.   switch (OBJECT_DATUM (FAST_MEMORY_REF (handle, 2)))
  907.   {
  908.     case BKPT_KIND_CLOSURE:
  909.     {
  910.       int i, len;
  911.       unsigned long * clos_entry
  912.     = (OBJECT_ADDRESS (FAST_MEMORY_REF (handle, 4)));
  913.       SCHEME_OBJECT real_entry_point;
  914.  
  915.       EXTRACT_CLOSURE_ENTRY_ADDRESS (real_entry_point, clos_entry);
  916.       len = (bkpt_closure_proceed_thunk_end - bkpt_closure_proceed_thunk);
  917.       for (i = 0; i < (len - 2); i++)
  918.     buffer[i] = bkpt_closure_proceed_thunk[i];
  919.       cache_flush_region (((PTR) buffer), (len - 2), (D_CACHE | I_CACHE));
  920.  
  921.       buffer[len - 2] = ((unsigned long) clos_entry);
  922.       buffer[len - 1] = real_entry_point;
  923.  
  924.       Val = SHARP_F;
  925.       * value = ((unsigned long) buffer);
  926.       return (TRUE);
  927.     }
  928.  
  929.     case BKPT_KIND_NORMAL:
  930.     {
  931.       int i, len;
  932.  
  933.       len = (bkpt_plus_proceed_thunk - bkpt_normal_proceed_thunk);
  934.       for (i = 0; i < (len - 2); i++)
  935.     buffer[i] = bkpt_normal_proceed_thunk[i];
  936.       buffer[len - 2] = ((unsigned long) (FAST_MEMORY_REF (handle, 3)));
  937.  
  938.       cache_flush_region (((PTR) buffer), (len - 1), (D_CACHE | I_CACHE));
  939.       buffer[len - 1] = (((unsigned long) (OBJECT_ADDRESS (ep))) + 4);
  940.  
  941.       Val = state;
  942.       * value = ((unsigned long) buffer);
  943.       return (TRUE);
  944.     }
  945.  
  946.     case BKPT_KIND_CLOSURE_ENTRY:
  947.     {
  948.       STACK_PUSH (state);    /* closure object */
  949.       * value = ((unsigned long) ((OBJECT_ADDRESS (ep)) + 2));
  950.       return (TRUE);
  951.     }
  952.  
  953.     case BKPT_KIND_BL_INST:
  954.     case BKPT_KIND_BLE_INST:
  955.     default:
  956.       STACK_PUSH (ep);
  957.       * value = ((unsigned long) ERR_EXTERNAL_RETURN);
  958.       return (FALSE);
  959.  
  960.     case BKPT_KIND_PC_REL_BRANCH:
  961.     {
  962.       long offset;
  963.       int i, len, clobber;
  964.       union branch_inst new, old;
  965.       unsigned long * instrs = ((unsigned long *) (OBJECT_ADDRESS (ep)));
  966.       unsigned long * block;
  967.  
  968.       old.inst = ((unsigned long) (FAST_MEMORY_REF (handle, 3)));
  969.       offset = (assemble_12 (old));
  970.       if (offset >= 0)
  971.       {
  972.     block = bkpt_plus_proceed_thunk;
  973.     len = (bkpt_minus_proceed_thunk_start - block);
  974.     clobber = 0;
  975.       }
  976.       else
  977.       {
  978.     block = bkpt_minus_proceed_thunk_start;
  979.     len = (bkpt_closure_proceed_thunk - block);
  980.     clobber = (bkpt_minus_proceed_thunk - block);
  981.       }
  982.       
  983.       for (i = 0; i < (len - 2); i++)
  984.     buffer[i] = block[i];
  985.  
  986.       new.inst = buffer[clobber];
  987.       old.inst = ((unsigned long) (FAST_MEMORY_REF (handle, 3)));
  988.       old.fields.w2b = new.fields.w2b;
  989.       old.fields.w2a = new.fields.w2a;
  990.       old.fields.w0 = new.fields.w0;
  991.       buffer[clobber] = old.inst;
  992.       buffer[clobber + 1] = instrs[1];
  993.       cache_flush_region (((PTR) buffer), (len - 2), (D_CACHE | I_CACHE));
  994.  
  995.       buffer[len - 2] = (((unsigned long) instrs) + 8);
  996.       buffer[len - 1] = ((((unsigned long) instrs) + 8)
  997.              + offset);
  998.       
  999.       Val = state;
  1000.       * value = ((unsigned long) &buffer[clobber]);
  1001.       return (TRUE);
  1002.     }
  1003.   }
  1004. }
  1005.  
  1006. static void
  1007. DEFUN (transform_procedure_entries, (len, otable, ntable),
  1008.        long len AND PTR * otable AND PTR * ntable)
  1009. {
  1010.   long counter;
  1011.   
  1012.   for (counter = 0; counter < len; counter++)
  1013.     ntable[counter] =
  1014.       ((PTR) (C_closure_entry_point ((unsigned long) (otable [counter]))));
  1015.   return;
  1016. }       
  1017.  
  1018. static PTR *
  1019. DEFUN (transform_procedure_table, (table_length, old_table),
  1020.        long table_length AND PTR * old_table)
  1021. {
  1022.   PTR * new_table;
  1023.  
  1024.   new_table = ((PTR *) (malloc (table_length * (sizeof (PTR)))));
  1025.   if (new_table == ((PTR *) NULL))
  1026.   {
  1027.     outf_fatal ("transform_procedure_table: malloc (%d) failed.\n",
  1028.         (table_length * (sizeof (PTR))));
  1029.     exit (1);
  1030.   }
  1031.   transform_procedure_entries (table_length, old_table, new_table);
  1032.   return (new_table);
  1033. }
  1034.  
  1035. #define UTIL_TABLE_PC_REF(index)                    \
  1036.   (C_closure_entry_point (UTIL_TABLE_PC_REF_REAL (index)))
  1037.  
  1038. #ifdef _BSD4_3
  1039. #  include <sys/mman.h>
  1040. #  define VM_PROT_SCHEME (PROT_READ | PROT_WRITE | PROT_EXEC)
  1041. #endif
  1042.  
  1043. void
  1044. DEFUN_VOID (change_vm_protection)
  1045. {
  1046. #if 0
  1047.   /* Thought I needed this under _BSD4_3 */
  1048.  
  1049.   unsigned long pagesize = (getpagesize ());
  1050.   unsigned long heap_start_page;
  1051.   unsigned long size;
  1052.  
  1053.   heap_start_page = (((unsigned long) Heap) & (pagesize - 1));
  1054.   size = (((((unsigned long) Highest_Allocated_Address) + (pagesize - 1))
  1055.        & (pagesize - 1))
  1056.       - heap_start_page);
  1057.   if ((mprotect (((caddr_t) heap_start_page), size, VM_PROT_SCHEME))
  1058.       == -1)
  1059.   {
  1060.     perror ("\nchange_vm_protection");
  1061.     outf_fatal ("mprotect (0x%lx, 0x%lx, 0x%lx)\n",
  1062.         heap_start_page, size, VM_PROT_SCHEME);
  1063.     outf_fatal ("ASM_RESET_HOOK: Unable to change VM protection of Heap.\n");
  1064.     termination_init_error ();
  1065.   }
  1066. #endif
  1067.   return;
  1068. }
  1069.  
  1070. #include "option.h"
  1071.  
  1072. #ifndef MODELS_FILENAME
  1073. #define MODELS_FILENAME "hppacach.mod"
  1074. #endif
  1075.  
  1076. static struct pdc_cache_dump cache_info;
  1077.  
  1078. static void
  1079. DEFUN_VOID (flush_i_cache_initialize)
  1080. {
  1081.   extern char * EXFUN (getenv, (const char *));
  1082.   CONST char * models_filename =
  1083.     (search_path_for_file (0, MODELS_FILENAME, 1, 1));
  1084.   char * model;
  1085.  
  1086.   model = (getenv ("MITSCHEME_HPPA_MODEL"));
  1087.  
  1088. #ifdef _HPUX
  1089.   if (model == ((char *) NULL))
  1090.   {
  1091.     struct utsname sysinfo;
  1092.     if ((uname (&sysinfo)) < 0)
  1093.     {
  1094.       outf_fatal ("\nflush_i_cache: uname failed.\n");
  1095.       goto loser;
  1096.     }
  1097.     model = &sysinfo.machine[0];
  1098.   }
  1099. #endif /* _HPUX */
  1100.   if (model == ((char *) NULL))
  1101.   {
  1102.     outf_fatal
  1103.       ("\nflush_i_cache: MITSCHEME_HPPA_MODEL not set in environment.\n");
  1104.     goto loser;
  1105.   }
  1106.   {
  1107.     int fd = (open (models_filename, O_RDONLY));
  1108.     if (fd < 0)
  1109.       {
  1110.     outf_fatal ("\nflush_i_cache: open (%s) failed.\n",
  1111.             models_filename);
  1112.     goto loser;
  1113.       }
  1114.     while (1)
  1115.       {
  1116.     int read_result =
  1117.       (read (fd,
  1118.          ((char *) (&cache_info)),
  1119.          (sizeof (struct pdc_cache_dump))));
  1120.     if (read_result == 0)
  1121.       {
  1122.         close (fd);
  1123.         break;
  1124.       }
  1125.     if (read_result != (sizeof (struct pdc_cache_dump)))
  1126.       {
  1127.         close (fd);
  1128.         outf_fatal ("\nflush_i_cache: read (%s) failed.\n",
  1129.             models_filename);
  1130.         goto loser;
  1131.       }
  1132.     if ((strcmp (model, (cache_info . hardware))) == 0)
  1133.       {
  1134.         close (fd);
  1135.         return;
  1136.       }
  1137.       }
  1138.   }
  1139.   outf_fatal (
  1140.           "The cache parameters database has no entry for the %s model.\n",
  1141.           model);
  1142.   outf_fatal ("Please make an entry in the database;\n");
  1143.   outf_fatal ("the installation notes contain instructions for doing so.\n");
  1144.  loser:
  1145.   outf_fatal ("\nASM_RESET_HOOK: Unable to read cache parameters.\n");
  1146.   termination_init_error ();
  1147. }
  1148.  
  1149. /* This loads the cache information structure for use by flush_i_cache,
  1150.    sets the floating point flags correctly, and accommodates the c
  1151.    function pointer closure format problems for utilities for HP-UX >= 8.0 .
  1152.    It also changes the VM protection of the heap, if necessary.
  1153.  */
  1154.  
  1155. extern PTR * hppa_utility_table;
  1156. extern PTR * hppa_primitive_table;
  1157.  
  1158. PTR * hppa_utility_table = ((PTR *) NULL);
  1159.  
  1160. static void
  1161. DEFUN (hppa_reset_hook, (utility_length, utility_table),
  1162.        long utility_length AND PTR * utility_table)
  1163. {
  1164.   extern void EXFUN (interface_initialize, (void));
  1165.   extern void EXFUN (cross_segment_call, (void));
  1166.  
  1167.   flush_i_cache_initialize ();
  1168.   interface_initialize ();
  1169.   change_vm_protection ();
  1170.   hppa_closure_hook
  1171.     = (C_closure_entry_point ((unsigned long) cross_segment_call));
  1172.   hppa_utility_table
  1173.     = (transform_procedure_table (utility_length, utility_table));
  1174.   return;
  1175. }
  1176.  
  1177. #define ASM_RESET_HOOK() do                        \
  1178. {                                    \
  1179.   bkpt_init ();                                \
  1180.   hppa_reset_hook (((sizeof (utility_table)) / (sizeof (PTR))),        \
  1181.            ((PTR *) (&utility_table[0])));            \
  1182. } while (0)
  1183.  
  1184. PTR * hppa_primitive_table = ((PTR *) NULL);
  1185.  
  1186. void
  1187. DEFUN (hppa_update_primitive_table, (low, high), int low AND int high)
  1188. {
  1189.   transform_procedure_entries ((high - low),
  1190.                    ((PTR *) (Primitive_Procedure_Table + low)),
  1191.                    (hppa_primitive_table + low));
  1192.   return;
  1193. }
  1194.  
  1195. Boolean 
  1196. DEFUN (hppa_grow_primitive_table, (new_size), int new_size)
  1197. {
  1198.   PTR * new_table
  1199.     = ((PTR *) (realloc (hppa_primitive_table, (new_size * (sizeof (PTR))))));
  1200.   if (new_table != ((PTR *) NULL))
  1201.     hppa_primitive_table = new_table;
  1202.   return (new_table != ((PTR *) NULL));
  1203. }
  1204.  
  1205. /*
  1206.    Note: The following does not do a full decoding of the BLE instruction.
  1207.    It assumes that the bits have been set by STORE_ABSOLUTE_ADDRESS below,
  1208.    which decomposes an absolute address according to the `short_pointer'
  1209.    structure above, and thus certain fields are 0.
  1210.  
  1211.    The sequence inserted by STORE_ABSOLUTE_ADDRESS is approximately
  1212.    (the actual address decomposition is given above).
  1213.    LDIL        L'ep,26
  1214.    BLE        R'ep(5,26)
  1215.  */
  1216.  
  1217. unsigned long
  1218. DEFUN (hppa_extract_absolute_address, (addr), unsigned long * addr)
  1219. {
  1220.   union short_pointer result;
  1221.   union branch_inst ble;
  1222.   union ldil_inst ldil;
  1223.  
  1224.   ldil.inst = *addr++;
  1225.   ble.inst = *addr;
  1226.  
  1227.   /* Fill the padding */
  1228.   result.address = 0;
  1229.  
  1230.   result.fields.A = ldil.fields.A;
  1231.   result.fields.B = ldil.fields.B;
  1232.   result.fields.C = ldil.fields.C;
  1233.   result.fields.D = ldil.fields.D;
  1234.   result.fields.w2a = ble.fields.w2a;
  1235.   result.fields.w2b = ble.fields.w2b;
  1236.  
  1237.   return (result.address);
  1238. }
  1239.  
  1240. void
  1241. DEFUN (hppa_store_absolute_address, (addr, sourcev, nullify_p),
  1242.        unsigned long * addr AND unsigned long sourcev
  1243.        AND unsigned long nullify_p)
  1244. {
  1245.   union short_pointer source;
  1246.   union ldil_inst ldil;
  1247.   union branch_inst ble;
  1248.  
  1249.   source.address = sourcev;
  1250.  
  1251. #if 0
  1252.   ldil.fields.opcode = 0x08;
  1253.   ldil.fields.base = 26;
  1254.   ldil.fields.E = 0;
  1255. #else
  1256.   ldil.inst = ((0x08 << 26) | (26 << 21));
  1257. #endif
  1258.  
  1259.   ldil.fields.A = source.fields.A;
  1260.   ldil.fields.B = source.fields.B;
  1261.   ldil.fields.C = source.fields.C;
  1262.   ldil.fields.D = source.fields.D;
  1263.  
  1264. #if 0
  1265.   ble.fields.opcode = 0x39;
  1266.   ble.fields.t_or_b = 26;
  1267.   ble.fields.x_or_w1 = 0;
  1268.   ble.fields.s = 3;
  1269.   ble.fields.w0 = 0;
  1270. #else
  1271.   ble.inst = ((0x39 << 26) | (26 << 21) | (3 << 13));
  1272. #endif
  1273.  
  1274.   ble.fields.w2a = source.fields.w2a;
  1275.   ble.fields.w2b = source.fields.w2b;
  1276.   ble.fields.n = (nullify_p & 1);
  1277.  
  1278.   *addr++ = ldil.inst;
  1279.   *addr = ble.inst;
  1280.   return;
  1281. }
  1282.  
  1283. /* Cache flushing/pushing code.
  1284.    Uses routines from cmpaux-hppa.m4.
  1285.  */
  1286.  
  1287. extern void
  1288.   EXFUN (flush_i_cache, (void)),
  1289.   EXFUN (push_d_cache_region, (PTR, unsigned long));
  1290.  
  1291. void
  1292. DEFUN_VOID (flush_i_cache)
  1293. {
  1294.   extern void
  1295.     EXFUN (cache_flush_all, (unsigned int, struct pdc_cache_result *));
  1296.  
  1297.   struct pdc_cache_result * cache_desc;
  1298.   
  1299.   cache_desc = ((struct pdc_cache_result *) &(cache_info.cache_format));
  1300.  
  1301.   /* The call can be interrupted in the middle of a set, so do it twice.
  1302.      Probability of two interrupts in the same cache line is
  1303.      exceedingly small, so this is likely to win.
  1304.      On the other hand, if the caches are directly mapped, a single
  1305.      call can't lose.
  1306.      In addition, if the cache is shared, there is no need to flush at all.
  1307.    */
  1308.  
  1309.   if (((cache_desc->I_info.conf.bits.fsel & 1) == 0)
  1310.       || ((cache_desc->D_info.conf.bits.fsel & 1) == 0))
  1311.   {
  1312.     unsigned int flag = 0;
  1313.  
  1314.     if (cache_desc->I_info.loop != 1)
  1315.       flag |= I_CACHE;
  1316.     if (cache_desc->D_info.loop != 1)
  1317.       flag |= D_CACHE;
  1318.  
  1319.     if (flag != 0)
  1320.       cache_flush_all (flag, cache_desc);
  1321.     cache_flush_all ((D_CACHE | I_CACHE), cache_desc);
  1322.   }
  1323. }
  1324.  
  1325. void
  1326. DEFUN (push_d_cache_region, (start_address, block_size),
  1327.        PTR start_address AND unsigned long block_size)
  1328. {
  1329.   extern void
  1330.     EXFUN (cache_flush_region, (PTR, long, unsigned int));
  1331.  
  1332.   struct pdc_cache_result * cache_desc;
  1333.   
  1334.   cache_desc = ((struct pdc_cache_result *) &(cache_info.cache_format));
  1335.  
  1336.   /* Note that the first and last words are also flushed from the I-cache
  1337.      in case this object is adjacent to another that has already caused
  1338.      the cache line to be copied into the I-cache.
  1339.    */
  1340.  
  1341.   if (((cache_desc->I_info.conf.bits.fsel & 1) == 0)
  1342.       || ((cache_desc->D_info.conf.bits.fsel & 1) == 0))
  1343.   {
  1344.     cache_flush_region (start_address, block_size, D_CACHE);
  1345.     cache_flush_region (start_address, 1, I_CACHE);
  1346.     cache_flush_region (((PTR)
  1347.              (((unsigned long *) start_address)
  1348.               + (block_size - 1))),
  1349.             1,
  1350.             I_CACHE);
  1351.   }
  1352.   return;
  1353. }
  1354.  
  1355. #define DECLARE_CMPINTMD_UTILITIES()                    \
  1356.   UTLD (assemble_17),                            \
  1357.   UTLD (assemble_12),                            \
  1358.   UTLD (C_closure_entry_point),                        \
  1359.   UTLD (bkpt_init),                            \
  1360.   UTLD (alloc_bkpt_handle),                        \
  1361.   UTLD (bkpt_install),                            \
  1362.   UTLD (bkpt_closure_install),                        \
  1363.   UTLD (bkpt_remove),                            \
  1364.   UTLD (bkpt_p),                            \
  1365.   UTLD (do_bkpt_proceed),                        \
  1366.   UTLD (transform_procedure_entries),                    \
  1367.   UTLD (transform_procedure_table),                    \
  1368.   UTLD (change_vm_protection),                        \
  1369.   UTLD (hppa_reset_hook),                        \
  1370.   UTLD (hppa_update_primitive_table),                    \
  1371.   UTLD (hppa_grow_primitive_table),                    \
  1372.   UTLD (hppa_extract_absolute_address),                    \
  1373.   UTLD (hppa_store_absolute_address),                    \
  1374.   UTLD (flush_i_cache),                            \
  1375.   UTLD (push_d_cache_region),                        \
  1376.   UTLD (flush_i_cache_initialize)
  1377.  
  1378. #endif /* IN_CMPINT_C */
  1379.  
  1380. #endif /* CMPINTMD_H_INCLUDED */
  1381.