home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / prog_c / schem2c2.lzh / Scheme2C / Scheme-C-000.lzh / objects.h next >
C/C++ Source or Header  |  1991-10-08  |  37KB  |  1,170 lines
  1. /* SCHEME->C */
  2.  
  3. /*              Copyright 1989 Digital Equipment Corporation
  4.  *                         All Rights Reserved
  5.  *
  6.  * Permission to use, copy, and modify this software and its documentation is
  7.  * hereby granted only under the following terms and conditions.  Both the
  8.  * above copyright notice and this permission notice must appear in all copies
  9.  * of the software, derivative works or modified versions, and any portions
  10.  * thereof, and both notices must appear in supporting documentation.
  11.  *
  12.  * Users of this software agree to the terms and conditions set forth herein,
  13.  * and hereby grant back to Digital a non-exclusive, unrestricted, royalty-free
  14.  * right and license under any changes, enhancements or extensions made to the
  15.  * core functions of the software, including but not limited to those affording
  16.  * compatibility with other hardware or software environments, but excluding
  17.  * applications which incorporate this software.  Users further agree to use
  18.  * their best efforts to return to Digital any such changes, enhancements or
  19.  * extensions that they make and inform Digital of noteworthy uses of this
  20.  * software.  Correspondence should be provided to Digital at:
  21.  * 
  22.  *                       Director of Licensing
  23.  *                       Western Research Laboratory
  24.  *                       Digital Equipment Corporation
  25.  *                       100 Hamilton Avenue
  26.  *                       Palo Alto, California  94301  
  27.  * 
  28.  * This software may be distributed (but not offered for sale or transferred
  29.  * for compensation) to third parties, provided such third parties agree to
  30.  * abide by the terms and conditions of this notice.  
  31.  * 
  32.  * THE SOFTWARE IS PROVIDED "AS IS" AND DIGITAL EQUIPMENT CORP. DISCLAIMS ALL
  33.  * WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
  34.  * MERCHANTABILITY AND FITNESS.   IN NO EVENT SHALL DIGITAL EQUIPMENT
  35.  * CORPORATION BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
  36.  * DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
  37.  * PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
  38.  * ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
  39.  * SOFTWARE.
  40. */
  41.  
  42. /* This module defines the basic data objects and their associated functions.
  43. */
  44.  
  45. /* Default the value of CPUTYPE if not currently defined. */
  46. #ifndef MIPS
  47. #ifndef TITAN
  48. #ifndef VAX
  49. #ifndef SPARC
  50. #ifndef SUN3
  51. #ifndef I386
  52. #ifndef APOLLO
  53. #ifndef PRISM
  54.  
  55. #ifdef mips
  56. #define MIPS 1
  57. #endif
  58. #ifdef titan
  59. #define TITAN 1
  60. #endif
  61. #ifdef vax
  62. #define VAX 1
  63. #endif
  64. #ifdef sun
  65. #  ifdef sparc
  66. #    define SPARC 1
  67. #  else
  68. #    ifdef mc68000
  69. #      define SUN3 1
  70. #    endif
  71. #  endif
  72. #endif
  73. #ifdef i386
  74. #define I386 1
  75. #endif
  76. #ifdef apollo
  77. #  ifdef _ISP_A88K
  78. #    define PRISM 1
  79. #  else
  80. #    define APOLLO 1
  81. #  endif
  82. #endif
  83.  
  84. #endif /* PRISM */
  85. #endif /* APOLLO */
  86. #endif /* I386 */
  87. #endif /* SUN3 */
  88. #endif /* SPARC */
  89. #endif /* VAX */
  90. #endif /* TITAN */
  91. #endif /* MIPS */
  92.  
  93. /* The Scheme->C installer may elect to have arithmetic overflow handled
  94.    gracefully on either the MIPS or the VAX implementations.  The default
  95.    is to handle it.
  96. */
  97.  
  98. #ifndef MATHTRAPS
  99. #define MATHTRAPS 1
  100. #endif
  101.  
  102. /* A machine dependent definition:  the setjmp/longjmp buffer.  */
  103.  
  104. #ifdef MIPS
  105. #include <setjmp.h>
  106. #define CPUTYPE MIPS
  107. #define DOUBLE_ALIGN 1
  108. #endif
  109.  
  110. #ifdef TITAN
  111. #include <setjmp.h>
  112. #define CPUTYPE TITAN
  113. #undef MATHTRAPS
  114. #endif
  115.  
  116. #ifdef VAX
  117. typedef int jmp_buf[ 16 ];    /* The buffer contains the following items:
  118.                    R2-R11    saved registers
  119.                    SIGM        saved signal mask
  120.                    SP        stack pointer on entry to
  121.                            setjmp
  122.                    PSW        PSW word from stack frame
  123.                    AP        saved argument ptr from frame
  124.                    FP        saved frame ptr from frame
  125.                    PC        saved program cntr from frame
  126.                 */
  127. #define CPUTYPE VAX
  128. #endif
  129.  
  130. #ifdef    AMIGA
  131. #include <setjmp.h>
  132. #define    NO_RUSAGE
  133. #define BIG_ENDIAN
  134. #undef    DOUBLE_ALIGN
  135. #undef    SHORTFLOAT
  136. #undef    MATHTRAPS
  137. #define    MATHTRAPS 0
  138. #endif
  139.  
  140. #ifdef APOLLO
  141. #include <setjmp.h>
  142. #define CPUTYPE APOLLO
  143. #define BIG_ENDIAN
  144. #endif
  145.  
  146. #ifdef PRISM
  147. /* Use our own setjmp/longjmp so we can make sure all the registers
  148.    are saved that need to be saved, namely, .10 through .23,
  149.    plus the signal mask, return PC, and PSWs.
  150.  
  151.    The layout of these registers in the array is described in prism.asm.
  152. */
  153. typedef int jmp_buf[18];
  154. #define CPUTYPE PRISM
  155. #define BIG_ENDIAN
  156. #endif
  157.  
  158. #ifdef SPARC
  159. typedef int jmp_buf[2+7+8+8+1];
  160. #define DOUBLE_ALIGN 1
  161. #define CPUTYPE SPARC
  162. #define BIG_ENDIAN
  163. #undef MATHTRAPS
  164. #define MATHTRAPS 0
  165. #endif
  166.  
  167. #ifdef SUN3
  168. #include <setjmp.h>
  169. #define CPUTYPE SUN3
  170. #define BIG_ENDIAN
  171. #undef MATHTRAPS
  172. #define MATHTRAPS 0
  173. #endif
  174.  
  175. #ifdef I386
  176. #include <setjmp.h>
  177. #define CPUTYPE I386
  178. #undef MATHTRAPS
  179. #define MATHTRAPS 0
  180. #endif
  181.  
  182. #ifdef    SYSV
  183. #define    NO_RUSAGE
  184. #endif
  185.  
  186. /* The data encoding scheme is similar to that used by Vax NIL and T, where
  187.    all objects are represented by 32-bit pointers, with a "low tag" encoded
  188.    in the two least significant bits encoding the type.  All objects are
  189.    multiples of 32-bits and must be allocated on word boundaries.
  190.  
  191.    The basic data object is a "Scheme to C Object", or SCOBJ.  It is defined
  192.    by the following UNION type.  In addition, the following types are also
  193.    defined:
  194.  
  195.     SCP        pointer to a SCOBJ.
  196.     TSCP        tagged pointer to a SCOBJ
  197.     PATSCP        pointer to an array of TSCP's.
  198.     TSCPP        function which returns a TSCP as its value.
  199.  
  200.    The most common type conversion is that which converts SCP's and TSCP's.
  201.    It is done by the following:
  202.  
  203.     U_T( tsp, tag )    convert Untagged SCP to a Tagged TSCP.
  204.     U_TX( tsp )    convert Untagged SCP to an Extended Tagged TSCP.
  205.         U_TP( tsp )     convert Untagged SCP to an Pair Tagged TSCP.
  206.     T_U( tscp )    convert Tagged TSCP to an Untagged SCP.
  207.     TX_U( tscp )    convert Tagged eXtended pointer to an Untagged SCP.
  208.         TP_U( tscp )    convert Tagged Pair pointer to an Untagged SCP.
  209. */
  210.  
  211. struct  STACKTRACE;
  212.  
  213. /*
  214.   Ugly, but machine independent way to declare and use bit fields:
  215.   Bit fields are declared using F?(...), where the least significant
  216.   fields are listed first (in honor of the original implementations).
  217.   Similarly, static objects are created with the U?(...) macros.
  218.  */
  219. #ifdef BIG_ENDIAN
  220. #define    F2(a,b)        b;a
  221. #define F3(a,b,c)    c;b;a
  222. #define U2(a,b)        (b),(a)
  223. #define    U3(a,b,c)    (c),(b),(a)
  224. #else
  225. #define F2(a,b)        a;b
  226. #define F3(a,b,c)    a;b;c
  227. #define U2(a,b)        (a),(b)
  228. #define U3(a,b,c)    (a),(b),(c)
  229. #endif
  230.  
  231. typedef char *TSCP;
  232.  
  233. typedef union SCOBJ {        /* SCHEME to C OBJECT */
  234.        struct {    /* as an unsigned value */
  235.           unsigned  gned;
  236.        }  unsi;
  237.        struct {    /* EXTENDEDOBJ */
  238.           F2(unsigned  tag:8,
  239.           unsigned  rest:24);
  240.        }  extendedobj;
  241.        struct {    /* SYMBOL */
  242.           F2(unsigned  tag:8,
  243.           unsigned  rest:24);
  244.           TSCP  name;
  245.           TSCP  *ptrtovalue;
  246.           TSCP  value;
  247.           TSCP  propertylist;
  248.        }  symbol;
  249.        struct {    /* STRING */
  250.           F2(unsigned  tag:8,
  251.           unsigned  length:24);
  252.           char  char0;
  253.        }  string;
  254.        struct {    /* VECTOR */
  255.           F2(unsigned  tag:8,
  256.           unsigned  length:24);
  257.           TSCP  element0;
  258.        }  vector;
  259.        struct {    /* PROCEDURE */
  260.           F3(unsigned  tag:8,
  261.           unsigned  required:8,
  262.           unsigned  optional:16);
  263.           TSCP  (*code)();
  264.           TSCP  closure;
  265.        }  procedure;
  266.        struct {    /* CLOSURE */
  267.           F2(unsigned  tag:8,
  268.           unsigned  length:24);
  269.           TSCP  closure;
  270.           TSCP  var0;
  271.        }  closure;
  272.        struct {    /* CONTINUATION */
  273.           F2(unsigned  tag:8,
  274.           unsigned  length:24);
  275.           TSCP  continuation;
  276.           jmp_buf  savedstate;
  277.           int  *address;
  278.           struct STACKTRACE*  stacktrace;
  279.           int  word0;
  280.        }  continuation;
  281.        struct {    /* FLOAT32 */
  282.           F2(unsigned  tag:8,
  283.           unsigned  rest:24);
  284.           float  value;
  285.        }  float32;
  286.        struct {    /* FLOAT64 */
  287.           F2(unsigned  tag:8,
  288.           unsigned  rest:24);
  289.           double  value;
  290.        }  float64;
  291.        struct {    /* FORWARD */
  292.           F2(unsigned  tag:8,
  293.           unsigned  length:24);
  294.           TSCP  forward;
  295.        } forward;
  296.        struct {    /* WORDALIGN */
  297.           F2(unsigned  tag:8,
  298.           unsigned  length:24);
  299.        }  wordalign;
  300.        struct {    /* PAIR */
  301.           TSCP  car;
  302.           TSCP  cdr;
  303.        } pair;
  304.     }  *SCP;
  305.  
  306. typedef TSCP *PATSCP;     /* POINTER to ARRAY of TAGGED SCHEME to C POINTERs */
  307.  
  308. typedef TSCP (*TSCPP)(); /* TAGGED SCHEME to C POINTER returning PROCEDURE */
  309.  
  310. #define     TAGMASK 3
  311. #define  TSCPTAG( x ) ((int)x & TAGMASK)
  312. #define  U_T( scp, tag ) ((TSCP)((char*)(scp)+tag))
  313. #define  U_TX( scp ) ((TSCP)((char*)(scp)+EXTENDEDTAG))
  314. #define  U_TP( scp ) ((TSCP)((char*)(scp)+PAIRTAG))
  315. #define  T_U( tscp ) ((SCP)((int)(tscp) & (~TAGMASK)))
  316. #ifdef MIPS
  317. #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
  318. #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
  319. #endif
  320. #ifdef TITAN
  321. #define  TX_U( tscp ) ((SCP)tscp)
  322. #define  TP_U( tscp ) ((SCP)tscp)
  323. #endif
  324. #ifdef VAX
  325. #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
  326. #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
  327. #endif
  328. #ifdef apollo
  329. #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
  330. #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
  331. #endif
  332. #ifdef SPARC
  333. #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
  334. #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
  335. #endif
  336. #ifdef SUN3
  337. #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
  338. #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
  339. #endif
  340. #ifdef AMIGA
  341. #define  TX_U( tscp ) ((SCP)((char*)(tscp)-EXTENDEDTAG))
  342. #define  TP_U( tscp ) ((SCP)((char*)(tscp)-PAIRTAG))
  343. #endif
  344. #ifdef I386
  345. #define  TX_U( tscp ) ((SCP)((char*)tscp-EXTENDEDTAG))
  346. #define  TP_U( tscp ) ((SCP)((char*)tscp-PAIRTAG))
  347. #endif
  348.  
  349. /* Fixed point numbers are encoded in the address portion of the pointer.  The
  350.    value is obtained by arithmetically shifting the pointer value two bits to
  351.    the right.  A tag value of 0 is used to allow fixed point numbers to be
  352.    added and subtracted without any tag extraction and insertion.  Note that
  353.    the define FIXED_C assumes that >> provides an arithmetic right shift.
  354.  
  355.     +--------+--------+--------+--------+
  356.     |....signed fixed point value.....00|
  357.     +--------+--------+--------+--------+
  358. */
  359.  
  360. #define    FIXNUMTAG 0
  361.  
  362. typedef int     SCFIXED;    /* Scheme to C fixed point number */
  363.  
  364. #define FIXED_C( x ) (((int)(x))>>2)
  365. #define C_FIXED( x ) ((TSCP)((x)<<2))
  366.  
  367.  
  368. /* The second type of object is an "extended" object.  This is where the
  369.    pointer points to the header of a multi-word object.
  370.  
  371.         +--------+--------+--------+--------+
  372.         |........pointer to object........01|
  373.         +--------+--------+--------+--------+
  374.  
  375.    This header in turn has an immediate tag (tag = 2) and the remaining 6 bits
  376.    of the first byte define the type of the object as follows.
  377.  
  378.    A SYMBOL is represented by:
  379.  
  380.     +--------+--------+--------+--------+
  381.     |    0   |    0   |    0   |10000010|        symbol (tag = 130)
  382.     +--------+--------+--------+--------+
  383.     |            symbol name        |
  384.     +--------+--------+--------+--------+
  385.     |       pointer to value        |
  386.     +--------+--------+--------+--------+
  387.     |               value            |
  388.     +--------+--------+--------+--------+
  389.     |           property list        |
  390.     +--------+--------+--------+--------+
  391.  
  392.    where the first word contains the tag.  Following the tag is the symbol
  393.    name.  It is a string and is of the form "symbol-name" for top-level
  394.    symbols and "module-name_symbol-name" for other symbols.
  395.  
  396.    Next comes a pointer to the top-level value of the symbol.  If the symbol
  397.    is bound to a compiled global value, then the pointer will point to that
  398.    value and the following field will not be used.  On the other hand, if
  399.    the symbol is not bound to a compiled global, then the pointer will point
  400.    to the following word which will hold its value.
  401.  
  402.    The final field points to the property list for the symbol.   
  403.  
  404.    All "interned" symbols are kept in a data structure called the OBARRAY.  It
  405.    is a Scheme array which maintains bucket-hash lists of all allocated
  406.    symbols.  Symbols are created and entered into the data structure by the
  407.    function "sc_string_2d_3esymbol".
  408.  
  409.    A STRING is represented by:  
  410.  
  411.     +--------+--------+--------+--------+
  412.     |     length of string     |10000110|        string (tag = 134)
  413.         +--------+--------+--------+--------+
  414.         |    i   |    r   |    t   |    s   |
  415.         +--------+--------+--------+--------+
  416.     |    -   |    0   |    g   |    n   |
  417.     +--------+--------+--------+--------+
  418.  
  419.    where the first word contains the tag and the length (in bytes) of the
  420.    string.  The string storage starts in the next word.  Following the last
  421.    character of the string is a null byte. 
  422.  
  423.    A VECTOR is represented by:
  424.  
  425.     +--------+--------+--------+--------+
  426.     |   number of elements     |10001010|           vector (tag = 138)
  427.     +--------+--------+--------+--------+
  428.     |            element 0              |
  429.     +--------+--------+--------+--------+
  430.     |            element 1              |
  431.     +--------+--------+--------+--------+
  432.     |             ...            |
  433.  
  434.   where the first word contains the tag and the length (in elements) of the
  435.   vector.  The vector storage starts in the next word, where each element is a
  436.   scheme pointer.
  437.  
  438.    A PROCEDURE is represented by:
  439.  
  440.         +--------+--------+--------+--------+
  441.     |   0    |optional|required|10001110|           procedure (tag = 142)
  442.     +--------+--------+--------+--------+
  443.         |         code address              |
  444.         +--------+--------+--------+--------+
  445.     |  pointer to enclosing closure     |
  446.     +--------+--------+--------+--------+
  447.  
  448.    where the first word contains the tag and the argument flags.  The optional
  449.    flag is 0 when the function takes a fixed number of arguments and 1 when it
  450.    takes a list of optional arguments as its final argument.  The required
  451.    field is the number of required arguments that the function takes.  This is
  452.    followed by the code address and a pointer to the enclosing closure (which
  453.    may be () or a continuation).
  454.  
  455.    A CLOSURE is represented by:
  456.  
  457.     +--------+--------+--------+--------+
  458.         |      # closed values     |10010010|           closure (tag = 146)
  459.         +--------+--------+--------+--------+
  460.         |    pointer to enclosing closure   |
  461.         +--------+--------+--------+--------+
  462.         |        1st closed variable        |
  463.         +--------+--------+--------+--------+
  464.         |        2nd closed variable        |
  465.         +--------+--------+--------+--------+
  466.         |                ...                |
  467.  
  468.    where the first word contains the tag and the number of closed variables.
  469.    The next word contains a pointer to the enclosing closure (which may be ())
  470.    and the closed variables then follow.
  471.  
  472.    A CONTINUATION is a formed by CALL-WITH-CURRENT-CONTINUATION.  It is
  473.    represented by:
  474.  
  475.         +--------+--------+--------+--------+
  476.         |      # saved words       |10010110|           continuation (tag=150)
  477.         +--------+--------+--------+--------+
  478.         | pointer to enclosing continuation |
  479.         +--------+--------+--------+--------+
  480.         .                    .
  481.         .      state saved by setjmp        .
  482.         .                         .
  483.         +--------+--------+--------+--------+
  484.         | address of word[0] of saved stack |
  485.     +--------+--------+--------+--------+
  486.     |   saved value of sc_stacktrace    |
  487.     +--------+--------+--------+--------+
  488.         .                    .
  489.     .           saved display           .
  490.     .                     .
  491.     +--------+--------+--------+--------+
  492.     |      1st word of saved stack      |
  493.     +--------+--------+--------+--------+
  494.     |      2nd word of saved stack      |
  495.     +--------+--------+--------+--------+
  496.     |                ...                |
  497.  
  498.    where the first word contains the tag and the count of the number of words
  499.    required to hold the continuation (does not include word for pointer to
  500.    enclosing continuation).  The next word contains a pointer to the enclosing
  501.    continuation (or () if there isn't one).  Following this is the state saved
  502.    by setjmp.  The continuation is terminated by the stack address, the value
  503.    of sc_stacktrace, the saved display, and the saved stack block.  Note the
  504.    contents of any of these saved words may be pointers or derived from
  505.    pointers.
  506.  
  507.    A 32-BIT FLOATING POINT number is represented by:
  508.  
  509.         +--------+--------+--------+--------+
  510.         |    0   |    0   |    0   |10011010|           32-bit fp (tag = 154)
  511.         +--------+--------+--------+--------+
  512.         |   32-bit floating point value     |
  513.         +--------+--------+--------+--------+
  514.  
  515.    A 64-BIT FLOATING POINT number is represented by:
  516.  
  517.         +--------+--------+--------+--------+
  518.         |    0   |    0   |    0   |10011110|           64-bit fp (tag = 158)
  519.         +--------+--------+--------+--------+
  520.         |                       |
  521.         +--  64-bit floating point value  --+
  522.     |                    |
  523.     +--------+--------+--------+--------+
  524.  
  525.    A forwarded object (which may be a pair or an extended object) is
  526.    represented by:
  527.  
  528.     +--------+--------+--------+--------+
  529.     |        word count        |10100010|        forward (tag = 162)
  530.     +--------+--------+--------+--------+
  531.     |    tagged pointer to new copy     |
  532.     +--------+--------+--------+--------+
  533.  
  534.    where the first word contains the tag and the size of the object (in words).
  535.    The next word contains a Scheme pointer to the new copy of the object.
  536.  
  537.    When storage must be allocated to correctly align objects, a wordalign
  538.    object is allocated:
  539.  
  540.     +--------+--------+--------+--------+
  541.     |    0   |    0   |    0   |10100110|        word align (tag = 166)
  542.     +--------+--------+--------+--------+
  543. */
  544.  
  545. #define    EXTENDEDTAG     1
  546. #define    SYMBOLTAG     130
  547. #define STRINGTAG    134
  548. #define    VECTORTAG    138
  549. #define    PROCEDURETAG    142
  550. #define    CLOSURETAG    146
  551. #define CONTINUATIONTAG 150
  552. #define    FLOAT32TAG    154
  553. #define FLOAT64TAG      158
  554. #define FORWARDTAG    162
  555. #define WORDALIGNTAG    166
  556.  
  557. /* The following definitions define the size in words of each extended object.
  558. */
  559.  
  560. #define SYMBOLSIZE           5
  561. #define STRINGSIZE( x )        ((((x)+4)/4)+1)
  562. #define VECTORSIZE( x )        ((x)+1)
  563. #define PROCEDURESIZE           3
  564. #define CLOSURESIZE( x )       ((x)+2)
  565. #define CONTINUATIONSIZE( x )  ((x)+2)
  566. #define FLOAT32SIZE           2
  567. #ifdef DOUBLE_ALIGN
  568. #define FLOAT64SIZE           4
  569. #endif
  570. #ifndef DOUBLE_ALIGN
  571. #define FLOAT64SIZE           3
  572. #endif
  573. #define FORWARDSIZE( x )       (x)
  574. #define WORDALIGNSIZE           1
  575.  
  576. /* While the data representation allows for two types of floating point
  577.    numbers, only one type is actually used.  The default is 64-bits, but 32-bit
  578.    numbers may be selected by defining the flag SHORTFLOAT.
  579. */
  580.  
  581. #ifdef SHORTFLOAT
  582.  
  583. #define FLOATTAG     FLOAT32TAG
  584. #define FLOATTYPE     float
  585. #define FLOATUTYPE     float32
  586. #define MAKEFLOAT    sc_makefloat32
  587.  
  588. #else
  589.  
  590. #define FLOATTAG     FLOAT64TAG
  591. #define FLOATTYPE     double
  592. #define FLOATUTYPE     float64
  593. #define MAKEFLOAT    sc_makefloat64
  594.  
  595. #endif
  596.  
  597. /* A pointer that points to an extended object must pass the following test.
  598.    Note that some things which aren't pointers can pass this test too.  The
  599.    pointer P must be untagged.
  600. */
  601.  
  602. #define EXTENDEDHEADER( p ) ((p->extendedobj.tag >= SYMBOLTAG) && \
  603.                  (TSCPTAG( p->extendedobj.tag ) == IMMEDIATETAG))
  604.  
  605. /* The number of closed variables in a contination with 0 saved stack words is
  606.    NULLCONTINUATIONSIZE.
  607. */
  608.  
  609. #define NULLCONTINUATIONSIZE (sizeof( jmp_buf )/4+2)
  610.  
  611. /* There is one string which is the empty string and one vector which is the
  612.    empty vector.
  613. */
  614.  
  615. #define EMPTYSTRING    sc_emptystring
  616. #define EMPTYVECTOR    sc_emptyvector
  617.  
  618. extern TSCP    sc_emptystring,
  619.         sc_emptyvector;
  620.  
  621. /* The third type of object is an "immediate" object where the actual
  622.    object type is encoded in the rest of the pointer.  The objects of this
  623.    type are:
  624.  
  625.     +--------+--------+--------+--------+
  626.     |    0     |    0   |    0   |00000010|        empty list
  627.     +--------+--------+--------+--------+
  628.  
  629.     +--------+--------+--------+--------+
  630.     |    0     |    0   |    0   |00001010|        #F
  631.     +--------+--------+--------+--------+
  632.  
  633.     +--------+--------+--------+--------+
  634.     |    0     |    0   |    0   |00001110|        #T
  635.     +--------+--------+--------+--------+
  636.  
  637.     +--------+--------+--------+--------+
  638.     |    0     |    0   |  char  |00010010|        character
  639.     +--------+--------+--------+--------+
  640.  
  641.     +--------+--------+--------+--------+
  642.     |    0   |    0   |    0   |00010110|        eof object
  643.     +--------+--------+--------+--------+
  644.  
  645.     +--------+--------+--------+--------+
  646.     |    0   |    0   |    0   |00011010|        undefined
  647.     +--------+--------+--------+--------+
  648.  
  649.    Tags are allocated with an eye toward null testing.  Note that the the
  650.    boolean #F and the list () are separate objects, but both are treated as
  651.    false to conform to the Scheme definition.
  652.     
  653.     ()    ==  2   ==  emptylist
  654.     
  655.     #F    ==  10  ==  falsevalue
  656.     
  657.     #T    ==  14  ==  truevalue
  658.  
  659.     (NOT P)    ==  $1 := P and 247;        
  660.             $1 := $1 =i 2;
  661. */
  662.  
  663. #define    IMMEDIATETAG        2
  664. #define    IMMEDIATETAGMASK    255
  665. #define    EMPTYLIST        ((TSCP)2)
  666. #define    FALSEVALUE        ((TSCP)10)
  667. #define    TRUEVALUE        ((TSCP)14)
  668. #define    CHARACTERTAG        18
  669. #define    EOFOBJECT        ((TSCP)22)
  670. #define UNDEFINED        ((TSCP)26)
  671.  
  672. #define C_CHAR( i )     ((TSCP)(((unsigned)( i )<< 8)+CHARACTERTAG))
  673. #define CHAR_C( c )     ((char)(((unsigned)( c )) >> 8))
  674. #define CHAR_FIX( c )    ((TSCP)(((unsigned)( c )) >> 6))
  675. #define FIX_CHAR( fix )  ((TSCP)(((unsigned)( fix ) << 6)+CHARACTERTAG))
  676.  
  677. #define TSCPIMMEDIATETAG( p ) ((int)(p) & IMMEDIATETAGMASK)
  678.  
  679. extern TSCP  sc_emptylist,    /* Immediate denoting empty list */
  680.          sc_falsevalue,    /* Immediate denoting false */
  681.          sc_truevalue,    /* Immediate denoting true  */
  682.          sc_eofobject,    /* Immediate denoting end-of-file */
  683.          sc_undefined;    /* Immediate denoting the undefined value */
  684.  
  685. /* The final type of object is a list cell.  The CAR of the cell is a word
  686.    stored at (pointer), and the CDR of the cell is the next word.
  687.  
  688.     +--------+--------+--------+--------+
  689.     |           CAR of the pair        |        pair
  690.     +--------+--------+--------+--------+
  691.     |           CDR of the pair        |
  692.     +--------+--------+--------+--------+
  693. */
  694.  
  695. #define    PAIRTAG      3
  696. #define CONSSIZE  2
  697. #define CONSBYTES 8
  698.  
  699.  
  700. /* Symbols are kept in the "obarray" which is a data structure internal to
  701.    this module.  It is used by SYMBOL->STRING to make symbols unique.
  702. */
  703.  
  704. extern TSCP  sc_obarray;
  705.  
  706. /* In order for garbage collection to work correctly, the addresses of all
  707.    globals containing constants and top level variables must be known.  They
  708.    are maintained in two extensible structures:  sc_constants and sc_globals.
  709.    Entries are added by addtoSCPTRS.
  710. */
  711.  
  712. struct  SCPTRS  {
  713.    int  count;        /* # of pointers in the structure */
  714.    int  limit;        /* # of pointers it could hold */
  715.    TSCP  *ptrs[ 1 ];    /* pointers */
  716. };
  717.  
  718. #define sizeofSCPTRS( x ) (sizeof(struct SCPTRS)+sizeof(TSCP)*((x)-1))
  719.  
  720. extern struct  SCPTRS  *addtoSCPTRS();
  721.  
  722. extern struct  SCPTRS  *sc_constants;
  723.  
  724. extern struct  SCPTRS  *sc_globals;
  725.  
  726. /* Access to lexically nested variables is via a display maintained by the
  727.    following data structure.  SC_DISPLAY is an array which maintains the
  728.    display, and SC_MAXDISPLAY is the maximum number of cells in the display
  729.    that are ever used.
  730. */
  731.  
  732. extern TSCP  sc_display[];
  733.  
  734. extern int  sc_maxdisplay;
  735.  
  736. /* Debugging information is kept on the stack in an implementation independent
  737.    manner by using the following data structures and conventions.  When a
  738.    procedure is entered, it will allocate a STACKTRACE structure on the stack
  739.    and set SC_STACKTRACE to point to it.  The fields in the structure are
  740.    set as follows:
  741.             in sceval_exec:        in any other procedure:
  742.  
  743.    prevstacktrace:    previous value of    previous value of
  744.             sc_stacktrace        sc_stacktrace
  745.  
  746.    procname:        current environment    string naming the procedure
  747.  
  748.    exp:            expression being    unused
  749.                 interpreted    
  750.  
  751.    When the procedure is exited, sc_stacktrace is restored.  In order to assure
  752.    that sc_stacktrace always points to a valid entry, the list is maintained
  753.    by subroutines (compilers want to optimize it out!).
  754.  
  755.    In dobacktrace(), the stack is traced by calling C-UNSIGNED-REF
  756.    to get the prevstacktrace pointer.  The problem with this is that
  757.    C-UNSIGNED-REF (aka scrt4_c_2dunsigned_2dref) uses MUNSIGNED, which
  758.    uses T_U, which masks out the least significant two bits of the pointer.
  759.    The trick is to get an implementation independent method of aligning
  760.    the stacktrace structure.  Most compilers at least align the structure
  761.    with an even address, but only some will align it on a four-byte boundary.
  762.  
  763.    The macro ALIGN4(t,x) declares "x" to be a pointer to "t", aligned on
  764.    a 4-byte boundary.  If nothing special needs to be done, then the default
  765.    definition can be used.
  766. */
  767.  
  768. #ifdef APOLLO
  769. /* On an Apollo, things are usually aligned properly on the stack,
  770.    but after an interrupt, things can get screwy, and even doubles
  771.    can end up non-longword aligned.  To be safe, we need to align
  772.    everything on a longword boundary ourselves.
  773. */
  774. #define IDENT(a)    a
  775. #define CAT(a,b)    IDENT(a)b
  776. #define ALIGN4(t,x)    char CAT(x,buf)[sizeof(t) + sizeof(long)];\
  777.     t& x = * (t*) ((unsigned)CAT(x,buf) & ~(sizeof(long)-1))
  778. #endif
  779.  
  780. /* the rest of the world does not need to worry about such matters */
  781. #ifndef ALIGN4
  782. #define ALIGN4(t,x)    t x
  783. #endif
  784. struct  STACKTRACE {            /* Stack trace back record */
  785.     struct STACKTRACE*  prevstacktrace;    
  786.     TSCP  procname;
  787.     TSCP  exp;
  788.     };
  789.  
  790. extern  struct STACKTRACE  *sc_stacktrace;
  791.  
  792. #define  PUSHSTACKTRACE( procedure )    ALIGN4(struct  STACKTRACE,  st); \
  793.                     sc_pushtrace( &st, (procedure) )
  794.  
  795. #define  POPSTACKTRACE( exp )        return( sc_poptrace( &st, (exp) ) )
  796.  
  797. #define  LOOPSTACKTRACE( exp, env )    sc_looptrace( &st, (exp), (env) )
  798.  
  799. /* The procedural interfaces to this module are: */
  800.  
  801. extern TSCP   sc_make_2dstring_v;
  802.  
  803. extern TSCP   sc_make_2dstring();
  804.  
  805. extern TSCP   sc_string_2dcopy_v;
  806.  
  807. extern TSCP   sc_string_2dcopy();
  808.  
  809. extern TSCP   sc_cstringtostring();
  810.  
  811. extern TSCP   sc_make_2dvector_v;
  812.  
  813. extern TSCP   sc_make_2dvector();
  814.  
  815. extern TSCP   sc_makeclosure();
  816.  
  817. extern TSCP   sc_makeprocedure();
  818.  
  819. extern void   sc_initializevar();
  820.  
  821. extern void   sc_global_TSCP();
  822.  
  823. extern void   sc_constantexp();
  824.  
  825. extern TSCP   sc_string_2d_3esymbol_v;
  826.  
  827. extern TSCP   sc_string_2d_3esymbol();
  828.  
  829. extern TSCP   sc_d_2dsymbol_ab4b4447_v;
  830.  
  831. extern TSCP   sc_d_2dsymbol_ab4b4447();
  832.  
  833. extern TSCP   sc_uninterned_2dsymbol_3f_v;
  834.  
  835. extern TSCP   sc_uninterned_2dsymbol_3f();
  836.  
  837. extern TSCP   sc_clarguments();
  838.  
  839. extern char   sc_tscp_char();
  840.  
  841. extern int    sc_tscp_int();
  842.  
  843. extern unsigned  sc_tscp_unsigned();
  844.  
  845. extern unsigned  sc_tscp_pointer();
  846.  
  847. extern double sc_tscp_double();
  848.  
  849. extern TSCP   sc_int_tscp();
  850.  
  851. extern TSCP   sc_unsigned_tscp();
  852.  
  853. extern unsigned  sc_procedureaddress();
  854.  
  855. extern void   sc_pushtrace();
  856.  
  857. extern void   sc_looptrace();
  858.  
  859. extern TSCP   sc_poptrace();
  860.  
  861. /* The definitions which follow are used by the code generated by the Scheme->C
  862.    compiler.  They are included in this file so that only one #include file
  863.    will be required.
  864. */
  865.  
  866. /* Alternative C access to SCOBJ's */
  867.  
  868. #define UNSI_GNED( tscp )  (TX_U( tscp )->unsi.gned)
  869.  
  870. #define TSCP_EXTENDEDTAG( tscp )  (TX_U( tscp )->extendedobj.tag)
  871.  
  872. #define SYMBOL_NAME( tscp )          (TX_U( tscp )->symbol.name)
  873. #define SYMBOL_VALUEADDR( tscp )     (TX_U( tscp )->symbol.ptrtovalue)
  874. #define SYMBOL_VALUE( tscp )         (*TX_U( tscp )->symbol.ptrtovalue)
  875. #define SYMBOL_PROPERTYLIST( tscp )  (TX_U( tscp )->symbol.propertylist)
  876.  
  877. #define STRING_LENGTH( tscp )   (TX_U( tscp )->string.length)
  878. #define STRING_CHAR( tscp, n )  (*(((unsigned char*)tscp)+FIXED_C( n )+3))
  879.  
  880. #define VECTOR_LENGTH( tscp )     (TX_U( tscp )->vector.length)
  881. #ifdef MIPS
  882. #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
  883. #endif
  884. #ifdef TITAN
  885. #define VECTOR_ELEMENT( tscp, n ) (*(&TX_U( tscp )->vector.element0+ \
  886.                             FIXED_C( n )))
  887. #endif
  888. #ifdef VAX
  889. #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
  890. #endif
  891. #ifdef apollo
  892. #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
  893. #endif
  894. #ifdef SPARC
  895. #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
  896. #endif
  897. #ifdef I386
  898. #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
  899. #endif
  900. #ifdef SUN3
  901. #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
  902. #endif
  903. #ifdef AMIGA
  904. #define VECTOR_ELEMENT( tscp, n ) (*((PATSCP)(((char*)( tscp ))+3+((int)n))))
  905. #endif
  906.  
  907. #define PROCEDURE_REQUIRED( tscp )  (TX_U( tscp )->procedure.required)
  908. #define PROCEDURE_OPTIONAL( tscp )  (TX_U( tscp )->procedure.optional)
  909. #define PROCEDURE_CLOSURE( tscp )   (TX_U( tscp )->procedure.closure)
  910. #define PROCEDURE_CODE( tscp )        (TX_U( tscp )->procedure.code)
  911.  
  912. #define CLOSURE_LENGTH( tscp )   (TX_U( tscp )->closure.length)
  913. #define CLOSURE_CLOSURE( tscp )  (TX_U( tscp )->closure.closure)
  914. #define CLOSURE_VAR( tscp, n )   (*(&TX_U( tscp )->closure.var0+(n)))
  915.  
  916. #define FLOAT_VALUE( tscp )  (TX_U( tscp )->FLOATUTYPE.value)
  917.  
  918. #define PAIR_CAR( tscp )  (TP_U( tscp )->pair.car)
  919. #define PAIR_CDR( tscp )  (TP_U( tscp )->pair.cdr)
  920.  
  921. /* C declarations */
  922.  
  923. #define DEFSTRING( name, chars, len ) \
  924.     static struct { F2(unsigned tag:8, \
  925.                 unsigned length:24); \
  926.                 char char0[len+(4-(len % 4))]; } \
  927.     name = { U2(STRINGTAG, len), chars }
  928.  
  929. #define DEFFLOAT( name, value ) \
  930.     static struct { F2(unsigned tag:8, \
  931.                 unsigned length: 24); \
  932.                 FLOATTYPE f; } \
  933.     name = { U2(FLOATTAG, 0), value }
  934.  
  935. #define DEFTSCP( name ) TSCP  name
  936.  
  937. #define DEFSTATICTSCP( name )  static TSCP  name
  938.  
  939. #define DEFSTATICTSCP2( name, obj )  static TSCP  name = U_TX( &obj )
  940.  
  941. #define EXTERNTSCP( a ) extern TSCP  a
  942.  
  943. #define EXTERNTSCPP( a )  extern TSCP  (a)()
  944.  
  945. #define EXTERNINT( a )  extern int a
  946.  
  947. #define EXTERNINTP( a ) extern int (a)()
  948.  
  949. #define EXTERNPOINTER( a )  extern void *a
  950.  
  951. #define EXTERNPOINTERP( a ) extern void *(a)()
  952.  
  953. #define EXTERNCHAR( a ) extern char a
  954.  
  955. #define EXTERNCHARP( a ) extern char (a)()
  956.  
  957. #define EXTERNSHORTINT( a ) extern short int a
  958.  
  959. #define EXTERNSHORTINTP( a ) extern short int (a)()
  960.  
  961. #define EXTERNLONGINT( a ) extern long int a
  962.  
  963. #define EXTERNLONGINTP( a ) extern long int (a)()
  964.  
  965. #define EXTERNUNSIGNED( a ) extern unsigned a
  966.  
  967. #define EXTERNUNSIGNEDP( a ) extern unsigned (a)()
  968.  
  969. #define EXTERNSHORTUNSIGNED( a ) extern unsigned short a
  970.  
  971. #define EXTERNSHORTUNSIGNEDP( a ) extern unsigned short (a)()
  972.  
  973. #define EXTERNLONGUNSIGNED( a ) extern unsigned long a
  974.  
  975. #define EXTERNLONGUNSIGNEDP( a ) extern unsigned long (a)()
  976.  
  977. #define EXTERNFLOAT( a ) extern float a
  978.  
  979. #define EXTERNFLOATP( a ) extern float (a)()
  980.  
  981. #define EXTERNDOUBLE( a ) extern double a
  982.  
  983. #define EXTERNDOUBLEP( a ) extern double (a)()
  984.  
  985. #define EXTERNVOIDP( a ) extern void (a)()
  986.  
  987. #define MAXDISPLAY( a ) if (a > sc_maxdisplay) sc_maxdisplay = a
  988.  
  989. /* C operators */
  990.  
  991. #define EQ( a, b )        (a == b)
  992. #define NEQ( a, b )        (a != b)
  993. #define NOT( a )        (a == 0)
  994. #define GT( a, b )        (a > b)
  995. #define LT( a, b )        (a < b)
  996. #define GTE( a, b )        (a >= b)
  997. #define LTE( a, b )        (a <= b)
  998. #define OR( a, b )        (a || b)
  999. #define AND( a, b )        (a && b)
  1000. #define SET( a, b )        (a = b)
  1001. #define BITAND( a, b )        (a & b)
  1002. #define BITOR( a, b )        (a | b)
  1003. #define BITXOR( a, b )        (a ^ b)
  1004. #define BITLSH( a, b )        (a << b)
  1005. #define BITRSH( a, b )        (a >> b)
  1006. #define PLUS( a, b )        (a + b)
  1007. #define DIFFERENCE( a, b )    (a - b)
  1008. #define NEGATE( a )        (- a)
  1009. #define TIMES( a, b )        (a * b)
  1010. #define QUOTIENT( a, b )    (a / b)
  1011. #define REMAINDER( a, b )    (a % b)
  1012. #define SHORTINT( a )        ((short int) a)
  1013. #define INT( a )        ((int) a)
  1014. #define LONGINT( a )        ((long int) a)
  1015. #define SHORTUNSIGNED( a )    ((unsigned short) a)
  1016. #define UNSIGNED( a )        ((unsigned) a)
  1017. #define LONGUNSIGNED( a )    ((unsigned long) a)
  1018. #define FLOAT( a )        ((FLOATTYPE) a)
  1019. #define CFLOAT( a )        ((float) a)
  1020. #define CDOUBLE( a )        ((double) a)
  1021. #define _TSCP( a )        ((TSCP) a)
  1022. #define VIA( a )        (*a)
  1023. #define ADR( a )        (&a)
  1024. #define DISPLAY( a )        (sc_display[ a ])
  1025.  
  1026. /* AmigaOS doesn't do divide-by-zero trapping, so we add it here */
  1027. #ifdef    AMIGA
  1028. #undef QUOTIENT
  1029. #define QUOTIENT(a, b) (b == 0 ? sc_error("?????", "Divide by zero", 0) : (a / b))
  1030. #undef REMAINDER
  1031. #define REMAINDER(a, b) (b == 0 ? sc_error("?????", "Divide by zero", 0) : (a % b))
  1032. #endif
  1033.  
  1034. /* C operators that detect integer overflow in some implementations */
  1035.  
  1036. #if (MATHTRAPS == 0 || CPUTYPE == TITAN)
  1037. #define IPLUS( a, b )        (a + b)
  1038. #define IDIFFERENCE( a, b )    (a - b)
  1039. #define INEGATE( a )        (- a)
  1040. #define ITIMES( a, b )        (a * b)
  1041.  
  1042. #else
  1043.  
  1044. #define IPLUS( a, b )        sc_iplus( a, b )
  1045. #define IDIFFERENCE( a, b )    sc_idifference( a, b )
  1046. #define ITIMES( a, b )        sc_itimes( a, b )
  1047. #define INEGATE( a )        sc_inegate( a )
  1048. #endif
  1049.  
  1050. /* Generational garbage collection requires that stores of pointers to new
  1051.    objects in old objects be detected.  This is done by requiring the use
  1052.    of the macro SETGEN to set cells in SET-CAR!, SET-CDR!, VECTOR-SET!,
  1053.    PUTPROP, SCHEME-TSCP-SET!, and SET! of lexically bound variables.  The
  1054.    macro SETGENTL must be used to set the values of top level variables.
  1055.  
  1056.    N.B.  These macros assume a page size of 512 bytes.
  1057. */
  1058.  
  1059. #define SETGEN( a, b )        ((sc_pagelink[ (int)(((unsigned)(&a))>>9) ])?\
  1060.                  (a = b):sc_setgeneration( &a, b ))
  1061.  
  1062. #define SETGENTL( a, b )    (sc_setgeneration( &a, b ))
  1063.  
  1064. /* Scheme boolean tests */
  1065.  
  1066. #define TRUE( x )   ((((int)(x)) & 247) != 2)
  1067. #define FALSE( x )  ((((int)(x)) & 247) == 2)
  1068.  
  1069. /* Short circuiting for procedure application.  In order for this code
  1070.    to work correctly, it requires that the tag field be in the least
  1071.    significant 8 bits of the extended object header.
  1072. */
  1073.  
  1074. #define UNKNOWNCALL( proc, argc ) \
  1075.     (sc_unknownargc = argc, sc_unknownproc[ 1 ] = proc, \
  1076.     sc_unknownproc[(PROCEDURE_REQUIRED(sc_unknownproc[ TSCPTAG(proc) ]) == argc\
  1077.             && ! PROCEDURE_OPTIONAL(sc_unknownproc[ TSCPTAG( proc )]))])
  1078. /* UNSI_GNED(sc_unknownproc[ TSCPTAG( proc ) ] ) \
  1079.             == (argc*256+PROCEDURETAG)) ])
  1080. */
  1081.  
  1082. /* Inline type conversions */
  1083.  
  1084. /* round a floating point number to the nearest integer */
  1085. #ifdef apollo
  1086. #include <math.h>
  1087. /* Apollo SR10.2, with cc 6.7: rint() returns a bogus value (e.g., 0.9
  1088.    is "rounded" to 0.899902).
  1089.    If Apollo does not fix rint() soon, then we should write our own.
  1090. */
  1091. #define rint(x)        floor((x) + 0.5)
  1092. #define ROUND(x)    ((int) rint(x))
  1093. #endif
  1094.  
  1095. #ifndef ROUND
  1096. #define ROUND(x)    ((int) (x))
  1097. #endif
  1098.  
  1099. #define FLT_FIX( flt )   C_FIXED( ROUND(FLOAT_VALUE( flt )) )
  1100. #define FIX_FLT( fix )   MAKEFLOAT( (FLOATTYPE)(FIXED_C( fix )) )
  1101. #define FIX_FLTV( fix )  ((FLOATTYPE)(FIXED_C( fix )))
  1102. #define FLTV_FLT( flt )     MAKEFLOAT( flt )
  1103. #define FLTP_FLT( fltp ) MAKEFLOAT( *((FLOATTYPE*)( fltp )) )
  1104.  
  1105. #define STRING_C( s ) (&T_U( s )->string.char0)
  1106.  
  1107. #define BOOLEAN( c )     ((c) ? TRUEVALUE : FALSEVALUE)
  1108.  
  1109. /* Memory Access */
  1110.  
  1111. #define MBYTE( base, bx )   (*( ((unsigned char*)T_U( base ))+bx ))
  1112. #define MSINT( base, bx )   (*((short int*)( ((char*)T_U( base )) + bx )))
  1113. #define MINT( base, bx )    (*((int*)( ((char*)T_U( base )) + bx )))
  1114. #define MUNSIGNED(base, bx) (*((unsigned *)( ((char*)T_U( base )) + bx )))
  1115. #define MSUNSIGNED(base,bx) (*((unsigned short*)( ((char*)T_U( base )) + bx )))
  1116. #define MTSCP( base, bx )   (*((TSCP*)( ((char*)T_U( base )) + bx )))
  1117. #define MFLOAT( base, bx ) (*((float*)( ((char*)T_U( base )) + bx )))
  1118. #define MDOUBLE( base, bx ) (*((double*)( ((char*)T_U( base )) + bx )))
  1119.  
  1120. /* Low-level builtins */
  1121.  
  1122. #define CONS         sc_cons
  1123. #define STRINGTOSYMBOL     sc_string_2d_3esymbol
  1124. #define CONSTANTEXP     sc_constantexp
  1125. #define CLARGUMENTS     sc_clarguments
  1126. #define MAKEPROCEDURE     sc_makeprocedure
  1127. #define MAKECLOSURE     sc_makeclosure
  1128. #define INITIALIZEVAR     sc_initializevar
  1129. #define TSCP_CHAR    sc_tscp_char
  1130. #define TSCP_UNSIGNED    sc_tscp_unsigned
  1131. #define TSCP_INT    sc_tscp_int
  1132. #define TSCP_POINTER    sc_tscp_pointer
  1133. #define TSCP_DOUBLE    sc_tscp_double
  1134. #define CHAR_TSCP    C_CHAR
  1135. #define INT_TSCP    sc_int_tscp
  1136. #define UNSIGNED_TSCP   sc_unsigned_tscp
  1137. #define POINTER_TSCP    sc_unsigned_tscp
  1138. #define DOUBLE_TSCP    FLTV_FLT
  1139. #define INITHEAP    sc_restoreheap
  1140. #define SCHEMEEXIT()    scrt6_default_2dexit()
  1141. #define LISTTOVECTOR    scrt4_list_2d_3evector
  1142.  
  1143. /* External Functions and SCHEME->C globals which are defined in other
  1144.    modules.  They are duplicated here so that this file contains all external
  1145.    definitions needed by a SCHEME->C program.
  1146. */
  1147.  
  1148. #ifdef PRISM
  1149. /* As explained in heap.c, it is important to declare the function prototype,
  1150.    so the compiler passes the floating point argument in a register, rather
  1151.    than on the stack.
  1152. */
  1153. extern  TSCP  sc_makefloat32(float);
  1154. extern  TSCP  sc_makefloat64(double);
  1155. #else
  1156. extern  TSCP  sc_makefloat32();
  1157. extern  TSCP  sc_makefloat64();
  1158. #endif
  1159. extern  TSCP  sc_cons();
  1160. extern  int  sc_unknownargc;
  1161. extern  TSCP  sc_unknownproc[ 4 ];
  1162. extern  void  sc_restoreheap();
  1163. extern  TSCP  scrt4_list_2d_3evector();
  1164. extern  int   sc_iplus();
  1165. extern  int   sc_idifference();
  1166. extern  int   sc_itimes();
  1167. extern  int   sc_inegate();
  1168. extern  int*  sc_pagelink;
  1169. extern  TSCP  sc_setgeneration();
  1170.