amd64: first steps towards 64-bit pmap
[dragonfly.git] / sys / platform / pc64 / amd64 / swtch.s
1 /*
2  * Copyright (c) 2003,2004,2008 The DragonFly Project.  All rights reserved.
3  * Copyright (c) 2008 Jordan Gordeev.
4  * 
5  * This code is derived from software contributed to The DragonFly Project
6  * by Matthew Dillon <dillon@backplane.com>
7  * 
8  * Redistribution and use in source and binary forms, with or without
9  * modification, are permitted provided that the following conditions
10  * are met:
11  * 
12  * 1. Redistributions of source code must retain the above copyright
13  *    notice, this list of conditions and the following disclaimer.
14  * 2. Redistributions in binary form must reproduce the above copyright
15  *    notice, this list of conditions and the following disclaimer in
16  *    the documentation and/or other materials provided with the
17  *    distribution.
18  * 3. Neither the name of The DragonFly Project nor the names of its
19  *    contributors may be used to endorse or promote products derived
20  *    from this software without specific, prior written permission.
21  * 
22  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23  * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24  * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25  * FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE
26  * COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27  * INCIDENTAL, SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING,
28  * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29  * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
30  * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
31  * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
32  * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
33  * SUCH DAMAGE.
34  * 
35  * Copyright (c) 1990 The Regents of the University of California.
36  * All rights reserved.
37  *
38  * This code is derived from software contributed to Berkeley by
39  * William Jolitz.
40  *
41  * Redistribution and use in source and binary forms, with or without
42  * modification, are permitted provided that the following conditions
43  * are met:
44  * 1. Redistributions of source code must retain the above copyright
45  *    notice, this list of conditions and the following disclaimer.
46  * 2. Redistributions in binary form must reproduce the above copyright
47  *    notice, this list of conditions and the following disclaimer in the
48  *    documentation and/or other materials provided with the distribution.
49  * 3. All advertising materials mentioning features or use of this software
50  *    must display the following acknowledgement:
51  *      This product includes software developed by the University of
52  *      California, Berkeley and its contributors.
53  * 4. Neither the name of the University nor the names of its contributors
54  *    may be used to endorse or promote products derived from this software
55  *    without specific prior written permission.
56  *
57  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
58  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
59  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
60  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
61  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
62  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
63  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
64  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
65  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
66  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
67  * SUCH DAMAGE.
68  *
69  * $FreeBSD: src/sys/i386/i386/swtch.s,v 1.89.2.10 2003/01/23 03:36:24 ps Exp $
70  * $DragonFly: src/sys/platform/pc64/amd64/swtch.s,v 1.3 2008/08/29 17:07:10 dillon Exp $
71  */
72
73 //#include "use_npx.h"
74
75 #include <sys/rtprio.h>
76
77 #include <machine/asmacros.h>
78 #include <machine/segments.h>
79
80 #include <machine/pmap.h>
81 #if JG
82 #include <machine_base/apic/apicreg.h>
83 #endif
84 #include <machine/lock.h>
85
86 #define CHECKNZ(expr, scratch_reg) \
87         movq expr, scratch_reg; testq scratch_reg, scratch_reg; jnz 7f; int $3; 7:
88
89 #include "assym.s"
90
91 #if defined(SMP)
92 #define MPLOCKED        lock ;
93 #else
94 #define MPLOCKED
95 #endif
96
97         .data
98
99         .globl  panic
100
101 #if defined(SWTCH_OPTIM_STATS)
102         .globl  swtch_optim_stats, tlb_flush_count
103 swtch_optim_stats:      .long   0               /* number of _swtch_optims */
104 tlb_flush_count:        .long   0
105 #endif
106
107         .text
108
109
110 /*
111  * cpu_heavy_switch(struct thread *next_thread)
112  *
113  *      Switch from the current thread to a new thread.  This entry
114  *      is normally called via the thread->td_switch function, and will
115  *      only be called when the current thread is a heavy weight process.
116  *
117  *      Some instructions have been reordered to reduce pipeline stalls.
118  *
119  *      YYY disable interrupts once giant is removed.
120  */
121 ENTRY(cpu_heavy_switch)
122         /*
123          * Save RIP, RSP and callee-saved registers (RBX, RBP, R12-R15).
124          */
125         movq    PCPU(curthread),%rcx
126         /* On top of the stack is the return adress. */
127         movq    (%rsp),%rax                     /* (reorder optimization) */
128         movq    TD_PCB(%rcx),%rdx               /* RDX = PCB */
129         movq    %rax,PCB_RIP(%rdx)              /* return PC may be modified */
130         movq    %rbx,PCB_RBX(%rdx)
131         movq    %rsp,PCB_RSP(%rdx)
132         movq    %rbp,PCB_RBP(%rdx)
133         movq    %r12,PCB_R12(%rdx)
134         movq    %r13,PCB_R13(%rdx)
135         movq    %r14,PCB_R14(%rdx)
136         movq    %r15,PCB_R15(%rdx)
137
138         movq    %rcx,%rbx                       /* RBX = curthread */
139         movq    TD_LWP(%rcx),%rcx
140         movl    PCPU(cpuid), %eax
141         movq    LWP_VMSPACE(%rcx), %rcx         /* RCX = vmspace */
142         MPLOCKED btrl   %eax, VM_PMAP+PM_ACTIVE(%rcx)
143
144         /*
145          * Push the LWKT switch restore function, which resumes a heavy
146          * weight process.  Note that the LWKT switcher is based on
147          * TD_SP, while the heavy weight process switcher is based on
148          * PCB_RSP.  TD_SP is usually two ints pushed relative to
149          * PCB_RSP.  We push the flags for later restore by cpu_heavy_restore.
150          */
151         pushfq
152         movq    $cpu_heavy_restore, %rax
153         pushq   %rax
154         movq    %rsp,TD_SP(%rbx)
155
156         /*
157          * Save debug regs if necessary
158          */
159         movq    PCB_FLAGS(%rdx),%rax
160         andq    $PCB_DBREGS,%rax
161         jz      1f                              /* no, skip over */
162         movq    %dr7,%rax                       /* yes, do the save */
163         movq    %rax,PCB_DR7(%rdx)
164         /* JG correct value? */
165         andq    $0x0000fc00, %rax               /* disable all watchpoints */
166         movq    %rax,%dr7
167         movq    %dr6,%rax
168         movq    %rax,PCB_DR6(%rdx)
169         movq    %dr3,%rax
170         movq    %rax,PCB_DR3(%rdx)
171         movq    %dr2,%rax
172         movq    %rax,PCB_DR2(%rdx)
173         movq    %dr1,%rax
174         movq    %rax,PCB_DR1(%rdx)
175         movq    %dr0,%rax
176         movq    %rax,PCB_DR0(%rdx)
177 1:
178  
179 #if JG
180 #if NNPX > 0
181         /*
182          * Save the FP state if we have used the FP.  Note that calling
183          * npxsave will NULL out PCPU(npxthread).
184          */
185         cmpl    %ebx,PCPU(npxthread)
186         jne     1f
187         pushl   TD_SAVEFPU(%ebx)
188         call    npxsave                 /* do it in a big C function */
189         addl    $4,%esp                 /* EAX, ECX, EDX trashed */
190 1:
191 #endif
192 #endif  /* NNPX > 0 */
193
194         /*
195          * Switch to the next thread, which was passed as an argument
196          * to cpu_heavy_switch().  The argument is in %rdi.
197          * Set the current thread, load the stack pointer,
198          * and 'ret' into the switch-restore function.
199          *
200          * The switch restore function expects the new thread to be in %rax
201          * and the old one to be in %rbx.
202          *
203          * There is a one-instruction window where curthread is the new
204          * thread but %rsp still points to the old thread's stack, but
205          * we are protected by a critical section so it is ok.
206          */
207         movq    %rdi,%rax               /* RAX = newtd, RBX = oldtd */
208         movq    %rax,PCPU(curthread)
209         movq    TD_SP(%rax),%rsp
210         CHECKNZ((%rsp), %r9)
211         ret
212
213 /*
214  *  cpu_exit_switch(struct thread *next)
215  *
216  *      The switch function is changed to this when a thread is going away
217  *      for good.  We have to ensure that the MMU state is not cached, and
218  *      we don't bother saving the existing thread state before switching.
219  *
220  *      At this point we are in a critical section and this cpu owns the
221  *      thread's token, which serves as an interlock until the switchout is
222  *      complete.
223  */
224 ENTRY(cpu_exit_switch)
225         /*
226          * Get us out of the vmspace
227          */
228         movq    KPML4phys,%rcx
229         movq    %cr3,%rax
230         cmpq    %rcx,%rax
231         je      1f
232         /* JG no increment of statistics counters? see cpu_heavy_restore */
233         movq    %rcx,%cr3
234 1:
235         movq    PCPU(curthread),%rbx
236
237         /*
238          * If this is a process/lwp, deactivate the pmap after we've
239          * switched it out.
240          */
241         movq    TD_LWP(%rbx),%rcx
242         testq   %rcx,%rcx
243         jz      2f
244         movl    PCPU(cpuid), %eax
245         movq    LWP_VMSPACE(%rcx), %rcx         /* RCX = vmspace */
246         MPLOCKED btrl   %eax, VM_PMAP+PM_ACTIVE(%rcx)
247 2:
248         /*
249          * Switch to the next thread.  RET into the restore function, which
250          * expects the new thread in RAX and the old in RBX.
251          *
252          * There is a one-instruction window where curthread is the new
253          * thread but %rsp still points to the old thread's stack, but
254          * we are protected by a critical section so it is ok.
255          */
256         movq    %rdi,%rax
257         movq    %rax,PCPU(curthread)
258         movq    TD_SP(%rax),%rsp
259         CHECKNZ((%rsp), %r9)
260         ret
261
262 /*
263  * cpu_heavy_restore()  (current thread in %rax on entry)
264  *
265  *      Restore the thread after an LWKT switch.  This entry is normally
266  *      called via the LWKT switch restore function, which was pulled 
267  *      off the thread stack and jumped to.
268  *
269  *      This entry is only called if the thread was previously saved
270  *      using cpu_heavy_switch() (the heavy weight process thread switcher),
271  *      or when a new process is initially scheduled.  The first thing we
272  *      do is clear the TDF_RUNNING bit in the old thread and set it in the
273  *      new thread.
274  *
275  *      NOTE: The lwp may be in any state, not necessarily LSRUN, because
276  *      a preemption switch may interrupt the process and then return via 
277  *      cpu_heavy_restore.
278  *
279  *      YYY theoretically we do not have to restore everything here, a lot
280  *      of this junk can wait until we return to usermode.  But for now
281  *      we restore everything.
282  *
283  *      YYY the PCB crap is really crap, it makes startup a bitch because
284  *      we can't switch away.
285  *
286  *      YYY note: spl check is done in mi_switch when it splx()'s.
287  */
288
289 ENTRY(cpu_heavy_restore)
290         popfq
291         movq    TD_PCB(%rax),%rdx               /* RDX = PCB */
292         movq    TD_LWP(%rax),%rcx
293
294 #if defined(SWTCH_OPTIM_STATS)
295         incl    _swtch_optim_stats
296 #endif
297         /*
298          * Tell the pmap that our cpu is using the VMSPACE now.  We cannot
299          * safely test/reload %cr3 until after we have set the bit in the
300          * pmap (remember, we do not hold the MP lock in the switch code).
301          */
302         movq    LWP_VMSPACE(%rcx), %rcx         /* RCX = vmspace */
303         movl    PCPU(cpuid), %esi
304         MPLOCKED btsl   %esi, VM_PMAP+PM_ACTIVE(%rcx)
305
306         /*
307          * Restore the MMU address space.  If it is the same as the last
308          * thread we don't have to invalidate the tlb (i.e. reload cr3).
309          * YYY which naturally also means that the PM_ACTIVE bit had better
310          * already have been set before we set it above, check? YYY
311          */
312         movq    %cr3,%rsi
313         movq    PCB_CR3(%rdx),%rcx
314         cmpq    %rsi,%rcx
315         je      4f
316 #if defined(SWTCH_OPTIM_STATS)
317         decl    _swtch_optim_stats
318         incl    _tlb_flush_count
319 #endif
320         movq    %rcx,%cr3
321 4:
322         /*
323          * Clear TDF_RUNNING flag in old thread only after cleaning up
324          * %cr3.  The target thread is already protected by being TDF_RUNQ
325          * so setting TDF_RUNNING isn't as big a deal.
326          */
327         andl    $~TDF_RUNNING,TD_FLAGS(%rbx)
328         orl     $TDF_RUNNING,TD_FLAGS(%rax)
329
330         /*
331          * Deal with the PCB extension, restore the private tss
332          */
333         movq    PCB_EXT(%rdx),%rdi      /* check for a PCB extension */
334         /* JG cheaper than "movq $1,%rbx", right? */
335         /* JG what's that magic value $1? */
336         movl    $1,%ebx                 /* maybe mark use of a private tss */
337         testq   %rdi,%rdi
338 #if JG
339         jnz     2f
340 #endif
341
342         /* JG
343          * Going back to the common_tss.  We may need to update TSS_ESP0
344          * which sets the top of the supervisor stack when entering from
345          * usermode.  The PCB is at the top of the stack but we need another
346          * 16 bytes to take vm86 into account.
347          */
348         leaq    -16(%rdx),%rbx
349         movq    %rbx, PCPU(common_tss) + TSS_RSP0
350         movq    %rbx, PCPU(rsp0)
351
352 #if JG
353         cmpl    $0,PCPU(private_tss)    /* don't have to reload if      */
354         je      3f                      /* already using the common TSS */
355
356         /* JG? */
357         subl    %ebx,%ebx               /* unmark use of private tss */
358
359         /*
360          * Get the address of the common TSS descriptor for the ltr.
361          * There is no way to get the address of a segment-accessed variable
362          * so we store a self-referential pointer at the base of the per-cpu
363          * data area and add the appropriate offset.
364          */
365         /* JG movl? */
366         movq    $gd_common_tssd, %rdi
367         /* JG name for "%gs:0"? */
368         addq    %gs:0, %rdi
369
370         /*
371          * Move the correct TSS descriptor into the GDT slot, then reload
372          * ltr.
373          */
374 2:
375         /* JG */
376         movl    %ebx,PCPU(private_tss)          /* mark/unmark private tss */
377         movq    PCPU(tss_gdt), %rbx             /* entry in GDT */
378         movq    0(%rdi), %rax
379         movq    %rax, 0(%rbx)
380         movl    $GPROC0_SEL*8, %esi             /* GSEL(entry, SEL_KPL) */
381         ltr     %si
382 #endif
383
384 3:
385         /*
386          * Restore the user %gs and %fs
387          */
388         movq    PCB_FSBASE(%rdx),%r9
389         cmpq    PCPU(user_fs),%r9
390         je      4f
391         movq    %rdx,%r10
392         movq    %r9,PCPU(user_fs)
393         movl    $MSR_FSBASE,%ecx
394         movl    PCB_FSBASE(%r10),%eax
395         movl    PCB_FSBASE+4(%r10),%edx
396         wrmsr
397         movq    %r10,%rdx
398 4:
399         movq    PCB_GSBASE(%rdx),%r9
400         cmpq    PCPU(user_gs),%r9
401         je      5f
402         movq    %rdx,%r10
403         movq    %r9,PCPU(user_gs)
404         movl    $MSR_KGSBASE,%ecx       /* later swapgs moves it to GSBASE */
405         movl    PCB_GSBASE(%r10),%eax
406         movl    PCB_GSBASE+4(%r10),%edx
407         wrmsr
408         movq    %r10,%rdx
409 5:
410
411         /*
412          * Restore general registers.
413          */
414         movq    PCB_RBX(%rdx), %rbx
415         movq    PCB_RSP(%rdx), %rsp
416         movq    PCB_RBP(%rdx), %rbp
417         movq    PCB_R12(%rdx), %r12
418         movq    PCB_R13(%rdx), %r13
419         movq    PCB_R14(%rdx), %r14
420         movq    PCB_R15(%rdx), %r15
421         movq    PCB_RIP(%rdx), %rax
422         movq    %rax, (%rsp)
423
424 #if JG
425         /*
426          * Restore the user LDT if we have one
427          */
428         cmpl    $0, PCB_USERLDT(%edx)
429         jnz     1f
430         movl    _default_ldt,%eax
431         cmpl    PCPU(currentldt),%eax
432         je      2f
433         lldt    _default_ldt
434         movl    %eax,PCPU(currentldt)
435         jmp     2f
436 1:      pushl   %edx
437         call    set_user_ldt
438         popl    %edx
439 2:
440 #endif
441 #if JG
442         /*
443          * Restore the user TLS if we have one
444          */
445         pushl   %edx
446         call    set_user_TLS
447         popl    %edx
448 #endif
449
450         /*
451          * Restore the DEBUG register state if necessary.
452          */
453         movq    PCB_FLAGS(%rdx),%rax
454         andq    $PCB_DBREGS,%rax
455         jz      1f                              /* no, skip over */
456         movq    PCB_DR6(%rdx),%rax              /* yes, do the restore */
457         movq    %rax,%dr6
458         movq    PCB_DR3(%rdx),%rax
459         movq    %rax,%dr3
460         movq    PCB_DR2(%rdx),%rax
461         movq    %rax,%dr2
462         movq    PCB_DR1(%rdx),%rax
463         movq    %rax,%dr1
464         movq    PCB_DR0(%rdx),%rax
465         movq    %rax,%dr0
466         movq    %dr7,%rax                /* load dr7 so as not to disturb */
467         /* JG correct value? */
468         andq    $0x0000fc00,%rax         /*   reserved bits               */
469         /* JG we've got more registers on amd64 */
470         pushq   %rbx
471         movq    PCB_DR7(%rdx),%rbx
472         /* JG correct value? */
473         andq    $~0x0000fc00,%rbx
474         orq     %rbx,%rax
475         popq    %rbx
476         movq    %rax,%dr7
477 1:
478
479         CHECKNZ((%rsp), %r9)
480         ret
481
482 /*
483  * savectx(struct pcb *pcb)
484  *
485  * Update pcb, saving current processor state.
486  */
487 ENTRY(savectx)
488         /* fetch PCB */
489         /* JG use %rdi instead of %rcx everywhere? */
490         movq    %rdi,%rcx
491
492         /* caller's return address - child won't execute this routine */
493         movq    (%rsp),%rax
494         movq    %rax,PCB_RIP(%rcx)
495
496         movq    %cr3,%rax
497         movq    %rax,PCB_CR3(%rcx)
498
499         movq    %rbx,PCB_RBX(%rcx)
500         movq    %rsp,PCB_RSP(%rcx)
501         movq    %rbp,PCB_RBP(%rcx)
502         movq    %r12,PCB_R12(%rcx)
503         movq    %r13,PCB_R13(%rcx)
504         movq    %r14,PCB_R14(%rcx)
505         movq    %r15,PCB_R15(%rcx)
506
507 #if JG
508 #if NNPX > 0
509         /*
510          * If npxthread == NULL, then the npx h/w state is irrelevant and the
511          * state had better already be in the pcb.  This is true for forks
512          * but not for dumps (the old book-keeping with FP flags in the pcb
513          * always lost for dumps because the dump pcb has 0 flags).
514          *
515          * If npxthread != NULL, then we have to save the npx h/w state to
516          * npxthread's pcb and copy it to the requested pcb, or save to the
517          * requested pcb and reload.  Copying is easier because we would
518          * have to handle h/w bugs for reloading.  We used to lose the
519          * parent's npx state for forks by forgetting to reload.
520          */
521         movl    PCPU(npxthread),%eax
522         testl   %eax,%eax
523         je      1f
524
525         pushl   %ecx                    /* target pcb */
526         movl    TD_SAVEFPU(%eax),%eax   /* originating savefpu area */
527         pushl   %eax
528
529         pushl   %eax
530         call    npxsave
531         addl    $4,%esp
532
533         popl    %eax
534         popl    %ecx
535
536         pushl   $PCB_SAVEFPU_SIZE
537         leal    PCB_SAVEFPU(%ecx),%ecx
538         pushl   %ecx
539         pushl   %eax
540         call    bcopy
541         addl    $12,%esp
542 #endif  /* NNPX > 0 */
543
544 1:
545 #endif
546         CHECKNZ((%rsp), %r9)
547         ret
548
549 /*
550  * cpu_idle_restore()   (current thread in %rax on entry) (one-time execution)
551  *
552  *      Don't bother setting up any regs other than %rbp so backtraces
553  *      don't die.  This restore function is used to bootstrap into the
554  *      cpu_idle() LWKT only, after that cpu_lwkt_*() will be used for
555  *      switching.
556  *
557  *      Clear TDF_RUNNING in old thread only after we've cleaned up %cr3.
558  *
559  *      If we are an AP we have to call ap_init() before jumping to
560  *      cpu_idle().  ap_init() will synchronize with the BP and finish
561  *      setting up various ncpu-dependant globaldata fields.  This may
562  *      happen on UP as well as SMP if we happen to be simulating multiple
563  *      cpus.
564  */
565 ENTRY(cpu_idle_restore)
566         /* cli */
567         movq    KPML4phys,%rcx
568         /* JG xor? */
569         movl    $0,%ebp
570         /* JG push RBP? */
571         pushq   $0
572         movq    %rcx,%cr3
573         andl    $~TDF_RUNNING,TD_FLAGS(%rbx)
574         orl     $TDF_RUNNING,TD_FLAGS(%rax)
575 #ifdef SMP
576         cmpl    $0,PCPU(cpuid)
577         je      1f
578         call    ap_init
579 1:
580 #endif
581         /*
582          * ap_init can decide to enable interrupts early, but otherwise, or if
583          * we are UP, do it here.
584          */
585         sti
586         jmp     cpu_idle
587
588 /*
589  * cpu_kthread_restore() (current thread is %rax on entry) (one-time execution)
590  *
591  *      Don't bother setting up any regs other then %rbp so backtraces
592  *      don't die.  This restore function is used to bootstrap into an
593  *      LWKT based kernel thread only.  cpu_lwkt_switch() will be used
594  *      after this.
595  *
596  *      Since all of our context is on the stack we are reentrant and
597  *      we can release our critical section and enable interrupts early.
598  */
599 ENTRY(cpu_kthread_restore)
600         sti
601         movq    KPML4phys,%rcx
602         movq    TD_PCB(%rax),%rdx
603         /* JG "movq $0, %rbp"? "xorq %rbp, %rbp"? */
604         movl    $0,%ebp
605         movq    %rcx,%cr3
606         /* rax and rbx come from the switchout code */
607         andl    $~TDF_RUNNING,TD_FLAGS(%rbx)
608         orl     $TDF_RUNNING,TD_FLAGS(%rax)
609         subl    $TDPRI_CRIT,TD_PRI(%rax)
610         movq    PCB_R12(%rdx),%rdi      /* argument to RBX function */
611         movq    PCB_RBX(%rdx),%rax      /* thread function */
612         /* note: top of stack return address inherited by function */
613         CHECKNZ(%rax, %r9)
614         jmp     *%rax
615
616 /*
617  * cpu_lwkt_switch(struct thread *)
618  *
619  *      Standard LWKT switching function.  Only non-scratch registers are
620  *      saved and we don't bother with the MMU state or anything else.
621  *
622  *      This function is always called while in a critical section.
623  *
624  *      There is a one-instruction window where curthread is the new
625  *      thread but %rsp still points to the old thread's stack, but
626  *      we are protected by a critical section so it is ok.
627  *
628  *      YYY BGL, SPL
629  */
630 ENTRY(cpu_lwkt_switch)
631         pushq   %rbp    /* JG note: GDB hacked to locate ebp relative to td_sp */
632         /* JG we've got more registers on AMD64 */
633         pushq   %rbx
634         movq    PCPU(curthread),%rbx
635         pushq   %r12
636         pushq   %r13
637         pushq   %r14
638         pushq   %r15
639         pushfq
640
641 #if JG
642 #if NNPX > 0
643         /*
644          * Save the FP state if we have used the FP.  Note that calling
645          * npxsave will NULL out PCPU(npxthread).
646          *
647          * We have to deal with the FP state for LWKT threads in case they
648          * happen to get preempted or block while doing an optimized
649          * bzero/bcopy/memcpy.
650          */
651         cmpl    %ebx,PCPU(npxthread)
652         jne     1f
653         pushl   TD_SAVEFPU(%ebx)
654         call    npxsave                 /* do it in a big C function */
655         addl    $4,%esp                 /* EAX, ECX, EDX trashed */
656 1:
657 #endif  /* NNPX > 0 */
658 #endif
659
660         movq    %rdi,%rax               /* switch to this thread */
661         pushq   $cpu_lwkt_restore
662         movq    %rsp,TD_SP(%rbx)
663         movq    %rax,PCPU(curthread)
664         movq    TD_SP(%rax),%rsp
665
666         /*
667          * %rax contains new thread, %rbx contains old thread.
668          */
669         CHECKNZ((%rsp), %r9)
670         ret
671
672 /*
673  * cpu_lwkt_restore()   (current thread in %rax on entry)
674  *
675  *      Standard LWKT restore function.  This function is always called
676  *      while in a critical section.
677  *      
678  *      Warning: due to preemption the restore function can be used to 
679  *      'return' to the original thread.  Interrupt disablement must be
680  *      protected through the switch so we cannot run splz here.
681  *
682  *      YYY we theoretically do not need to load KPML4phys into cr3, but if
683  *      so we need a way to detect when the PTD we are using is being 
684  *      deleted due to a process exiting.
685  */
686 ENTRY(cpu_lwkt_restore)
687         movq    KPML4phys,%rcx  /* YYY borrow but beware desched/cpuchg/exit */
688         movq    %cr3,%rdx
689         cmpq    %rcx,%rdx
690         je      1f
691         movq    %rcx,%cr3
692 1:
693         andl    $~TDF_RUNNING,TD_FLAGS(%rbx)
694         orl     $TDF_RUNNING,TD_FLAGS(%rax)
695         popfq
696         popq    %r15
697         popq    %r14
698         popq    %r13
699         popq    %r12
700         popq    %rbx
701         popq    %rbp
702         ret