source: release/1.7/source/lisp-kernel/x86-subprims32.s @ 15267

Last change on this file since 15267 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.

File size: 3.4 KB
Line 
1        include(lisp.s)
2        _beginfile
3       
4        .globl _SPmkcatch1v
5        .globl _SPnthrow1value
6       
7/* This is called from a c-style context and calls a lisp function.*/
8/* This does the moral equivalent of*/
9/*   (loop */
10/*      (let* ((fn (%function_on_top_of_lisp_stack)))*/
11/*        (if fn*/
12/*            (catch %toplevel-catch%*/
13/*             (funcall fn))*/
14/*            (return nil))))*/
15
16
17_exportfn(toplevel_loop)
18Xsubprims_start:               
19        __(push %ebp)
20        __(movl %esp,%ebp)
21        /* Switch to the lisp stack */
22        __(movl %esp,rcontext(tcr.foreign_sp))
23        __(movl rcontext(tcr.save_vsp),%esp)
24        __(push $0)
25        __(mov %esp,%ebp)
26        __(cmpl $0,C(GCDebug))
27        __(je 1f)
28        __(ref_global(initial_tcr,%imm0))
29        __(cmpl rcontext(tcr.linear),%imm0)
30        __(jne 1f)
31        __(clr %imm0)
32        __(uuo_error_gc_trap)
331:
34        __(jmp local_label(test))
35local_label(loop):
36        __(ref_nrs_value(toplcatch,%arg_z))
37        __(movl `$'local_label(back_from_catch),%ra0)
38        __(movl `$'local_label(test),%xfn)
39        __(push %ra0)
40        __(jmp _SPmkcatch1v)
41__(tra(local_label(back_from_catch)))
42        __(movl %arg_y,%temp0)
43        __(pushl `$'local_label(back_from_funcall))
44        __(set_nargs(0))
45        __(jmp _SPfuncall)
46__(tra(local_label(back_from_funcall)))
47        __(movl $fixnumone,%imm0)
48        __(movl `$'local_label(test),%ra0)
49        __(jmp _SPnthrow1value)
50__(tra(local_label(test)))
51        __(movl 4(%ebp),%arg_y)
52        __(cmpl $nil_value,%arg_y)
53        __(jnz local_label(loop))
54local_label(back_to_c):
55        __(movl rcontext(tcr.foreign_sp),%esp)
56        __(movl %esp,%ebp)
57        __(leave)
58        __(ret)
59
60/* This is called from C code when a thread (including the initial thread) */
61/* starts execution.  (Historically, it also provided a primitive way of */
62/* "resettting" a thread in the event of catastrophic failure, but this */
63/* hasn't worked in a long time.) */
64/* For compatibility with PPC code, this is called with the first foreign */
65/* argument pointing to the thread's TCR and the second foreign argument */
66/*  being a Boolean which indicates whether the thread should try to */
67/* "reset" itself or start running lisp code. */
68/* The reset/panic code doesn't work. */
69
70_exportfn(C(start_lisp))
71        __(push %ebp)
72        __(movl %esp, %ebp)
73        __(push %edi)
74        __(push %esi)
75        __(push %ebx)
76        __(mov 8(%ebp), %ebx)   /* get tcr */
77        __(cmpb $0,C(rcontext_readonly))
78        __(jne 0f)
79ifdef(`WIN_32',`
80',`
81        __(movw tcr.ldt_selector(%ebx), %rcontext_reg)
82')
830:             
84        __(movl 8(%ebp),%eax)
85        __(cmpl rcontext(tcr.linear),%eax)
86        __(je 1f)
87        __(hlt)
881:             
89        .if c_stack_16_byte_aligned
90        __(sub $12, %esp)       /* stack now 16-byte aligned */
91        .else
92        __(andl $~15,%esp)
93        .endif
94        __(clr %arg_z)
95        __(clr %arg_y) 
96        __(clr %temp0)
97        __(clr %temp1)
98        __(clr %fn)
99        __(pxor %fpzero, %fpzero)
100        __(stmxcsr rcontext(tcr.foreign_mxcsr))
101        __(andb $~mxcsr_all_exceptions,rcontext(tcr.foreign_mxcsr))
102        __(ldmxcsr rcontext(tcr.lisp_mxcsr))
103        __(movl $TCR_STATE_LISP, rcontext(tcr.valence))
104        __(call toplevel_loop)
105        __(movl $TCR_STATE_FOREIGN, rcontext(tcr.valence))
106        __(emms)
107        __(leal -3*node_size(%ebp),%esp)
108        __(pop %ebx)
109        __(pop %esi)
110        __(pop %edi)
111        __(ldmxcsr rcontext(tcr.foreign_mxcsr))
112        __ifdef(`WIN32_ES_HACK')
113         __(push %ds)
114         __(pop %es)
115        __endif
116        __(movl $nil_value, %eax)
117        __(leave)
118        __(ret)
119Xsubprims_end:           
120_endfn
121
122        .data
123        .globl C(subprims_start)
124        .globl C(subprims_end)
125C(subprims_start):      .long Xsubprims_start
126C(subprims_end):        .long Xsubprims_end
127        .text
128
129
Note: See TracBrowser for help on using the repository browser.