source: release/1.9/source/lisp-kernel/macros.h @ 15630

Last change on this file since 15630 was 14619, checked in by rme, 8 years ago

Merge shrink-tcr branch. This enables the 32-bit Windows lisp to run
on 64-bit Windows.

On 32-bit x86 ports, we expect to use a segment register to point to a
block of thread-local data called the TCR (thread context record).
This has always been kind of a bother on 32-bit Windows: we have been
using a kludge that allows us to use the %es segment register
(conditionalized on WIN32_ES_HACK).

Unfortunately, 64-bit Windows doesn't support using an LDT. This is
why the 32-bit lisp wouldn't run on 64-bit Windows.

The new scheme is to use some of the TlsSlots? (part of the Windows
TEB) for the most important parts of the TCR, and to introduce an "aux
vector" for the remaining TCR slots. Since %fs points to the TEB, we
can make this work. We reserve the last 34 (of 64) slots for our use,
and will die if we don't get them.

Microsoft's documentation says not to access the TlsSlots? directly
(you're supposed to use TlsGetValue/TlsSetValue?), so we're treading on
undocumented ground. Frankly, we've done worse.

This change introduces some ugliness. In lisp kernel C files, there's
a TCR_AUX(tcr) macro that expands to "tcr->aux" on win32, and to "tcr"
elsewhere.

If lisp or lap code has a pointer to a TCR, it's necessary to subtract
off target::tcr-bias (which on Windows/x86 is #xe10, the offset from
%fs to the TlsSlots? in the Windows TEB). We also sometimes have to load
target::tcr.aux to get at data which has been moved there.

These changes should only affect Windows/x86. The story on the other
platforms is just the same as before.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.8 KB
Line 
1/*
2   Copyright (C) 2009 Clozure Associates
3   Copyright (C) 1994-2001 Digitool, Inc
4   This file is part of Clozure CL. 
5
6   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7   License , known as the LLGPL and distributed with Clozure CL as the
8   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9   which is distributed with Clozure CL as the file "LGPL".  Where these
10   conflict, the preamble takes precedence. 
11
12   Clozure CL is referenced in the preamble as the "LIBRARY."
13
14   The LLGPL is also available online at
15   http://opensource.franz.com/preamble.html
16*/
17
18/* Totally different content than 'macros.s' */
19
20
21
22#ifndef __macros__
23#define __macros__
24
25#define ptr_to_lispobj(p) ((LispObj)(p))
26#define ptr_from_lispobj(o) ((LispObj*)(o))
27#define lisp_reg_p(reg)  ((reg) >= fn)
28
29#define fulltag_of(o)  ((o) & fulltagmask)
30#define tag_of(o) ((o) & tagmask)
31#define untag(o) ((o) & ~fulltagmask)
32#define node_aligned(o) ((o) & ~tagmask)
33#define indirect_node(o) (*(LispObj *)(node_aligned(o)))
34
35#define deref(o,n) ((((LispObj*) (untag((LispObj)o))))[(n)])
36#define header_of(o) deref(o,0)
37
38#define header_subtag(h) ((h) & subtagmask)
39#define header_element_count(h) ((h) >> num_subtag_bits)
40#define make_header(subtag,element_count) ((subtag)|((element_count)<<num_subtag_bits))
41
42#define unbox_fixnum(x) ((signed_natural)(((signed_natural)(x))>>fixnum_shift))
43#define box_fixnum(x) ((LispObj)((signed_natural)(x)<<fixnum_shift))
44
45#define car(x) (((cons *)ptr_from_lispobj(untag(x)))->car)
46#define cdr(x) (((cons *)ptr_from_lispobj(untag(x)))->cdr)
47
48/* "sym" is an untagged pointer to a symbol */
49#define BOUNDP(sym)  ((((lispsymbol *)(sym))->vcell) != undefined)
50
51/* Likewise. */
52#define FBOUNDP(sym) ((((lispsymbol *)(sym))->fcell) != nrs_UDF.vcell)
53
54#ifdef PPC
55#ifdef PPC64
56#define nodeheader_tag_p(tag) (((tag) & lowtag_mask) == lowtag_nodeheader)
57#define immheader_tag_p(tag) (((tag) & lowtag_mask) == lowtag_immheader)
58#else
59#define nodeheader_tag_p(tag) (tag == fulltag_nodeheader)
60#define immheader_tag_p(tag) (tag == fulltag_immheader)
61#endif
62#endif
63
64#ifdef X86
65#ifdef X8664
66#define NODEHEADER_MASK ((1<<(fulltag_nodeheader_0)) | \
67                         (1<<(fulltag_nodeheader_1)))
68#define nodeheader_tag_p(tag) ((1<<(tag)) &  NODEHEADER_MASK)
69
70#define IMMHEADER_MASK ((1<<fulltag_immheader_0) | \
71                        (1UL<<fulltag_immheader_1) |                    \
72                        (1UL<<fulltag_immheader_2))
73
74#define immheader_tag_p(tag) ((1<<(tag)) & IMMHEADER_MASK)
75#else
76#define nodeheader_tag_p(tag) (tag == fulltag_nodeheader)
77#define immheader_tag_p(tag) (tag == fulltag_immheader)
78#endif
79#endif
80
81#ifdef ARM
82#define nodeheader_tag_p(tag) (tag == fulltag_nodeheader)
83#define immheader_tag_p(tag) (tag == fulltag_immheader)
84#endif
85
86#ifdef VC
87#define inline
88#define __attribute__(x)
89#endif
90
91/* lfuns */
92#define lfun_bits(f) (deref(f,header_element_count(header_of(f))))
93#define named_function_p(f) (!(lfun_bits(f)&(1<<(29+fixnum_shift))))
94#define named_function_name(f) (deref(f,-1+header_element_count(header_of(f))))
95
96#define TCR_INTERRUPT_LEVEL(tcr) \
97  (((signed_natural *)((tcr)->tlb_pointer))[INTERRUPT_LEVEL_BINDING_INDEX])
98
99#ifdef WINDOWS
100#define LSEEK(fd,offset,how) _lseeki64(fd,offset,how)
101#else
102#define LSEEK(fd,offset,how) lseek(fd,offset,how)
103#endif
104
105/* We can't easily and unconditionally use format strings like "0x%lx"
106   to print lisp objects: the "l" might not match the word size, and
107   neither would (necessarily) something like "0x%llx".  We can at
108   least exploit the fact that on all current platforms, "ll" ("long long")
109   is the size of a 64-bit lisp object and "l" ("long") is the size of
110   a 32-bit lisp object. */
111
112#if (WORD_SIZE == 64)
113#define LISP "%llx"
114#define ZLISP "%016llx"
115#define DECIMAL "%lld"
116#else
117#define LISP "%lx"
118#define ZLISP "%08x"
119#define DECIMAL "%ld"
120#endif
121
122#ifdef WIN_32
123#define TCR_AUX(tcr) tcr->aux
124#else
125#define TCR_AUX(tcr) tcr
126#endif
127#endif /* __macros __ */
Note: See TracBrowser for help on using the repository browser.