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 / alpha.h next >
C/C++ Source or Header  |  1993-06-24  |  26KB  |  749 lines
  1. /* -*- C -*-
  2.  
  3. $Id: alpha.h,v 1.5 1993/06/24 04:02:18 gjr Exp $
  4.  
  5. Copyright (c) 1992-1993 Digital Equipment Corporation (D.E.C.)
  6.  
  7. This software was developed at the Digital Equipment Corporation
  8. Cambridge Research Laboratory.  Permission to copy this software, to
  9. redistribute it, and to use it for any purpose is granted, subject to
  10. the following restrictions and understandings.
  11.  
  12. 1. Any copy made of this software must include this copyright notice
  13. in full.
  14.  
  15. 2. Users of this software agree to make their best efforts (a) to
  16. return to both the Digital Equipment Corporation Cambridge Research
  17. Lab (CRL) and the MIT Scheme project any improvements or extensions
  18. that they make, so that these may be included in future releases; and
  19. (b) to inform CRL and MIT of noteworthy uses of this software.
  20.  
  21. 3. All materials developed as a consequence of the use of this
  22. software shall duly acknowledge such use, in accordance with the usual
  23. standards of acknowledging credit in academic research.
  24.  
  25. 4. D.E.C. has made no warrantee or representation that the operation
  26. of this software will be error-free, and D.E.C. is under no obligation
  27. to provide any services, by way of maintenance, update, or otherwise.
  28.  
  29. 5. In conjunction with products arising from the use of this material,
  30. there shall be no use of the name of the Digital Equipment Corporation
  31. nor of any adaptation thereof in any advertising, promotional, or
  32. sales literature without prior written consent from D.E.C. in each
  33. case. */
  34.  
  35. /*
  36.  *
  37.  * Compiled code interface macros.
  38.  *
  39.  * See cmpint.txt for a description of these fields.
  40.  *
  41.  * Specialized for the Alpha
  42.  */
  43.  
  44. #ifndef CMPINTMD_H_INCLUDED
  45. #define CMPINTMD_H_INCLUDED
  46.  
  47. #include "cmptype.h"
  48.  
  49. /* Machine parameters to be set by the user. */
  50.  
  51. /* Until cmpaux-alpha.m4 is updated. */
  52. #define CMPINT_USE_STRUCS
  53.  
  54. #define PAGE_SIZE (8 * 1024)
  55.  
  56. /* Processor type.  Choose a number from the above list, or allocate your own.
  57.  */
  58.  
  59. #define COMPILER_PROCESSOR_TYPE            COMPILER_ALPHA_TYPE
  60.  
  61. /* Size (in long words) of the contents of a floating point register if
  62.    different from a double.  For example, an MC68881 saves registers
  63.    in 96 bit (3 longword) blocks.
  64.    #define COMPILER_TEMP_SIZE            1
  65. */
  66.  
  67. /* Descriptor size.
  68.    This is the size of the offset field, and of the format field.
  69.    This definition probably does not need to be changed.
  70.  */
  71.  
  72. typedef unsigned short format_word; /* 16 bits */
  73.  
  74. /* PC alignment constraint.
  75.    Change PC_ZERO_BITS to be how many low order bits of the pc are
  76.    guaranteed to be 0 always because of PC alignment constraints.
  77. */
  78.  
  79. #define PC_ZERO_BITS                    2
  80.  
  81. /* Utilities for manipulating absolute subroutine calls.
  82.    On the ALPHA this is done with either
  83.        BR rtarget, displacement
  84.         <absolute address of destination>
  85.                    or
  86.         JMP rtarget, closure_hook
  87.         <absolute address of destination>
  88.    The latter form is installed by the out-of-line code that allocates
  89.    and initializes closures and execute caches.  The former is
  90.    generated by the GC when the closure is close enough to the
  91.    destination address to fit in a branch displacement (4 megabytes).
  92.  
  93.    Why does EXTRACT_ABSOLUTE_ADDRESS store into the execute cache or
  94.    closure?  Because the GC (which calls it) assumes that if the
  95.    destination is in constant space there will be no need to modify the
  96.    cell, since the destination won't move.  Since the Alpha uses
  97.    PC-relative addressing, though, the cell needs to be updated if the
  98.    cell has moved even if the destination hasn't.
  99.  */
  100.  
  101. #define EXTRACT_ABSOLUTE_ADDRESS(target, address)            \
  102.   (target) = (* ((SCHEME_OBJECT *) (((int *) address) + 1)));        \
  103.   /* The +1 skips over the instruction to the absolute address  */    \
  104.   alpha_store_absolute_address(((void *) target), ((void *) address))
  105.  
  106.  
  107. #define STORE_ABSOLUTE_ADDRESS(entry_point, address)    \
  108.   alpha_store_absolute_address (((void *) entry_point), ((void *) address))
  109.  
  110. extern void EXFUN(alpha_store_absolute_address, (void *, void *));
  111.  
  112. #define opJMP            0x1A
  113. #define fnJMP            0x00
  114. #define JMP(linkage, dest, displacement)    \
  115.   ((opJMP << 26) | ((linkage) << 21) |        \
  116.    ((dest) << 16) | (fnJMP << 14) |        \
  117.    (((displacement)>>PC_ZERO_BITS) & ((1<<14)-1)))
  118.  
  119. /* Compiled Code Register Conventions */
  120. /* This must match the compiler and cmpaux-alpha.m4 */
  121.  
  122. #define COMP_REG_UTILITY_CODE        1
  123. #define COMP_REG_TRAMP_INDEX        COMP_REG_UTILITY_CODE
  124. #define COMP_REG_STACK_POINTER        2
  125. #define COMP_REG_MEMTOP            3
  126. #define COMP_REG_FREE            4
  127. #define COMP_REG_REGISTERS        9
  128. #define COMP_REG_SCHEME_INTERFACE    10
  129. #define COMP_REG_CLOSURE_HOOK        11
  130. #define COMP_REG_LONGJUMP        COMP_REG_CLOSURE_HOOK
  131. #define COMP_REG_FIRST_ARGUMENT        17
  132. #define COMP_REG_LINKAGE        26
  133. #define COMP_REG_TEMPORARY        28
  134. #define COMP_REG_ZERO            31
  135.  
  136. #ifdef IN_CMPINT_C
  137. #define PC_FIELD_SIZE        21
  138. #define MAX_PC_DISPLACEMENT    (1<<(PC_FIELD_SIZE+PC_ZERO_BITS-1))
  139. #define MIN_PC_DISPLACEMENT    (-MAX_PC_DISPLACEMENT)
  140. #define opBR            0x30
  141.  
  142. void
  143. DEFUN (alpha_store_absolute_address, (entry_point, address),
  144.        void *entry_point AND void *address)
  145. {
  146.   extern void scheme_closure_hook (void);
  147.   int *Instruction_Address = (int *) address;
  148.   SCHEME_OBJECT *Addr = (SCHEME_OBJECT *) (Instruction_Address + 1);
  149.   SCHEME_OBJECT *Entry_Point = (SCHEME_OBJECT *) entry_point;
  150.   long offset = ((char *) Entry_Point) - ((char *) Addr);
  151.   *Addr = (SCHEME_OBJECT) Entry_Point;
  152.   if ((offset < MAX_PC_DISPLACEMENT) &&
  153.       (offset >= MIN_PC_DISPLACEMENT))
  154.     *Instruction_Address =
  155.       (opBR << 26) | (COMP_REG_LINKAGE << 21) |
  156.       ((offset>>PC_ZERO_BITS)  & ((1L<<PC_FIELD_SIZE)-1));
  157.   else
  158.     *Instruction_Address =
  159.       JMP(COMP_REG_LINKAGE, COMP_REG_LONGJUMP,
  160.       (((char *) scheme_closure_hook) - ((char *) Addr)));
  161.   return;
  162. }
  163. #endif
  164.  
  165. /* Interrupt/GC polling. */
  166.  
  167. /* Procedure entry points look like:
  168.  
  169.         CONTINUATIONS AND ORDINARY PROCEDURES
  170.  
  171.    GC_Handler: <code sequence 1> -- call interrupt handler
  172.                <entry descriptor> (32 bits)
  173.    label:      <code sequence 2> -- test for interrupts
  174.                <code for procedure>
  175.    Interrupt:  BR GC_Handler     -- to help branch predictor in
  176.                                     code sequences 2
  177.  
  178.    It is a good idea to align the GC_Handler (hence the label) so that
  179.    we dual issue nicely.
  180.  
  181. Code sequence 1 (call interrupt handler):
  182.    LDA   UTILITY_CODE,#code(ZERO)
  183.    JMP   LINKAGE,(SCHEME-TO-INTERFACE-JSR)
  184.  
  185. Code sequence 2 (test for interrupts):
  186.    CMPLT FREE,MEMTOP,temp
  187.    LDQ     MEMTOP, 0(BLOCK)
  188.    BEQ   temp,Interrupt
  189.  
  190.                    CLOSURES
  191.  
  192.               <entry descriptor> (32 bits)
  193.    label:     <code sequence 3> -- test for interrupts
  194.    merge:     <code for procedure>
  195.    Internal-Label:
  196.               <code sequence 4> -- test for interrupts, and
  197.                                    branch to merge: if none
  198.    Interrupt: <code sequence 5> -- call interrupt handler
  199.                                    to help branch predictor in
  200.                                    code sequence 3
  201.  
  202. Code sequence 3 (test for interrupts):
  203.    ...SUBQ SP,#8,SP              -- in closure object before entry
  204.    SUBQ  LINKAGE,#8,temp         -- bump ret. addr. back to entry point
  205.    CMPLT FREE,MEMTOP,temp2       -- interrupt/gc check
  206.    LDQ   MEMTOP,0(BLOCK)         -- Fill MemTop register
  207.    BIS   CC_ENTRY_TYPE,temp,temp -- put tag on closure object
  208.    STQ   temp,0(SP)              -- save closure on top of stack
  209.    BEQ   temp2,Interrupt         -- possible interrupt ...  
  210.  
  211. Code sequence 4 (test for interrupts):
  212.   *Note*: In most machines code sequence 3 and 4 are the same and are
  213.   shared. We've carefully optimized sequence 3 for dual issue, so it
  214.   differs from sequence 4.  Time over space ...
  215.    CMPLT FREE,MEMTOP,temp        -- interrupt/gc check
  216.    LDQ   MEMTOP,0(BLOCK)         -- Fill MemTop register
  217.    BNE   temp,Merge              -- branch back if no interrupt
  218.  
  219. Code sequence 5 (call interrupt handler):
  220.    LDA   UTILITY_CODE,#code(ZERO)
  221.    JMP   LINKAGE,(SCHEME-TO-INTERFACE)
  222.  
  223. */
  224.  
  225. #define INSTRUCTIONS            *4 /* bytes/instruction */
  226.  
  227. /* The length of code sequence 1, above */
  228. #define ENTRY_PREFIX_LENGTH        (2 INSTRUCTIONS)
  229.  
  230. /* Compiled closures */
  231.  
  232. /* On the Alpha (byte offsets from start of closure):
  233.  
  234.      -16: TC_MANIFEST_CLOSURE || length of object
  235.      -8 : count of entry points
  236.      -4 : Format word and GC offset
  237.       0 : SUBQ SP,#8,SP
  238.      +4 : BR or JMP instruction
  239.      +8 : absolute target address
  240.      +16: more entry points (i.e. repetitions from -8 through +8)
  241.           and/or closed variables
  242.      ...
  243.  
  244.   Note: On other machines, there is a different format used for one
  245.   entry point closures and closures with more than one entry point.
  246.   This is not needed on the Alpha, because we have a "wasted" 32 bit
  247.   pad area in all closures.
  248. */
  249.  
  250. #define CLOSURE_OFFSET_OF_FIRST_ENTRY_POINT    16
  251. /* Bytes from manifest header to SUBQ in first entry point code */
  252.  
  253. /* A NOP on machines where closure entry points are aligned at object */
  254. /* boundaries, as on the Alpha.                                       */
  255.  
  256. #define ADJUST_CLOSURE_AT_CALL(entry_point, location)            \
  257. do {                                    \
  258.    } while (0)
  259.  
  260. /* Manifest closure entry block size.
  261.    Size in bytes of a compiled closure's header excluding the
  262.    TC_MANIFEST_CLOSURE header.
  263.  
  264.    On the Alpha this is 32 bits (one instruction) of padding, 16 bits
  265.    of format_word, 16 bits of GC offset word, 2 32-bit instructions
  266.    (SUBQ and JMP or BR), and a 64-bit absolute address.
  267.  */
  268.  
  269. #define COMPILED_CLOSURE_ENTRY_SIZE     \
  270.   ((1 INSTRUCTIONS) + (2*(sizeof(format_word)) +         \
  271.    (2 INSTRUCTIONS) + (sizeof(SCHEME_OBJECT *))))
  272.  
  273. /* Override the default definition of MANIFEST_CLOSURE_END in cmpgc.h */
  274.  
  275. #define MANIFEST_CLOSURE_END(start, count)                \
  276. (((SCHEME_OBJECT *) (start)) +                        \
  277.  ((CHAR_TO_SCHEME_OBJECT (((count) * COMPILED_CLOSURE_ENTRY_SIZE)))-1))
  278.  
  279. /* Manifest closure entry destructuring.
  280.  
  281.    Given the entry point of a closure, extract the `real entry point'
  282.    (the address of the real code of the procedure, ie. one indirection)
  283.    from the closure.
  284. */
  285.  
  286. #define EXTRACT_CLOSURE_ENTRY_ADDRESS(returned_address, entry_point)    \
  287. { EXTRACT_ABSOLUTE_ADDRESS (returned_address,                \
  288.                 (((unsigned int *) entry_point) + 1));    \
  289. }
  290.  
  291. /* This is the inverse of EXTRACT_CLOSURE_ENTRY_ADDRESS.
  292.    Given a closure's entry point and a code entry point, store the
  293.    code entry point in the closure.
  294.  */
  295.  
  296. #define STORE_CLOSURE_ENTRY_ADDRESS(address_to_store, entry_point)    \
  297. { STORE_ABSOLUTE_ADDRESS (address_to_store,                \
  298.               (((unsigned int *) entry_point) + 1));    \
  299. }
  300.  
  301. /* Trampolines
  302.  
  303.    On the Alpha, here's a picture of a trampoline (offset in bytes
  304.    from entry point)
  305.  
  306.      -24: MANIFEST vector header
  307.      -16: NON_MARKED header
  308.      - 8: 0
  309.      - 4: Format word
  310.      - 2: 0xC (GC Offset to start of block from .+2)
  311.           Note the encoding -- divided by 2, low bit for
  312.           extended distances (see OFFSET_WORD_TO_BYTE_OFFSET)
  313.        0: BIS ZERO, #index, TRAMP_INDEX
  314.        4: JMP Utility_Argument_1, (SCHEME_TO_INTERFACE)
  315.        8: trampoline dependent storage (0 - 3 objects)
  316.  
  317.    TRAMPOLINE_ENTRY_SIZE is the size in longwords of the machine
  318.    dependent portion of a trampoline, including the GC and format
  319.    headers.  The code in the trampoline must store an index (used to
  320.    determine which C SCHEME_UTILITY procedure to invoke) in a
  321.    register, jump to "scheme_to_interface" and leave the address of
  322.    the storage following the code in a standard location.
  323.  
  324.    TRAMPOLINE_ENTRY_POINT takes the address of the manifest vector
  325.    header of a trampoline and returns the address of its first
  326.    instruction.
  327.  
  328.    TRAMPOLINE_STORAGE takes the address of the first instruction in a
  329.    trampoline (not the start of the trampoline block) and returns the
  330.    address of the first storage word in the trampoline.
  331.  
  332.    STORE_TRAMPOLINE_ENTRY gets the address of the first instruction in
  333.    the trampoline and stores the instructions.  It also receives the
  334.    index of the C SCHEME_UTILITY to be invoked.
  335. */
  336.  
  337. #define TRAMPOLINE_ENTRY_SIZE        2
  338. #define TRAMPOLINE_ENTRY_POINT(tramp)    \
  339.   ((void *) (((SCHEME_OBJECT *) (tramp)) + 3))
  340. #define TRAMPOLINE_STORAGE(tramp_entry)    \
  341.   ((SCHEME_OBJECT *) (((char *) (tramp_entry)) + (2 INSTRUCTIONS)))
  342.  
  343. #define opBIS                0x11
  344. #define opSUBQ                0x10
  345. #define funcBIS                0x20
  346. #define funcSUBQ            0x29
  347.  
  348. #define constantBIS(source, constant, target)    \
  349.   ((opBIS << 26) | ((source) << 21) |         \
  350.    ((constant) << 13) | (1 << 12) | (funcBIS << 5) | (target))
  351.  
  352. #define constantSUBQ(source, constant, target)    \
  353.   ((opSUBQ << 26) | ((source) << 21) |         \
  354.    ((constant) << 13) | (1 << 12) | (funcSUBQ << 5) | (target))
  355.  
  356. #define STORE_TRAMPOLINE_ENTRY(entry_address, index)    \
  357. { unsigned int *PC;                    \
  358.   extern void scheme_to_interface(void);        \
  359.   PC = ((unsigned int *) (entry_address));        \
  360.   *PC++ = constantBIS(COMP_REG_ZERO, index, COMP_REG_TRAMP_INDEX);\
  361.   *PC = JMP(COMP_REG_FIRST_ARGUMENT,            \
  362.         COMP_REG_SCHEME_INTERFACE,            \
  363.         (((char *) scheme_to_interface) -        \
  364.          ((char *) (PC+1))));            \
  365.   PC += 1;                        \
  366. }
  367.  
  368. /* Execute cache entries.
  369.  
  370.    Execute cache entry size in longwords.  The cache itself
  371.    contains both the number of arguments provided by the caller and
  372.    code to jump to the destination address.  Before linkage, the cache
  373.    contains the callee's name instead of the jump code.
  374.  
  375.    On Alpha: 2 machine words (64 bits each).
  376.  */
  377.  
  378. #define EXECUTE_CACHE_ENTRY_SIZE        2
  379.  
  380. /* Execute cache destructuring. */
  381.  
  382. /* Given a target location and the address of the first word of an
  383.    execute cache entry, extract from the cache cell the number of
  384.    arguments supplied by the caller and store it in target. */
  385.  
  386. /* For the Alpha, addresses in bytes from the start of the cache:
  387.  
  388.    Before linking
  389.      +0:  number of supplied arguments, +1
  390.      +4:  TC_FIXNUM | 0
  391.      +8:  TC_SYMBOL || symbol address
  392.  
  393.    After linking
  394.      +0: number of supplied arguments, +1
  395.      +4: BR or JMP instruction
  396.      +8: absolute target address
  397. */
  398.  
  399. #define EXTRACT_EXECUTE_CACHE_ARITY(target, address)            \
  400.   (target) = ((long) (((unsigned int *) (address)) [0]))
  401.  
  402. #define EXTRACT_EXECUTE_CACHE_SYMBOL(target, address)            \
  403.   (target) = ((SCHEME_OBJECT *) (address))[1]
  404.  
  405. /* Extract the target address (not the code to get there) from an
  406.    execute cache cell.
  407.  */
  408.  
  409. #define EXTRACT_EXECUTE_CACHE_ADDRESS(target, address)            \
  410. {                                    \
  411.   EXTRACT_ABSOLUTE_ADDRESS (target, (((unsigned int *)address)+1));    \
  412. }
  413.  
  414. /* This is the inverse of EXTRACT_EXECUTE_CACHE_ADDRESS.
  415.  */
  416.  
  417. #define STORE_EXECUTE_CACHE_ADDRESS(address, entry)            \
  418. {                                    \
  419.   STORE_ABSOLUTE_ADDRESS (entry, (((unsigned int *)address)+1));    \
  420. }
  421.  
  422. /* This stores the fixed part of the instructions leaving the
  423.    destination address and the number of arguments intact.  These are
  424.    split apart so the GC can call EXTRACT/STORE...ADDRESS but it does
  425.    NOT need to store the instructions back.  On this architecture the
  426.    instructions may change due to GC and thus STORE_EXECUTE_CACHE_CODE
  427.    is a no-op; all of the work is done by STORE_EXECUTE_CACHE_ADDRESS
  428.    instead.
  429.  */
  430.  
  431. #define STORE_EXECUTE_CACHE_CODE(address)    { }
  432.  
  433. /* This flushes the Scheme portion of the I-cache.
  434.    It is used after a GC or disk-restore.
  435.    It's needed because the GC has moved code around, and closures
  436.    and execute cache cells have absolute addresses that the
  437.    processor might have old copies of.
  438.  */
  439.  
  440. extern long EXFUN(Synchronize_Caches, (void));
  441. extern void EXFUN(Flush_I_Cache, (void));
  442.  
  443. #if 1
  444. #define FLUSH_I_CACHE()         ((void) Synchronize_Caches())
  445. #else
  446. #define    FLUSH_I_CACHE()            (Flush_I_Cache())
  447. #endif
  448.  
  449. /* This flushes a region of the I-cache.
  450.    It is used after updating an execute cache while running.
  451.    Not needed during GC because FLUSH_I_CACHE will be used.
  452.  */   
  453.  
  454. #define FLUSH_I_CACHE_REGION(address, nwords) FLUSH_I_CACHE()
  455. #define PUSH_D_CACHE_REGION(address, nwords) FLUSH_I_CACHE()
  456. #define SPLIT_CACHES
  457.  
  458. #ifdef IN_CMPINT_C
  459. #include <sys/mman.h>
  460. #include <sys/types.h>
  461.  
  462. #define VM_PROT_SCHEME (PROT_READ | PROT_WRITE | PROT_EXEC)
  463.  
  464. #define ASM_RESET_HOOK() interface_initialize((PTR) &utility_table[0])
  465.  
  466. #define REGBLOCK_EXTRA_SIZE        8 /* See lapgen.scm */
  467. #define COMPILER_REGBLOCK_N_FIXED    16
  468. #define REGBLOCK_FIRST_EXTRA            COMPILER_REGBLOCK_N_FIXED
  469. #define REGBLOCK_ADDRESS_OF_STACK_POINTER    REGBLOCK_FIRST_EXTRA
  470. #define REGBLOCK_ADDRESS_OF_FREE        REGBLOCK_FIRST_EXTRA+1
  471. #define REGBLOCK_ADDRESS_OF_UTILITY_TABLE    REGBLOCK_FIRST_EXTRA+2
  472. #define REGBLOCK_ALLOCATE_CLOSURE        REGBLOCK_FIRST_EXTRA+3
  473. #define REGBLOCK_DIVQ                REGBLOCK_FIRST_EXTRA+4
  474. #define REGBLOCK_REMQ                REGBLOCK_FIRST_EXTRA+5
  475.  
  476. void *
  477. DEFUN (alpha_heap_malloc, (Size), long Size)
  478. { int pagesize;
  479.   caddr_t Heap_Start_Page;
  480.   void *Area;
  481.  
  482.   pagesize = getpagesize();
  483.   Area = (void *) malloc(Size+pagesize);
  484.   if (Area==NULL) return Area;
  485.   Heap_Start_Page =
  486.     ((caddr_t) (((((long) Area)+(pagesize-1)) /
  487.          pagesize) *
  488.         pagesize));
  489.   if (mprotect (Heap_Start_Page, Size, VM_PROT_SCHEME) == -1)
  490.   { perror("compiler_reset: unable to change protection for Heap");
  491.     fprintf(stderr, "mprotect(0x%lx, %d (0x%lx), 0x%lx)\n",
  492.         Heap_Start_Page, Size, Size, VM_PROT_SCHEME);
  493.     Microcode_Termination (TERM_EXIT);
  494.     /*NOTREACHED*/
  495.   }
  496.   return (void *) Heap_Start_Page;
  497. }
  498.  
  499. /* ASSUMPTION: Direct mapped first level cache, with 
  500.    shared secondary caches.  Sizes in bytes.
  501. */
  502. #define DCACHE_SIZE        (8*1024)
  503. #define DCACHE_LINE_SIZE    32
  504. #define WRITE_BUFFER_SIZE    (4*DCACHE_LINE_SIZE)
  505.  
  506. long
  507. DEFUN_VOID (Synchronize_Caches)
  508. { long Foo=0;
  509.  
  510.   Flush_I_Cache();
  511.   { static volatile long Fake_Out[WRITE_BUFFER_SIZE/(sizeof (long))];
  512.     volatile long *Ptr, *End, i=0;
  513.     
  514.     for (End = &(Fake_Out[WRITE_BUFFER_SIZE/(sizeof (long))]),
  515.        Ptr = &(Fake_Out[0]);
  516.      Ptr < End;
  517.      Ptr += DCACHE_LINE_SIZE/(sizeof (long)))
  518.     { Foo += *Ptr;
  519.       *Ptr = Foo;
  520.       i += 1;
  521.     }
  522.   }
  523. #if 0
  524.   { static volatile long Fake_Out[DCACHE_SIZE/(sizeof (long))];
  525.     volatile long *Ptr, *End;
  526.     
  527.     for (End = &(Fake_Out[DCACHE_SIZE/(sizeof (long))]),
  528.        Ptr = &(Fake_Out[0]);
  529.      Ptr < End;
  530.      Ptr += DCACHE_LINE_SIZE/(sizeof (long)))
  531.       Foo += *Ptr;
  532.   }
  533. #endif
  534.     return Foo;
  535. }
  536.  
  537. extern char *EXFUN(allocate_closure, (long, char *));
  538.  
  539. static void
  540. DEFUN (interface_initialize, (table),
  541.        PTR table)
  542. { extern void __divq();
  543.   extern void __remq();
  544.  
  545.   Registers[REGBLOCK_ADDRESS_OF_STACK_POINTER] =
  546.     ((SCHEME_OBJECT) &Ext_Stack_Pointer);
  547.   Registers[REGBLOCK_ADDRESS_OF_FREE] =
  548.     ((SCHEME_OBJECT) &Free);
  549.   Registers[REGBLOCK_ADDRESS_OF_UTILITY_TABLE] =
  550.     ((SCHEME_OBJECT) table);
  551.   Registers[REGBLOCK_ALLOCATE_CLOSURE] =
  552.     ((SCHEME_OBJECT) allocate_closure);
  553.   Registers[REGBLOCK_DIVQ] = ((SCHEME_OBJECT) __divq);
  554.   Registers[REGBLOCK_REMQ] = ((SCHEME_OBJECT) __remq);
  555.   return;
  556. }
  557.  
  558. #define CLOSURE_ENTRY_WORDS            \
  559.   (COMPILED_CLOSURE_ENTRY_SIZE / (sizeof (SCHEME_OBJECT)))
  560.  
  561. static long closure_chunk = (1024 * CLOSURE_ENTRY_WORDS);
  562. static long last_chunk_size;
  563.  
  564. #define REGBLOCK_CLOSURE_LIMIT    REGBLOCK_CLOSURE_SPACE
  565.  
  566. char *
  567. DEFUN (allocate_closure, (size, this_block),
  568.        long size AND char *this_block)
  569. /* size in Scheme objects of the block we need to allocate.
  570.    this_block is a pointer to the first entry point in the block we
  571.               didn't manage to allocate.
  572. */
  573. { long space;
  574.   SCHEME_OBJECT *free_closure, *limit;
  575.  
  576.   free_closure = (SCHEME_OBJECT *)
  577.     (this_block-CLOSURE_OFFSET_OF_FIRST_ENTRY_POINT);
  578.   limit = ((SCHEME_OBJECT *) Registers[REGBLOCK_CLOSURE_LIMIT]);
  579.   space =  limit - free_closure;
  580.   if (size > space)
  581.   { SCHEME_OBJECT *ptr;
  582.     unsigned int *wptr;
  583.     /* Clear remaining words from last chunk so that the heap can be scanned
  584.        forward.
  585.      */
  586.     if (space > 0)
  587.     { for (ptr = free_closure; ptr < limit; ptr++) *ptr = SHARP_F;
  588.       /* We can reformat the closures (from JMPs to BRs) using
  589.      last_chunk_size.  The start of the area is
  590.      (limit - last_chunk_size), and all closures are contiguous
  591.      and have appropriate headers.
  592.       */
  593.     }
  594.     free_closure = Free;
  595.     if ((size <= closure_chunk) && (!(GC_Check (closure_chunk))))
  596.     { limit = (free_closure + closure_chunk);
  597.     }
  598.     else
  599.     { if (GC_Check (size))
  600.       { if ((Heap_Top - Free) < size)
  601.     { /* No way to back out -- die. */
  602.       fprintf (stderr, "\nC_allocate_closure (%d): No space.\n", size);
  603.       Microcode_Termination (TERM_NO_SPACE);
  604.       /* NOTREACHED */
  605.     }
  606.     Request_GC (0);
  607.       }
  608.       else if (size <= closure_chunk)
  609.       { Request_GC (0);
  610.       }
  611.       limit = (free_closure + size);
  612.     }
  613.     Free = limit;
  614.     last_chunk_size = limit-free_closure; /* For next time, maybe. */
  615.     for (wptr = (unsigned int *) free_closure;
  616.      wptr < (unsigned int *) limit;)
  617.     { extern void scheme_closure_hook (void);
  618.       *wptr++ = constantSUBQ (COMP_REG_STACK_POINTER,
  619.                   8,
  620.                   COMP_REG_STACK_POINTER);
  621.       *wptr = JMP(COMP_REG_LINKAGE, COMP_REG_LONGJUMP,
  622.           (((char *) scheme_closure_hook) -
  623.            ((char *) (wptr + 1))));
  624.       wptr += 1;
  625.     }
  626.     PUSH_D_CACHE_REGION (free_closure, last_chunk_size);
  627.     Registers[REGBLOCK_CLOSURE_LIMIT] = (SCHEME_OBJECT) limit;
  628.   }
  629.   Registers[REGBLOCK_CLOSURE_FREE] = (SCHEME_OBJECT) (free_closure+size);
  630.   return (((char *) free_closure)+CLOSURE_OFFSET_OF_FIRST_ENTRY_POINT);
  631. }
  632. #endif /* IN_CMPINT_C */
  633.  
  634. /* Derived parameters and macros.
  635.  
  636.    These macros expect the above definitions to be meaningful.
  637.    If they are not, the macros below may have to be changed as well.
  638.  */
  639.  
  640. #define COMPILED_ENTRY_OFFSET_WORD(entry) (((format_word *) (entry)) [-1])
  641. #define COMPILED_ENTRY_FORMAT_WORD(entry) (((format_word *) (entry)) [-2])
  642.  
  643. /* The next one assumes 2's complement integers....*/
  644. #define CLEAR_LOW_BIT(word)                     ((word) & ((unsigned long) -2))
  645. #define OFFSET_WORD_CONTINUATION_P(word)        (((word) & 1) != 0)
  646.  
  647. #if (PC_ZERO_BITS == 0)
  648. /* Instructions aligned on byte boundaries */
  649. #define BYTE_OFFSET_TO_OFFSET_WORD(offset)      ((offset) << 1)
  650. #define OFFSET_WORD_TO_BYTE_OFFSET(offset_word)                         \
  651.   ((CLEAR_LOW_BIT(offset_word)) >> 1)
  652. #endif
  653.  
  654. #if (PC_ZERO_BITS == 1)
  655. /* Instructions aligned on word (16 bit) boundaries */
  656. #define BYTE_OFFSET_TO_OFFSET_WORD(offset)      (offset)
  657. #define OFFSET_WORD_TO_BYTE_OFFSET(offset_word)                         \
  658.   (CLEAR_LOW_BIT(offset_word))
  659. #endif
  660.  
  661. #if (PC_ZERO_BITS >= 2)
  662. /* Should be OK for =2, but bets are off for >2 because of problems
  663.    mentioned earlier!
  664. */
  665. #define SHIFT_AMOUNT                            (PC_ZERO_BITS - 1)
  666. #define BYTE_OFFSET_TO_OFFSET_WORD(offset)      ((offset) >> (SHIFT_AMOUNT))
  667. #define OFFSET_WORD_TO_BYTE_OFFSET(offset_word)                         \
  668.   ((CLEAR_LOW_BIT(offset_word)) << (SHIFT_AMOUNT))
  669. #endif
  670.  
  671. #define MAKE_OFFSET_WORD(entry, block, continue)                        \
  672.   ((BYTE_OFFSET_TO_OFFSET_WORD(((char *) (entry)) -                     \
  673.                                ((char *) (block)))) |                   \
  674.    ((continue) ? 1 : 0))
  675.  
  676. #if (EXECUTE_CACHE_ENTRY_SIZE == 2)
  677. #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count)                           \
  678.   ((count) >> 1)
  679. #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries)                \
  680.   ((entries) << 1)
  681. #endif
  682.  
  683. #if (EXECUTE_CACHE_ENTRY_SIZE == 4)
  684. #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count)                           \
  685.   ((count) >> 2)
  686. #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries)                \
  687.   ((entries) << 2)
  688. #endif
  689.  
  690. #if (!defined(EXECUTE_CACHE_COUNT_TO_ENTRIES))
  691. #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count)                           \
  692.   ((count) / EXECUTE_CACHE_ENTRY_SIZE)
  693. #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries)                \
  694.   ((entries) * EXECUTE_CACHE_ENTRY_SIZE)
  695. #endif
  696.  
  697. /* The first entry in a cc block is preceeded by 2 headers (block and nmv),
  698.    a format word and a gc offset word.   See the early part of the
  699.    TRAMPOLINE picture, above.
  700.  */
  701.  
  702. #define CC_BLOCK_FIRST_ENTRY_OFFSET                                     \
  703.   (2 * ((sizeof(SCHEME_OBJECT)) + (sizeof(format_word))))
  704.  
  705. /* Format words */
  706.  
  707. #define FORMAT_BYTE_EXPR                0xFF
  708. #define FORMAT_BYTE_COMPLR              0xFE
  709. #define FORMAT_BYTE_CMPINT              0xFD
  710. #define FORMAT_BYTE_DLINK               0xFC
  711. #define FORMAT_BYTE_RETURN              0xFB
  712.  
  713. #define FORMAT_WORD_EXPR        (MAKE_FORMAT_WORD(0xFF, FORMAT_BYTE_EXPR))
  714. #define FORMAT_WORD_CMPINT      (MAKE_FORMAT_WORD(0xFF, FORMAT_BYTE_CMPINT))
  715. #define FORMAT_WORD_RETURN      (MAKE_FORMAT_WORD(0xFF, FORMAT_BYTE_RETURN))
  716.  
  717. /* This assumes that a format word is at least 16 bits,
  718.    and the low order field is always 8 bits.
  719.  */
  720.  
  721. #define MAKE_FORMAT_WORD(field1, field2)                                \
  722.   (((field1) << 8) | ((field2) & 0xff))
  723.  
  724. #define SIGN_EXTEND_FIELD(field, size)                                  \
  725.   (((field) & ((1 << (size)) - 1)) |                                    \
  726.    ((((field) & (1 << ((size) - 1))) == 0) ? 0 :                        \
  727.     ((-1) << (size))))
  728.  
  729. #define FORMAT_WORD_LOW_BYTE(word)                                      \
  730.   (SIGN_EXTEND_FIELD ((((unsigned long) (word)) & 0xff), 8))
  731.  
  732. #define FORMAT_WORD_HIGH_BYTE(word)                    \
  733.   (SIGN_EXTEND_FIELD                            \
  734.    ((((unsigned long) (word)) >> 8),                    \
  735.     (((sizeof (format_word)) * CHAR_BIT) - 8)))
  736.  
  737. #define COMPILED_ENTRY_FORMAT_HIGH(addr)                                \
  738.   (FORMAT_WORD_HIGH_BYTE (COMPILED_ENTRY_FORMAT_WORD (addr)))
  739.  
  740. #define COMPILED_ENTRY_FORMAT_LOW(addr)                                 \
  741.   (FORMAT_WORD_LOW_BYTE (COMPILED_ENTRY_FORMAT_WORD (addr)))
  742.  
  743. #define FORMAT_BYTE_FRAMEMAX            0x7f
  744.  
  745. #define COMPILED_ENTRY_MAXIMUM_ARITY    COMPILED_ENTRY_FORMAT_LOW
  746. #define COMPILED_ENTRY_MINIMUM_ARITY    COMPILED_ENTRY_FORMAT_HIGH
  747.  
  748. #endif /* CMPINTMD_H_INCLUDED */
  749.