Index: head/sys/amd64/amd64/cpu_switch.S =================================================================== --- head/sys/amd64/amd64/cpu_switch.S (revision 48690) +++ head/sys/amd64/amd64/cpu_switch.S (revision 48691) @@ -1,805 +1,843 @@ /*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * - * $Id: swtch.s,v 1.82 1999/06/01 18:19:45 jlemon Exp $ + * $Id: swtch.s,v 1.83 1999/07/03 06:33:24 alc Exp $ */ #include "npx.h" #include "opt_user_ldt.h" #include #include #ifdef SMP #include #include #include /** GRAB_LOPRIO */ #include #include #endif /* SMP */ #include "assym.s" /*****************************************************************************/ /* Scheduling */ /*****************************************************************************/ /* * The following primitives manipulate the run queues. * _whichqs tells which of the 32 queues _qs * have processes in them. setrunqueue puts processes into queues, Remrq * removes them from queues. The running process is on no queue, * other processes are on a queue related to p->p_priority, divided by 4 * actually to shrink the 0-127 range of priorities into the 32 available * queues. */ .data .globl _whichqs, _whichrtqs, _whichidqs _whichqs: .long 0 /* which run queues have data */ _whichrtqs: .long 0 /* which realtime run qs have data */ _whichidqs: .long 0 /* which idletime run qs have data */ .globl _hlt_vector _hlt_vector: .long _default_halt /* pointer to halt routine */ .globl _qs,_cnt,_panic .globl _want_resched _want_resched: .long 0 /* we need to re-run the scheduler */ #if defined(SWTCH_OPTIM_STATS) .globl _swtch_optim_stats, _tlb_flush_count _swtch_optim_stats: .long 0 /* number of _swtch_optims */ _tlb_flush_count: .long 0 #endif .text /* * setrunqueue(p) * * Call should be made at spl6(), and p->p_stat should be SRUN */ ENTRY(setrunqueue) movl 4(%esp),%eax #ifdef DIAGNOSTIC cmpb $SRUN,P_STAT(%eax) je set1 pushl $set2 call _panic set1: #endif cmpw $RTP_PRIO_NORMAL,P_RTPRIO_TYPE(%eax) /* normal priority process? */ je set_nort movzwl P_RTPRIO_PRIO(%eax),%edx cmpw $RTP_PRIO_REALTIME,P_RTPRIO_TYPE(%eax) /* RR realtime priority? */ je set_rt /* RT priority */ cmpw $RTP_PRIO_FIFO,P_RTPRIO_TYPE(%eax) /* FIFO realtime priority? */ jne set_id /* must be idle priority */ set_rt: btsl %edx,_whichrtqs /* set q full bit */ shll $3,%edx addl $_rtqs,%edx /* locate q hdr */ movl %edx,P_FORW(%eax) /* link process on tail of q */ movl P_BACK(%edx),%ecx movl %ecx,P_BACK(%eax) movl %eax,P_BACK(%edx) movl %eax,P_FORW(%ecx) ret set_id: btsl %edx,_whichidqs /* set q full bit */ shll $3,%edx addl $_idqs,%edx /* locate q hdr */ movl %edx,P_FORW(%eax) /* link process on tail of q */ movl P_BACK(%edx),%ecx movl %ecx,P_BACK(%eax) movl %eax,P_BACK(%edx) movl %eax,P_FORW(%ecx) ret set_nort: /* Normal (RTOFF) code */ movzbl P_PRI(%eax),%edx shrl $2,%edx btsl %edx,_whichqs /* set q full bit */ shll $3,%edx addl $_qs,%edx /* locate q hdr */ movl %edx,P_FORW(%eax) /* link process on tail of q */ movl P_BACK(%edx),%ecx movl %ecx,P_BACK(%eax) movl %eax,P_BACK(%edx) movl %eax,P_FORW(%ecx) ret set2: .asciz "setrunqueue" /* * Remrq(p) * * Call should be made at spl6(). */ ENTRY(remrq) movl 4(%esp),%eax cmpw $RTP_PRIO_NORMAL,P_RTPRIO_TYPE(%eax) /* normal priority process? */ je rem_nort movzwl P_RTPRIO_PRIO(%eax),%edx cmpw $RTP_PRIO_REALTIME,P_RTPRIO_TYPE(%eax) /* realtime priority process? */ je rem0rt cmpw $RTP_PRIO_FIFO,P_RTPRIO_TYPE(%eax) /* FIFO realtime priority process? */ jne rem_id rem0rt: btrl %edx,_whichrtqs /* clear full bit, panic if clear already */ jb rem1rt pushl $rem3rt call _panic rem1rt: pushl %edx movl P_FORW(%eax),%ecx /* unlink process */ movl P_BACK(%eax),%edx movl %edx,P_BACK(%ecx) movl P_BACK(%eax),%ecx movl P_FORW(%eax),%edx movl %edx,P_FORW(%ecx) popl %edx movl $_rtqs,%ecx shll $3,%edx addl %edx,%ecx cmpl P_FORW(%ecx),%ecx /* q still has something? */ je rem2rt shrl $3,%edx /* yes, set bit as still full */ btsl %edx,_whichrtqs rem2rt: ret rem_id: btrl %edx,_whichidqs /* clear full bit, panic if clear already */ jb rem1id pushl $rem3id call _panic rem1id: pushl %edx movl P_FORW(%eax),%ecx /* unlink process */ movl P_BACK(%eax),%edx movl %edx,P_BACK(%ecx) movl P_BACK(%eax),%ecx movl P_FORW(%eax),%edx movl %edx,P_FORW(%ecx) popl %edx movl $_idqs,%ecx shll $3,%edx addl %edx,%ecx cmpl P_FORW(%ecx),%ecx /* q still has something? */ je rem2id shrl $3,%edx /* yes, set bit as still full */ btsl %edx,_whichidqs rem2id: ret rem_nort: movzbl P_PRI(%eax),%edx shrl $2,%edx btrl %edx,_whichqs /* clear full bit, panic if clear already */ jb rem1 pushl $rem3 call _panic rem1: pushl %edx movl P_FORW(%eax),%ecx /* unlink process */ movl P_BACK(%eax),%edx movl %edx,P_BACK(%ecx) movl P_BACK(%eax),%ecx movl P_FORW(%eax),%edx movl %edx,P_FORW(%ecx) popl %edx movl $_qs,%ecx shll $3,%edx addl %edx,%ecx cmpl P_FORW(%ecx),%ecx /* q still has something? */ je rem2 shrl $3,%edx /* yes, set bit as still full */ btsl %edx,_whichqs rem2: ret rem3: .asciz "remrq" rem3rt: .asciz "remrq.rt" rem3id: .asciz "remrq.id" /* * When no processes are on the runq, cpu_switch() branches to _idle * to wait for something to come ready. */ ALIGN_TEXT .type _idle,@function _idle: xorl %ebp,%ebp movl %ebp,_switchtime #ifdef SMP /* when called, we have the mplock, intr disabled */ /* use our idleproc's "context" */ movl _IdlePTD, %ecx movl %cr3, %eax cmpl %ecx, %eax je 2f #if defined(SWTCH_OPTIM_STATS) decl _swtch_optim_stats incl _tlb_flush_count #endif movl %ecx, %cr3 2: /* Keep space for nonexisting return addr, or profiling bombs */ movl $gd_idlestack_top-4, %ecx addl %fs:0, %ecx movl %ecx, %esp /* update common_tss.tss_esp0 pointer */ movl %ecx, _common_tss + TSS_ESP0 movl _cpuid, %esi btrl %esi, _private_tss jae 1f movl $gd_common_tssd, %edi addl %fs:0, %edi /* move correct tss descriptor into GDT slot, then reload tr */ movl _tss_gdt, %ebx /* entry in GDT */ movl 0(%edi), %eax movl %eax, 0(%ebx) movl 4(%edi), %eax movl %eax, 4(%ebx) movl $GPROC0_SEL*8, %esi /* GSEL(entry, SEL_KPL) */ ltr %si 1: sti /* * XXX callers of cpu_switch() do a bogus splclock(). Locking should * be left to cpu_switch(). */ call _spl0 cli /* * _REALLY_ free the lock, no matter how deep the prior nesting. * We will recover the nesting on the way out when we have a new * proc to load. * * XXX: we had damn well better be sure we had it before doing this! */ CPL_LOCK /* XXX */ MPLOCKED andl $~SWI_AST_MASK, _ipending /* XXX */ movl $0, _cpl /* XXX Allow ASTs on other CPU */ CPL_UNLOCK /* XXX */ movl $FREE_LOCK, %eax movl %eax, _mp_lock /* do NOT have lock, intrs disabled */ .globl idle_loop idle_loop: cmpl $0,_smp_active jne 1f cmpl $0,_cpuid je 1f jmp 2f 1: cmpl $0,_whichrtqs /* real-time queue */ jne 3f cmpl $0,_whichqs /* normal queue */ jne 3f cmpl $0,_whichidqs /* 'idle' queue */ jne 3f cmpl $0,_do_page_zero_idle je 2f /* XXX appears to cause panics */ /* * Inside zero_idle we enable interrupts and grab the mplock * as needed. It needs to be careful about entry/exit mutexes. */ call _vm_page_zero_idle /* internal locking */ testl %eax, %eax jnz idle_loop 2: /* enable intrs for a halt */ movl $0, lapic_tpr /* 1st candidate for an INT */ sti call *_hlt_vector /* wait for interrupt */ cli jmp idle_loop 3: movl $LOPRIO_LEVEL, lapic_tpr /* arbitrate for INTs */ call _get_mplock CPL_LOCK /* XXX */ movl $SWI_AST_MASK, _cpl /* XXX Disallow ASTs on other CPU */ CPL_UNLOCK /* XXX */ cmpl $0,_whichrtqs /* real-time queue */ CROSSJUMP(jne, sw1a, je) cmpl $0,_whichqs /* normal queue */ CROSSJUMP(jne, nortqr, je) cmpl $0,_whichidqs /* 'idle' queue */ CROSSJUMP(jne, idqr, je) CPL_LOCK /* XXX */ movl $0, _cpl /* XXX Allow ASTs on other CPU */ CPL_UNLOCK /* XXX */ call _rel_mplock jmp idle_loop #else /* !SMP */ movl $HIDENAME(tmpstk),%esp #if defined(OVERLY_CONSERVATIVE_PTD_MGMT) #if defined(SWTCH_OPTIM_STATS) incl _swtch_optim_stats #endif movl _IdlePTD, %ecx movl %cr3, %eax cmpl %ecx, %eax je 2f #if defined(SWTCH_OPTIM_STATS) decl _swtch_optim_stats incl _tlb_flush_count #endif movl %ecx, %cr3 2: #endif /* update common_tss.tss_esp0 pointer */ movl %esp, _common_tss + TSS_ESP0 movl $0, %esi btrl %esi, _private_tss jae 1f movl $_common_tssd, %edi /* move correct tss descriptor into GDT slot, then reload tr */ movl _tss_gdt, %ebx /* entry in GDT */ movl 0(%edi), %eax movl %eax, 0(%ebx) movl 4(%edi), %eax movl %eax, 4(%ebx) movl $GPROC0_SEL*8, %esi /* GSEL(entry, SEL_KPL) */ ltr %si 1: sti /* * XXX callers of cpu_switch() do a bogus splclock(). Locking should * be left to cpu_switch(). */ call _spl0 ALIGN_TEXT idle_loop: cli cmpl $0,_whichrtqs /* real-time queue */ CROSSJUMP(jne, sw1a, je) cmpl $0,_whichqs /* normal queue */ CROSSJUMP(jne, nortqr, je) cmpl $0,_whichidqs /* 'idle' queue */ CROSSJUMP(jne, idqr, je) call _vm_page_zero_idle testl %eax, %eax jnz idle_loop sti call *_hlt_vector /* wait for interrupt */ jmp idle_loop #endif /* SMP */ CROSSJUMPTARGET(_idle) ENTRY(default_halt) #ifndef SMP hlt /* XXX: until a wakeup IPI */ #endif ret /* * cpu_switch() */ ENTRY(cpu_switch) /* switch to new process. first, save context as needed */ movl _curproc,%ecx /* if no process to save, don't bother */ testl %ecx,%ecx je sw1 #ifdef SMP movb P_ONCPU(%ecx), %al /* save "last" cpu */ movb %al, P_LASTCPU(%ecx) movb $0xff, P_ONCPU(%ecx) /* "leave" the cpu */ #endif /* SMP */ movl P_VMSPACE(%ecx), %edx #ifdef SMP movl _cpuid, %eax #else xorl %eax, %eax #endif /* SMP */ btrl %eax, VM_PMAP+PM_ACTIVE(%edx) movl P_ADDR(%ecx),%edx movl (%esp),%eax /* Hardware registers */ movl %eax,PCB_EIP(%edx) movl %ebx,PCB_EBX(%edx) movl %esp,PCB_ESP(%edx) movl %ebp,PCB_EBP(%edx) movl %esi,PCB_ESI(%edx) movl %edi,PCB_EDI(%edx) movl %gs,PCB_GS(%edx) + /* test if debug regisers should be saved */ + movb PCB_FLAGS(%edx),%al + andb $PCB_DBREGS,%al + jz 1f /* no, skip over */ + movl %dr7,%eax /* yes, do the save */ + movl %eax,PCB_DR7(%edx) + andl $0x0000ff00, %eax /* disable all watchpoints */ + movl %eax,%dr7 + movl %dr6,%eax + movl %eax,PCB_DR6(%edx) + movl %dr3,%eax + movl %eax,PCB_DR3(%edx) + movl %dr2,%eax + movl %eax,PCB_DR2(%edx) + movl %dr1,%eax + movl %eax,PCB_DR1(%edx) + movl %dr0,%eax + movl %eax,PCB_DR0(%edx) +1: + #ifdef SMP movl _mp_lock, %eax /* XXX FIXME: we should be saving the local APIC TPR */ #ifdef DIAGNOSTIC cmpl $FREE_LOCK, %eax /* is it free? */ je badsw4 /* yes, bad medicine! */ #endif /* DIAGNOSTIC */ andl $COUNT_FIELD, %eax /* clear CPU portion */ movl %eax, PCB_MPNEST(%edx) /* store it */ #endif /* SMP */ #if NNPX > 0 /* have we used fp, and need a save? */ cmpl %ecx,_npxproc jne 1f addl $PCB_SAVEFPU,%edx /* h/w bugs make saving complicated */ pushl %edx call _npxsave /* do it in a big C function */ popl %eax 1: #endif /* NNPX > 0 */ movl $0,_curproc /* out of process */ /* save is done, now choose a new process or idle */ sw1: cli #ifdef SMP /* Stop scheduling if smp_active goes zero and we are not BSP */ cmpl $0,_smp_active jne 1f cmpl $0,_cpuid je 1f CROSSJUMP(je, _idle, jne) /* wind down */ 1: #endif sw1a: movl _whichrtqs,%edi /* pick next p. from rtqs */ testl %edi,%edi jz nortqr /* no realtime procs */ /* XXX - bsf is sloow */ bsfl %edi,%ebx /* find a full q */ jz nortqr /* no proc on rt q - try normal ... */ /* XX update whichqs? */ btrl %ebx,%edi /* clear q full status */ leal _rtqs(,%ebx,8),%eax /* select q */ movl %eax,%esi movl P_FORW(%eax),%ecx /* unlink from front of process q */ movl P_FORW(%ecx),%edx movl %edx,P_FORW(%eax) movl P_BACK(%ecx),%eax movl %eax,P_BACK(%edx) cmpl P_FORW(%ecx),%esi /* q empty */ je rt3 btsl %ebx,%edi /* nope, set to indicate not empty */ rt3: movl %edi,_whichrtqs /* update q status */ jmp swtch_com /* old sw1a */ /* Normal process priority's */ nortqr: movl _whichqs,%edi 2: /* XXX - bsf is sloow */ bsfl %edi,%ebx /* find a full q */ jz idqr /* if none, idle */ /* XX update whichqs? */ btrl %ebx,%edi /* clear q full status */ leal _qs(,%ebx,8),%eax /* select q */ movl %eax,%esi movl P_FORW(%eax),%ecx /* unlink from front of process q */ movl P_FORW(%ecx),%edx movl %edx,P_FORW(%eax) movl P_BACK(%ecx),%eax movl %eax,P_BACK(%edx) cmpl P_FORW(%ecx),%esi /* q empty */ je 3f btsl %ebx,%edi /* nope, set to indicate not empty */ 3: movl %edi,_whichqs /* update q status */ jmp swtch_com idqr: /* was sw1a */ movl _whichidqs,%edi /* pick next p. from idqs */ /* XXX - bsf is sloow */ bsfl %edi,%ebx /* find a full q */ CROSSJUMP(je, _idle, jne) /* if no proc, idle */ /* XX update whichqs? */ btrl %ebx,%edi /* clear q full status */ leal _idqs(,%ebx,8),%eax /* select q */ movl %eax,%esi movl P_FORW(%eax),%ecx /* unlink from front of process q */ movl P_FORW(%ecx),%edx movl %edx,P_FORW(%eax) movl P_BACK(%ecx),%eax movl %eax,P_BACK(%edx) cmpl P_FORW(%ecx),%esi /* q empty */ je id3 btsl %ebx,%edi /* nope, set to indicate not empty */ id3: movl %edi,_whichidqs /* update q status */ swtch_com: movl $0,%eax movl %eax,_want_resched #ifdef DIAGNOSTIC cmpl %eax,P_WCHAN(%ecx) jne badsw1 cmpb $SRUN,P_STAT(%ecx) jne badsw2 #endif movl %eax,P_BACK(%ecx) /* isolate process to run */ movl P_ADDR(%ecx),%edx #if defined(SWTCH_OPTIM_STATS) incl _swtch_optim_stats #endif /* switch address space */ movl %cr3,%ebx cmpl PCB_CR3(%edx),%ebx je 4f #if defined(SWTCH_OPTIM_STATS) decl _swtch_optim_stats incl _tlb_flush_count #endif movl PCB_CR3(%edx),%ebx movl %ebx,%cr3 4: #ifdef SMP movl _cpuid, %esi #else xorl %esi, %esi #endif cmpl $0, PCB_EXT(%edx) /* has pcb extension? */ je 1f btsl %esi, _private_tss /* mark use of private tss */ movl PCB_EXT(%edx), %edi /* new tss descriptor */ jmp 2f 1: /* update common_tss.tss_esp0 pointer */ movl %edx, %ebx /* pcb */ addl $(UPAGES * PAGE_SIZE - 16), %ebx movl %ebx, _common_tss + TSS_ESP0 btrl %esi, _private_tss jae 3f #ifdef SMP movl $gd_common_tssd, %edi addl %fs:0, %edi #else movl $_common_tssd, %edi #endif 2: /* move correct tss descriptor into GDT slot, then reload tr */ movl _tss_gdt, %ebx /* entry in GDT */ movl 0(%edi), %eax movl %eax, 0(%ebx) movl 4(%edi), %eax movl %eax, 4(%ebx) movl $GPROC0_SEL*8, %esi /* GSEL(entry, SEL_KPL) */ ltr %si 3: movl P_VMSPACE(%ecx), %ebx #ifdef SMP movl _cpuid, %eax #else xorl %eax, %eax #endif btsl %eax, VM_PMAP+PM_ACTIVE(%ebx) /* restore context */ movl PCB_EBX(%edx),%ebx movl PCB_ESP(%edx),%esp movl PCB_EBP(%edx),%ebp movl PCB_ESI(%edx),%esi movl PCB_EDI(%edx),%edi movl PCB_EIP(%edx),%eax movl %eax,(%esp) #ifdef SMP #ifdef GRAB_LOPRIO /* hold LOPRIO for INTs */ #ifdef CHEAP_TPR movl $0, lapic_tpr #else andl $~APIC_TPR_PRIO, lapic_tpr #endif /** CHEAP_TPR */ #endif /** GRAB_LOPRIO */ movl _cpuid,%eax movb %al, P_ONCPU(%ecx) #endif /* SMP */ movl %edx, _curpcb movl %ecx, _curproc /* into next process */ #ifdef SMP movl _cpu_lockid, %eax orl PCB_MPNEST(%edx), %eax /* add next count from PROC */ movl %eax, _mp_lock /* load the mp_lock */ /* XXX FIXME: we should be restoring the local APIC TPR */ #endif /* SMP */ #ifdef USER_LDT cmpl $0, PCB_USERLDT(%edx) jnz 1f movl __default_ldt,%eax cmpl _currentldt,%eax je 2f lldt __default_ldt movl %eax,_currentldt jmp 2f 1: pushl %edx call _set_user_ldt popl %edx 2: #endif /* This must be done after loading the user LDT. */ .globl cpu_switch_load_gs cpu_switch_load_gs: movl PCB_GS(%edx),%gs + + /* test if debug regisers should be restored */ + movb PCB_FLAGS(%edx),%al + andb $PCB_DBREGS,%al + jz 1f /* no, skip over */ + movl PCB_DR6(%edx),%eax /* yes, do the restore */ + movl %eax,%dr6 + movl PCB_DR3(%edx),%eax + movl %eax,%dr3 + movl PCB_DR2(%edx),%eax + movl %eax,%dr2 + movl PCB_DR1(%edx),%eax + movl %eax,%dr1 + movl PCB_DR0(%edx),%eax + movl %eax,%dr0 + movl PCB_DR7(%edx),%eax + movl %eax,%dr7 +1: sti ret CROSSJUMPTARGET(idqr) CROSSJUMPTARGET(nortqr) CROSSJUMPTARGET(sw1a) #ifdef DIAGNOSTIC badsw1: pushl $sw0_1 call _panic sw0_1: .asciz "cpu_switch: has wchan" badsw2: pushl $sw0_2 call _panic sw0_2: .asciz "cpu_switch: not SRUN" #endif #if defined(SMP) && defined(DIAGNOSTIC) badsw4: pushl $sw0_4 call _panic sw0_4: .asciz "cpu_switch: do not have lock" #endif /* SMP && DIAGNOSTIC */ /* * savectx(pcb) * Update pcb, saving current processor state. */ ENTRY(savectx) /* fetch PCB */ movl 4(%esp),%ecx /* caller's return address - child won't execute this routine */ movl (%esp),%eax movl %eax,PCB_EIP(%ecx) movl %ebx,PCB_EBX(%ecx) movl %esp,PCB_ESP(%ecx) movl %ebp,PCB_EBP(%ecx) movl %esi,PCB_ESI(%ecx) movl %edi,PCB_EDI(%ecx) movl %gs,PCB_GS(%ecx) #if NNPX > 0 /* * If npxproc == NULL, then the npx h/w state is irrelevant and the * state had better already be in the pcb. This is true for forks * but not for dumps (the old book-keeping with FP flags in the pcb * always lost for dumps because the dump pcb has 0 flags). * * If npxproc != NULL, then we have to save the npx h/w state to * npxproc's pcb and copy it to the requested pcb, or save to the * requested pcb and reload. Copying is easier because we would * have to handle h/w bugs for reloading. We used to lose the * parent's npx state for forks by forgetting to reload. */ movl _npxproc,%eax testl %eax,%eax je 1f pushl %ecx movl P_ADDR(%eax),%eax leal PCB_SAVEFPU(%eax),%eax pushl %eax pushl %eax call _npxsave addl $4,%esp popl %eax popl %ecx pushl $PCB_SAVEFPU_SIZE leal PCB_SAVEFPU(%ecx),%ecx pushl %ecx pushl %eax call _bcopy addl $12,%esp #endif /* NNPX > 0 */ 1: ret Index: head/sys/amd64/amd64/genassym.c =================================================================== --- head/sys/amd64/amd64/genassym.c (revision 48690) +++ head/sys/amd64/amd64/genassym.c (revision 48691) @@ -1,232 +1,239 @@ /*- * Copyright (c) 1982, 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)genassym.c 5.11 (Berkeley) 5/10/91 - * $Id: genassym.c,v 1.71 1999/06/28 09:21:41 peter Exp $ + * $Id: genassym.c,v 1.72 1999/07/06 07:13:32 cracauer Exp $ */ #include "opt_user_ldt.h" #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #define KERNEL /* Avoid userland compatability headers */ #include #undef KERNEL #include #include #include #include #include #include #ifdef SMP #include #endif #include #include #include #define OS(s, m) ((u_int)offsetof(struct s, m)) int main __P((void)); int printf __P((const char *, ...)); int main() { printf("#define\tP_FORW %#x\n", OS(proc, p_procq.tqe_next)); printf("#define\tP_BACK %#x\n", OS(proc, p_procq.tqe_prev)); printf("#define\tP_VMSPACE %#x\n", OS(proc, p_vmspace)); printf("#define\tVM_PMAP %#x\n", OS(vmspace, vm_pmap)); printf("#define\tPM_ACTIVE %#x\n", OS(pmap, pm_active)); printf("#define\tP_ADDR %#x\n", OS(proc, p_addr)); printf("#define\tP_PRI %#x\n", OS(proc, p_priority)); printf("#define\tP_RTPRIO_TYPE %#x\n", OS(proc, p_rtprio.type)); printf("#define\tP_RTPRIO_PRIO %#x\n", OS(proc, p_rtprio.prio)); printf("#define\tP_STAT %#x\n", OS(proc, p_stat)); printf("#define\tP_WCHAN %#x\n", OS(proc, p_wchan)); printf("#define\tP_FLAG %#x\n", OS(proc, p_flag)); printf("#define\tP_PID %#x\n", OS(proc, p_pid)); #ifdef SMP printf("#define\tP_ONCPU %#x\n", OS(proc, p_oncpu)); printf("#define\tP_LASTCPU %#x\n", OS(proc, p_lastcpu)); #endif printf("#define\tSSLEEP %d\n", SSLEEP); printf("#define\tSRUN %d\n", SRUN); printf("#define\tV_TRAP %#x\n", OS(vmmeter, v_trap)); printf("#define\tV_SYSCALL %#x\n", OS(vmmeter, v_syscall)); printf("#define\tV_INTR %#x\n", OS(vmmeter, v_intr)); printf("#define\tUPAGES %d\n", UPAGES); printf("#define\tPAGE_SIZE %d\n", PAGE_SIZE); printf("#define\tNPTEPG %d\n", NPTEPG); printf("#define\tNPDEPG %d\n", NPDEPG); printf("#define\tPDESIZE %d\n", PDESIZE); printf("#define\tPTESIZE %d\n", PTESIZE); printf("#define\tNKPDE %d\n", NKPDE); printf("#define\tNKPT %d\n", NKPT); printf("#define\tPAGE_SHIFT %d\n", PAGE_SHIFT); printf("#define\tPAGE_MASK %d\n", PAGE_MASK); printf("#define\tPDRSHIFT %d\n", PDRSHIFT); printf("#define\tUSRSTACK %#x\n", USRSTACK); printf("#define\tVM_MAXUSER_ADDRESS %#x\n", VM_MAXUSER_ADDRESS); printf("#define\tKERNBASE %#x\n", KERNBASE); printf("#define\tMCLBYTES %d\n", MCLBYTES); printf("#define\tPCB_CR3 %#x\n", OS(pcb, pcb_cr3)); printf("#define\tPCB_EDI %#x\n", OS(pcb, pcb_edi)); printf("#define\tPCB_ESI %#x\n", OS(pcb, pcb_esi)); printf("#define\tPCB_EBP %#x\n", OS(pcb, pcb_ebp)); printf("#define\tPCB_ESP %#x\n", OS(pcb, pcb_esp)); printf("#define\tPCB_EBX %#x\n", OS(pcb, pcb_ebx)); printf("#define\tPCB_EIP %#x\n", OS(pcb, pcb_eip)); printf("#define\tTSS_ESP0 %#x\n", OS(i386tss, tss_esp0)); printf("#define\tPCB_USERLDT %#x\n", OS(pcb, pcb_ldt)); printf("#define\tPCB_GS %#x\n", OS(pcb, pcb_gs)); + printf("#define\tPCB_DR0 %#x\n", OS(pcb, pcb_dr0)); + printf("#define\tPCB_DR1 %#x\n", OS(pcb, pcb_dr1)); + printf("#define\tPCB_DR2 %#x\n", OS(pcb, pcb_dr2)); + printf("#define\tPCB_DR3 %#x\n", OS(pcb, pcb_dr3)); + printf("#define\tPCB_DR6 %#x\n", OS(pcb, pcb_dr6)); + printf("#define\tPCB_DR7 %#x\n", OS(pcb, pcb_dr7)); + printf("#define\tPCB_DBREGS %#x\n", PCB_DBREGS ); printf("#define\tPCB_EXT %#x\n", OS(pcb, pcb_ext)); #ifdef SMP printf("#define\tPCB_MPNEST %#x\n", OS(pcb, pcb_mpnest)); #endif printf("#define\tPCB_SPARE %#x\n", OS(pcb, __pcb_spare)); printf("#define\tU_PROF %#x\n", OS(user, u_stats.p_prof)); printf("#define\tU_PROFSCALE %#x\n", OS(user, u_stats.p_prof.pr_scale)); printf("#define\tPR_BASE %#x\n", OS(uprof, pr_base)); printf("#define\tPR_SIZE %#x\n", OS(uprof, pr_size)); printf("#define\tPR_OFF %#x\n", OS(uprof, pr_off)); printf("#define\tPR_SCALE %#x\n", OS(uprof, pr_scale)); printf("#define\tRU_MINFLT %#x\n", OS(rusage, ru_minflt)); printf("#define\tPCB_FLAGS %#x\n", OS(pcb, pcb_flags)); printf("#define\tPCB_SAVEFPU %#x\n", OS(pcb, pcb_savefpu)); printf("#define\tPCB_SAVEFPU_SIZE %u\n", sizeof(struct save87)); printf("#define\tPCB_ONFAULT %#x\n", OS(pcb, pcb_onfault)); #ifdef SMP printf("#define\tPCB_SIZE %u\n", sizeof(struct pcb)); #endif printf("#define\tTF_ES %#x\n", OS(trapframe, tf_es)); printf("#define\tTF_DS %#x\n", OS(trapframe, tf_ds)); printf("#define\tTF_EDI %#x\n", OS(trapframe, tf_edi)); printf("#define\tTF_ESI %#x\n", OS(trapframe, tf_esi)); printf("#define\tTF_EBP %#x\n", OS(trapframe, tf_ebp)); printf("#define\tTF_ISP %#x\n", OS(trapframe, tf_isp)); printf("#define\tTF_EBX %#x\n", OS(trapframe, tf_ebx)); printf("#define\tTF_EDX %#x\n", OS(trapframe, tf_edx)); printf("#define\tTF_ECX %#x\n", OS(trapframe, tf_ecx)); printf("#define\tTF_EAX %#x\n", OS(trapframe, tf_eax)); printf("#define\tTF_TRAPNO %#x\n", OS(trapframe, tf_trapno)); printf("#define\tTF_ERR %#x\n", OS(trapframe, tf_err)); printf("#define\tTF_EIP %#x\n", OS(trapframe, tf_eip)); printf("#define\tTF_CS %#x\n", OS(trapframe, tf_cs)); printf("#define\tTF_EFLAGS %#x\n", OS(trapframe, tf_eflags)); printf("#define\tTF_ESP %#x\n", OS(trapframe, tf_esp)); printf("#define\tTF_SS %#x\n", OS(trapframe, tf_ss)); printf("#define\tSIGF_HANDLER %#x\n", OS(sigframe, sf_ahu.sf_handler)); printf("#define\tSIGF_SC %#x\n", OS(sigframe, sf_siginfo.si_sc)); printf("#define\tB_READ %#x\n", B_READ); printf("#define\tENOENT %d\n", ENOENT); printf("#define\tEFAULT %d\n", EFAULT); printf("#define\tENAMETOOLONG %d\n", ENAMETOOLONG); printf("#define\tMAXPATHLEN %d\n", MAXPATHLEN); printf("#define\tBOOTINFO_SIZE %u\n", sizeof(struct bootinfo)); printf("#define\tBI_VERSION %#x\n", OS(bootinfo, bi_version)); printf("#define\tBI_KERNELNAME %#x\n", OS(bootinfo, bi_kernelname)); printf("#define\tBI_NFS_DISKLESS %#x\n", OS(bootinfo, bi_nfs_diskless)); printf("#define\tBI_ENDCOMMON %#x\n", OS(bootinfo, bi_endcommon)); printf("#define\tNFSDISKLESS_SIZE %u\n", sizeof(struct nfs_diskless)); printf("#define\tBI_SIZE %#x\n", OS(bootinfo, bi_size)); printf("#define\tBI_SYMTAB %#x\n", OS(bootinfo, bi_symtab)); printf("#define\tBI_ESYMTAB %#x\n", OS(bootinfo, bi_esymtab)); printf("#define\tBI_KERNEND %#x\n", OS(bootinfo, bi_kernend)); printf("#define\tBI_ENVP %#x\n", OS(bootinfo, bi_envp)); printf("#define\tBI_MODULEP %#x\n", OS(bootinfo, bi_modulep)); printf("#define\tGD_SIZEOF %u\n", sizeof(struct globaldata)); printf("#define\tGD_CURPROC %#x\n", OS(globaldata, gd_curproc)); printf("#define\tGD_NPXPROC %#x\n", OS(globaldata, gd_npxproc)); printf("#define\tGD_CURPCB %#x\n", OS(globaldata, gd_curpcb)); printf("#define\tGD_COMMON_TSS %#x\n", OS(globaldata, gd_common_tss)); printf("#define\tGD_SWITCHTIME %#x\n", OS(globaldata, gd_switchtime)); printf("#define\tGD_SWITCHTICKS %#x\n", OS(globaldata, gd_switchticks)); printf("#define\tGD_COMMON_TSSD %#x\n", OS(globaldata, gd_common_tssd)); printf("#define\tGD_TSS_GDT %#x\n", OS(globaldata, gd_tss_gdt)); #ifdef USER_LDT printf("#define\tGD_CURRENTLDT %#x\n", OS(globaldata, gd_currentldt)); #endif #ifdef SMP printf("#define\tGD_CPUID %#x\n", OS(globaldata, gd_cpuid)); printf("#define\tGD_CPU_LOCKID %#x\n", OS(globaldata, gd_cpu_lockid)); printf("#define\tGD_OTHER_CPUS %#x\n", OS(globaldata, gd_other_cpus)); printf("#define\tGD_SS_EFLAGS %#x\n", OS(globaldata, gd_ss_eflags)); printf("#define\tGD_INSIDE_INTR %#x\n", OS(globaldata, gd_inside_intr)); printf("#define\tGD_PRV_CMAP1 %#x\n", OS(globaldata, gd_prv_CMAP1)); printf("#define\tGD_PRV_CMAP2 %#x\n", OS(globaldata, gd_prv_CMAP2)); printf("#define\tGD_PRV_CMAP3 %#x\n", OS(globaldata, gd_prv_CMAP3)); printf("#define\tGD_PRV_PMAP1 %#x\n", OS(globaldata, gd_prv_PMAP1)); printf("#define\tGD_PRV_CADDR1 %#x\n", OS(globaldata, gd_prv_CADDR1)); printf("#define\tGD_PRV_CADDR2 %#x\n", OS(globaldata, gd_prv_CADDR2)); printf("#define\tGD_PRV_CADDR3 %#x\n", OS(globaldata, gd_prv_CADDR3)); printf("#define\tGD_PRV_PADDR1 %#x\n", OS(globaldata, gd_prv_PADDR1)); printf("#define\tPS_GLOBALDATA %#x\n", OS(privatespace, globaldata)); printf("#define\tPS_IDLESTACK %#x\n", OS(privatespace, idlestack)); printf("#define\tPS_IDLESTACK_TOP %#x\n", sizeof(struct privatespace)); #endif printf("#define\tKCSEL %#x\n", GSEL(GCODE_SEL, SEL_KPL)); printf("#define\tKDSEL %#x\n", GSEL(GDATA_SEL, SEL_KPL)); #ifdef SMP printf("#define\tKPSEL %#x\n", GSEL(GPRIV_SEL, SEL_KPL)); #endif printf("#define\tGPROC0_SEL %#x\n", GPROC0_SEL); printf("#define\tVM86_FRAMESIZE %#x\n", sizeof(struct vm86frame)); return (0); } Index: head/sys/amd64/amd64/machdep.c =================================================================== --- head/sys/amd64/amd64/machdep.c (revision 48690) +++ head/sys/amd64/amd64/machdep.c (revision 48691) @@ -1,2041 +1,2122 @@ /*- * Copyright (c) 1992 Terrence R. Lambert. * Copyright (c) 1982, 1987, 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)machdep.c 7.4 (Berkeley) 6/3/91 - * $Id: machdep.c,v 1.353 1999/07/06 07:13:33 cracauer Exp $ + * $Id: machdep.c,v 1.354 1999/07/08 06:05:48 mckusick Exp $ */ #include "apm.h" #include "ether.h" #include "npx.h" #include "opt_atalk.h" #include "opt_cpu.h" #include "opt_ddb.h" #include "opt_inet.h" #include "opt_ipx.h" #include "opt_maxmem.h" #include "opt_msgbuf.h" #include "opt_perfmon.h" #include "opt_smp.h" #include "opt_sysvipc.h" #include "opt_user_ldt.h" #include "opt_userconfig.h" #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #ifdef SYSVSHM #include #endif #ifdef SYSVMSG #include #endif #ifdef SYSVSEM #include #endif #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include /* pcb.h included via sys/user.h */ #ifdef SMP #include #include #endif #ifdef PERFMON #include #endif #ifdef OLD_BUS_ARCH #include #endif #include #include #include #include #include extern void init386 __P((int first)); extern void dblfault_handler __P((void)); extern void printcpuinfo(void); /* XXX header file */ extern void earlysetcpuclass(void); /* same header file */ extern void finishidentcpu(void); extern void panicifcpuunsupported(void); extern void initializecpu(void); static void cpu_startup __P((void *)); SYSINIT(cpu, SI_SUB_CPU, SI_ORDER_FIRST, cpu_startup, NULL) static MALLOC_DEFINE(M_MBUF, "mbuf", "mbuf"); int _udatasel, _ucodesel; u_int atdevbase; #if defined(SWTCH_OPTIM_STATS) extern int swtch_optim_stats; SYSCTL_INT(_debug, OID_AUTO, swtch_optim_stats, CTLFLAG_RD, &swtch_optim_stats, 0, ""); SYSCTL_INT(_debug, OID_AUTO, tlb_flush_count, CTLFLAG_RD, &tlb_flush_count, 0, ""); #endif #ifdef PC98 static int ispc98 = 1; #else static int ispc98 = 0; #endif SYSCTL_INT(_machdep, OID_AUTO, ispc98, CTLFLAG_RD, &ispc98, 0, ""); int physmem = 0; int cold = 1; static int sysctl_hw_physmem SYSCTL_HANDLER_ARGS { int error = sysctl_handle_int(oidp, 0, ctob(physmem), req); return (error); } SYSCTL_PROC(_hw, HW_PHYSMEM, physmem, CTLTYPE_INT|CTLFLAG_RD, 0, 0, sysctl_hw_physmem, "I", ""); static int sysctl_hw_usermem SYSCTL_HANDLER_ARGS { int error = sysctl_handle_int(oidp, 0, ctob(physmem - cnt.v_wire_count), req); return (error); } SYSCTL_PROC(_hw, HW_USERMEM, usermem, CTLTYPE_INT|CTLFLAG_RD, 0, 0, sysctl_hw_usermem, "I", ""); static int sysctl_hw_availpages SYSCTL_HANDLER_ARGS { int error = sysctl_handle_int(oidp, 0, i386_btop(avail_end - avail_start), req); return (error); } SYSCTL_PROC(_hw, OID_AUTO, availpages, CTLTYPE_INT|CTLFLAG_RD, 0, 0, sysctl_hw_availpages, "I", ""); static int sysctl_machdep_msgbuf SYSCTL_HANDLER_ARGS { int error; /* Unwind the buffer, so that it's linear (possibly starting with * some initial nulls). */ error=sysctl_handle_opaque(oidp,msgbufp->msg_ptr+msgbufp->msg_bufr, msgbufp->msg_size-msgbufp->msg_bufr,req); if(error) return(error); if(msgbufp->msg_bufr>0) { error=sysctl_handle_opaque(oidp,msgbufp->msg_ptr, msgbufp->msg_bufr,req); } return(error); } SYSCTL_PROC(_machdep, OID_AUTO, msgbuf, CTLTYPE_STRING|CTLFLAG_RD, 0, 0, sysctl_machdep_msgbuf, "A","Contents of kernel message buffer"); static int msgbuf_clear; static int sysctl_machdep_msgbuf_clear SYSCTL_HANDLER_ARGS { int error; error = sysctl_handle_int(oidp, oidp->oid_arg1, oidp->oid_arg2, req); if (!error && req->newptr) { /* Clear the buffer and reset write pointer */ bzero(msgbufp->msg_ptr,msgbufp->msg_size); msgbufp->msg_bufr=msgbufp->msg_bufx=0; msgbuf_clear=0; } return (error); } SYSCTL_PROC(_machdep, OID_AUTO, msgbuf_clear, CTLTYPE_INT|CTLFLAG_RW, &msgbuf_clear, 0, sysctl_machdep_msgbuf_clear, "I", "Clear kernel message buffer"); int bootverbose = 0, Maxmem = 0; long dumplo; vm_offset_t phys_avail[10]; /* must be 2 less so 0 0 can signal end of chunks */ #define PHYS_AVAIL_ARRAY_END ((sizeof(phys_avail) / sizeof(vm_offset_t)) - 2) static vm_offset_t buffer_sva, buffer_eva; vm_offset_t clean_sva, clean_eva; static vm_offset_t pager_sva, pager_eva; #define offsetof(type, member) ((size_t)(&((type *)0)->member)) static void cpu_startup(dummy) void *dummy; { register unsigned i; register caddr_t v; vm_offset_t maxaddr; vm_size_t size = 0; int firstaddr; vm_offset_t minaddr; if (boothowto & RB_VERBOSE) bootverbose++; /* * Good {morning,afternoon,evening,night}. */ printf(version); earlysetcpuclass(); startrtclock(); printcpuinfo(); panicifcpuunsupported(); #ifdef PERFMON perfmon_init(); #endif printf("real memory = %u (%uK bytes)\n", ptoa(Maxmem), ptoa(Maxmem) / 1024); /* * Display any holes after the first chunk of extended memory. */ if (bootverbose) { int indx; printf("Physical memory chunk(s):\n"); for (indx = 0; phys_avail[indx + 1] != 0; indx += 2) { int size1 = phys_avail[indx + 1] - phys_avail[indx]; printf("0x%08x - 0x%08x, %u bytes (%u pages)\n", phys_avail[indx], phys_avail[indx + 1] - 1, size1, size1 / PAGE_SIZE); } } /* * Calculate callout wheel size */ for (callwheelsize = 1, callwheelbits = 0; callwheelsize < ncallout; callwheelsize <<= 1, ++callwheelbits) ; callwheelmask = callwheelsize - 1; /* * Allocate space for system data structures. * The first available kernel virtual address is in "v". * As pages of kernel virtual memory are allocated, "v" is incremented. * As pages of memory are allocated and cleared, * "firstaddr" is incremented. * An index into the kernel page table corresponding to the * virtual memory address maintained in "v" is kept in "mapaddr". */ /* * Make two passes. The first pass calculates how much memory is * needed and allocates it. The second pass assigns virtual * addresses to the various data structures. */ firstaddr = 0; again: v = (caddr_t)firstaddr; #define valloc(name, type, num) \ (name) = (type *)v; v = (caddr_t)((name)+(num)) #define valloclim(name, type, num, lim) \ (name) = (type *)v; v = (caddr_t)((lim) = ((name)+(num))) valloc(callout, struct callout, ncallout); valloc(callwheel, struct callout_tailq, callwheelsize); #ifdef SYSVSHM valloc(shmsegs, struct shmid_ds, shminfo.shmmni); #endif #ifdef SYSVSEM valloc(sema, struct semid_ds, seminfo.semmni); valloc(sem, struct sem, seminfo.semmns); /* This is pretty disgusting! */ valloc(semu, int, (seminfo.semmnu * seminfo.semusz) / sizeof(int)); #endif #ifdef SYSVMSG valloc(msgpool, char, msginfo.msgmax); valloc(msgmaps, struct msgmap, msginfo.msgseg); valloc(msghdrs, struct msg, msginfo.msgtql); valloc(msqids, struct msqid_ds, msginfo.msgmni); #endif if (nbuf == 0) { nbuf = 30; if( physmem > 1024) nbuf += min((physmem - 1024) / 8, 2048); if( physmem > 65536) nbuf += (physmem - 65536) / 20; } nswbuf = max(min(nbuf/4, 256), 16); valloc(swbuf, struct buf, nswbuf); valloc(buf, struct buf, nbuf); v = bufhashinit(v); /* * End of first pass, size has been calculated so allocate memory */ if (firstaddr == 0) { size = (vm_size_t)(v - firstaddr); firstaddr = (int)kmem_alloc(kernel_map, round_page(size)); if (firstaddr == 0) panic("startup: no room for tables"); goto again; } /* * End of second pass, addresses have been assigned */ if ((vm_size_t)(v - firstaddr) != size) panic("startup: table size inconsistency"); clean_map = kmem_suballoc(kernel_map, &clean_sva, &clean_eva, (nbuf*BKVASIZE) + (nswbuf*MAXPHYS) + pager_map_size); buffer_map = kmem_suballoc(clean_map, &buffer_sva, &buffer_eva, (nbuf*BKVASIZE)); pager_map = kmem_suballoc(clean_map, &pager_sva, &pager_eva, (nswbuf*MAXPHYS) + pager_map_size); pager_map->system_map = 1; exec_map = kmem_suballoc(kernel_map, &minaddr, &maxaddr, (16*(ARG_MAX+(PAGE_SIZE*3)))); /* * Finally, allocate mbuf pool. Since mclrefcnt is an off-size * we use the more space efficient malloc in place of kmem_alloc. */ { vm_offset_t mb_map_size; mb_map_size = nmbufs * MSIZE + nmbclusters * MCLBYTES; mb_map_size = roundup2(mb_map_size, max(MCLBYTES, PAGE_SIZE)); mclrefcnt = malloc(mb_map_size / MCLBYTES, M_MBUF, M_NOWAIT); bzero(mclrefcnt, mb_map_size / MCLBYTES); mb_map = kmem_suballoc(kmem_map, (vm_offset_t *)&mbutl, &maxaddr, mb_map_size); mb_map->system_map = 1; } /* * Initialize callouts */ SLIST_INIT(&callfree); for (i = 0; i < ncallout; i++) { callout_init(&callout[i]); callout[i].c_flags = CALLOUT_LOCAL_ALLOC; SLIST_INSERT_HEAD(&callfree, &callout[i], c_links.sle); } for (i = 0; i < callwheelsize; i++) { TAILQ_INIT(&callwheel[i]); } #if defined(USERCONFIG) userconfig(); cninit(); /* the preferred console may have changed */ #endif printf("avail memory = %u (%uK bytes)\n", ptoa(cnt.v_free_count), ptoa(cnt.v_free_count) / 1024); /* * Set up buffers, so they can be used to read disk labels. */ bufinit(); vm_pager_bufferinit(); #ifdef SMP /* * OK, enough kmem_alloc/malloc state should be up, lets get on with it! */ mp_start(); /* fire up the APs and APICs */ mp_announce(); #endif /* SMP */ } int register_netisr(num, handler) int num; netisr_t *handler; { if (num < 0 || num >= (sizeof(netisrs)/sizeof(*netisrs)) ) { printf("register_netisr: bad isr number: %d\n", num); return (EINVAL); } netisrs[num] = handler; return (0); } void netisr_sysinit(data) void *data; { const struct netisrtab *nit; nit = (const struct netisrtab *)data; register_netisr(nit->nit_num, nit->nit_isr); } /* * Send an interrupt to process. * * Stack is set up to allow sigcode stored * at top to call routine, followed by kcall * to sigreturn routine below. After sigreturn * resets the signal mask, the stack, and the * frame pointer, it returns to the user * specified pc, psl. */ void sendsig(catcher, sig, mask, code) sig_t catcher; int sig, mask; u_long code; { register struct proc *p = curproc; register struct trapframe *regs; register struct sigframe *fp; struct sigframe sf; struct sigacts *psp = p->p_sigacts; int oonstack; regs = p->p_md.md_regs; oonstack = psp->ps_sigstk.ss_flags & SS_ONSTACK; /* * Allocate and validate space for the signal handler context. */ if ((psp->ps_flags & SAS_ALTSTACK) && !oonstack && (psp->ps_sigonstack & sigmask(sig))) { fp = (struct sigframe *)(psp->ps_sigstk.ss_sp + psp->ps_sigstk.ss_size - sizeof(struct sigframe)); psp->ps_sigstk.ss_flags |= SS_ONSTACK; } else { fp = (struct sigframe *)regs->tf_esp - 1; } /* * grow() will return FALSE if the fp will not fit inside the stack * and the stack can not be grown. useracc will return FALSE * if access is denied. */ if ((grow_stack (p, (int)fp) == FALSE) || (useracc((caddr_t)fp, sizeof(struct sigframe), B_WRITE) == FALSE)) { /* * Process has trashed its stack; give it an illegal * instruction to halt it in its tracks. */ #ifdef DEBUG printf("process %d has trashed its stack\n", p->p_pid); #endif SIGACTION(p, SIGILL) = SIG_DFL; sig = sigmask(SIGILL); p->p_sigignore &= ~sig; p->p_sigcatch &= ~sig; p->p_sigmask &= ~sig; psignal(p, SIGILL); return; } /* * Build the argument list for the signal handler. */ if (p->p_sysent->sv_sigtbl) { if (sig < p->p_sysent->sv_sigsize) sig = p->p_sysent->sv_sigtbl[sig]; else sig = p->p_sysent->sv_sigsize + 1; } sf.sf_signum = sig; sf.sf_scp = (register_t)&fp->sf_siginfo.si_sc; if (p->p_sigacts->ps_siginfo & sigmask(sig)) { /* * Signal handler installed with SA_SIGINFO. */ sf.sf_arg2 = (register_t)&fp->sf_siginfo; sf.sf_siginfo.si_signo = sig; sf.sf_siginfo.si_code = code; sf.sf_ahu.sf_action = (__siginfohandler_t *)catcher; } else { /* * Old FreeBSD-style arguments. */ sf.sf_arg2 = code; sf.sf_ahu.sf_handler = catcher; } sf.sf_addr = (char *) regs->tf_err; /* save scratch registers */ sf.sf_siginfo.si_sc.sc_eax = regs->tf_eax; sf.sf_siginfo.si_sc.sc_ebx = regs->tf_ebx; sf.sf_siginfo.si_sc.sc_ecx = regs->tf_ecx; sf.sf_siginfo.si_sc.sc_edx = regs->tf_edx; sf.sf_siginfo.si_sc.sc_esi = regs->tf_esi; sf.sf_siginfo.si_sc.sc_edi = regs->tf_edi; sf.sf_siginfo.si_sc.sc_cs = regs->tf_cs; sf.sf_siginfo.si_sc.sc_ds = regs->tf_ds; sf.sf_siginfo.si_sc.sc_ss = regs->tf_ss; sf.sf_siginfo.si_sc.sc_es = regs->tf_es; sf.sf_siginfo.si_sc.sc_fs = regs->tf_fs; sf.sf_siginfo.si_sc.sc_isp = regs->tf_isp; /* * Build the signal context to be used by sigreturn. */ sf.sf_siginfo.si_sc.sc_onstack = oonstack; sf.sf_siginfo.si_sc.sc_mask = mask; sf.sf_siginfo.si_sc.sc_sp = regs->tf_esp; sf.sf_siginfo.si_sc.sc_fp = regs->tf_ebp; sf.sf_siginfo.si_sc.sc_pc = regs->tf_eip; sf.sf_siginfo.si_sc.sc_ps = regs->tf_eflags; sf.sf_siginfo.si_sc.sc_trapno = regs->tf_trapno; sf.sf_siginfo.si_sc.sc_err = regs->tf_err; /* * If we're a vm86 process, we want to save the segment registers. * We also change eflags to be our emulated eflags, not the actual * eflags. */ if (regs->tf_eflags & PSL_VM) { struct trapframe_vm86 *tf = (struct trapframe_vm86 *)regs; struct vm86_kernel *vm86 = &p->p_addr->u_pcb.pcb_ext->ext_vm86; sf.sf_siginfo.si_sc.sc_gs = tf->tf_vm86_gs; sf.sf_siginfo.si_sc.sc_fs = tf->tf_vm86_fs; sf.sf_siginfo.si_sc.sc_es = tf->tf_vm86_es; sf.sf_siginfo.si_sc.sc_ds = tf->tf_vm86_ds; if (vm86->vm86_has_vme == 0) sf.sf_siginfo.si_sc.sc_ps = (tf->tf_eflags & ~(PSL_VIF | PSL_VIP)) | (vm86->vm86_eflags & (PSL_VIF | PSL_VIP)); /* * We should never have PSL_T set when returning from vm86 * mode. It may be set here if we deliver a signal before * getting to vm86 mode, so turn it off. * * Clear PSL_NT to inhibit T_TSSFLT faults on return from * syscalls made by the signal handler. This just avoids * wasting time for our lazy fixup of such faults. PSL_NT * does nothing in vm86 mode, but vm86 programs can set it * almost legitimately in probes for old cpu types. */ tf->tf_eflags &= ~(PSL_VM | PSL_NT | PSL_T | PSL_VIF | PSL_VIP); } /* * Copy the sigframe out to the user's stack. */ if (copyout(&sf, fp, sizeof(struct sigframe)) != 0) { /* * Something is wrong with the stack pointer. * ...Kill the process. */ sigexit(p, SIGILL); } regs->tf_esp = (int)fp; regs->tf_eip = PS_STRINGS - *(p->p_sysent->sv_szsigcode); regs->tf_cs = _ucodesel; regs->tf_ds = _udatasel; regs->tf_es = _udatasel; regs->tf_fs = _udatasel; regs->tf_ss = _udatasel; } /* * System call to cleanup state after a signal * has been taken. Reset signal mask and * stack state from context left by sendsig (above). * Return to previous pc and psl as specified by * context left by sendsig. Check carefully to * make sure that the user has not modified the * state to gain improper privileges. */ int sigreturn(p, uap) struct proc *p; struct sigreturn_args /* { struct sigcontext *sigcntxp; } */ *uap; { register struct sigcontext *scp; register struct sigframe *fp; register struct trapframe *regs = p->p_md.md_regs; int eflags; /* * (XXX old comment) regs->tf_esp points to the return address. * The user scp pointer is above that. * The return address is faked in the signal trampoline code * for consistency. */ scp = uap->sigcntxp; fp = (struct sigframe *) ((caddr_t)scp - offsetof(struct sigframe, sf_siginfo.si_sc)); if (useracc((caddr_t)fp, sizeof (*fp), B_WRITE) == 0) return(EFAULT); eflags = scp->sc_ps; if (eflags & PSL_VM) { struct trapframe_vm86 *tf = (struct trapframe_vm86 *)regs; struct vm86_kernel *vm86; /* * if pcb_ext == 0 or vm86_inited == 0, the user hasn't * set up the vm86 area, and we can't enter vm86 mode. */ if (p->p_addr->u_pcb.pcb_ext == 0) return (EINVAL); vm86 = &p->p_addr->u_pcb.pcb_ext->ext_vm86; if (vm86->vm86_inited == 0) return (EINVAL); /* go back to user mode if both flags are set */ if ((eflags & PSL_VIP) && (eflags & PSL_VIF)) trapsignal(p, SIGBUS, 0); if (vm86->vm86_has_vme) { eflags = (tf->tf_eflags & ~VME_USERCHANGE) | (eflags & VME_USERCHANGE) | PSL_VM; } else { vm86->vm86_eflags = eflags; /* save VIF, VIP */ eflags = (tf->tf_eflags & ~VM_USERCHANGE) | (eflags & VM_USERCHANGE) | PSL_VM; } tf->tf_vm86_ds = scp->sc_ds; tf->tf_vm86_es = scp->sc_es; tf->tf_vm86_fs = scp->sc_fs; tf->tf_vm86_gs = scp->sc_gs; tf->tf_ds = _udatasel; tf->tf_es = _udatasel; tf->tf_fs = _udatasel; } else { /* * Don't allow users to change privileged or reserved flags. */ #define EFLAGS_SECURE(ef, oef) ((((ef) ^ (oef)) & ~PSL_USERCHANGE) == 0) /* * XXX do allow users to change the privileged flag PSL_RF. * The cpu sets PSL_RF in tf_eflags for faults. Debuggers * should sometimes set it there too. tf_eflags is kept in * the signal context during signal handling and there is no * other place to remember it, so the PSL_RF bit may be * corrupted by the signal handler without us knowing. * Corruption of the PSL_RF bit at worst causes one more or * one less debugger trap, so allowing it is fairly harmless. */ if (!EFLAGS_SECURE(eflags & ~PSL_RF, regs->tf_eflags & ~PSL_RF)) { #ifdef DEBUG printf("sigreturn: eflags = 0x%x\n", eflags); #endif return(EINVAL); } /* * Don't allow users to load a valid privileged %cs. Let the * hardware check for invalid selectors, excess privilege in * other selectors, invalid %eip's and invalid %esp's. */ #define CS_SECURE(cs) (ISPL(cs) == SEL_UPL) if (!CS_SECURE(scp->sc_cs)) { #ifdef DEBUG printf("sigreturn: cs = 0x%x\n", scp->sc_cs); #endif trapsignal(p, SIGBUS, T_PROTFLT); return(EINVAL); } regs->tf_ds = scp->sc_ds; regs->tf_es = scp->sc_es; regs->tf_fs = scp->sc_fs; } /* restore scratch registers */ regs->tf_eax = scp->sc_eax; regs->tf_ebx = scp->sc_ebx; regs->tf_ecx = scp->sc_ecx; regs->tf_edx = scp->sc_edx; regs->tf_esi = scp->sc_esi; regs->tf_edi = scp->sc_edi; regs->tf_cs = scp->sc_cs; regs->tf_ss = scp->sc_ss; regs->tf_isp = scp->sc_isp; if (useracc((caddr_t)scp, sizeof (*scp), B_WRITE) == 0) return(EINVAL); if (scp->sc_onstack & 01) p->p_sigacts->ps_sigstk.ss_flags |= SS_ONSTACK; else p->p_sigacts->ps_sigstk.ss_flags &= ~SS_ONSTACK; p->p_sigmask = scp->sc_mask & ~sigcantmask; regs->tf_ebp = scp->sc_fp; regs->tf_esp = scp->sc_sp; regs->tf_eip = scp->sc_pc; regs->tf_eflags = eflags; return(EJUSTRETURN); } /* * Machine dependent boot() routine * * I haven't seen anything to put here yet * Possibly some stuff might be grafted back here from boot() */ void cpu_boot(int howto) { } /* * Shutdown the CPU as much as possible */ void cpu_halt(void) { for (;;) __asm__ ("hlt"); } /* * Clear registers on exec */ void setregs(p, entry, stack, ps_strings) struct proc *p; u_long entry; u_long stack; u_long ps_strings; { struct trapframe *regs = p->p_md.md_regs; struct pcb *pcb = &p->p_addr->u_pcb; #ifdef USER_LDT /* was i386_user_cleanup() in NetBSD */ if (pcb->pcb_ldt) { if (pcb == curpcb) { lldt(_default_ldt); currentldt = _default_ldt; } kmem_free(kernel_map, (vm_offset_t)pcb->pcb_ldt, pcb->pcb_ldt_len * sizeof(union descriptor)); pcb->pcb_ldt_len = (int)pcb->pcb_ldt = 0; } #endif bzero((char *)regs, sizeof(struct trapframe)); regs->tf_eip = entry; regs->tf_esp = stack; regs->tf_eflags = PSL_USER | (regs->tf_eflags & PSL_T); regs->tf_ss = _udatasel; regs->tf_ds = _udatasel; regs->tf_es = _udatasel; regs->tf_fs = _udatasel; regs->tf_cs = _ucodesel; /* PS_STRINGS value for BSD/OS binaries. It is 0 for non-BSD/OS. */ regs->tf_ebx = ps_strings; /* reset %gs as well */ pcb->pcb_gs = _udatasel; if (pcb == curpcb) { load_gs(_udatasel); } /* * Initialize the math emulator (if any) for the current process. * Actually, just clear the bit that says that the emulator has * been initialized. Initialization is delayed until the process * traps to the emulator (if it is done at all) mainly because * emulators don't provide an entry point for initialization. */ p->p_addr->u_pcb.pcb_flags &= ~FP_SOFTFP; /* * Arrange to trap the next npx or `fwait' instruction (see npx.c * for why fwait must be trapped at least if there is an npx or an * emulator). This is mainly to handle the case where npx0 is not * configured, since the npx routines normally set up the trap * otherwise. It should be done only at boot time, but doing it * here allows modifying `npx_exists' for testing the emulator on * systems with an npx. */ load_cr0(rcr0() | CR0_MP | CR0_TS); #if NNPX > 0 /* Initialize the npx (if any) for the current process. */ npxinit(__INITIAL_NPXCW__); #endif /* * XXX - Linux emulator * Make sure sure edx is 0x0 on entry. Linux binaries depend * on it. */ p->p_retval[1] = 0; } static int sysctl_machdep_adjkerntz SYSCTL_HANDLER_ARGS { int error; error = sysctl_handle_int(oidp, oidp->oid_arg1, oidp->oid_arg2, req); if (!error && req->newptr) resettodr(); return (error); } SYSCTL_PROC(_machdep, CPU_ADJKERNTZ, adjkerntz, CTLTYPE_INT|CTLFLAG_RW, &adjkerntz, 0, sysctl_machdep_adjkerntz, "I", ""); SYSCTL_INT(_machdep, CPU_DISRTCSET, disable_rtc_set, CTLFLAG_RW, &disable_rtc_set, 0, ""); SYSCTL_STRUCT(_machdep, CPU_BOOTINFO, bootinfo, CTLFLAG_RD, &bootinfo, bootinfo, ""); SYSCTL_INT(_machdep, CPU_WALLCLOCK, wall_cmos_clock, CTLFLAG_RW, &wall_cmos_clock, 0, ""); /* * Initialize 386 and configure to run kernel */ /* * Initialize segments & interrupt table */ int _default_ldt; #ifdef SMP union descriptor gdt[NGDT * NCPU]; /* global descriptor table */ #else union descriptor gdt[NGDT]; /* global descriptor table */ #endif static struct gate_descriptor idt0[NIDT]; struct gate_descriptor *idt = &idt0[0]; /* interrupt descriptor table */ union descriptor ldt[NLDT]; /* local descriptor table */ #ifdef SMP /* table descriptors - used to load tables by microp */ struct region_descriptor r_gdt, r_idt; #endif #ifndef SMP extern struct segment_descriptor common_tssd, *tss_gdt; #endif int private_tss; /* flag indicating private tss */ #if defined(I586_CPU) && !defined(NO_F00F_HACK) extern int has_f00f_bug; #endif static struct i386tss dblfault_tss; static char dblfault_stack[PAGE_SIZE]; extern struct user *proc0paddr; /* software prototypes -- in more palatable form */ struct soft_segment_descriptor gdt_segs[] = { /* GNULL_SEL 0 Null Descriptor */ { 0x0, /* segment base address */ 0x0, /* length */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GCODE_SEL 1 Code Descriptor for kernel */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMERA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GDATA_SEL 2 Data Descriptor for kernel */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMRWA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GPRIV_SEL 3 SMP Per-Processor Private Data Descriptor */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMRWA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GPROC0_SEL 4 Proc 0 Tss Descriptor */ { 0x0, /* segment base address */ sizeof(struct i386tss)-1,/* length - all address space */ SDT_SYS386TSS, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* unused - default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GLDT_SEL 5 LDT Descriptor */ { (int) ldt, /* segment base address */ sizeof(ldt)-1, /* length - all address space */ SDT_SYSLDT, /* segment type */ SEL_UPL, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* unused - default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GUSERLDT_SEL 6 User LDT Descriptor per process */ { (int) ldt, /* segment base address */ (512 * sizeof(union descriptor)-1), /* length */ SDT_SYSLDT, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* unused - default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GTGATE_SEL 7 Null Descriptor - Placeholder */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GPANIC_SEL 8 Panic Tss Descriptor */ { (int) &dblfault_tss, /* segment base address */ sizeof(struct i386tss)-1,/* length - all address space */ SDT_SYS386TSS, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* unused - default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GAPMCODE32_SEL 9 APM BIOS 32-bit interface (32bit Code) */ { 0, /* segment base address (overwritten by APM) */ 0xfffff, /* length */ SDT_MEMERA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GAPMCODE16_SEL 10 APM BIOS 32-bit interface (16bit Code) */ { 0, /* segment base address (overwritten by APM) */ 0xfffff, /* length */ SDT_MEMERA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GAPMDATA_SEL 11 APM BIOS 32-bit interface (Data) */ { 0, /* segment base address (overwritten by APM) */ 0xfffff, /* length */ SDT_MEMRWA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, }; static struct soft_segment_descriptor ldt_segs[] = { /* Null Descriptor - overwritten by call gate */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* Null Descriptor - overwritten by call gate */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* Null Descriptor - overwritten by call gate */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* Code Descriptor for user */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMERA, /* segment type */ SEL_UPL, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* Null Descriptor - overwritten by call gate */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* Data Descriptor for user */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMRWA, /* segment type */ SEL_UPL, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, }; void setidt(idx, func, typ, dpl, selec) int idx; inthand_t *func; int typ; int dpl; int selec; { struct gate_descriptor *ip; ip = idt + idx; ip->gd_looffset = (int)func; ip->gd_selector = selec; ip->gd_stkcpy = 0; ip->gd_xx = 0; ip->gd_type = typ; ip->gd_dpl = dpl; ip->gd_p = 1; ip->gd_hioffset = ((int)func)>>16 ; } #define IDTVEC(name) __CONCAT(X,name) extern inthand_t IDTVEC(div), IDTVEC(dbg), IDTVEC(nmi), IDTVEC(bpt), IDTVEC(ofl), IDTVEC(bnd), IDTVEC(ill), IDTVEC(dna), IDTVEC(fpusegm), IDTVEC(tss), IDTVEC(missing), IDTVEC(stk), IDTVEC(prot), IDTVEC(page), IDTVEC(mchk), IDTVEC(rsvd), IDTVEC(fpu), IDTVEC(align), IDTVEC(syscall), IDTVEC(int0x80_syscall); void sdtossd(sd, ssd) struct segment_descriptor *sd; struct soft_segment_descriptor *ssd; { ssd->ssd_base = (sd->sd_hibase << 24) | sd->sd_lobase; ssd->ssd_limit = (sd->sd_hilimit << 16) | sd->sd_lolimit; ssd->ssd_type = sd->sd_type; ssd->ssd_dpl = sd->sd_dpl; ssd->ssd_p = sd->sd_p; ssd->ssd_def32 = sd->sd_def32; ssd->ssd_gran = sd->sd_gran; } #define PHYSMAP_SIZE (2 * 8) /* * Populate the (physmap) array with base/bound pairs describing the * available physical memory in the system, then test this memory and * build the phys_avail array describing the actually-available memory. * * If we cannot accurately determine the physical memory map, then use * value from the 0xE801 call, and failing that, the RTC. * * Total memory size may be set by the kernel environment variable * hw.physmem or the compile-time define MAXMEM. */ static void getmemsize(int first) { int i, physmap_idx, pa_indx; u_int basemem, extmem; struct vm86frame vmf; struct vm86context vmc; vm_offset_t pa, physmap[PHYSMAP_SIZE]; pt_entry_t pte; const char *cp; struct { u_int64_t base; u_int64_t length; u_int32_t type; } *smap; bzero(&vmf, sizeof(struct vm86frame)); bzero(physmap, sizeof(physmap)); /* * Perform "base memory" related probes & setup */ vm86_intcall(0x12, &vmf); basemem = vmf.vmf_ax; if (basemem > 640) { printf("Preposterous BIOS basemem of %uK, truncating to 640K\n", basemem); basemem = 640; } /* * XXX if biosbasemem is now < 640, there is a `hole' * between the end of base memory and the start of * ISA memory. The hole may be empty or it may * contain BIOS code or data. Map it read/write so * that the BIOS can write to it. (Memory from 0 to * the physical end of the kernel is mapped read-only * to begin with and then parts of it are remapped. * The parts that aren't remapped form holes that * remain read-only and are unused by the kernel. * The base memory area is below the physical end of * the kernel and right now forms a read-only hole. * The part of it from PAGE_SIZE to * (trunc_page(biosbasemem * 1024) - 1) will be * remapped and used by the kernel later.) * * This code is similar to the code used in * pmap_mapdev, but since no memory needs to be * allocated we simply change the mapping. */ for (pa = trunc_page(basemem * 1024); pa < ISA_HOLE_START; pa += PAGE_SIZE) { pte = (pt_entry_t)vtopte(pa + KERNBASE); *pte = pa | PG_RW | PG_V; } /* * if basemem != 640, map pages r/w into vm86 page table so * that the bios can scribble on it. */ pte = (pt_entry_t)vm86paddr; for (i = basemem / 4; i < 160; i++) pte[i] = (i << PAGE_SHIFT) | PG_V | PG_RW | PG_U; /* * map page 1 R/W into the kernel page table so we can use it * as a buffer. The kernel will unmap this page later. */ pte = (pt_entry_t)vtopte(KERNBASE + (1 << PAGE_SHIFT)); *pte = (1 << PAGE_SHIFT) | PG_RW | PG_V; /* * get memory map with INT 15:E820 */ #define SMAPSIZ sizeof(*smap) #define SMAP_SIG 0x534D4150 /* 'SMAP' */ vmc.npages = 0; smap = (void *)vm86_addpage(&vmc, 1, KERNBASE + (1 << PAGE_SHIFT)); vm86_getptr(&vmc, (vm_offset_t)smap, &vmf.vmf_es, &vmf.vmf_di); physmap_idx = 0; vmf.vmf_ebx = 0; do { vmf.vmf_eax = 0xE820; vmf.vmf_edx = SMAP_SIG; vmf.vmf_ecx = SMAPSIZ; i = vm86_datacall(0x15, &vmf, &vmc); if (i || vmf.vmf_eax != SMAP_SIG) break; if (boothowto & RB_VERBOSE) printf("SMAP type=%02x base=%08x %08x len=%08x %08x\n", smap->type, *(u_int32_t *)((char *)&smap->base + 4), (u_int32_t)smap->base, *(u_int32_t *)((char *)&smap->length + 4), (u_int32_t)smap->length); if (smap->type != 0x01) goto next_run; if (smap->length == 0) goto next_run; if (smap->base >= 0xffffffff) { printf("%uK of memory above 4GB ignored\n", (u_int)(smap->length / 1024)); goto next_run; } for (i = 0; i <= physmap_idx; i += 2) { if (smap->base < physmap[i + 1]) { if (boothowto & RB_VERBOSE) printf( "Overlapping or non-montonic memory region, ignoring second region\n"); goto next_run; } } if (smap->base == physmap[physmap_idx + 1]) { physmap[physmap_idx + 1] += smap->length; goto next_run; } physmap_idx += 2; if (physmap_idx == PHYSMAP_SIZE) { printf( "Too many segments in the physical address map, giving up\n"); break; } physmap[physmap_idx] = smap->base; physmap[physmap_idx + 1] = smap->base + smap->length; next_run: } while (vmf.vmf_ebx != 0); if (physmap[1] != 0) goto physmap_done; /* * If we failed above, try memory map with INT 15:E801 */ vmf.vmf_ax = 0xE801; if (vm86_intcall(0x15, &vmf) == 0) { extmem = vmf.vmf_cx + vmf.vmf_dx * 64; } else { #if 0 vmf.vmf_ah = 0x88; vm86_intcall(0x15, &vmf); extmem = vmf.vmf_ax; #else /* * Prefer the RTC value for extended memory. */ extmem = rtcin(RTC_EXTLO) + (rtcin(RTC_EXTHI) << 8); #endif } /* * Special hack for chipsets that still remap the 384k hole when * there's 16MB of memory - this really confuses people that * are trying to use bus mastering ISA controllers with the * "16MB limit"; they only have 16MB, but the remapping puts * them beyond the limit. * * If extended memory is between 15-16MB (16-17MB phys address range), * chop it to 15MB. */ if ((extmem > 15 * 1024) && (extmem < 16 * 1024)) extmem = 15 * 1024; physmap[0] = 0; physmap[1] = basemem * 1024; physmap_idx = 2; physmap[physmap_idx] = 0x100000; physmap[physmap_idx + 1] = physmap[physmap_idx] + extmem * 1024; physmap_done: /* * Now, physmap contains a map of physical memory. */ #ifdef SMP /* make hole for AP bootstrap code */ physmap[1] = mp_bootaddress(physmap[1] / 1024); /* look for the MP hardware - needed for apic addresses */ mp_probe(); #endif /* * Maxmem isn't the "maximum memory", it's one larger than the * highest page of the physical address space. It should be * called something like "Maxphyspage". We may adjust this * based on ``hw.physmem'' and the results of the memory test. */ Maxmem = atop(physmap[physmap_idx + 1]); #ifdef MAXMEM Maxmem = MAXMEM / 4; #endif /* * hw.maxmem is a size in bytes; we also allow k, m, and g suffixes * for the appropriate modifiers. This overrides MAXMEM. */ if ((cp = getenv("hw.physmem")) != NULL) { u_int64_t AllowMem, sanity; const char *ep; sanity = AllowMem = strtouq(cp, &ep, 0); if ((ep != cp) && (*ep != 0)) { switch(*ep) { case 'g': case 'G': AllowMem <<= 10; case 'm': case 'M': AllowMem <<= 10; case 'k': case 'K': AllowMem <<= 10; break; default: AllowMem = sanity = 0; } if (AllowMem < sanity) AllowMem = 0; } if (AllowMem == 0) printf("Ignoring invalid memory size of '%s'\n", cp); else Maxmem = atop(AllowMem); } if (atop(physmap[physmap_idx + 1]) != Maxmem && (boothowto & RB_VERBOSE)) printf("Physical memory use set to %uK\n", Maxmem * 4); /* * If Maxmem has been increased beyond what the system has detected, * extend the last memory segment to the new limit. */ if (atop(physmap[physmap_idx + 1]) < Maxmem) physmap[physmap_idx + 1] = ptoa(Maxmem); /* call pmap initialization to make new kernel address space */ pmap_bootstrap(first, 0); /* * Size up each available chunk of physical memory. */ physmap[0] = PAGE_SIZE; /* mask off page 0 */ pa_indx = 0; phys_avail[pa_indx++] = physmap[0]; phys_avail[pa_indx] = physmap[0]; #if 0 pte = (pt_entry_t)vtopte(KERNBASE); #else pte = (pt_entry_t)CMAP1; #endif /* * physmap is in bytes, so when converting to page boundaries, * round up the start address and round down the end address. */ for (i = 0; i <= physmap_idx; i += 2) { vm_offset_t end; end = ptoa(Maxmem); if (physmap[i + 1] < end) end = trunc_page(physmap[i + 1]); for (pa = round_page(physmap[i]); pa < end; pa += PAGE_SIZE) { int tmp, page_bad; #if 0 int *ptr = 0; #else int *ptr = (int *)CADDR1; #endif /* * block out kernel memory as not available. */ if (pa >= 0x100000 && pa < first) continue; page_bad = FALSE; /* * map page into kernel: valid, read/write,non-cacheable */ *pte = pa | PG_V | PG_RW | PG_N; invltlb(); tmp = *(int *)ptr; /* * Test for alternating 1's and 0's */ *(volatile int *)ptr = 0xaaaaaaaa; if (*(volatile int *)ptr != 0xaaaaaaaa) { page_bad = TRUE; } /* * Test for alternating 0's and 1's */ *(volatile int *)ptr = 0x55555555; if (*(volatile int *)ptr != 0x55555555) { page_bad = TRUE; } /* * Test for all 1's */ *(volatile int *)ptr = 0xffffffff; if (*(volatile int *)ptr != 0xffffffff) { page_bad = TRUE; } /* * Test for all 0's */ *(volatile int *)ptr = 0x0; if (*(volatile int *)ptr != 0x0) { page_bad = TRUE; } /* * Restore original value. */ *(int *)ptr = tmp; /* * Adjust array of valid/good pages. */ if (page_bad == TRUE) { continue; } /* * If this good page is a continuation of the * previous set of good pages, then just increase * the end pointer. Otherwise start a new chunk. * Note that "end" points one higher than end, * making the range >= start and < end. * If we're also doing a speculative memory * test and we at or past the end, bump up Maxmem * so that we keep going. The first bad page * will terminate the loop. */ if (phys_avail[pa_indx] == pa) { phys_avail[pa_indx] += PAGE_SIZE; } else { pa_indx++; if (pa_indx == PHYS_AVAIL_ARRAY_END) { printf("Too many holes in the physical address space, giving up\n"); pa_indx--; break; } phys_avail[pa_indx++] = pa; /* start */ phys_avail[pa_indx] = pa + PAGE_SIZE; /* end */ } physmem++; } } *pte = 0; invltlb(); /* * XXX * The last chunk must contain at least one page plus the message * buffer to avoid complicating other code (message buffer address * calculation, etc.). */ while (phys_avail[pa_indx - 1] + PAGE_SIZE + round_page(MSGBUF_SIZE) >= phys_avail[pa_indx]) { physmem -= atop(phys_avail[pa_indx] - phys_avail[pa_indx - 1]); phys_avail[pa_indx--] = 0; phys_avail[pa_indx--] = 0; } Maxmem = atop(phys_avail[pa_indx]); /* Trim off space for the message buffer. */ phys_avail[pa_indx] -= round_page(MSGBUF_SIZE); avail_end = phys_avail[pa_indx]; } void init386(first) int first; { int x; struct gate_descriptor *gdp; int gsel_tss; #ifndef SMP /* table descriptors - used to load tables by microp */ struct region_descriptor r_gdt, r_idt; #endif int off; /* * Prevent lowering of the ipl if we call tsleep() early. */ safepri = cpl; proc0.p_addr = proc0paddr; atdevbase = ISA_HOLE_START + KERNBASE; if (bootinfo.bi_modulep) { preload_metadata = (caddr_t)bootinfo.bi_modulep + KERNBASE; preload_bootstrap_relocate(KERNBASE); } if (bootinfo.bi_envp) kern_envp = (caddr_t)bootinfo.bi_envp + KERNBASE; /* * make gdt memory segments, the code segment goes up to end of the * page with etext in it, the data segment goes to the end of * the address space */ /* * XXX text protection is temporarily (?) disabled. The limit was * i386_btop(round_page(etext)) - 1. */ gdt_segs[GCODE_SEL].ssd_limit = i386_btop(0) - 1; gdt_segs[GDATA_SEL].ssd_limit = i386_btop(0) - 1; #ifdef SMP gdt_segs[GPRIV_SEL].ssd_limit = i386_btop(sizeof(struct privatespace)) - 1; gdt_segs[GPRIV_SEL].ssd_base = (int) &SMP_prvspace[0]; gdt_segs[GPROC0_SEL].ssd_base = (int) &SMP_prvspace[0].globaldata.gd_common_tss; SMP_prvspace[0].globaldata.gd_prvspace = &SMP_prvspace[0]; #else gdt_segs[GPRIV_SEL].ssd_limit = i386_btop(0) - 1; gdt_segs[GPROC0_SEL].ssd_base = (int) &common_tss; #endif for (x = 0; x < NGDT; x++) { #ifdef BDE_DEBUGGER /* avoid overwriting db entries with APM ones */ if (x >= GAPMCODE32_SEL && x <= GAPMDATA_SEL) continue; #endif ssdtosd(&gdt_segs[x], &gdt[x].sd); } r_gdt.rd_limit = NGDT * sizeof(gdt[0]) - 1; r_gdt.rd_base = (int) gdt; lgdt(&r_gdt); /* make ldt memory segments */ /* * The data segment limit must not cover the user area because we * don't want the user area to be writable in copyout() etc. (page * level protection is lost in kernel mode on 386's). Also, we * don't want the user area to be writable directly (page level * protection of the user area is not available on 486's with * CR0_WP set, because there is no user-read/kernel-write mode). * * XXX - VM_MAXUSER_ADDRESS is an end address, not a max. And it * should be spelled ...MAX_USER... */ #define VM_END_USER_RW_ADDRESS VM_MAXUSER_ADDRESS /* * The code segment limit has to cover the user area until we move * the signal trampoline out of the user area. This is safe because * the code segment cannot be written to directly. */ #define VM_END_USER_R_ADDRESS (VM_END_USER_RW_ADDRESS + UPAGES * PAGE_SIZE) ldt_segs[LUCODE_SEL].ssd_limit = i386_btop(VM_END_USER_R_ADDRESS) - 1; ldt_segs[LUDATA_SEL].ssd_limit = i386_btop(VM_END_USER_RW_ADDRESS) - 1; for (x = 0; x < sizeof ldt_segs / sizeof ldt_segs[0]; x++) ssdtosd(&ldt_segs[x], &ldt[x].sd); _default_ldt = GSEL(GLDT_SEL, SEL_KPL); lldt(_default_ldt); #ifdef USER_LDT currentldt = _default_ldt; #endif /* exceptions */ for (x = 0; x < NIDT; x++) setidt(x, &IDTVEC(rsvd), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(0, &IDTVEC(div), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(1, &IDTVEC(dbg), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(2, &IDTVEC(nmi), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(3, &IDTVEC(bpt), SDT_SYS386TGT, SEL_UPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(4, &IDTVEC(ofl), SDT_SYS386TGT, SEL_UPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(5, &IDTVEC(bnd), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(6, &IDTVEC(ill), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(7, &IDTVEC(dna), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(8, 0, SDT_SYSTASKGT, SEL_KPL, GSEL(GPANIC_SEL, SEL_KPL)); setidt(9, &IDTVEC(fpusegm), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(10, &IDTVEC(tss), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(11, &IDTVEC(missing), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(12, &IDTVEC(stk), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(13, &IDTVEC(prot), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(14, &IDTVEC(page), SDT_SYS386IGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(15, &IDTVEC(rsvd), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(16, &IDTVEC(fpu), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(17, &IDTVEC(align), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(18, &IDTVEC(mchk), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(0x80, &IDTVEC(int0x80_syscall), SDT_SYS386TGT, SEL_UPL, GSEL(GCODE_SEL, SEL_KPL)); r_idt.rd_limit = sizeof(idt0) - 1; r_idt.rd_base = (int) idt; lidt(&r_idt); /* * Initialize the console before we print anything out. */ cninit(); #include "isa.h" #if NISA >0 isa_defaultirq(); #endif rand_initialize(); #ifdef DDB kdb_init(); if (boothowto & RB_KDB) Debugger("Boot flags requested debugger"); #endif finishidentcpu(); /* Final stage of CPU initialization */ setidt(6, &IDTVEC(ill), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(13, &IDTVEC(prot), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); initializecpu(); /* Initialize CPU registers */ /* make an initial tss so cpu can get interrupt stack on syscall! */ common_tss.tss_esp0 = (int) proc0.p_addr + UPAGES*PAGE_SIZE - 16; common_tss.tss_ss0 = GSEL(GDATA_SEL, SEL_KPL) ; gsel_tss = GSEL(GPROC0_SEL, SEL_KPL); private_tss = 0; tss_gdt = &gdt[GPROC0_SEL].sd; common_tssd = *tss_gdt; common_tss.tss_ioopt = (sizeof common_tss) << 16; ltr(gsel_tss); dblfault_tss.tss_esp = dblfault_tss.tss_esp0 = dblfault_tss.tss_esp1 = dblfault_tss.tss_esp2 = (int) &dblfault_stack[sizeof(dblfault_stack)]; dblfault_tss.tss_ss = dblfault_tss.tss_ss0 = dblfault_tss.tss_ss1 = dblfault_tss.tss_ss2 = GSEL(GDATA_SEL, SEL_KPL); dblfault_tss.tss_cr3 = (int)IdlePTD; dblfault_tss.tss_eip = (int) dblfault_handler; dblfault_tss.tss_eflags = PSL_KERNEL; dblfault_tss.tss_ds = dblfault_tss.tss_es = dblfault_tss.tss_gs = GSEL(GDATA_SEL, SEL_KPL); dblfault_tss.tss_fs = GSEL(GPRIV_SEL, SEL_KPL); dblfault_tss.tss_cs = GSEL(GCODE_SEL, SEL_KPL); dblfault_tss.tss_ldt = GSEL(GLDT_SEL, SEL_KPL); vm86_initialize(); getmemsize(first); /* now running on new page tables, configured,and u/iom is accessible */ /* Map the message buffer. */ for (off = 0; off < round_page(MSGBUF_SIZE); off += PAGE_SIZE) pmap_kenter((vm_offset_t)msgbufp + off, avail_end + off); msgbufinit(msgbufp, MSGBUF_SIZE); /* make a call gate to reenter kernel with */ gdp = &ldt[LSYS5CALLS_SEL].gd; x = (int) &IDTVEC(syscall); gdp->gd_looffset = x++; gdp->gd_selector = GSEL(GCODE_SEL,SEL_KPL); gdp->gd_stkcpy = 1; gdp->gd_type = SDT_SYS386CGT; gdp->gd_dpl = SEL_UPL; gdp->gd_p = 1; gdp->gd_hioffset = ((int) &IDTVEC(syscall)) >>16; /* XXX does this work? */ ldt[LBSDICALLS_SEL] = ldt[LSYS5CALLS_SEL]; ldt[LSOL26CALLS_SEL] = ldt[LSYS5CALLS_SEL]; /* transfer to user mode */ _ucodesel = LSEL(LUCODE_SEL, SEL_UPL); _udatasel = LSEL(LUDATA_SEL, SEL_UPL); /* setup proc 0's pcb */ proc0.p_addr->u_pcb.pcb_flags = 0; proc0.p_addr->u_pcb.pcb_cr3 = (int)IdlePTD; #ifdef SMP proc0.p_addr->u_pcb.pcb_mpnest = 1; #endif proc0.p_addr->u_pcb.pcb_ext = 0; } #if defined(I586_CPU) && !defined(NO_F00F_HACK) static void f00f_hack(void *unused); SYSINIT(f00f_hack, SI_SUB_INTRINSIC, SI_ORDER_FIRST, f00f_hack, NULL); static void f00f_hack(void *unused) { struct gate_descriptor *new_idt; #ifndef SMP struct region_descriptor r_idt; #endif vm_offset_t tmp; if (!has_f00f_bug) return; printf("Intel Pentium detected, installing workaround for F00F bug\n"); r_idt.rd_limit = sizeof(idt0) - 1; tmp = kmem_alloc(kernel_map, PAGE_SIZE * 2); if (tmp == 0) panic("kmem_alloc returned 0"); if (((unsigned int)tmp & (PAGE_SIZE-1)) != 0) panic("kmem_alloc returned non-page-aligned memory"); /* Put the first seven entries in the lower page */ new_idt = (struct gate_descriptor*)(tmp + PAGE_SIZE - (7*8)); bcopy(idt, new_idt, sizeof(idt0)); r_idt.rd_base = (int)new_idt; lidt(&r_idt); idt = new_idt; if (vm_map_protect(kernel_map, tmp, tmp + PAGE_SIZE, VM_PROT_READ, FALSE) != KERN_SUCCESS) panic("vm_map_protect failed"); return; } #endif /* defined(I586_CPU) && !NO_F00F_HACK */ int ptrace_set_pc(p, addr) struct proc *p; unsigned long addr; { p->p_md.md_regs->tf_eip = addr; return (0); } int ptrace_single_step(p) struct proc *p; { p->p_md.md_regs->tf_eflags |= PSL_T; return (0); } int ptrace_read_u_check(p, addr, len) struct proc *p; vm_offset_t addr; size_t len; { vm_offset_t gap; if ((vm_offset_t) (addr + len) < addr) return EPERM; if ((vm_offset_t) (addr + len) <= sizeof(struct user)) return 0; gap = (char *) p->p_md.md_regs - (char *) p->p_addr; if ((vm_offset_t) addr < gap) return EPERM; if ((vm_offset_t) (addr + len) <= (vm_offset_t) (gap + sizeof(struct trapframe))) return 0; return EPERM; } int ptrace_write_u(p, off, data) struct proc *p; vm_offset_t off; long data; { struct trapframe frame_copy; vm_offset_t min; struct trapframe *tp; /* * Privileged kernel state is scattered all over the user area. * Only allow write access to parts of regs and to fpregs. */ min = (char *)p->p_md.md_regs - (char *)p->p_addr; if (off >= min && off <= min + sizeof(struct trapframe) - sizeof(int)) { tp = p->p_md.md_regs; frame_copy = *tp; *(int *)((char *)&frame_copy + (off - min)) = data; if (!EFLAGS_SECURE(frame_copy.tf_eflags, tp->tf_eflags) || !CS_SECURE(frame_copy.tf_cs)) return (EINVAL); *(int*)((char *)p->p_addr + off) = data; return (0); } min = offsetof(struct user, u_pcb) + offsetof(struct pcb, pcb_savefpu); if (off >= min && off <= min + sizeof(struct save87) - sizeof(int)) { *(int*)((char *)p->p_addr + off) = data; return (0); } return (EFAULT); } int fill_regs(p, regs) struct proc *p; struct reg *regs; { struct pcb *pcb; struct trapframe *tp; tp = p->p_md.md_regs; regs->r_fs = tp->tf_fs; regs->r_es = tp->tf_es; regs->r_ds = tp->tf_ds; regs->r_edi = tp->tf_edi; regs->r_esi = tp->tf_esi; regs->r_ebp = tp->tf_ebp; regs->r_ebx = tp->tf_ebx; regs->r_edx = tp->tf_edx; regs->r_ecx = tp->tf_ecx; regs->r_eax = tp->tf_eax; regs->r_eip = tp->tf_eip; regs->r_cs = tp->tf_cs; regs->r_eflags = tp->tf_eflags; regs->r_esp = tp->tf_esp; regs->r_ss = tp->tf_ss; pcb = &p->p_addr->u_pcb; regs->r_gs = pcb->pcb_gs; return (0); } int set_regs(p, regs) struct proc *p; struct reg *regs; { struct pcb *pcb; struct trapframe *tp; tp = p->p_md.md_regs; if (!EFLAGS_SECURE(regs->r_eflags, tp->tf_eflags) || !CS_SECURE(regs->r_cs)) return (EINVAL); tp->tf_fs = regs->r_fs; tp->tf_es = regs->r_es; tp->tf_ds = regs->r_ds; tp->tf_edi = regs->r_edi; tp->tf_esi = regs->r_esi; tp->tf_ebp = regs->r_ebp; tp->tf_ebx = regs->r_ebx; tp->tf_edx = regs->r_edx; tp->tf_ecx = regs->r_ecx; tp->tf_eax = regs->r_eax; tp->tf_eip = regs->r_eip; tp->tf_cs = regs->r_cs; tp->tf_eflags = regs->r_eflags; tp->tf_esp = regs->r_esp; tp->tf_ss = regs->r_ss; pcb = &p->p_addr->u_pcb; pcb->pcb_gs = regs->r_gs; return (0); } int fill_fpregs(p, fpregs) struct proc *p; struct fpreg *fpregs; { bcopy(&p->p_addr->u_pcb.pcb_savefpu, fpregs, sizeof *fpregs); return (0); } int set_fpregs(p, fpregs) struct proc *p; struct fpreg *fpregs; { bcopy(fpregs, &p->p_addr->u_pcb.pcb_savefpu, sizeof *fpregs); + return (0); +} + +int +fill_dbregs(p, dbregs) + struct proc *p; + struct dbreg *dbregs; +{ + struct pcb *pcb; + + pcb = &p->p_addr->u_pcb; + dbregs->dr0 = pcb->pcb_dr0; + dbregs->dr1 = pcb->pcb_dr1; + dbregs->dr2 = pcb->pcb_dr2; + dbregs->dr3 = pcb->pcb_dr3; + dbregs->dr4 = 0; + dbregs->dr5 = 0; + dbregs->dr6 = pcb->pcb_dr6; + dbregs->dr7 = pcb->pcb_dr7; + return (0); +} + +int +set_dbregs(p, dbregs) + struct proc *p; + struct dbreg *dbregs; +{ + struct pcb *pcb; + + pcb = &p->p_addr->u_pcb; + + /* + * Don't let a process set a breakpoint that is not within the + * process's address space. If a process could do this, it + * could halt the system by setting a breakpoint in the kernel + * (if ddb was enabled). Thus, we need to check to make sure + * that no breakpoints are being enabled for addresses outside + * process's address space, unless, perhaps, we were called by + * uid 0. + * + * XXX - what about when the watched area of the user's + * address space is written into from within the kernel + * ... wouldn't that still cause a breakpoint to be generated + * from within kernel mode? + */ + + if (p->p_cred->pc_ucred->cr_uid != 0) { + if (dbregs->dr7 & 0x3) { + /* dr0 is enabled */ + if (dbregs->dr0 >= VM_MAXUSER_ADDRESS) + return (EINVAL); + } + + if (dbregs->dr7 & (0x3<<2)) { + /* dr1 is enabled */ + if (dbregs->dr1 >= VM_MAXUSER_ADDRESS) + return (EINVAL); + } + + if (dbregs->dr7 & (0x3<<4)) { + /* dr2 is enabled */ + if (dbregs->dr2 >= VM_MAXUSER_ADDRESS) + return (EINVAL); + } + + if (dbregs->dr7 & (0x3<<6)) { + /* dr3 is enabled */ + if (dbregs->dr3 >= VM_MAXUSER_ADDRESS) + return (EINVAL); + } + } + + pcb->pcb_dr0 = dbregs->dr0; + pcb->pcb_dr1 = dbregs->dr1; + pcb->pcb_dr2 = dbregs->dr2; + pcb->pcb_dr3 = dbregs->dr3; + pcb->pcb_dr6 = dbregs->dr6; + pcb->pcb_dr7 = dbregs->dr7; + + pcb->pcb_flags |= PCB_DBREGS; + return (0); } #ifndef DDB void Debugger(const char *msg) { printf("Debugger(\"%s\") called.\n", msg); } #endif /* no DDB */ #include /* * Determine the size of the transfer, and make sure it is * within the boundaries of the partition. Adjust transfer * if needed, and signal errors or early completion. */ int bounds_check_with_label(struct buf *bp, struct disklabel *lp, int wlabel) { struct partition *p = lp->d_partitions + dkpart(bp->b_dev); int labelsect = lp->d_partitions[0].p_offset; int maxsz = p->p_size, sz = (bp->b_bcount + DEV_BSIZE - 1) >> DEV_BSHIFT; /* overwriting disk label ? */ /* XXX should also protect bootstrap in first 8K */ if (bp->b_blkno + p->p_offset <= LABELSECTOR + labelsect && #if LABELSECTOR != 0 bp->b_blkno + p->p_offset + sz > LABELSECTOR + labelsect && #endif (bp->b_flags & B_READ) == 0 && wlabel == 0) { bp->b_error = EROFS; goto bad; } #if defined(DOSBBSECTOR) && defined(notyet) /* overwriting master boot record? */ if (bp->b_blkno + p->p_offset <= DOSBBSECTOR && (bp->b_flags & B_READ) == 0 && wlabel == 0) { bp->b_error = EROFS; goto bad; } #endif /* beyond partition? */ if (bp->b_blkno < 0 || bp->b_blkno + sz > maxsz) { /* if exactly at end of disk, return an EOF */ if (bp->b_blkno == maxsz) { bp->b_resid = bp->b_bcount; return(0); } /* or truncate if part of it fits */ sz = maxsz - bp->b_blkno; if (sz <= 0) { bp->b_error = EINVAL; goto bad; } bp->b_bcount = sz << DEV_BSHIFT; } bp->b_pblkno = bp->b_blkno + p->p_offset; return(1); bad: bp->b_flags |= B_ERROR; return(-1); } #ifdef DDB /* * Provide inb() and outb() as functions. They are normally only * available as macros calling inlined functions, thus cannot be * called inside DDB. * * The actual code is stolen from , and de-inlined. */ #undef inb #undef outb /* silence compiler warnings */ u_char inb(u_int); void outb(u_int, u_char); u_char inb(u_int port) { u_char data; /* * We use %%dx and not %1 here because i/o is done at %dx and not at * %edx, while gcc generates inferior code (movw instead of movl) * if we tell it to load (u_short) port. */ __asm __volatile("inb %%dx,%0" : "=a" (data) : "d" (port)); return (data); } void outb(u_int port, u_char data) { u_char al; /* * Use an unnecessary assignment to help gcc's register allocator. * This make a large difference for gcc-1.40 and a tiny difference * for gcc-2.6.0. For gcc-1.40, al had to be ``asm("ax")'' for * best results. gcc-2.6.0 can't handle this. */ al = data; __asm __volatile("outb %0,%%dx" : : "a" (al), "d" (port)); } #endif /* DDB */ Index: head/sys/amd64/amd64/swtch.s =================================================================== --- head/sys/amd64/amd64/swtch.s (revision 48690) +++ head/sys/amd64/amd64/swtch.s (revision 48691) @@ -1,805 +1,843 @@ /*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * - * $Id: swtch.s,v 1.82 1999/06/01 18:19:45 jlemon Exp $ + * $Id: swtch.s,v 1.83 1999/07/03 06:33:24 alc Exp $ */ #include "npx.h" #include "opt_user_ldt.h" #include #include #ifdef SMP #include #include #include /** GRAB_LOPRIO */ #include #include #endif /* SMP */ #include "assym.s" /*****************************************************************************/ /* Scheduling */ /*****************************************************************************/ /* * The following primitives manipulate the run queues. * _whichqs tells which of the 32 queues _qs * have processes in them. setrunqueue puts processes into queues, Remrq * removes them from queues. The running process is on no queue, * other processes are on a queue related to p->p_priority, divided by 4 * actually to shrink the 0-127 range of priorities into the 32 available * queues. */ .data .globl _whichqs, _whichrtqs, _whichidqs _whichqs: .long 0 /* which run queues have data */ _whichrtqs: .long 0 /* which realtime run qs have data */ _whichidqs: .long 0 /* which idletime run qs have data */ .globl _hlt_vector _hlt_vector: .long _default_halt /* pointer to halt routine */ .globl _qs,_cnt,_panic .globl _want_resched _want_resched: .long 0 /* we need to re-run the scheduler */ #if defined(SWTCH_OPTIM_STATS) .globl _swtch_optim_stats, _tlb_flush_count _swtch_optim_stats: .long 0 /* number of _swtch_optims */ _tlb_flush_count: .long 0 #endif .text /* * setrunqueue(p) * * Call should be made at spl6(), and p->p_stat should be SRUN */ ENTRY(setrunqueue) movl 4(%esp),%eax #ifdef DIAGNOSTIC cmpb $SRUN,P_STAT(%eax) je set1 pushl $set2 call _panic set1: #endif cmpw $RTP_PRIO_NORMAL,P_RTPRIO_TYPE(%eax) /* normal priority process? */ je set_nort movzwl P_RTPRIO_PRIO(%eax),%edx cmpw $RTP_PRIO_REALTIME,P_RTPRIO_TYPE(%eax) /* RR realtime priority? */ je set_rt /* RT priority */ cmpw $RTP_PRIO_FIFO,P_RTPRIO_TYPE(%eax) /* FIFO realtime priority? */ jne set_id /* must be idle priority */ set_rt: btsl %edx,_whichrtqs /* set q full bit */ shll $3,%edx addl $_rtqs,%edx /* locate q hdr */ movl %edx,P_FORW(%eax) /* link process on tail of q */ movl P_BACK(%edx),%ecx movl %ecx,P_BACK(%eax) movl %eax,P_BACK(%edx) movl %eax,P_FORW(%ecx) ret set_id: btsl %edx,_whichidqs /* set q full bit */ shll $3,%edx addl $_idqs,%edx /* locate q hdr */ movl %edx,P_FORW(%eax) /* link process on tail of q */ movl P_BACK(%edx),%ecx movl %ecx,P_BACK(%eax) movl %eax,P_BACK(%edx) movl %eax,P_FORW(%ecx) ret set_nort: /* Normal (RTOFF) code */ movzbl P_PRI(%eax),%edx shrl $2,%edx btsl %edx,_whichqs /* set q full bit */ shll $3,%edx addl $_qs,%edx /* locate q hdr */ movl %edx,P_FORW(%eax) /* link process on tail of q */ movl P_BACK(%edx),%ecx movl %ecx,P_BACK(%eax) movl %eax,P_BACK(%edx) movl %eax,P_FORW(%ecx) ret set2: .asciz "setrunqueue" /* * Remrq(p) * * Call should be made at spl6(). */ ENTRY(remrq) movl 4(%esp),%eax cmpw $RTP_PRIO_NORMAL,P_RTPRIO_TYPE(%eax) /* normal priority process? */ je rem_nort movzwl P_RTPRIO_PRIO(%eax),%edx cmpw $RTP_PRIO_REALTIME,P_RTPRIO_TYPE(%eax) /* realtime priority process? */ je rem0rt cmpw $RTP_PRIO_FIFO,P_RTPRIO_TYPE(%eax) /* FIFO realtime priority process? */ jne rem_id rem0rt: btrl %edx,_whichrtqs /* clear full bit, panic if clear already */ jb rem1rt pushl $rem3rt call _panic rem1rt: pushl %edx movl P_FORW(%eax),%ecx /* unlink process */ movl P_BACK(%eax),%edx movl %edx,P_BACK(%ecx) movl P_BACK(%eax),%ecx movl P_FORW(%eax),%edx movl %edx,P_FORW(%ecx) popl %edx movl $_rtqs,%ecx shll $3,%edx addl %edx,%ecx cmpl P_FORW(%ecx),%ecx /* q still has something? */ je rem2rt shrl $3,%edx /* yes, set bit as still full */ btsl %edx,_whichrtqs rem2rt: ret rem_id: btrl %edx,_whichidqs /* clear full bit, panic if clear already */ jb rem1id pushl $rem3id call _panic rem1id: pushl %edx movl P_FORW(%eax),%ecx /* unlink process */ movl P_BACK(%eax),%edx movl %edx,P_BACK(%ecx) movl P_BACK(%eax),%ecx movl P_FORW(%eax),%edx movl %edx,P_FORW(%ecx) popl %edx movl $_idqs,%ecx shll $3,%edx addl %edx,%ecx cmpl P_FORW(%ecx),%ecx /* q still has something? */ je rem2id shrl $3,%edx /* yes, set bit as still full */ btsl %edx,_whichidqs rem2id: ret rem_nort: movzbl P_PRI(%eax),%edx shrl $2,%edx btrl %edx,_whichqs /* clear full bit, panic if clear already */ jb rem1 pushl $rem3 call _panic rem1: pushl %edx movl P_FORW(%eax),%ecx /* unlink process */ movl P_BACK(%eax),%edx movl %edx,P_BACK(%ecx) movl P_BACK(%eax),%ecx movl P_FORW(%eax),%edx movl %edx,P_FORW(%ecx) popl %edx movl $_qs,%ecx shll $3,%edx addl %edx,%ecx cmpl P_FORW(%ecx),%ecx /* q still has something? */ je rem2 shrl $3,%edx /* yes, set bit as still full */ btsl %edx,_whichqs rem2: ret rem3: .asciz "remrq" rem3rt: .asciz "remrq.rt" rem3id: .asciz "remrq.id" /* * When no processes are on the runq, cpu_switch() branches to _idle * to wait for something to come ready. */ ALIGN_TEXT .type _idle,@function _idle: xorl %ebp,%ebp movl %ebp,_switchtime #ifdef SMP /* when called, we have the mplock, intr disabled */ /* use our idleproc's "context" */ movl _IdlePTD, %ecx movl %cr3, %eax cmpl %ecx, %eax je 2f #if defined(SWTCH_OPTIM_STATS) decl _swtch_optim_stats incl _tlb_flush_count #endif movl %ecx, %cr3 2: /* Keep space for nonexisting return addr, or profiling bombs */ movl $gd_idlestack_top-4, %ecx addl %fs:0, %ecx movl %ecx, %esp /* update common_tss.tss_esp0 pointer */ movl %ecx, _common_tss + TSS_ESP0 movl _cpuid, %esi btrl %esi, _private_tss jae 1f movl $gd_common_tssd, %edi addl %fs:0, %edi /* move correct tss descriptor into GDT slot, then reload tr */ movl _tss_gdt, %ebx /* entry in GDT */ movl 0(%edi), %eax movl %eax, 0(%ebx) movl 4(%edi), %eax movl %eax, 4(%ebx) movl $GPROC0_SEL*8, %esi /* GSEL(entry, SEL_KPL) */ ltr %si 1: sti /* * XXX callers of cpu_switch() do a bogus splclock(). Locking should * be left to cpu_switch(). */ call _spl0 cli /* * _REALLY_ free the lock, no matter how deep the prior nesting. * We will recover the nesting on the way out when we have a new * proc to load. * * XXX: we had damn well better be sure we had it before doing this! */ CPL_LOCK /* XXX */ MPLOCKED andl $~SWI_AST_MASK, _ipending /* XXX */ movl $0, _cpl /* XXX Allow ASTs on other CPU */ CPL_UNLOCK /* XXX */ movl $FREE_LOCK, %eax movl %eax, _mp_lock /* do NOT have lock, intrs disabled */ .globl idle_loop idle_loop: cmpl $0,_smp_active jne 1f cmpl $0,_cpuid je 1f jmp 2f 1: cmpl $0,_whichrtqs /* real-time queue */ jne 3f cmpl $0,_whichqs /* normal queue */ jne 3f cmpl $0,_whichidqs /* 'idle' queue */ jne 3f cmpl $0,_do_page_zero_idle je 2f /* XXX appears to cause panics */ /* * Inside zero_idle we enable interrupts and grab the mplock * as needed. It needs to be careful about entry/exit mutexes. */ call _vm_page_zero_idle /* internal locking */ testl %eax, %eax jnz idle_loop 2: /* enable intrs for a halt */ movl $0, lapic_tpr /* 1st candidate for an INT */ sti call *_hlt_vector /* wait for interrupt */ cli jmp idle_loop 3: movl $LOPRIO_LEVEL, lapic_tpr /* arbitrate for INTs */ call _get_mplock CPL_LOCK /* XXX */ movl $SWI_AST_MASK, _cpl /* XXX Disallow ASTs on other CPU */ CPL_UNLOCK /* XXX */ cmpl $0,_whichrtqs /* real-time queue */ CROSSJUMP(jne, sw1a, je) cmpl $0,_whichqs /* normal queue */ CROSSJUMP(jne, nortqr, je) cmpl $0,_whichidqs /* 'idle' queue */ CROSSJUMP(jne, idqr, je) CPL_LOCK /* XXX */ movl $0, _cpl /* XXX Allow ASTs on other CPU */ CPL_UNLOCK /* XXX */ call _rel_mplock jmp idle_loop #else /* !SMP */ movl $HIDENAME(tmpstk),%esp #if defined(OVERLY_CONSERVATIVE_PTD_MGMT) #if defined(SWTCH_OPTIM_STATS) incl _swtch_optim_stats #endif movl _IdlePTD, %ecx movl %cr3, %eax cmpl %ecx, %eax je 2f #if defined(SWTCH_OPTIM_STATS) decl _swtch_optim_stats incl _tlb_flush_count #endif movl %ecx, %cr3 2: #endif /* update common_tss.tss_esp0 pointer */ movl %esp, _common_tss + TSS_ESP0 movl $0, %esi btrl %esi, _private_tss jae 1f movl $_common_tssd, %edi /* move correct tss descriptor into GDT slot, then reload tr */ movl _tss_gdt, %ebx /* entry in GDT */ movl 0(%edi), %eax movl %eax, 0(%ebx) movl 4(%edi), %eax movl %eax, 4(%ebx) movl $GPROC0_SEL*8, %esi /* GSEL(entry, SEL_KPL) */ ltr %si 1: sti /* * XXX callers of cpu_switch() do a bogus splclock(). Locking should * be left to cpu_switch(). */ call _spl0 ALIGN_TEXT idle_loop: cli cmpl $0,_whichrtqs /* real-time queue */ CROSSJUMP(jne, sw1a, je) cmpl $0,_whichqs /* normal queue */ CROSSJUMP(jne, nortqr, je) cmpl $0,_whichidqs /* 'idle' queue */ CROSSJUMP(jne, idqr, je) call _vm_page_zero_idle testl %eax, %eax jnz idle_loop sti call *_hlt_vector /* wait for interrupt */ jmp idle_loop #endif /* SMP */ CROSSJUMPTARGET(_idle) ENTRY(default_halt) #ifndef SMP hlt /* XXX: until a wakeup IPI */ #endif ret /* * cpu_switch() */ ENTRY(cpu_switch) /* switch to new process. first, save context as needed */ movl _curproc,%ecx /* if no process to save, don't bother */ testl %ecx,%ecx je sw1 #ifdef SMP movb P_ONCPU(%ecx), %al /* save "last" cpu */ movb %al, P_LASTCPU(%ecx) movb $0xff, P_ONCPU(%ecx) /* "leave" the cpu */ #endif /* SMP */ movl P_VMSPACE(%ecx), %edx #ifdef SMP movl _cpuid, %eax #else xorl %eax, %eax #endif /* SMP */ btrl %eax, VM_PMAP+PM_ACTIVE(%edx) movl P_ADDR(%ecx),%edx movl (%esp),%eax /* Hardware registers */ movl %eax,PCB_EIP(%edx) movl %ebx,PCB_EBX(%edx) movl %esp,PCB_ESP(%edx) movl %ebp,PCB_EBP(%edx) movl %esi,PCB_ESI(%edx) movl %edi,PCB_EDI(%edx) movl %gs,PCB_GS(%edx) + /* test if debug regisers should be saved */ + movb PCB_FLAGS(%edx),%al + andb $PCB_DBREGS,%al + jz 1f /* no, skip over */ + movl %dr7,%eax /* yes, do the save */ + movl %eax,PCB_DR7(%edx) + andl $0x0000ff00, %eax /* disable all watchpoints */ + movl %eax,%dr7 + movl %dr6,%eax + movl %eax,PCB_DR6(%edx) + movl %dr3,%eax + movl %eax,PCB_DR3(%edx) + movl %dr2,%eax + movl %eax,PCB_DR2(%edx) + movl %dr1,%eax + movl %eax,PCB_DR1(%edx) + movl %dr0,%eax + movl %eax,PCB_DR0(%edx) +1: + #ifdef SMP movl _mp_lock, %eax /* XXX FIXME: we should be saving the local APIC TPR */ #ifdef DIAGNOSTIC cmpl $FREE_LOCK, %eax /* is it free? */ je badsw4 /* yes, bad medicine! */ #endif /* DIAGNOSTIC */ andl $COUNT_FIELD, %eax /* clear CPU portion */ movl %eax, PCB_MPNEST(%edx) /* store it */ #endif /* SMP */ #if NNPX > 0 /* have we used fp, and need a save? */ cmpl %ecx,_npxproc jne 1f addl $PCB_SAVEFPU,%edx /* h/w bugs make saving complicated */ pushl %edx call _npxsave /* do it in a big C function */ popl %eax 1: #endif /* NNPX > 0 */ movl $0,_curproc /* out of process */ /* save is done, now choose a new process or idle */ sw1: cli #ifdef SMP /* Stop scheduling if smp_active goes zero and we are not BSP */ cmpl $0,_smp_active jne 1f cmpl $0,_cpuid je 1f CROSSJUMP(je, _idle, jne) /* wind down */ 1: #endif sw1a: movl _whichrtqs,%edi /* pick next p. from rtqs */ testl %edi,%edi jz nortqr /* no realtime procs */ /* XXX - bsf is sloow */ bsfl %edi,%ebx /* find a full q */ jz nortqr /* no proc on rt q - try normal ... */ /* XX update whichqs? */ btrl %ebx,%edi /* clear q full status */ leal _rtqs(,%ebx,8),%eax /* select q */ movl %eax,%esi movl P_FORW(%eax),%ecx /* unlink from front of process q */ movl P_FORW(%ecx),%edx movl %edx,P_FORW(%eax) movl P_BACK(%ecx),%eax movl %eax,P_BACK(%edx) cmpl P_FORW(%ecx),%esi /* q empty */ je rt3 btsl %ebx,%edi /* nope, set to indicate not empty */ rt3: movl %edi,_whichrtqs /* update q status */ jmp swtch_com /* old sw1a */ /* Normal process priority's */ nortqr: movl _whichqs,%edi 2: /* XXX - bsf is sloow */ bsfl %edi,%ebx /* find a full q */ jz idqr /* if none, idle */ /* XX update whichqs? */ btrl %ebx,%edi /* clear q full status */ leal _qs(,%ebx,8),%eax /* select q */ movl %eax,%esi movl P_FORW(%eax),%ecx /* unlink from front of process q */ movl P_FORW(%ecx),%edx movl %edx,P_FORW(%eax) movl P_BACK(%ecx),%eax movl %eax,P_BACK(%edx) cmpl P_FORW(%ecx),%esi /* q empty */ je 3f btsl %ebx,%edi /* nope, set to indicate not empty */ 3: movl %edi,_whichqs /* update q status */ jmp swtch_com idqr: /* was sw1a */ movl _whichidqs,%edi /* pick next p. from idqs */ /* XXX - bsf is sloow */ bsfl %edi,%ebx /* find a full q */ CROSSJUMP(je, _idle, jne) /* if no proc, idle */ /* XX update whichqs? */ btrl %ebx,%edi /* clear q full status */ leal _idqs(,%ebx,8),%eax /* select q */ movl %eax,%esi movl P_FORW(%eax),%ecx /* unlink from front of process q */ movl P_FORW(%ecx),%edx movl %edx,P_FORW(%eax) movl P_BACK(%ecx),%eax movl %eax,P_BACK(%edx) cmpl P_FORW(%ecx),%esi /* q empty */ je id3 btsl %ebx,%edi /* nope, set to indicate not empty */ id3: movl %edi,_whichidqs /* update q status */ swtch_com: movl $0,%eax movl %eax,_want_resched #ifdef DIAGNOSTIC cmpl %eax,P_WCHAN(%ecx) jne badsw1 cmpb $SRUN,P_STAT(%ecx) jne badsw2 #endif movl %eax,P_BACK(%ecx) /* isolate process to run */ movl P_ADDR(%ecx),%edx #if defined(SWTCH_OPTIM_STATS) incl _swtch_optim_stats #endif /* switch address space */ movl %cr3,%ebx cmpl PCB_CR3(%edx),%ebx je 4f #if defined(SWTCH_OPTIM_STATS) decl _swtch_optim_stats incl _tlb_flush_count #endif movl PCB_CR3(%edx),%ebx movl %ebx,%cr3 4: #ifdef SMP movl _cpuid, %esi #else xorl %esi, %esi #endif cmpl $0, PCB_EXT(%edx) /* has pcb extension? */ je 1f btsl %esi, _private_tss /* mark use of private tss */ movl PCB_EXT(%edx), %edi /* new tss descriptor */ jmp 2f 1: /* update common_tss.tss_esp0 pointer */ movl %edx, %ebx /* pcb */ addl $(UPAGES * PAGE_SIZE - 16), %ebx movl %ebx, _common_tss + TSS_ESP0 btrl %esi, _private_tss jae 3f #ifdef SMP movl $gd_common_tssd, %edi addl %fs:0, %edi #else movl $_common_tssd, %edi #endif 2: /* move correct tss descriptor into GDT slot, then reload tr */ movl _tss_gdt, %ebx /* entry in GDT */ movl 0(%edi), %eax movl %eax, 0(%ebx) movl 4(%edi), %eax movl %eax, 4(%ebx) movl $GPROC0_SEL*8, %esi /* GSEL(entry, SEL_KPL) */ ltr %si 3: movl P_VMSPACE(%ecx), %ebx #ifdef SMP movl _cpuid, %eax #else xorl %eax, %eax #endif btsl %eax, VM_PMAP+PM_ACTIVE(%ebx) /* restore context */ movl PCB_EBX(%edx),%ebx movl PCB_ESP(%edx),%esp movl PCB_EBP(%edx),%ebp movl PCB_ESI(%edx),%esi movl PCB_EDI(%edx),%edi movl PCB_EIP(%edx),%eax movl %eax,(%esp) #ifdef SMP #ifdef GRAB_LOPRIO /* hold LOPRIO for INTs */ #ifdef CHEAP_TPR movl $0, lapic_tpr #else andl $~APIC_TPR_PRIO, lapic_tpr #endif /** CHEAP_TPR */ #endif /** GRAB_LOPRIO */ movl _cpuid,%eax movb %al, P_ONCPU(%ecx) #endif /* SMP */ movl %edx, _curpcb movl %ecx, _curproc /* into next process */ #ifdef SMP movl _cpu_lockid, %eax orl PCB_MPNEST(%edx), %eax /* add next count from PROC */ movl %eax, _mp_lock /* load the mp_lock */ /* XXX FIXME: we should be restoring the local APIC TPR */ #endif /* SMP */ #ifdef USER_LDT cmpl $0, PCB_USERLDT(%edx) jnz 1f movl __default_ldt,%eax cmpl _currentldt,%eax je 2f lldt __default_ldt movl %eax,_currentldt jmp 2f 1: pushl %edx call _set_user_ldt popl %edx 2: #endif /* This must be done after loading the user LDT. */ .globl cpu_switch_load_gs cpu_switch_load_gs: movl PCB_GS(%edx),%gs + + /* test if debug regisers should be restored */ + movb PCB_FLAGS(%edx),%al + andb $PCB_DBREGS,%al + jz 1f /* no, skip over */ + movl PCB_DR6(%edx),%eax /* yes, do the restore */ + movl %eax,%dr6 + movl PCB_DR3(%edx),%eax + movl %eax,%dr3 + movl PCB_DR2(%edx),%eax + movl %eax,%dr2 + movl PCB_DR1(%edx),%eax + movl %eax,%dr1 + movl PCB_DR0(%edx),%eax + movl %eax,%dr0 + movl PCB_DR7(%edx),%eax + movl %eax,%dr7 +1: sti ret CROSSJUMPTARGET(idqr) CROSSJUMPTARGET(nortqr) CROSSJUMPTARGET(sw1a) #ifdef DIAGNOSTIC badsw1: pushl $sw0_1 call _panic sw0_1: .asciz "cpu_switch: has wchan" badsw2: pushl $sw0_2 call _panic sw0_2: .asciz "cpu_switch: not SRUN" #endif #if defined(SMP) && defined(DIAGNOSTIC) badsw4: pushl $sw0_4 call _panic sw0_4: .asciz "cpu_switch: do not have lock" #endif /* SMP && DIAGNOSTIC */ /* * savectx(pcb) * Update pcb, saving current processor state. */ ENTRY(savectx) /* fetch PCB */ movl 4(%esp),%ecx /* caller's return address - child won't execute this routine */ movl (%esp),%eax movl %eax,PCB_EIP(%ecx) movl %ebx,PCB_EBX(%ecx) movl %esp,PCB_ESP(%ecx) movl %ebp,PCB_EBP(%ecx) movl %esi,PCB_ESI(%ecx) movl %edi,PCB_EDI(%ecx) movl %gs,PCB_GS(%ecx) #if NNPX > 0 /* * If npxproc == NULL, then the npx h/w state is irrelevant and the * state had better already be in the pcb. This is true for forks * but not for dumps (the old book-keeping with FP flags in the pcb * always lost for dumps because the dump pcb has 0 flags). * * If npxproc != NULL, then we have to save the npx h/w state to * npxproc's pcb and copy it to the requested pcb, or save to the * requested pcb and reload. Copying is easier because we would * have to handle h/w bugs for reloading. We used to lose the * parent's npx state for forks by forgetting to reload. */ movl _npxproc,%eax testl %eax,%eax je 1f pushl %ecx movl P_ADDR(%eax),%eax leal PCB_SAVEFPU(%eax),%eax pushl %eax pushl %eax call _npxsave addl $4,%esp popl %eax popl %ecx pushl $PCB_SAVEFPU_SIZE leal PCB_SAVEFPU(%ecx),%ecx pushl %ecx pushl %eax call _bcopy addl $12,%esp #endif /* NNPX > 0 */ 1: ret Index: head/sys/amd64/include/md_var.h =================================================================== --- head/sys/amd64/include/md_var.h (revision 48690) +++ head/sys/amd64/include/md_var.h (revision 48691) @@ -1,98 +1,100 @@ /*- * Copyright (c) 1995 Bruce D. Evans. * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the author nor the names of contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * - * $Id: md_var.h,v 1.28 1999/01/08 16:29:58 bde Exp $ + * $Id: md_var.h,v 1.29 1999/04/28 01:04:02 luoqi Exp $ */ #ifndef _MACHINE_MD_VAR_H_ #define _MACHINE_MD_VAR_H_ /* * Miscellaneous machine-dependent declarations. */ extern int Maxmem; extern u_int atdevbase; /* offset in virtual memory of ISA io mem */ extern void (*bcopy_vector) __P((const void *from, void *to, size_t len)); extern int busdma_swi_pending; extern int (*copyin_vector) __P((const void *udaddr, void *kaddr, size_t len)); extern int (*copyout_vector) __P((const void *kaddr, void *udaddr, size_t len)); extern u_int cpu_feature; extern u_int cpu_high; extern u_int cpu_id; extern char cpu_vendor[]; extern u_int cyrix_did; extern char kstack[]; #ifdef PC98 extern int need_pre_dma_flush; extern int need_post_dma_flush; #endif extern void (*netisrs[32]) __P((void)); extern int nfs_diskless_valid; extern void (*ovbcopy_vector) __P((const void *from, void *to, size_t len)); extern char sigcode[]; extern int szsigcode; typedef void alias_for_inthand_t __P((u_int cs, u_int ef, u_int esp, u_int ss)); struct proc; struct reg; struct fpreg; +struct dbreg; void bcopyb __P((const void *from, void *to, size_t len)); void busdma_swi __P((void)); void cpu_halt __P((void)); void cpu_reset __P((void)); void cpu_switch_load_gs __P((void)) __asm(__STRING(cpu_switch_load_gs)); void doreti_iret __P((void)) __asm(__STRING(doreti_iret)); void doreti_iret_fault __P((void)) __asm(__STRING(doreti_iret_fault)); void doreti_popl_ds __P((void)) __asm(__STRING(doreti_popl_ds)); void doreti_popl_ds_fault __P((void)) __asm(__STRING(doreti_popl_ds_fault)); void doreti_popl_es __P((void)) __asm(__STRING(doreti_popl_es)); void doreti_popl_es_fault __P((void)) __asm(__STRING(doreti_popl_es_fault)); void doreti_popl_fs __P((void)) __asm(__STRING(doreti_popl_fs)); void doreti_popl_fs_fault __P((void)) __asm(__STRING(doreti_popl_fs_fault)); int fill_fpregs __P((struct proc *, struct fpreg *)); int fill_regs __P((struct proc *p, struct reg *regs)); +int fill_dbregs __P((struct proc *p, struct dbreg *dbregs)); void fillw __P((int /*u_short*/ pat, void *base, size_t cnt)); void i486_bzero __P((void *buf, size_t len)); void i586_bcopy __P((const void *from, void *to, size_t len)); void i586_bzero __P((void *buf, size_t len)); int i586_copyin __P((const void *udaddr, void *kaddr, size_t len)); int i586_copyout __P((const void *kaddr, void *udaddr, size_t len)); void i686_pagezero __P((void *addr)); int is_physical_memory __P((vm_offset_t addr)); u_long kvtop __P((void *addr)); void setidt __P((int idx, alias_for_inthand_t *func, int typ, int dpl, int selec)); void swi_vm __P((void)); void userconfig __P((void)); int vm_page_zero_idle __P((void)); #endif /* !_MACHINE_MD_VAR_H_ */ Index: head/sys/amd64/include/pcb.h =================================================================== --- head/sys/amd64/include/pcb.h (revision 48690) +++ head/sys/amd64/include/pcb.h (revision 48691) @@ -1,89 +1,98 @@ /*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)pcb.h 5.10 (Berkeley) 5/12/91 - * $Id: pcb.h,v 1.27 1999/04/28 01:04:05 luoqi Exp $ + * $Id: pcb.h,v 1.28 1999/06/01 18:20:06 jlemon Exp $ */ #ifndef _I386_PCB_H_ #define _I386_PCB_H_ /* * Intel 386 process control block */ #include #include struct pcb { int pcb_cr3; int pcb_edi; int pcb_esi; int pcb_ebp; int pcb_esp; int pcb_ebx; int pcb_eip; + + int pcb_dr0; + int pcb_dr1; + int pcb_dr2; + int pcb_dr3; + int pcb_dr6; + int pcb_dr7; + caddr_t pcb_ldt; /* per process (user) LDT */ int pcb_ldt_len; /* number of LDT entries */ struct save87 pcb_savefpu; /* floating point state for 287/387 */ u_char pcb_flags; #define FP_SOFTFP 0x01 /* process using software fltng pnt emulator */ +#define PCB_DBREGS 0x02 /* process using debug registers */ caddr_t pcb_onfault; /* copyin/out fault recovery */ #ifdef SMP u_long pcb_mpnest; #else u_long pcb_mpnest_dontuse; #endif int pcb_gs; struct pcb_ext *pcb_ext; /* optional pcb extension */ u_long __pcb_spare[2]; /* adjust to avoid core dump size changes */ }; /* * The pcb is augmented with machine-dependent additional data for * core dumps. For the i386: ??? */ struct md_coredump { }; #ifdef KERNEL #ifndef curpcb extern struct pcb *curpcb; /* our current running pcb */ #endif void savectx __P((struct pcb *)); #endif #endif /* _I386_PCB_H_ */ Index: head/sys/amd64/include/ptrace.h =================================================================== --- head/sys/amd64/include/ptrace.h (revision 48690) +++ head/sys/amd64/include/ptrace.h (revision 48691) @@ -1,53 +1,55 @@ /* * Copyright (c) 1992, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)ptrace.h 8.1 (Berkeley) 6/11/93 - * $Id: ptrace.h,v 1.5 1997/02/22 09:35:03 peter Exp $ + * $Id: ptrace.h,v 1.6 1998/05/19 00:00:12 tegge Exp $ */ #ifndef _MACHINE_PTRACE_H_ #define _MACHINE_PTRACE_H_ /* * Machine dependent trace commands. */ #define PT_GETREGS (PT_FIRSTMACH + 1) #define PT_SETREGS (PT_FIRSTMACH + 2) #define PT_GETFPREGS (PT_FIRSTMACH + 3) #define PT_SETFPREGS (PT_FIRSTMACH + 4) +#define PT_GETDBREGS (PT_FIRSTMACH + 5) +#define PT_SETDBREGS (PT_FIRSTMACH + 6) #ifdef KERNEL int ptrace_read_u_check __P((struct proc *p, vm_offset_t off, size_t len)); #endif /* !KERNEL */ #endif Index: head/sys/amd64/include/reg.h =================================================================== --- head/sys/amd64/include/reg.h (revision 48690) +++ head/sys/amd64/include/reg.h (revision 48691) @@ -1,130 +1,143 @@ /*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)reg.h 5.5 (Berkeley) 1/18/91 - * $Id: reg.h,v 1.17 1999/04/03 22:19:59 jdp Exp $ + * $Id: reg.h,v 1.18 1999/04/28 01:04:06 luoqi Exp $ */ #ifndef _MACHINE_REG_H_ #define _MACHINE_REG_H_ /* * Indices for registers in `struct trapframe' and `struct regs'. * * This interface is deprecated. In the kernel, it is only used in FPU * emulators to convert from register numbers encoded in instructions to * register values. Everything else just accesses the relevant struct * members. In userland, debuggers tend to abuse this interface since * they don't understand that `struct regs' is a struct. I hope they have * stopped accessing the registers in the trap frame via PT_{READ,WRITE}_U * and we can stop supporting the user area soon. */ #define tFS (0) #define tES (1) #define tDS (2) #define tEDI (3) #define tESI (4) #define tEBP (5) #define tISP (6) #define tEBX (7) #define tEDX (8) #define tECX (9) #define tEAX (10) #define tERR (12) #define tEIP (13) #define tCS (14) #define tEFLAGS (15) #define tESP (16) #define tSS (17) /* * Indices for registers in `struct regs' only. * * Some registers live in the pcb and are only in an "array" with the * other registers in application interfaces that copy all the registers * to or from a `struct regs'. */ #define tGS (18) /* * Register set accessible via /proc/$pid/regs and PT_{SET,GET}REGS. */ struct reg { unsigned int r_fs; unsigned int r_es; unsigned int r_ds; unsigned int r_edi; unsigned int r_esi; unsigned int r_ebp; unsigned int r_isp; unsigned int r_ebx; unsigned int r_edx; unsigned int r_ecx; unsigned int r_eax; unsigned int r_trapno; unsigned int r_err; unsigned int r_eip; unsigned int r_cs; unsigned int r_eflags; unsigned int r_esp; unsigned int r_ss; unsigned int r_gs; }; /* * Register set accessible via /proc/$pid/fpregs. */ struct fpreg { /* * XXX should get struct from npx.h. Here we give a slightly * simplified struct. This may be too much detail. Perhaps * an array of unsigned longs is best. */ unsigned long fpr_env[7]; unsigned char fpr_acc[8][10]; unsigned long fpr_ex_sw; unsigned char fpr_pad[64]; }; +struct dbreg { + unsigned int dr0; /* debug address register 0 */ + unsigned int dr1; /* debug address register 1 */ + unsigned int dr2; /* debug address register 2 */ + unsigned int dr3; /* debug address register 3 */ + unsigned int dr4; /* reserved */ + unsigned int dr5; /* reserved */ + unsigned int dr6; /* debug status register */ + unsigned int dr7; /* debug control register */ +}; + + #ifdef KERNEL /* * XXX these interfaces are MI, so they should be declared in a MI place. */ int set_fpregs __P((struct proc *, struct fpreg *)); int set_regs __P((struct proc *p, struct reg *regs)); void setregs __P((struct proc *, u_long, u_long, u_long)); +int set_dbregs __P((struct proc *p, struct dbreg *dbregs)); #endif #endif /* !_MACHINE_REG_H_ */ Index: head/sys/conf/files =================================================================== --- head/sys/conf/files (revision 48690) +++ head/sys/conf/files (revision 48691) @@ -1,737 +1,738 @@ # # The long compile-with and dependency lines are required because of # limitations in config: backslash-newline doesn't work in strings, and # dependency lines other than the first are silently ignored. # aicasm optional ahc \ dependency "$S/dev/aic7xxx/*.[chyl]" \ compile-with "${MAKE} -f $S/dev/aic7xxx/Makefile MAKESRCPATH=$S/dev/aic7xxx" \ no-obj no-implicit-rule \ clean "aicasm aicasm_gram.c aicasm_scan.c y.tab.h" aic7xxx_{seq,reg}.h optional ahc \ compile-with "./aicasm ${INCLUDES} -o aic7xxx_seq.h -r aic7xxx_reg.h $S/dev/aic7xxx/aic7xxx.seq" \ no-obj no-implicit-rule before-depend \ clean "aic7xxx_seq.h aic7xxx_reg.h" \ dependency "$S/dev/aic7xxx/aic7xxx.{reg,seq} $S/cam/scsi/scsi_message.h aicasm" device_if.o standard \ compile-with "${NORMAL_C}" \ no-implicit-rule local device_if.c standard \ dependency "$S/kern/makedevops.pl $S/kern/device_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -c $S/kern/device_if.m" \ no-obj no-implicit-rule before-depend local \ clean "device_if.c" device_if.h standard \ dependency "$S/kern/makedevops.pl $S/kern/device_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -h $S/kern/device_if.m" \ no-obj no-implicit-rule before-depend \ clean "device_if.h" bus_if.o standard \ compile-with "${NORMAL_C}" \ no-implicit-rule local bus_if.c standard \ dependency "$S/kern/makedevops.pl $S/kern/bus_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -c $S/kern/bus_if.m" \ no-obj no-implicit-rule before-depend local \ clean "bus_if.c" bus_if.h standard \ dependency "$S/kern/makedevops.pl $S/kern/bus_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -h $S/kern/bus_if.m" \ no-obj no-implicit-rule before-depend \ clean "bus_if.h" coda/coda_namecache.c optional vcoda coda/coda_fbsd.c optional vcoda coda/coda_psdev.c optional vcoda coda/coda_subr.c optional vcoda coda/coda_venus.c optional vcoda coda/coda_vfsops.c optional vcoda coda/coda_vnops.c optional vcoda cam/cam.c optional scbus cam/cam_xpt.c optional scbus cam/cam_extend.c optional scbus cam/cam_queue.c optional scbus cam/cam_periph.c optional scbus cam/cam_sim.c optional scbus cam/scsi/scsi_all.c optional scbus cam/scsi/scsi_da.c optional da cam/scsi/scsi_pt.c optional pt cam/scsi/scsi_sa.c optional sa cam/scsi/scsi_cd.c optional cd cam/scsi/scsi_ch.c optional ch cam/scsi/scsi_pass.c optional pass cam/scsi/scsi_scan.c optional scan cam/scsi/scsi_target.c optional targ cam/scsi/scsi_targ_bh.c optional targbh ddb/db_access.c optional ddb ddb/db_kld.c optional ddb ddb/db_aout.c optional ddb ddb/db_break.c optional ddb ddb/db_command.c optional ddb ddb/db_examine.c optional ddb ddb/db_expr.c optional ddb ddb/db_input.c optional ddb ddb/db_lex.c optional ddb ddb/db_output.c optional ddb ddb/db_print.c optional ddb ddb/db_ps.c optional ddb ddb/db_run.c optional ddb ddb/db_sym.c optional ddb ddb/db_trap.c optional ddb ddb/db_variables.c optional ddb ddb/db_watch.c optional ddb ddb/db_write_cmd.c optional ddb dev/advansys/advansys.c optional adv dev/advansys/advlib.c optional adv dev/advansys/advmcode.c optional adv dev/advansys/adwcam.c optional adw dev/advansys/adwlib.c optional adw dev/advansys/adwmcode.c optional adw dev/aha/aha.c optional aha dev/aic7xxx/aic7xxx.c optional ahc \ dependency "aic7xxx_{reg,seq}.h" dev/aic7xxx/93cx6.c optional ahc dev/buslogic/bt.c optional bt dev/ccd/ccd.c optional ccd #dev/dpt/dpt_control.c optional dpt dev/dpt/dpt_scsi.c optional dpt dev/en/midway.c optional en dev/hea/eni.c optional hea dev/hea/eni_buffer.c optional hea dev/hea/eni_globals.c optional hea dev/hea/eni_if.c optional hea dev/hea/eni_init.c optional hea dev/hea/eni_intr.c optional hea dev/hea/eni_receive.c optional hea dev/hea/eni_transmit.c optional hea dev/hea/eni_vcm.c optional hea dev/hfa/fore_buffer.c optional hfa dev/hfa/fore_command.c optional hfa dev/hfa/fore_globals.c optional hfa dev/hfa/fore_if.c optional hfa dev/hfa/fore_init.c optional hfa dev/hfa/fore_intr.c optional hfa dev/hfa/fore_load.c optional hfa dev/hfa/fore_output.c optional hfa dev/hfa/fore_receive.c optional hfa dev/hfa/fore_stats.c optional hfa dev/hfa/fore_timer.c optional hfa dev/hfa/fore_transmit.c optional hfa dev/hfa/fore_vcm.c optional hfa dev/ida/ida.c optional ida dev/ida/ida_disk.c optional id dev/isp/isp_freebsd.c optional isp dev/isp/isp.c optional isp dev/pdq/pdq.c optional fea dev/pdq/pdq_ifsubr.c optional fea dev/pdq/pdq.c optional fpa dev/pdq/pdq_ifsubr.c optional fpa dev/ppbus/immio.c optional vpo dev/ppbus/if_plip.c optional plip dev/ppbus/lpbb.c optional lpbb dev/ppbus/lpt.c optional lpt dev/ppbus/ppb_base.c optional ppbus dev/ppbus/ppb_1284.c optional ppbus dev/ppbus/ppb_msq.c optional ppbus dev/ppbus/ppbconf.c optional ppbus dev/ppbus/ppi.c optional ppi dev/ppbus/pps.c optional pps dev/ppbus/vpo.c optional vpo dev/ppbus/vpoio.c optional vpo smbus_if.o optional smbus \ dependency "smbus_if.c smbus_if.h" \ compile-with "${NORMAL_C}" \ no-implicit-rule local smbus_if.c optional smbus \ dependency "$S/kern/makedevops.pl $S/dev/smbus/smbus_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -c $S/dev/smbus/smbus_if.m" \ no-obj no-implicit-rule before-depend local \ clean "smbus_if.c" smbus_if.h optional smbus \ dependency "$S/kern/makedevops.pl $S/dev/smbus/smbus_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -h $S/dev/smbus/smbus_if.m" \ no-obj no-implicit-rule before-depend \ clean "smbus_if.h" dev/smbus/smbconf.c optional smbus dev/smbus/smbus.c optional smbus dev/smbus/smb.c optional smb dev/iicbus/iicbb.c optional iicbb iicbb_if.o optional iicbb \ dependency "iicbb_if.c" \ compile-with "${NORMAL_C}" \ no-implicit-rule local iicbb_if.c optional iicbb \ dependency "$S/kern/makedevops.pl $S/dev/iicbus/iicbb_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -c $S/dev/iicbus/iicbb_if.m" \ no-obj no-implicit-rule before-depend local \ clean "iicbb_if.c" iicbb_if.h optional iicbb \ dependency "$S/kern/makedevops.pl $S/dev/iicbus/iicbb_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -h $S/dev/iicbus/iicbb_if.m" \ no-obj no-implicit-rule before-depend \ clean "iicbb_if.h" dev/iicbus/iicsmb.c optional iicsmb \ dependency "iicbus_if.h" iicbus_if.o optional iicbus \ dependency "iicbus_if.c iicbus_if.h" \ compile-with "${NORMAL_C}" \ no-implicit-rule local iicbus_if.c optional iicbus \ dependency "$S/kern/makedevops.pl $S/dev/iicbus/iicbus_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -c $S/dev/iicbus/iicbus_if.m" \ no-obj no-implicit-rule before-depend local \ clean "iicbus_if.c" iicbus_if.h optional iicbus \ dependency "$S/kern/makedevops.pl $S/dev/iicbus/iicbus_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -h $S/dev/iicbus/iicbus_if.m" \ no-obj no-implicit-rule before-depend \ clean "iicbus_if.h" dev/iicbus/iiconf.c optional iicbus dev/iicbus/iicbus.c optional iicbus dev/iicbus/if_ic.c optional ic dev/iicbus/iic.c optional iic dev/vinum/vinum.c optional vinum dev/vinum/vinumconfig.c optional vinum dev/vinum/vinumdaemon.c optional vinum dev/vinum/vinuminterrupt.c optional vinum dev/vinum/vinumio.c optional vinum dev/vinum/vinumioctl.c optional vinum dev/vinum/vinumlock.c optional vinum dev/vinum/vinummemory.c optional vinum dev/vinum/vinumparser.c optional vinum dev/vinum/vinumrequest.c optional vinum dev/vinum/vinumrevive.c optional vinum dev/vinum/vinumstate.c optional vinum dev/vinum/vinumutil.c optional vinum dev/vn/vn.c optional vn dev/vx/if_vx.c optional vx gnu/ext2fs/ext2_alloc.c optional ext2fs gnu/ext2fs/ext2_balloc.c optional ext2fs gnu/ext2fs/ext2_inode.c optional ext2fs gnu/ext2fs/ext2_inode_cnv.c optional ext2fs gnu/ext2fs/ext2_linux_balloc.c optional ext2fs gnu/ext2fs/ext2_linux_ialloc.c optional ext2fs gnu/ext2fs/ext2_lookup.c optional ext2fs gnu/ext2fs/ext2_subr.c optional ext2fs gnu/ext2fs/ext2_vfsops.c optional ext2fs gnu/ext2fs/ext2_vnops.c optional ext2fs # device drivers i4b/driver/i4b_trace.c optional i4btrc i4b/driver/i4b_rbch.c optional i4brbch i4b/driver/i4b_tel.c optional i4btel i4b/driver/i4b_ipr.c optional i4bipr i4b/driver/i4b_ctl.c optional i4bctl i4b/driver/i4b_isppp.c optional i4bisppp net/if_spppsubr.c optional sppp # needed by i4bipr net/slcompress.c optional i4bipr # tina-dd control driver i4b/tina-dd/i4b_tina_dd.c optional tina # support i4b/layer2/i4b_mbuf.c optional i4btrc # Q.921 handler i4b/layer2/i4b_l2.c optional i4bq921 i4b/layer2/i4b_l2fsm.c optional i4bq921 i4b/layer2/i4b_uframe.c optional i4bq921 i4b/layer2/i4b_tei.c optional i4bq921 i4b/layer2/i4b_sframe.c optional i4bq921 i4b/layer2/i4b_iframe.c optional i4bq921 i4b/layer2/i4b_l2timer.c optional i4bq921 i4b/layer2/i4b_util.c optional i4bq921 i4b/layer2/i4b_lme.c optional i4bq921 # Q.931 handler i4b/layer3/i4b_q931.c optional i4bq931 i4b/layer3/i4b_l3fsm.c optional i4bq931 i4b/layer3/i4b_l3timer.c optional i4bq931 i4b/layer3/i4b_l2if.c optional i4bq931 i4b/layer3/i4b_l4if.c optional i4bq931 i4b/layer3/i4b_q932fac.c optional i4bq931 # isdn device driver, interface to i4bd i4b/layer4/i4b_i4bdrv.c optional i4b i4b/layer4/i4b_l4.c optional i4b i4b/layer4/i4b_l4mgmt.c optional i4b i4b/layer4/i4b_l4timer.c optional i4b isofs/cd9660/cd9660_bmap.c optional cd9660 isofs/cd9660/cd9660_lookup.c optional cd9660 isofs/cd9660/cd9660_node.c optional cd9660 isofs/cd9660/cd9660_rrip.c optional cd9660 isofs/cd9660/cd9660_util.c optional cd9660 isofs/cd9660/cd9660_vfsops.c optional cd9660 isofs/cd9660/cd9660_vnops.c optional cd9660 kern/imgact_aout.c standard kern/imgact_elf.c standard kern/imgact_gzip.c optional gzip kern/imgact_shell.c standard kern/inflate.c optional gzip kern/init_main.c standard kern/init_sysent.c standard kern/kern_intr.c standard kern/kern_module.c standard kern/kern_linker.c standard kern/link_aout.c standard kern/link_elf.c standard kern/kern_acct.c standard kern/kern_clock.c standard kern/kern_conf.c standard kern/kern_descrip.c standard kern/kern_environment.c standard kern/kern_exec.c standard kern/kern_exit.c standard kern/kern_fork.c standard kern/kern_jail.c standard kern/kern_kthread.c standard kern/kern_ktrace.c standard kern/kern_lock.c standard kern/kern_lockf.c standard kern/kern_malloc.c standard kern/kern_mib.c standard kern/kern_ntptime.c standard kern/kern_physio.c standard kern/kern_proc.c standard kern/kern_prot.c standard kern/kern_resource.c standard kern/kern_shutdown.c standard kern/kern_sig.c standard kern/kern_subr.c standard kern/kern_synch.c standard kern/kern_syscalls.c standard kern/kern_sysctl.c standard kern/kern_time.c standard kern/kern_timeout.c standard kern/kern_xxx.c standard kern/md5c.c standard kern/subr_autoconf.c standard kern/subr_bus.c standard kern/subr_devstat.c standard kern/subr_diskslice.c standard kern/subr_dkbad.c standard kern/subr_log.c standard kern/subr_module.c standard kern/subr_prf.c standard kern/subr_prof.c standard kern/subr_blist.c standard kern/subr_scanf.c standard kern/subr_xxx.c standard kern/sys_generic.c standard kern/sys_pipe.c standard kern/sys_process.c standard kern/subr_rman.c standard kern/sys_socket.c standard kern/sysv_ipc.c standard kern/sysv_msg.c optional sysvmsg kern/sysv_sem.c optional sysvsem kern/sysv_shm.c optional sysvshm kern/tty.c standard kern/tty_compat.c standard kern/tty_conf.c standard kern/tty_pty.c optional pty kern/tty_snoop.c optional snp kern/tty_subr.c standard kern/tty_tb.c optional tb kern/tty_tty.c standard kern/uipc_domain.c standard kern/uipc_mbuf.c standard kern/uipc_proto.c standard kern/uipc_socket.c standard kern/uipc_socket2.c standard kern/uipc_syscalls.c standard kern/uipc_usrreq.c standard kern/vfs_bio.c standard kern/vfs_cache.c standard kern/vfs_cluster.c standard kern/vfs_conf.c standard kern/vfs_default.c standard kern/vfs_init.c standard kern/vfs_lookup.c standard kern/vfs_subr.c standard kern/vfs_syscalls.c standard kern/vfs_vnops.c standard kern/kern_threads.c standard kern/vfs_aio.c standard miscfs/deadfs/dead_vnops.c standard miscfs/devfs/devfs_tree.c optional devfs miscfs/devfs/devfs_vfsops.c optional devfs miscfs/devfs/devfs_vnops.c optional devfs miscfs/fdesc/fdesc_vfsops.c optional fdesc miscfs/fdesc/fdesc_vnops.c optional fdesc miscfs/fifofs/fifo_vnops.c standard miscfs/kernfs/kernfs_vfsops.c optional kernfs miscfs/kernfs/kernfs_vnops.c optional kernfs miscfs/nullfs/null_subr.c optional nullfs miscfs/nullfs/null_vfsops.c optional nullfs miscfs/nullfs/null_vnops.c optional nullfs miscfs/portal/portal_vfsops.c optional portal miscfs/portal/portal_vnops.c optional portal miscfs/procfs/procfs_ctl.c optional procfs +miscfs/procfs/procfs_dbregs.c standard miscfs/procfs/procfs_fpregs.c standard miscfs/procfs/procfs_map.c optional procfs miscfs/procfs/procfs_mem.c standard miscfs/procfs/procfs_note.c optional procfs miscfs/procfs/procfs_regs.c standard miscfs/procfs/procfs_status.c optional procfs miscfs/procfs/procfs_subr.c optional procfs miscfs/procfs/procfs_type.c optional procfs miscfs/procfs/procfs_vfsops.c optional procfs miscfs/procfs/procfs_vnops.c optional procfs miscfs/procfs/procfs_rlimit.c optional procfs miscfs/specfs/spec_vnops.c standard miscfs/umapfs/umap_subr.c optional umapfs miscfs/umapfs/umap_vfsops.c optional umapfs miscfs/umapfs/umap_vnops.c optional umapfs miscfs/union/union_subr.c optional union miscfs/union/union_vfsops.c optional union miscfs/union/union_vnops.c optional union msdosfs/msdosfs_conv.c optional msdosfs msdosfs/msdosfs_denode.c optional msdosfs msdosfs/msdosfs_fat.c optional msdosfs msdosfs/msdosfs_lookup.c optional msdosfs msdosfs/msdosfs_vfsops.c optional msdosfs msdosfs/msdosfs_vnops.c optional msdosfs ntfs/ntfs_vfsops.c optional ntfs ntfs/ntfs_vnops.c optional ntfs ntfs/ntfs_subr.c optional ntfs ntfs/ntfs_compr.c optional ntfs ntfs/ntfs_ihash.c optional ntfs net/bpf.c standard net/bpf_filter.c optional bpf net/bridge.c optional bridge net/bsd_comp.c optional ppp_bsdcomp #net/hostcache.c standard net/if.c standard net/if_atmsubr.c optional atm net/if_disc.c optional disc net/if_ethersubr.c optional ether net/if_iso88025subr.c optional token net/if_fddisubr.c optional fddi net/if_loop.c optional loop net/if_media.c standard net/if_mib.c standard net/if_ppp.c optional ppp net/if_sl.c optional sl net/if_spppsubr.c optional sppp net/if_tun.c optional tun net/if_vlan.c optional vlan net/ppp_deflate.c optional ppp_deflate net/ppp_tty.c optional ppp net/radix.c standard net/raw_cb.c standard net/raw_usrreq.c standard net/route.c standard net/rtsock.c standard net/slcompress.c optional ppp net/slcompress.c optional sl net/zlib.c optional ppp_deflate netatalk/aarp.c optional netatalk netatalk/at_control.c optional netatalk netatalk/at_proto.c optional netatalk netatalk/at_rmx.c optional netatalkdebug netatalk/ddp_input.c optional netatalk netatalk/ddp_output.c optional netatalk netatalk/ddp_usrreq.c optional netatalk netatm/atm_aal5.c optional atm_core netatm/atm_cm.c optional atm_core netatm/atm_device.c optional atm_core netatm/atm_if.c optional atm_core netatm/atm_proto.c optional atm_core netatm/atm_signal.c optional atm_core netatm/atm_socket.c optional atm_core netatm/atm_subr.c optional atm_core netatm/atm_usrreq.c optional atm_core netatm/ipatm/ipatm_event.c optional atm_ip atm_core netatm/ipatm/ipatm_if.c optional atm_ip atm_core netatm/ipatm/ipatm_input.c optional atm_ip atm_core netatm/ipatm/ipatm_load.c optional atm_ip atm_core netatm/ipatm/ipatm_output.c optional atm_ip atm_core netatm/ipatm/ipatm_usrreq.c optional atm_ip atm_core netatm/ipatm/ipatm_vcm.c optional atm_ip atm_core netatm/sigpvc/sigpvc_if.c optional atm_sigpvc atm_core netatm/sigpvc/sigpvc_subr.c optional atm_sigpvc atm_core netatm/spans/spans_arp.c optional atm_spans atm_core \ dependency "spans_xdr.h" netatm/spans/spans_cls.c optional atm_spans atm_core netatm/spans/spans_if.c optional atm_spans atm_core netatm/spans/spans_kxdr.c optional atm_spans atm_core netatm/spans/spans_msg.c optional atm_spans atm_core netatm/spans/spans_print.c optional atm_spans atm_core netatm/spans/spans_proto.c optional atm_spans atm_core netatm/spans/spans_subr.c optional atm_spans atm_core netatm/spans/spans_util.c optional atm_spans atm_core spans_xdr.h optional atm_spans atm_core \ before-depend \ dependency "$S/netatm/spans/spans_xdr.x" \ compile-with "rpcgen -h -C $S/netatm/spans/spans_xdr.x > spans_xdr.h" \ clean "spans_xdr.h" \ no-obj no-implicit-rule spans_xdr.c optional atm_spans atm_core \ before-depend \ dependency "$S/netatm/spans/spans_xdr.x" \ compile-with "rpcgen -c -C $S/netatm/spans/spans_xdr.x > spans_xdr.c" \ clean "spans_xdr.c" \ no-obj no-implicit-rule local spans_xdr.o optional atm_spans atm_core \ dependency "$S/netatm/spans/spans_xdr.x" \ compile-with "${NORMAL_C}" \ no-implicit-rule local netatm/uni/q2110_sigaa.c optional atm_uni atm_core netatm/uni/q2110_sigcpcs.c optional atm_uni atm_core netatm/uni/q2110_subr.c optional atm_uni atm_core netatm/uni/qsaal1_sigaa.c optional atm_uni atm_core netatm/uni/qsaal1_sigcpcs.c optional atm_uni atm_core netatm/uni/qsaal1_subr.c optional atm_uni atm_core netatm/uni/sscf_uni.c optional atm_uni atm_core netatm/uni/sscf_uni_lower.c optional atm_uni atm_core netatm/uni/sscf_uni_upper.c optional atm_uni atm_core netatm/uni/sscop.c optional atm_uni atm_core netatm/uni/sscop_lower.c optional atm_uni atm_core netatm/uni/sscop_pdu.c optional atm_uni atm_core netatm/uni/sscop_sigaa.c optional atm_uni atm_core netatm/uni/sscop_sigcpcs.c optional atm_uni atm_core netatm/uni/sscop_subr.c optional atm_uni atm_core netatm/uni/sscop_timer.c optional atm_uni atm_core netatm/uni/sscop_upper.c optional atm_uni atm_core netatm/uni/uni_load.c optional atm_uni atm_core netatm/uni/uniarp.c optional atm_uni atm_core netatm/uni/uniarp_cache.c optional atm_uni atm_core netatm/uni/uniarp_input.c optional atm_uni atm_core netatm/uni/uniarp_output.c optional atm_uni atm_core netatm/uni/uniarp_timer.c optional atm_uni atm_core netatm/uni/uniarp_vcm.c optional atm_uni atm_core netatm/uni/uniip.c optional atm_uni atm_core netatm/uni/unisig_decode.c optional atm_uni atm_core netatm/uni/unisig_encode.c optional atm_uni atm_core netatm/uni/unisig_if.c optional atm_uni atm_core netatm/uni/unisig_mbuf.c optional atm_uni atm_core netatm/uni/unisig_msg.c optional atm_uni atm_core netatm/uni/unisig_print.c optional atm_uni atm_core netatm/uni/unisig_proto.c optional atm_uni atm_core netatm/uni/unisig_sigmgr_state.c optional atm_uni atm_core netatm/uni/unisig_subr.c optional atm_uni atm_core netatm/uni/unisig_util.c optional atm_uni atm_core netatm/uni/unisig_vc_state.c optional atm_uni atm_core netinet/fil.c optional ipfilter inet netinet/if_atm.c optional atm netinet/if_ether.c optional ether netinet/igmp.c optional inet netinet/in.c optional inet #netinet/in_hostcache.c optional inet netinet/in_pcb.c optional inet netinet/in_proto.c optional inet netinet/in_rmx.c optional inet netinet/ip_auth.c optional ipfilter inet netinet/ip_divert.c optional ipdivert netinet/ip_dummynet.c optional dummynet netinet/ip_fil.c optional ipfilter inet netinet/ip_flow.c optional inet netinet/ip_frag.c optional ipfilter inet netinet/ip_fw.c optional ipfirewall netinet/ip_icmp.c optional inet netinet/ip_input.c optional inet netinet/ip_log.c optional ipfilter inet netinet/ip_mroute.c optional inet netinet/ip_nat.c optional ipfilter inet netinet/ip_output.c optional inet netinet/ip_proxy.c optional ipfilter inet netinet/ip_state.c optional ipfilter inet netinet/mlf_ipl.c optional ipfilter inet netinet/raw_ip.c optional inet netinet/tcp_debug.c optional tcpdebug netinet/tcp_input.c optional inet netinet/tcp_output.c optional inet netinet/tcp_subr.c optional inet netinet/tcp_timer.c optional inet netinet/tcp_usrreq.c optional inet netinet/udp_usrreq.c optional inet netipx/ipx.c optional ipx netipx/ipx_cksum.c optional ipx netipx/ipx_input.c optional ipx netipx/ipx_ip.c optional ipx netipx/ipx_outputfl.c optional ipx netipx/ipx_pcb.c optional ipx netipx/ipx_proto.c optional ipx netipx/ipx_tun.c optional ipx netipx/ipx_usrreq.c optional ipx netipx/spx_debug.c optional ipx netipx/spx_usrreq.c optional ipx netkey/key.c optional key netkey/key_debug.c optional key_debug netnatm/natm.c optional natm netnatm/natm_pcb.c optional natm netnatm/natm_proto.c optional natm netns/idp_usrreq.c optional ns netns/ns.c optional ns netns/ns_error.c optional ns netns/ns_input.c optional ns netns/ns_ip.c optional ns netns/ns_output.c optional ns netns/ns_pcb.c optional ns netns/ns_proto.c optional ns netns/spp_debug.c optional ns netns/spp_usrreq.c optional ns nfs/nfs_bio.c optional nfs nfs/nfs_node.c optional nfs nfs/nfs_nqlease.c optional nfs nfs/nfs_serv.c optional nfs nfs/nfs_socket.c optional nfs nfs/nfs_srvcache.c optional nfs nfs/nfs_subs.c optional nfs nfs/nfs_syscalls.c optional nfs nfs/nfs_vfsops.c optional nfs nfs/nfs_vnops.c optional nfs nfs/bootp_subr.c optional bootp nfs/krpc_subr.c optional bootp pccard/pccard.c optional card pccard/pccard_beep.c optional card pccard/pcic.c optional pcic pci/amd.c optional amd pci/pcic_p.c optional pcic pci pci/adv_pci.c optional adv pci pci/adw_pci.c optional adw pci pci/ahc_pci.c optional ahc pci \ dependency "aic7xxx_reg.h $S/pci/ahc_pci.c" pci/brooktree848.c optional bktr pci pci/bt848_i2c.c optional bktr pci pci/bt_pci.c optional bt pci pci/cy_pci.c optional cy pci pci/dpt_pci.c optional dpt pci pci/ida_pci.c optional ida pci pci/if_al.c optional al pci/if_ax.c optional ax pci/if_de.c optional de pci/if_ed_p.c optional ed pci pci/if_en_pci.c optional en pci pci/if_fxp.c optional fxp pci/if_lnc_p.c optional lnc pci pci/if_mx.c optional mx pci/if_pn.c optional pn pci/if_fpa.c optional fpa pci pci/if_rl.c optional rl pci/if_sr_p.c optional sr pci pci/if_ti.c optional ti pci/if_tl.c optional tl pci/if_tx.c optional tx pci/if_vr.c optional vr pci/if_vx_pci.c optional vx pci pci/if_wb.c optional wb pci/if_xl.c optional xl pci/isp_pci.c optional isp pci/intpm.c optional intpm pci/meteor.c optional meteor pci pci/ncr.c optional ncr pci/pci.c optional pci pci/pci_compat.c optional pci pci/pcisupport.c optional pci pci_if.o optional pci \ dependency "pci_if.c pci_if.h" \ compile-with "${NORMAL_C}" \ no-implicit-rule local pci_if.c optional pci \ dependency "$S/kern/makedevops.pl $S/pci/pci_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -c $S/pci/pci_if.m" \ no-obj no-implicit-rule before-depend local \ clean "pci_if.c" pci_if.h optional pci \ dependency "$S/kern/makedevops.pl $S/pci/pci_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -h $S/pci/pci_if.m" \ no-obj no-implicit-rule before-depend \ clean "pci_if.h" pci/simos.c optional simos pci/alpm.c optional alpm pci/xrpu.c optional xrpu posix4/posix4_mib.c standard posix4/p1003_1b.c standard posix4/ksched.c optional _kposix_priority_scheduling ufs/ffs/ffs_alloc.c optional ffs ufs/ffs/ffs_alloc.c optional mfs ufs/ffs/ffs_balloc.c optional ffs ufs/ffs/ffs_balloc.c optional mfs ufs/ffs/ffs_inode.c optional ffs ufs/ffs/ffs_inode.c optional mfs ufs/ffs/ffs_softdep_stub.c standard ufs/ffs/ffs_softdep.c optional softupdates ufs/ffs/ffs_subr.c optional ffs ufs/ffs/ffs_subr.c optional mfs ufs/ffs/ffs_tables.c optional ffs ufs/ffs/ffs_tables.c optional mfs ufs/ffs/ffs_vfsops.c optional ffs ufs/ffs/ffs_vfsops.c optional mfs ufs/ffs/ffs_vnops.c optional ffs ufs/ffs/ffs_vnops.c optional mfs ufs/mfs/mfs_vfsops.c optional mfs ufs/mfs/mfs_vnops.c optional mfs ufs/ufs/ufs_bmap.c standard ufs/ufs/ufs_disksubr.c standard ufs/ufs/ufs_ihash.c standard ufs/ufs/ufs_inode.c standard ufs/ufs/ufs_lookup.c standard ufs/ufs/ufs_quota.c standard ufs/ufs/ufs_vfsops.c standard ufs/ufs/ufs_vnops.c standard vm/default_pager.c standard vm/device_pager.c standard vm/swap_pager.c standard vm/vm_fault.c standard vm/vm_glue.c standard vm/vm_init.c standard vm/vm_kern.c standard vm/vm_map.c standard vm/vm_meter.c standard vm/vm_mmap.c standard vm/vm_object.c standard vm/vm_page.c standard vm/vm_pageout.c standard vm/vm_pager.c standard vm/vm_swap.c standard vm/vm_unix.c standard vm/vnode_pager.c standard vm/vm_zone.c standard dev/streams/streams.c optional streams # # USB support pci/uhci_pci.c optional uhci pci/ohci_pci.c optional ohci usb_if.o optional usb \ dependency "usb_if.c" \ compile-with "${NORMAL_C}" \ no-implicit-rule local usb_if.c optional usb \ dependency "$S/kern/makedevops.pl $S/dev/usb/usb_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -c $S/dev/usb/usb_if.m" \ no-obj no-implicit-rule before-depend local \ clean "usb_if.c" usb_if.h optional usb \ dependency "$S/kern/makedevops.pl $S/dev/usb/usb_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -h $S/dev/usb/usb_if.m" \ no-obj no-implicit-rule before-depend \ clean "usb_if.h" dev/usb/uhci.c optional uhci dev/usb/ohci.c optional ohci dev/usb/usb.c optional usb dev/usb/usbdi.c optional usb dev/usb/usbdi_util.c optional usb #dev/usb/usb_mem.c optional usb dev/usb/usb_subr.c optional usb dev/usb/usb_quirks.c optional usb dev/usb/hid.c optional usb dev/usb/ugen.c optional ugen dev/usb/uhid.c optional uhid dev/usb/ums.c optional ums dev/usb/ulpt.c optional ulpt dev/usb/ukbd.c optional ukbd dev/usb/umass.c optional umass dev/usb/uhub.c optional usb isa_if.o optional isa \ dependency "isa_if.c isa_if.h" \ compile-with "${NORMAL_C}" \ no-implicit-rule local isa_if.c optional isa \ dependency "$S/kern/makedevops.pl $S/isa/isa_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -c $S/isa/isa_if.m" \ no-obj no-implicit-rule before-depend local \ clean "isa_if.c" isa_if.h optional isa \ dependency "$S/kern/makedevops.pl $S/isa/isa_if.m" \ compile-with "perl5 $S/kern/makedevops.pl -h $S/isa/isa_if.m" \ no-obj no-implicit-rule before-depend \ clean "isa_if.h" isa/isa_common.c optional isa isa/isahint.c optional isa isa/bt_isa.c optional bt isa Index: head/sys/fs/procfs/procfs.h =================================================================== --- head/sys/fs/procfs/procfs.h (revision 48690) +++ head/sys/fs/procfs/procfs.h (revision 48691) @@ -1,168 +1,174 @@ /* * Copyright (c) 1993 Jan-Simon Pendry * Copyright (c) 1993 * The Regents of the University of California. All rights reserved. * * This code is derived from software contributed to Berkeley by * Jan-Simon Pendry. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)procfs.h 8.9 (Berkeley) 5/14/95 * * From: - * $Id: procfs.h,v 1.25 1999/05/04 08:00:10 phk Exp $ + * $Id: procfs.h,v 1.26 1999/06/13 20:53:13 phk Exp $ */ /* * The different types of node in a procfs filesystem */ typedef enum { Proot, /* the filesystem root */ Pcurproc, /* symbolic link for curproc */ Pproc, /* a process-specific sub-directory */ Pfile, /* the executable file */ Pmem, /* the process's memory image */ Pregs, /* the process's register set */ Pfpregs, /* the process's FP register set */ + Pdbregs, /* the process's debug register set */ Pctl, /* process control */ Pstatus, /* process status */ Pnote, /* process notifier */ Pnotepg, /* process group notifier */ Pmap, /* memory map */ Ptype, /* executable type */ Pcmdline, /* command line */ Prlimit /* resource limits */ } pfstype; /* * control data for the proc file system. */ struct pfsnode { struct pfsnode *pfs_next; /* next on list */ struct vnode *pfs_vnode; /* vnode associated with this pfsnode */ pfstype pfs_type; /* type of procfs node */ pid_t pfs_pid; /* associated process */ u_short pfs_mode; /* mode bits for stat() */ u_long pfs_flags; /* open flags */ u_long pfs_fileno; /* unique file id */ pid_t pfs_lockowner; /* pfs lock owner */ }; #define PROCFS_NOTELEN 64 /* max length of a note (/proc/$pid/note) */ #define PROCFS_CTLLEN 8 /* max length of a ctl msg (/proc/$pid/ctl */ #define PROCFS_NAMELEN 8 /* max length of a filename component */ /* * Kernel stuff follows */ #ifdef KERNEL #define CNEQ(cnp, s, len) \ ((cnp)->cn_namelen == (len) && \ (bcmp((s), (cnp)->cn_nameptr, (len)) == 0)) #define KMEM_GROUP 2 /* * Check to see whether access to target process is allowed * Evaluates to 1 if access is allowed. */ #define CHECKIO(p1, p2) \ (PRISON_CHECK(p1, p2) && \ ((((p1)->p_cred->pc_ucred->cr_uid == (p2)->p_cred->p_ruid) && \ ((p1)->p_cred->p_ruid == (p2)->p_cred->p_ruid) && \ ((p1)->p_cred->p_svuid == (p2)->p_cred->p_ruid) && \ ((p2)->p_flag & P_SUGID) == 0) || \ (suser_xxx(0, (p1), PRISON_ROOT) == 0))) #define PROCFS_FILENO(pid, type) \ (((type) < Pproc) ? \ ((type) + 2) : \ ((((pid)+1) << 4) + ((int) (type)))) /* * Convert between pfsnode vnode */ #define VTOPFS(vp) ((struct pfsnode *)(vp)->v_data) #define PFSTOV(pfs) ((pfs)->pfs_vnode) typedef struct vfs_namemap vfs_namemap_t; struct vfs_namemap { const char *nm_name; int nm_val; }; int vfs_getuserstr __P((struct uio *, char *, int *)); vfs_namemap_t *vfs_findname __P((vfs_namemap_t *, char *, int)); /* */ struct reg; struct fpreg; +struct dbreg; #define PFIND(pid) ((pid) ? pfind(pid) : &proc0) void procfs_exit __P((struct proc *)); int procfs_freevp __P((struct vnode *)); int procfs_allocvp __P((struct mount *, struct vnode **, long, pfstype)); struct vnode *procfs_findtextvp __P((struct proc *)); int procfs_sstep __P((struct proc *)); void procfs_fix_sstep __P((struct proc *)); int procfs_read_regs __P((struct proc *, struct reg *)); int procfs_write_regs __P((struct proc *, struct reg *)); int procfs_read_fpregs __P((struct proc *, struct fpreg *)); int procfs_write_fpregs __P((struct proc *, struct fpreg *)); +int procfs_read_dbregs __P((struct proc *, struct dbreg *)); +int procfs_write_dbregs __P((struct proc *, struct dbreg *)); int procfs_donote __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_doregs __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_dofpregs __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); +int procfs_dodbregs __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_domem __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_doctl __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_dostatus __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_domap __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_dotype __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_docmdline __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_dorlimit __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); /* Return 1 if process has special kernel digging privileges */ int procfs_kmemaccess __P((struct proc *)); /* functions to check whether or not files should be displayed */ int procfs_validfile __P((struct proc *)); int procfs_validfpregs __P((struct proc *)); int procfs_validregs __P((struct proc *)); +int procfs_validdbregs __P((struct proc *)); int procfs_validmap __P((struct proc *)); int procfs_validtype __P((struct proc *)); #define PROCFS_LOCKED 0x01 #define PROCFS_WANT 0x02 extern vop_t **procfs_vnodeop_p; int procfs_root __P((struct mount *, struct vnode **)); int procfs_rw __P((struct vop_read_args *)); #endif /* KERNEL */ Index: head/sys/fs/procfs/procfs_subr.c =================================================================== --- head/sys/fs/procfs/procfs_subr.c (revision 48690) +++ head/sys/fs/procfs/procfs_subr.c (revision 48691) @@ -1,397 +1,402 @@ /* * Copyright (c) 1993 Jan-Simon Pendry * Copyright (c) 1993 * The Regents of the University of California. All rights reserved. * * This code is derived from software contributed to Berkeley by * Jan-Simon Pendry. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)procfs_subr.c 8.6 (Berkeley) 5/14/95 * - * $Id: procfs_subr.c,v 1.23 1999/01/27 22:42:07 dillon Exp $ + * $Id: procfs_subr.c,v 1.24 1999/04/30 13:04:21 phk Exp $ */ #include #include #include #include #include #include static struct pfsnode *pfshead; static int pfsvplock; /* * allocate a pfsnode/vnode pair. the vnode is * referenced, but not locked. * * the pid, pfs_type, and mount point uniquely * identify a pfsnode. the mount point is needed * because someone might mount this filesystem * twice. * * all pfsnodes are maintained on a singly-linked * list. new nodes are only allocated when they cannot * be found on this list. entries on the list are * removed when the vfs reclaim entry is called. * * a single lock is kept for the entire list. this is * needed because the getnewvnode() function can block * waiting for a vnode to become free, in which case there * may be more than one process trying to get the same * vnode. this lock is only taken if we are going to * call getnewvnode, since the kernel itself is single-threaded. * * if an entry is found on the list, then call vget() to * take a reference. this is done because there may be * zero references to it and so it needs to removed from * the vnode free list. */ int procfs_allocvp(mp, vpp, pid, pfs_type) struct mount *mp; struct vnode **vpp; long pid; pfstype pfs_type; { struct proc *p = curproc; /* XXX */ struct pfsnode *pfs; struct vnode *vp; struct pfsnode **pp; int error; loop: for (pfs = pfshead; pfs != 0; pfs = pfs->pfs_next) { vp = PFSTOV(pfs); if (pfs->pfs_pid == pid && pfs->pfs_type == pfs_type && vp->v_mount == mp) { if (vget(vp, 0, p)) goto loop; *vpp = vp; return (0); } } /* * otherwise lock the vp list while we call getnewvnode * since that can block. */ if (pfsvplock & PROCFS_LOCKED) { pfsvplock |= PROCFS_WANT; (void) tsleep((caddr_t) &pfsvplock, PINOD, "pfsavp", 0); goto loop; } pfsvplock |= PROCFS_LOCKED; /* * Do the MALLOC before the getnewvnode since doing so afterward * might cause a bogus v_data pointer to get dereferenced * elsewhere if MALLOC should block. */ MALLOC(pfs, struct pfsnode *, sizeof(struct pfsnode), M_TEMP, M_WAITOK); if ((error = getnewvnode(VT_PROCFS, mp, procfs_vnodeop_p, vpp)) != 0) { FREE(pfs, M_TEMP); goto out; } vp = *vpp; vp->v_data = pfs; pfs->pfs_next = 0; pfs->pfs_pid = (pid_t) pid; pfs->pfs_type = pfs_type; pfs->pfs_vnode = vp; pfs->pfs_flags = 0; pfs->pfs_lockowner = 0; pfs->pfs_fileno = PROCFS_FILENO(pid, pfs_type); switch (pfs_type) { case Proot: /* /proc = dr-xr-xr-x */ pfs->pfs_mode = (VREAD|VEXEC) | (VREAD|VEXEC) >> 3 | (VREAD|VEXEC) >> 6; vp->v_type = VDIR; vp->v_flag = VROOT; break; case Pcurproc: /* /proc/curproc = lr--r--r-- */ pfs->pfs_mode = (VREAD) | (VREAD >> 3) | (VREAD >> 6); vp->v_type = VLNK; break; case Pproc: pfs->pfs_mode = (VREAD|VEXEC) | (VREAD|VEXEC) >> 3 | (VREAD|VEXEC) >> 6; vp->v_type = VDIR; break; case Pfile: case Pmem: pfs->pfs_mode = (VREAD|VWRITE) | (VREAD) >> 3;; vp->v_type = VREG; break; case Pregs: case Pfpregs: + case Pdbregs: pfs->pfs_mode = (VREAD|VWRITE); vp->v_type = VREG; break; case Pctl: case Pnote: case Pnotepg: pfs->pfs_mode = (VWRITE); vp->v_type = VREG; break; case Ptype: case Pmap: case Pstatus: case Pcmdline: case Prlimit: pfs->pfs_mode = (VREAD) | (VREAD >> 3) | (VREAD >> 6); vp->v_type = VREG; break; default: panic("procfs_allocvp"); } /* add to procfs vnode list */ for (pp = &pfshead; *pp; pp = &(*pp)->pfs_next) continue; *pp = pfs; out: pfsvplock &= ~PROCFS_LOCKED; if (pfsvplock & PROCFS_WANT) { pfsvplock &= ~PROCFS_WANT; wakeup((caddr_t) &pfsvplock); } return (error); } int procfs_freevp(vp) struct vnode *vp; { struct pfsnode **pfspp; struct pfsnode *pfs = VTOPFS(vp); for (pfspp = &pfshead; *pfspp != 0; pfspp = &(*pfspp)->pfs_next) { if (*pfspp == pfs) { *pfspp = pfs->pfs_next; break; } } FREE(vp->v_data, M_TEMP); vp->v_data = 0; return (0); } int procfs_rw(ap) struct vop_read_args *ap; { struct vnode *vp = ap->a_vp; struct uio *uio = ap->a_uio; struct proc *curp = uio->uio_procp; struct pfsnode *pfs = VTOPFS(vp); struct proc *p; int rtval; p = PFIND(pfs->pfs_pid); if (p == 0) return (EINVAL); if (p->p_pid == 1 && securelevel > 0 && uio->uio_rw == UIO_WRITE) return (EACCES); while (pfs->pfs_lockowner) { tsleep(&pfs->pfs_lockowner, PRIBIO, "pfslck", 0); } pfs->pfs_lockowner = curproc->p_pid; switch (pfs->pfs_type) { case Pnote: case Pnotepg: rtval = procfs_donote(curp, p, pfs, uio); break; case Pregs: rtval = procfs_doregs(curp, p, pfs, uio); break; case Pfpregs: rtval = procfs_dofpregs(curp, p, pfs, uio); break; + + case Pdbregs: + rtval = procfs_dodbregs(curp, p, pfs, uio); + break; case Pctl: rtval = procfs_doctl(curp, p, pfs, uio); break; case Pstatus: rtval = procfs_dostatus(curp, p, pfs, uio); break; case Pmap: rtval = procfs_domap(curp, p, pfs, uio); break; case Pmem: rtval = procfs_domem(curp, p, pfs, uio); break; case Ptype: rtval = procfs_dotype(curp, p, pfs, uio); break; case Pcmdline: rtval = procfs_docmdline(curp, p, pfs, uio); break; case Prlimit: rtval = procfs_dorlimit(curp, p, pfs, uio); break; default: rtval = EOPNOTSUPP; break; } pfs->pfs_lockowner = 0; wakeup(&pfs->pfs_lockowner); return rtval; } /* * Get a string from userland into (buf). Strip a trailing * nl character (to allow easy access from the shell). * The buffer should be *buflenp + 1 chars long. vfs_getuserstr * will automatically add a nul char at the end. * * Returns 0 on success or the following errors * * EINVAL: file offset is non-zero. * EMSGSIZE: message is longer than kernel buffer * EFAULT: user i/o buffer is not addressable */ int vfs_getuserstr(uio, buf, buflenp) struct uio *uio; char *buf; int *buflenp; { int xlen; int error; if (uio->uio_offset != 0) return (EINVAL); xlen = *buflenp; /* must be able to read the whole string in one go */ if (xlen < uio->uio_resid) return (EMSGSIZE); xlen = uio->uio_resid; if ((error = uiomove(buf, xlen, uio)) != 0) return (error); /* allow multiple writes without seeks */ uio->uio_offset = 0; /* cleanup string and remove trailing newline */ buf[xlen] = '\0'; xlen = strlen(buf); if (xlen > 0 && buf[xlen-1] == '\n') buf[--xlen] = '\0'; *buflenp = xlen; return (0); } vfs_namemap_t * vfs_findname(nm, buf, buflen) vfs_namemap_t *nm; char *buf; int buflen; { for (; nm->nm_name; nm++) if (bcmp(buf, nm->nm_name, buflen+1) == 0) return (nm); return (0); } void procfs_exit(struct proc *p) { struct pfsnode *pfs; pid_t pid = p->p_pid; /* * The reason for this loop is not obvious -- basicly, * procfs_freevp(), which is called via vgone() (eventually), * removes the specified procfs node from the pfshead list. * It does this by *pfsp = pfs->pfs_next, meaning that it * overwrites the node. So when we do pfs = pfs->next, we * end up skipping the node that replaces the one that was * vgone'd. Since it may have been the last one on the list, * it may also have been set to null -- but *our* pfs pointer, * here, doesn't see this. So the loop starts from the beginning * again. * * This is not a for() loop because the final event * would be "pfs = pfs->pfs_next"; in the case where * pfs is set to pfshead again, that would mean that * pfshead is skipped over. * */ pfs = pfshead; while (pfs) { if (pfs->pfs_pid == pid) { vgone(PFSTOV(pfs)); pfs = pfshead; } else pfs = pfs->pfs_next; } } Index: head/sys/fs/procfs/procfs_vnops.c =================================================================== --- head/sys/fs/procfs/procfs_vnops.c (revision 48690) +++ head/sys/fs/procfs/procfs_vnops.c (revision 48691) @@ -1,1024 +1,1030 @@ /* * Copyright (c) 1993, 1995 Jan-Simon Pendry * Copyright (c) 1993, 1995 * The Regents of the University of California. All rights reserved. * * This code is derived from software contributed to Berkeley by * Jan-Simon Pendry. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)procfs_vnops.c 8.18 (Berkeley) 5/21/95 * - * $Id: procfs_vnops.c,v 1.68 1999/05/04 08:01:55 phk Exp $ + * $Id: procfs_vnops.c,v 1.69 1999/06/13 20:53:16 phk Exp $ */ /* * procfs vnode interface */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include static int procfs_abortop __P((struct vop_abortop_args *)); static int procfs_access __P((struct vop_access_args *)); static int procfs_badop __P((void)); static int procfs_bmap __P((struct vop_bmap_args *)); static int procfs_close __P((struct vop_close_args *)); static int procfs_getattr __P((struct vop_getattr_args *)); static int procfs_inactive __P((struct vop_inactive_args *)); static int procfs_ioctl __P((struct vop_ioctl_args *)); static int procfs_lookup __P((struct vop_lookup_args *)); static int procfs_open __P((struct vop_open_args *)); static int procfs_print __P((struct vop_print_args *)); static int procfs_readdir __P((struct vop_readdir_args *)); static int procfs_readlink __P((struct vop_readlink_args *)); static int procfs_reclaim __P((struct vop_reclaim_args *)); static int procfs_setattr __P((struct vop_setattr_args *)); /* * This is a list of the valid names in the * process-specific sub-directories. It is * used in procfs_lookup and procfs_readdir */ static struct proc_target { u_char pt_type; u_char pt_namlen; char *pt_name; pfstype pt_pfstype; int (*pt_valid) __P((struct proc *p)); } proc_targets[] = { #define N(s) sizeof(s)-1, s /* name type validp */ { DT_DIR, N("."), Pproc, NULL }, { DT_DIR, N(".."), Proot, NULL }, { DT_REG, N("file"), Pfile, procfs_validfile }, { DT_REG, N("mem"), Pmem, NULL }, { DT_REG, N("regs"), Pregs, procfs_validregs }, { DT_REG, N("fpregs"), Pfpregs, procfs_validfpregs }, + { DT_REG, N("dbregs"), Pdbregs, procfs_validdbregs }, { DT_REG, N("ctl"), Pctl, NULL }, { DT_REG, N("status"), Pstatus, NULL }, { DT_REG, N("note"), Pnote, NULL }, { DT_REG, N("notepg"), Pnotepg, NULL }, { DT_REG, N("map"), Pmap, procfs_validmap }, { DT_REG, N("etype"), Ptype, procfs_validtype }, { DT_REG, N("cmdline"), Pcmdline, NULL }, { DT_REG, N("rlimit"), Prlimit, NULL }, #undef N }; static const int nproc_targets = sizeof(proc_targets) / sizeof(proc_targets[0]); static pid_t atopid __P((const char *, u_int)); /* * set things up for doing i/o on * the pfsnode (vp). (vp) is locked * on entry, and should be left locked * on exit. * * for procfs we don't need to do anything * in particular for i/o. all that is done * is to support exclusive open on process * memory images. */ static int procfs_open(ap) struct vop_open_args /* { struct vnode *a_vp; int a_mode; struct ucred *a_cred; struct proc *a_p; } */ *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); struct proc *p1, *p2; p2 = PFIND(pfs->pfs_pid); if (p2 == NULL) return (ENOENT); if (!PRISON_CHECK(ap->a_p, p2)) return (ENOENT); switch (pfs->pfs_type) { case Pmem: if (((pfs->pfs_flags & FWRITE) && (ap->a_mode & O_EXCL)) || ((pfs->pfs_flags & O_EXCL) && (ap->a_mode & FWRITE))) return (EBUSY); p1 = ap->a_p; if (!CHECKIO(p1, p2) && !procfs_kmemaccess(p1)) return (EPERM); if (ap->a_mode & FWRITE) pfs->pfs_flags = ap->a_mode & (FWRITE|O_EXCL); return (0); default: break; } return (0); } /* * close the pfsnode (vp) after doing i/o. * (vp) is not locked on entry or exit. * * nothing to do for procfs other than undo * any exclusive open flag (see _open above). */ static int procfs_close(ap) struct vop_close_args /* { struct vnode *a_vp; int a_fflag; struct ucred *a_cred; struct proc *a_p; } */ *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); struct proc *p; switch (pfs->pfs_type) { case Pmem: if ((ap->a_fflag & FWRITE) && (pfs->pfs_flags & O_EXCL)) pfs->pfs_flags &= ~(FWRITE|O_EXCL); /* * This rather complicated-looking code is trying to * determine if this was the last close on this particular * vnode. While one would expect v_usecount to be 1 at * that point, it seems that (according to John Dyson) * the VM system will bump up the usecount. So: if the * usecount is 2, and VOBJBUF is set, then this is really * the last close. Otherwise, if the usecount is < 2 * then it is definitely the last close. * If this is the last close, then it checks to see if * the target process has PF_LINGER set in p_pfsflags, * if this is *not* the case, then the process' stop flags * are cleared, and the process is woken up. This is * to help prevent the case where a process has been * told to stop on an event, but then the requesting process * has gone away or forgotten about it. */ if ((ap->a_vp->v_usecount < 2) && (p = pfind(pfs->pfs_pid)) && !(p->p_pfsflags & PF_LINGER)) { p->p_stops = 0; p->p_step = 0; wakeup(&p->p_step); } break; default: break; } return (0); } /* * do an ioctl operation on a pfsnode (vp). * (vp) is not locked on entry or exit. */ static int procfs_ioctl(ap) struct vop_ioctl_args *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); struct proc *procp, *p; int error; int signo; struct procfs_status *psp; unsigned char flags; p = ap->a_p; procp = pfind(pfs->pfs_pid); if (procp == NULL) { return ENOTTY; } if (!CHECKIO(p, procp)) return EPERM; switch (ap->a_command) { case PIOCBIS: procp->p_stops |= *(unsigned int*)ap->a_data; break; case PIOCBIC: procp->p_stops &= ~*(unsigned int*)ap->a_data; break; case PIOCSFL: /* * NFLAGS is "non-suser_xxx flags" -- currently, only * PFS_ISUGID ("ignore set u/g id"); */ #define NFLAGS (PF_ISUGID) flags = (unsigned char)*(unsigned int*)ap->a_data; if (flags & NFLAGS && (error = suser(p))) return error; procp->p_pfsflags = flags; break; case PIOCGFL: *(unsigned int*)ap->a_data = (unsigned int)procp->p_pfsflags; case PIOCSTATUS: psp = (struct procfs_status *)ap->a_data; psp->state = (procp->p_step == 0); psp->flags = procp->p_pfsflags; psp->events = procp->p_stops; if (procp->p_step) { psp->why = procp->p_stype; psp->val = procp->p_xstat; } else { psp->why = psp->val = 0; /* Not defined values */ } break; case PIOCWAIT: psp = (struct procfs_status *)ap->a_data; if (procp->p_step == 0) { error = tsleep(&procp->p_stype, PWAIT | PCATCH, "piocwait", 0); if (error) return error; } psp->state = 1; /* It stopped */ psp->flags = procp->p_pfsflags; psp->events = procp->p_stops; psp->why = procp->p_stype; /* why it stopped */ psp->val = procp->p_xstat; /* any extra info */ break; case PIOCCONT: /* Restart a proc */ if (procp->p_step == 0) return EINVAL; /* Can only start a stopped process */ if ((signo = *(int*)ap->a_data) != 0) { if (signo >= NSIG || signo <= 0) return EINVAL; psignal(procp, signo); } procp->p_step = 0; wakeup(&procp->p_step); break; default: return (ENOTTY); } return 0; } /* * do block mapping for pfsnode (vp). * since we don't use the buffer cache * for procfs this function should never * be called. in any case, it's not clear * what part of the kernel ever makes use * of this function. for sanity, this is the * usual no-op bmap, although returning * (EIO) would be a reasonable alternative. */ static int procfs_bmap(ap) struct vop_bmap_args /* { struct vnode *a_vp; daddr_t a_bn; struct vnode **a_vpp; daddr_t *a_bnp; int *a_runp; } */ *ap; { if (ap->a_vpp != NULL) *ap->a_vpp = ap->a_vp; if (ap->a_bnp != NULL) *ap->a_bnp = ap->a_bn; if (ap->a_runp != NULL) *ap->a_runp = 0; return (0); } /* * procfs_inactive is called when the pfsnode * is vrele'd and the reference count goes * to zero. (vp) will be on the vnode free * list, so to get it back vget() must be * used. * * (vp) is locked on entry, but must be unlocked on exit. */ static int procfs_inactive(ap) struct vop_inactive_args /* { struct vnode *a_vp; } */ *ap; { struct vnode *vp = ap->a_vp; VOP_UNLOCK(vp, 0, ap->a_p); return (0); } /* * _reclaim is called when getnewvnode() * wants to make use of an entry on the vnode * free list. at this time the filesystem needs * to free any private data and remove the node * from any private lists. */ static int procfs_reclaim(ap) struct vop_reclaim_args /* { struct vnode *a_vp; } */ *ap; { return (procfs_freevp(ap->a_vp)); } /* * _print is used for debugging. * just print a readable description * of (vp). */ static int procfs_print(ap) struct vop_print_args /* { struct vnode *a_vp; } */ *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); printf("tag VT_PROCFS, type %d, pid %ld, mode %x, flags %lx\n", pfs->pfs_type, (long)pfs->pfs_pid, pfs->pfs_mode, pfs->pfs_flags); return (0); } /* * _abortop is called when operations such as * rename and create fail. this entry is responsible * for undoing any side-effects caused by the lookup. * this will always include freeing the pathname buffer. */ static int procfs_abortop(ap) struct vop_abortop_args /* { struct vnode *a_dvp; struct componentname *a_cnp; } */ *ap; { if ((ap->a_cnp->cn_flags & (HASBUF | SAVESTART)) == HASBUF) zfree(namei_zone, ap->a_cnp->cn_pnbuf); return (0); } /* * generic entry point for unsupported operations */ static int procfs_badop() { return (EIO); } /* * Invent attributes for pfsnode (vp) and store * them in (vap). * Directories lengths are returned as zero since * any real length would require the genuine size * to be computed, and nothing cares anyway. * * this is relatively minimal for procfs. */ static int procfs_getattr(ap) struct vop_getattr_args /* { struct vnode *a_vp; struct vattr *a_vap; struct ucred *a_cred; struct proc *a_p; } */ *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); struct vattr *vap = ap->a_vap; struct proc *procp; int error; /* * First make sure that the process and its credentials * still exist. */ switch (pfs->pfs_type) { case Proot: case Pcurproc: procp = 0; break; default: procp = PFIND(pfs->pfs_pid); if (procp == 0 || procp->p_cred == NULL || procp->p_ucred == NULL) return (ENOENT); } error = 0; /* start by zeroing out the attributes */ VATTR_NULL(vap); /* next do all the common fields */ vap->va_type = ap->a_vp->v_type; vap->va_mode = pfs->pfs_mode; vap->va_fileid = pfs->pfs_fileno; vap->va_flags = 0; vap->va_blocksize = PAGE_SIZE; vap->va_bytes = vap->va_size = 0; /* * Make all times be current TOD. * It would be possible to get the process start * time from the p_stat structure, but there's * no "file creation" time stamp anyway, and the * p_stat structure is not addressible if u. gets * swapped out for that process. */ nanotime(&vap->va_ctime); vap->va_atime = vap->va_mtime = vap->va_ctime; /* * If the process has exercised some setuid or setgid * privilege, then rip away read/write permission so * that only root can gain access. */ switch (pfs->pfs_type) { case Pctl: case Pregs: case Pfpregs: + case Pdbregs: if (procp->p_flag & P_SUGID) vap->va_mode &= ~((VREAD|VWRITE)| ((VREAD|VWRITE)>>3)| ((VREAD|VWRITE)>>6)); break; case Pmem: /* Retain group kmem readablity. */ if (procp->p_flag & P_SUGID) vap->va_mode &= ~(VREAD|VWRITE); break; default: break; } /* * now do the object specific fields * * The size could be set from struct reg, but it's hardly * worth the trouble, and it puts some (potentially) machine * dependent data into this machine-independent code. If it * becomes important then this function should break out into * a per-file stat function in the corresponding .c file. */ vap->va_nlink = 1; if (procp) { vap->va_uid = procp->p_ucred->cr_uid; vap->va_gid = procp->p_ucred->cr_gid; } switch (pfs->pfs_type) { case Proot: /* * Set nlink to 1 to tell fts(3) we don't actually know. */ vap->va_nlink = 1; vap->va_uid = 0; vap->va_gid = 0; vap->va_size = vap->va_bytes = DEV_BSIZE; break; case Pcurproc: { char buf[16]; /* should be enough */ vap->va_uid = 0; vap->va_gid = 0; vap->va_size = vap->va_bytes = snprintf(buf, sizeof(buf), "%ld", (long)curproc->p_pid); break; } case Pproc: vap->va_nlink = nproc_targets; vap->va_size = vap->va_bytes = DEV_BSIZE; break; case Pfile: error = EOPNOTSUPP; break; case Pmem: /* * If we denied owner access earlier, then we have to * change the owner to root - otherwise 'ps' and friends * will break even though they are setgid kmem. *SIGH* */ if (procp->p_flag & P_SUGID) vap->va_uid = 0; else vap->va_uid = procp->p_ucred->cr_uid; vap->va_gid = KMEM_GROUP; break; case Pregs: vap->va_bytes = vap->va_size = sizeof(struct reg); break; case Pfpregs: vap->va_bytes = vap->va_size = sizeof(struct fpreg); break; + + case Pdbregs: + vap->va_bytes = vap->va_size = sizeof(struct dbreg); + break; case Ptype: case Pmap: case Pctl: case Pstatus: case Pnote: case Pnotepg: case Pcmdline: case Prlimit: break; default: panic("procfs_getattr"); } return (error); } static int procfs_setattr(ap) struct vop_setattr_args /* { struct vnode *a_vp; struct vattr *a_vap; struct ucred *a_cred; struct proc *a_p; } */ *ap; { if (ap->a_vap->va_flags != VNOVAL) return (EOPNOTSUPP); /* * just fake out attribute setting * it's not good to generate an error * return, otherwise things like creat() * will fail when they try to set the * file length to 0. worse, this means * that echo $note > /proc/$pid/note will fail. */ return (0); } /* * implement access checking. * * something very similar to this code is duplicated * throughout the 4bsd kernel and should be moved * into kern/vfs_subr.c sometime. * * actually, the check for super-user is slightly * broken since it will allow read access to write-only * objects. this doesn't cause any particular trouble * but does mean that the i/o entry points need to check * that the operation really does make sense. */ static int procfs_access(ap) struct vop_access_args /* { struct vnode *a_vp; int a_mode; struct ucred *a_cred; struct proc *a_p; } */ *ap; { struct vattr *vap; struct vattr vattr; int error; /* * If you're the super-user, * you always get access. */ if (ap->a_cred->cr_uid == 0) return (0); vap = &vattr; error = VOP_GETATTR(ap->a_vp, vap, ap->a_cred, ap->a_p); if (error) return (error); /* * Access check is based on only one of owner, group, public. * If not owner, then check group. If not a member of the * group, then check public access. */ if (ap->a_cred->cr_uid != vap->va_uid) { gid_t *gp; int i; ap->a_mode >>= 3; gp = ap->a_cred->cr_groups; for (i = 0; i < ap->a_cred->cr_ngroups; i++, gp++) if (vap->va_gid == *gp) goto found; ap->a_mode >>= 3; found: ; } if ((vap->va_mode & ap->a_mode) == ap->a_mode) return (0); return (EACCES); } /* * lookup. this is incredibly complicated in the * general case, however for most pseudo-filesystems * very little needs to be done. * * unless you want to get a migraine, just make sure your * filesystem doesn't do any locking of its own. otherwise * read and inwardly digest ufs_lookup(). */ static int procfs_lookup(ap) struct vop_lookup_args /* { struct vnode * a_dvp; struct vnode ** a_vpp; struct componentname * a_cnp; } */ *ap; { struct componentname *cnp = ap->a_cnp; struct vnode **vpp = ap->a_vpp; struct vnode *dvp = ap->a_dvp; char *pname = cnp->cn_nameptr; struct proc *curp = cnp->cn_proc; struct proc_target *pt; struct vnode *fvp; pid_t pid; struct pfsnode *pfs; struct proc *p; int i; *vpp = NULL; if (cnp->cn_nameiop == DELETE || cnp->cn_nameiop == RENAME) return (EROFS); if (cnp->cn_namelen == 1 && *pname == '.') { *vpp = dvp; VREF(dvp); /* vn_lock(dvp, LK_EXCLUSIVE | LK_RETRY, curp); */ return (0); } pfs = VTOPFS(dvp); switch (pfs->pfs_type) { case Proot: if (cnp->cn_flags & ISDOTDOT) return (EIO); if (CNEQ(cnp, "curproc", 7)) return (procfs_allocvp(dvp->v_mount, vpp, 0, Pcurproc)); pid = atopid(pname, cnp->cn_namelen); if (pid == NO_PID) break; p = PFIND(pid); if (p == 0) break; return (procfs_allocvp(dvp->v_mount, vpp, pid, Pproc)); case Pproc: if (cnp->cn_flags & ISDOTDOT) return (procfs_root(dvp->v_mount, vpp)); p = PFIND(pfs->pfs_pid); if (p == 0) break; for (pt = proc_targets, i = 0; i < nproc_targets; pt++, i++) { if (cnp->cn_namelen == pt->pt_namlen && bcmp(pt->pt_name, pname, cnp->cn_namelen) == 0 && (pt->pt_valid == NULL || (*pt->pt_valid)(p))) goto found; } break; found: if (pt->pt_pfstype == Pfile) { fvp = procfs_findtextvp(p); /* We already checked that it exists. */ VREF(fvp); vn_lock(fvp, LK_EXCLUSIVE | LK_RETRY, curp); *vpp = fvp; return (0); } return (procfs_allocvp(dvp->v_mount, vpp, pfs->pfs_pid, pt->pt_pfstype)); default: return (ENOTDIR); } return (cnp->cn_nameiop == LOOKUP ? ENOENT : EROFS); } /* * Does this process have a text file? */ int procfs_validfile(p) struct proc *p; { return (procfs_findtextvp(p) != NULLVP); } /* * readdir() returns directory entries from pfsnode (vp). * * We generate just one directory entry at a time, as it would probably * not pay off to buffer several entries locally to save uiomove calls. */ static int procfs_readdir(ap) struct vop_readdir_args /* { struct vnode *a_vp; struct uio *a_uio; struct ucred *a_cred; int *a_eofflag; int *a_ncookies; u_long **a_cookies; } */ *ap; { struct uio *uio = ap->a_uio; struct dirent d; struct dirent *dp = &d; struct pfsnode *pfs; int count, error, i, off; static u_int delen; if (!delen) { d.d_namlen = PROCFS_NAMELEN; delen = GENERIC_DIRSIZ(&d); } pfs = VTOPFS(ap->a_vp); off = (int)uio->uio_offset; if (off != uio->uio_offset || off < 0 || off % delen != 0 || uio->uio_resid < delen) return (EINVAL); error = 0; count = 0; i = off / delen; switch (pfs->pfs_type) { /* * this is for the process-specific sub-directories. * all that is needed to is copy out all the entries * from the procent[] table (top of this file). */ case Pproc: { struct proc *p; struct proc_target *pt; p = PFIND(pfs->pfs_pid); if (p == NULL) break; if (!PRISON_CHECK(curproc, p)) break; for (pt = &proc_targets[i]; uio->uio_resid >= delen && i < nproc_targets; pt++, i++) { if (pt->pt_valid && (*pt->pt_valid)(p) == 0) continue; dp->d_reclen = delen; dp->d_fileno = PROCFS_FILENO(pfs->pfs_pid, pt->pt_pfstype); dp->d_namlen = pt->pt_namlen; bcopy(pt->pt_name, dp->d_name, pt->pt_namlen + 1); dp->d_type = pt->pt_type; if ((error = uiomove((caddr_t)dp, delen, uio)) != 0) break; } break; } /* * this is for the root of the procfs filesystem * what is needed is a special entry for "curproc" * followed by an entry for each process on allproc #ifdef PROCFS_ZOMBIE * and zombproc. #endif */ case Proot: { #ifdef PROCFS_ZOMBIE int doingzomb = 0; #endif int pcnt = 0; volatile struct proc *p = allproc.lh_first; for (; p && uio->uio_resid >= delen; i++, pcnt++) { bzero((char *) dp, delen); dp->d_reclen = delen; switch (i) { case 0: /* `.' */ case 1: /* `..' */ dp->d_fileno = PROCFS_FILENO(0, Proot); dp->d_namlen = i + 1; bcopy("..", dp->d_name, dp->d_namlen); dp->d_name[i + 1] = '\0'; dp->d_type = DT_DIR; break; case 2: dp->d_fileno = PROCFS_FILENO(0, Pcurproc); dp->d_namlen = 7; bcopy("curproc", dp->d_name, 8); dp->d_type = DT_LNK; break; default: while (pcnt < i) { p = p->p_list.le_next; if (!p) goto done; if (!PRISON_CHECK(curproc, p)) continue; pcnt++; } while (!PRISON_CHECK(curproc, p)) { p = p->p_list.le_next; if (!p) goto done; } dp->d_fileno = PROCFS_FILENO(p->p_pid, Pproc); dp->d_namlen = sprintf(dp->d_name, "%ld", (long)p->p_pid); dp->d_type = DT_REG; p = p->p_list.le_next; break; } if ((error = uiomove((caddr_t)dp, delen, uio)) != 0) break; } done: #ifdef PROCFS_ZOMBIE if (p == 0 && doingzomb == 0) { doingzomb = 1; p = zombproc.lh_first; goto again; } #endif break; } default: error = ENOTDIR; break; } uio->uio_offset = i * delen; return (error); } /* * readlink reads the link of `curproc' */ static int procfs_readlink(ap) struct vop_readlink_args *ap; { char buf[16]; /* should be enough */ int len; if (VTOPFS(ap->a_vp)->pfs_fileno != PROCFS_FILENO(0, Pcurproc)) return (EINVAL); len = snprintf(buf, sizeof(buf), "%ld", (long)curproc->p_pid); return (uiomove((caddr_t)buf, len, ap->a_uio)); } /* * convert decimal ascii to pid_t */ static pid_t atopid(b, len) const char *b; u_int len; { pid_t p = 0; while (len--) { char c = *b++; if (c < '0' || c > '9') return (NO_PID); p = 10 * p + (c - '0'); if (p > PID_MAX) return (NO_PID); } return (p); } /* * procfs vnode operations. */ vop_t **procfs_vnodeop_p; static struct vnodeopv_entry_desc procfs_vnodeop_entries[] = { { &vop_default_desc, (vop_t *) vop_defaultop }, { &vop_abortop_desc, (vop_t *) procfs_abortop }, { &vop_access_desc, (vop_t *) procfs_access }, { &vop_advlock_desc, (vop_t *) procfs_badop }, { &vop_bmap_desc, (vop_t *) procfs_bmap }, { &vop_close_desc, (vop_t *) procfs_close }, { &vop_create_desc, (vop_t *) procfs_badop }, { &vop_getattr_desc, (vop_t *) procfs_getattr }, { &vop_inactive_desc, (vop_t *) procfs_inactive }, { &vop_link_desc, (vop_t *) procfs_badop }, { &vop_lookup_desc, (vop_t *) procfs_lookup }, { &vop_mkdir_desc, (vop_t *) procfs_badop }, { &vop_mknod_desc, (vop_t *) procfs_badop }, { &vop_open_desc, (vop_t *) procfs_open }, { &vop_pathconf_desc, (vop_t *) vop_stdpathconf }, { &vop_print_desc, (vop_t *) procfs_print }, { &vop_read_desc, (vop_t *) procfs_rw }, { &vop_readdir_desc, (vop_t *) procfs_readdir }, { &vop_readlink_desc, (vop_t *) procfs_readlink }, { &vop_reclaim_desc, (vop_t *) procfs_reclaim }, { &vop_remove_desc, (vop_t *) procfs_badop }, { &vop_rename_desc, (vop_t *) procfs_badop }, { &vop_rmdir_desc, (vop_t *) procfs_badop }, { &vop_setattr_desc, (vop_t *) procfs_setattr }, { &vop_symlink_desc, (vop_t *) procfs_badop }, { &vop_write_desc, (vop_t *) procfs_rw }, { &vop_ioctl_desc, (vop_t *) procfs_ioctl }, { NULL, NULL } }; static struct vnodeopv_desc procfs_vnodeop_opv_desc = { &procfs_vnodeop_p, procfs_vnodeop_entries }; VNODEOP_SET(procfs_vnodeop_opv_desc); Index: head/sys/i386/i386/genassym.c =================================================================== --- head/sys/i386/i386/genassym.c (revision 48690) +++ head/sys/i386/i386/genassym.c (revision 48691) @@ -1,232 +1,239 @@ /*- * Copyright (c) 1982, 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)genassym.c 5.11 (Berkeley) 5/10/91 - * $Id: genassym.c,v 1.71 1999/06/28 09:21:41 peter Exp $ + * $Id: genassym.c,v 1.72 1999/07/06 07:13:32 cracauer Exp $ */ #include "opt_user_ldt.h" #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #define KERNEL /* Avoid userland compatability headers */ #include #undef KERNEL #include #include #include #include #include #include #ifdef SMP #include #endif #include #include #include #define OS(s, m) ((u_int)offsetof(struct s, m)) int main __P((void)); int printf __P((const char *, ...)); int main() { printf("#define\tP_FORW %#x\n", OS(proc, p_procq.tqe_next)); printf("#define\tP_BACK %#x\n", OS(proc, p_procq.tqe_prev)); printf("#define\tP_VMSPACE %#x\n", OS(proc, p_vmspace)); printf("#define\tVM_PMAP %#x\n", OS(vmspace, vm_pmap)); printf("#define\tPM_ACTIVE %#x\n", OS(pmap, pm_active)); printf("#define\tP_ADDR %#x\n", OS(proc, p_addr)); printf("#define\tP_PRI %#x\n", OS(proc, p_priority)); printf("#define\tP_RTPRIO_TYPE %#x\n", OS(proc, p_rtprio.type)); printf("#define\tP_RTPRIO_PRIO %#x\n", OS(proc, p_rtprio.prio)); printf("#define\tP_STAT %#x\n", OS(proc, p_stat)); printf("#define\tP_WCHAN %#x\n", OS(proc, p_wchan)); printf("#define\tP_FLAG %#x\n", OS(proc, p_flag)); printf("#define\tP_PID %#x\n", OS(proc, p_pid)); #ifdef SMP printf("#define\tP_ONCPU %#x\n", OS(proc, p_oncpu)); printf("#define\tP_LASTCPU %#x\n", OS(proc, p_lastcpu)); #endif printf("#define\tSSLEEP %d\n", SSLEEP); printf("#define\tSRUN %d\n", SRUN); printf("#define\tV_TRAP %#x\n", OS(vmmeter, v_trap)); printf("#define\tV_SYSCALL %#x\n", OS(vmmeter, v_syscall)); printf("#define\tV_INTR %#x\n", OS(vmmeter, v_intr)); printf("#define\tUPAGES %d\n", UPAGES); printf("#define\tPAGE_SIZE %d\n", PAGE_SIZE); printf("#define\tNPTEPG %d\n", NPTEPG); printf("#define\tNPDEPG %d\n", NPDEPG); printf("#define\tPDESIZE %d\n", PDESIZE); printf("#define\tPTESIZE %d\n", PTESIZE); printf("#define\tNKPDE %d\n", NKPDE); printf("#define\tNKPT %d\n", NKPT); printf("#define\tPAGE_SHIFT %d\n", PAGE_SHIFT); printf("#define\tPAGE_MASK %d\n", PAGE_MASK); printf("#define\tPDRSHIFT %d\n", PDRSHIFT); printf("#define\tUSRSTACK %#x\n", USRSTACK); printf("#define\tVM_MAXUSER_ADDRESS %#x\n", VM_MAXUSER_ADDRESS); printf("#define\tKERNBASE %#x\n", KERNBASE); printf("#define\tMCLBYTES %d\n", MCLBYTES); printf("#define\tPCB_CR3 %#x\n", OS(pcb, pcb_cr3)); printf("#define\tPCB_EDI %#x\n", OS(pcb, pcb_edi)); printf("#define\tPCB_ESI %#x\n", OS(pcb, pcb_esi)); printf("#define\tPCB_EBP %#x\n", OS(pcb, pcb_ebp)); printf("#define\tPCB_ESP %#x\n", OS(pcb, pcb_esp)); printf("#define\tPCB_EBX %#x\n", OS(pcb, pcb_ebx)); printf("#define\tPCB_EIP %#x\n", OS(pcb, pcb_eip)); printf("#define\tTSS_ESP0 %#x\n", OS(i386tss, tss_esp0)); printf("#define\tPCB_USERLDT %#x\n", OS(pcb, pcb_ldt)); printf("#define\tPCB_GS %#x\n", OS(pcb, pcb_gs)); + printf("#define\tPCB_DR0 %#x\n", OS(pcb, pcb_dr0)); + printf("#define\tPCB_DR1 %#x\n", OS(pcb, pcb_dr1)); + printf("#define\tPCB_DR2 %#x\n", OS(pcb, pcb_dr2)); + printf("#define\tPCB_DR3 %#x\n", OS(pcb, pcb_dr3)); + printf("#define\tPCB_DR6 %#x\n", OS(pcb, pcb_dr6)); + printf("#define\tPCB_DR7 %#x\n", OS(pcb, pcb_dr7)); + printf("#define\tPCB_DBREGS %#x\n", PCB_DBREGS ); printf("#define\tPCB_EXT %#x\n", OS(pcb, pcb_ext)); #ifdef SMP printf("#define\tPCB_MPNEST %#x\n", OS(pcb, pcb_mpnest)); #endif printf("#define\tPCB_SPARE %#x\n", OS(pcb, __pcb_spare)); printf("#define\tU_PROF %#x\n", OS(user, u_stats.p_prof)); printf("#define\tU_PROFSCALE %#x\n", OS(user, u_stats.p_prof.pr_scale)); printf("#define\tPR_BASE %#x\n", OS(uprof, pr_base)); printf("#define\tPR_SIZE %#x\n", OS(uprof, pr_size)); printf("#define\tPR_OFF %#x\n", OS(uprof, pr_off)); printf("#define\tPR_SCALE %#x\n", OS(uprof, pr_scale)); printf("#define\tRU_MINFLT %#x\n", OS(rusage, ru_minflt)); printf("#define\tPCB_FLAGS %#x\n", OS(pcb, pcb_flags)); printf("#define\tPCB_SAVEFPU %#x\n", OS(pcb, pcb_savefpu)); printf("#define\tPCB_SAVEFPU_SIZE %u\n", sizeof(struct save87)); printf("#define\tPCB_ONFAULT %#x\n", OS(pcb, pcb_onfault)); #ifdef SMP printf("#define\tPCB_SIZE %u\n", sizeof(struct pcb)); #endif printf("#define\tTF_ES %#x\n", OS(trapframe, tf_es)); printf("#define\tTF_DS %#x\n", OS(trapframe, tf_ds)); printf("#define\tTF_EDI %#x\n", OS(trapframe, tf_edi)); printf("#define\tTF_ESI %#x\n", OS(trapframe, tf_esi)); printf("#define\tTF_EBP %#x\n", OS(trapframe, tf_ebp)); printf("#define\tTF_ISP %#x\n", OS(trapframe, tf_isp)); printf("#define\tTF_EBX %#x\n", OS(trapframe, tf_ebx)); printf("#define\tTF_EDX %#x\n", OS(trapframe, tf_edx)); printf("#define\tTF_ECX %#x\n", OS(trapframe, tf_ecx)); printf("#define\tTF_EAX %#x\n", OS(trapframe, tf_eax)); printf("#define\tTF_TRAPNO %#x\n", OS(trapframe, tf_trapno)); printf("#define\tTF_ERR %#x\n", OS(trapframe, tf_err)); printf("#define\tTF_EIP %#x\n", OS(trapframe, tf_eip)); printf("#define\tTF_CS %#x\n", OS(trapframe, tf_cs)); printf("#define\tTF_EFLAGS %#x\n", OS(trapframe, tf_eflags)); printf("#define\tTF_ESP %#x\n", OS(trapframe, tf_esp)); printf("#define\tTF_SS %#x\n", OS(trapframe, tf_ss)); printf("#define\tSIGF_HANDLER %#x\n", OS(sigframe, sf_ahu.sf_handler)); printf("#define\tSIGF_SC %#x\n", OS(sigframe, sf_siginfo.si_sc)); printf("#define\tB_READ %#x\n", B_READ); printf("#define\tENOENT %d\n", ENOENT); printf("#define\tEFAULT %d\n", EFAULT); printf("#define\tENAMETOOLONG %d\n", ENAMETOOLONG); printf("#define\tMAXPATHLEN %d\n", MAXPATHLEN); printf("#define\tBOOTINFO_SIZE %u\n", sizeof(struct bootinfo)); printf("#define\tBI_VERSION %#x\n", OS(bootinfo, bi_version)); printf("#define\tBI_KERNELNAME %#x\n", OS(bootinfo, bi_kernelname)); printf("#define\tBI_NFS_DISKLESS %#x\n", OS(bootinfo, bi_nfs_diskless)); printf("#define\tBI_ENDCOMMON %#x\n", OS(bootinfo, bi_endcommon)); printf("#define\tNFSDISKLESS_SIZE %u\n", sizeof(struct nfs_diskless)); printf("#define\tBI_SIZE %#x\n", OS(bootinfo, bi_size)); printf("#define\tBI_SYMTAB %#x\n", OS(bootinfo, bi_symtab)); printf("#define\tBI_ESYMTAB %#x\n", OS(bootinfo, bi_esymtab)); printf("#define\tBI_KERNEND %#x\n", OS(bootinfo, bi_kernend)); printf("#define\tBI_ENVP %#x\n", OS(bootinfo, bi_envp)); printf("#define\tBI_MODULEP %#x\n", OS(bootinfo, bi_modulep)); printf("#define\tGD_SIZEOF %u\n", sizeof(struct globaldata)); printf("#define\tGD_CURPROC %#x\n", OS(globaldata, gd_curproc)); printf("#define\tGD_NPXPROC %#x\n", OS(globaldata, gd_npxproc)); printf("#define\tGD_CURPCB %#x\n", OS(globaldata, gd_curpcb)); printf("#define\tGD_COMMON_TSS %#x\n", OS(globaldata, gd_common_tss)); printf("#define\tGD_SWITCHTIME %#x\n", OS(globaldata, gd_switchtime)); printf("#define\tGD_SWITCHTICKS %#x\n", OS(globaldata, gd_switchticks)); printf("#define\tGD_COMMON_TSSD %#x\n", OS(globaldata, gd_common_tssd)); printf("#define\tGD_TSS_GDT %#x\n", OS(globaldata, gd_tss_gdt)); #ifdef USER_LDT printf("#define\tGD_CURRENTLDT %#x\n", OS(globaldata, gd_currentldt)); #endif #ifdef SMP printf("#define\tGD_CPUID %#x\n", OS(globaldata, gd_cpuid)); printf("#define\tGD_CPU_LOCKID %#x\n", OS(globaldata, gd_cpu_lockid)); printf("#define\tGD_OTHER_CPUS %#x\n", OS(globaldata, gd_other_cpus)); printf("#define\tGD_SS_EFLAGS %#x\n", OS(globaldata, gd_ss_eflags)); printf("#define\tGD_INSIDE_INTR %#x\n", OS(globaldata, gd_inside_intr)); printf("#define\tGD_PRV_CMAP1 %#x\n", OS(globaldata, gd_prv_CMAP1)); printf("#define\tGD_PRV_CMAP2 %#x\n", OS(globaldata, gd_prv_CMAP2)); printf("#define\tGD_PRV_CMAP3 %#x\n", OS(globaldata, gd_prv_CMAP3)); printf("#define\tGD_PRV_PMAP1 %#x\n", OS(globaldata, gd_prv_PMAP1)); printf("#define\tGD_PRV_CADDR1 %#x\n", OS(globaldata, gd_prv_CADDR1)); printf("#define\tGD_PRV_CADDR2 %#x\n", OS(globaldata, gd_prv_CADDR2)); printf("#define\tGD_PRV_CADDR3 %#x\n", OS(globaldata, gd_prv_CADDR3)); printf("#define\tGD_PRV_PADDR1 %#x\n", OS(globaldata, gd_prv_PADDR1)); printf("#define\tPS_GLOBALDATA %#x\n", OS(privatespace, globaldata)); printf("#define\tPS_IDLESTACK %#x\n", OS(privatespace, idlestack)); printf("#define\tPS_IDLESTACK_TOP %#x\n", sizeof(struct privatespace)); #endif printf("#define\tKCSEL %#x\n", GSEL(GCODE_SEL, SEL_KPL)); printf("#define\tKDSEL %#x\n", GSEL(GDATA_SEL, SEL_KPL)); #ifdef SMP printf("#define\tKPSEL %#x\n", GSEL(GPRIV_SEL, SEL_KPL)); #endif printf("#define\tGPROC0_SEL %#x\n", GPROC0_SEL); printf("#define\tVM86_FRAMESIZE %#x\n", sizeof(struct vm86frame)); return (0); } Index: head/sys/i386/i386/machdep.c =================================================================== --- head/sys/i386/i386/machdep.c (revision 48690) +++ head/sys/i386/i386/machdep.c (revision 48691) @@ -1,2041 +1,2122 @@ /*- * Copyright (c) 1992 Terrence R. Lambert. * Copyright (c) 1982, 1987, 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)machdep.c 7.4 (Berkeley) 6/3/91 - * $Id: machdep.c,v 1.353 1999/07/06 07:13:33 cracauer Exp $ + * $Id: machdep.c,v 1.354 1999/07/08 06:05:48 mckusick Exp $ */ #include "apm.h" #include "ether.h" #include "npx.h" #include "opt_atalk.h" #include "opt_cpu.h" #include "opt_ddb.h" #include "opt_inet.h" #include "opt_ipx.h" #include "opt_maxmem.h" #include "opt_msgbuf.h" #include "opt_perfmon.h" #include "opt_smp.h" #include "opt_sysvipc.h" #include "opt_user_ldt.h" #include "opt_userconfig.h" #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #ifdef SYSVSHM #include #endif #ifdef SYSVMSG #include #endif #ifdef SYSVSEM #include #endif #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include /* pcb.h included via sys/user.h */ #ifdef SMP #include #include #endif #ifdef PERFMON #include #endif #ifdef OLD_BUS_ARCH #include #endif #include #include #include #include #include extern void init386 __P((int first)); extern void dblfault_handler __P((void)); extern void printcpuinfo(void); /* XXX header file */ extern void earlysetcpuclass(void); /* same header file */ extern void finishidentcpu(void); extern void panicifcpuunsupported(void); extern void initializecpu(void); static void cpu_startup __P((void *)); SYSINIT(cpu, SI_SUB_CPU, SI_ORDER_FIRST, cpu_startup, NULL) static MALLOC_DEFINE(M_MBUF, "mbuf", "mbuf"); int _udatasel, _ucodesel; u_int atdevbase; #if defined(SWTCH_OPTIM_STATS) extern int swtch_optim_stats; SYSCTL_INT(_debug, OID_AUTO, swtch_optim_stats, CTLFLAG_RD, &swtch_optim_stats, 0, ""); SYSCTL_INT(_debug, OID_AUTO, tlb_flush_count, CTLFLAG_RD, &tlb_flush_count, 0, ""); #endif #ifdef PC98 static int ispc98 = 1; #else static int ispc98 = 0; #endif SYSCTL_INT(_machdep, OID_AUTO, ispc98, CTLFLAG_RD, &ispc98, 0, ""); int physmem = 0; int cold = 1; static int sysctl_hw_physmem SYSCTL_HANDLER_ARGS { int error = sysctl_handle_int(oidp, 0, ctob(physmem), req); return (error); } SYSCTL_PROC(_hw, HW_PHYSMEM, physmem, CTLTYPE_INT|CTLFLAG_RD, 0, 0, sysctl_hw_physmem, "I", ""); static int sysctl_hw_usermem SYSCTL_HANDLER_ARGS { int error = sysctl_handle_int(oidp, 0, ctob(physmem - cnt.v_wire_count), req); return (error); } SYSCTL_PROC(_hw, HW_USERMEM, usermem, CTLTYPE_INT|CTLFLAG_RD, 0, 0, sysctl_hw_usermem, "I", ""); static int sysctl_hw_availpages SYSCTL_HANDLER_ARGS { int error = sysctl_handle_int(oidp, 0, i386_btop(avail_end - avail_start), req); return (error); } SYSCTL_PROC(_hw, OID_AUTO, availpages, CTLTYPE_INT|CTLFLAG_RD, 0, 0, sysctl_hw_availpages, "I", ""); static int sysctl_machdep_msgbuf SYSCTL_HANDLER_ARGS { int error; /* Unwind the buffer, so that it's linear (possibly starting with * some initial nulls). */ error=sysctl_handle_opaque(oidp,msgbufp->msg_ptr+msgbufp->msg_bufr, msgbufp->msg_size-msgbufp->msg_bufr,req); if(error) return(error); if(msgbufp->msg_bufr>0) { error=sysctl_handle_opaque(oidp,msgbufp->msg_ptr, msgbufp->msg_bufr,req); } return(error); } SYSCTL_PROC(_machdep, OID_AUTO, msgbuf, CTLTYPE_STRING|CTLFLAG_RD, 0, 0, sysctl_machdep_msgbuf, "A","Contents of kernel message buffer"); static int msgbuf_clear; static int sysctl_machdep_msgbuf_clear SYSCTL_HANDLER_ARGS { int error; error = sysctl_handle_int(oidp, oidp->oid_arg1, oidp->oid_arg2, req); if (!error && req->newptr) { /* Clear the buffer and reset write pointer */ bzero(msgbufp->msg_ptr,msgbufp->msg_size); msgbufp->msg_bufr=msgbufp->msg_bufx=0; msgbuf_clear=0; } return (error); } SYSCTL_PROC(_machdep, OID_AUTO, msgbuf_clear, CTLTYPE_INT|CTLFLAG_RW, &msgbuf_clear, 0, sysctl_machdep_msgbuf_clear, "I", "Clear kernel message buffer"); int bootverbose = 0, Maxmem = 0; long dumplo; vm_offset_t phys_avail[10]; /* must be 2 less so 0 0 can signal end of chunks */ #define PHYS_AVAIL_ARRAY_END ((sizeof(phys_avail) / sizeof(vm_offset_t)) - 2) static vm_offset_t buffer_sva, buffer_eva; vm_offset_t clean_sva, clean_eva; static vm_offset_t pager_sva, pager_eva; #define offsetof(type, member) ((size_t)(&((type *)0)->member)) static void cpu_startup(dummy) void *dummy; { register unsigned i; register caddr_t v; vm_offset_t maxaddr; vm_size_t size = 0; int firstaddr; vm_offset_t minaddr; if (boothowto & RB_VERBOSE) bootverbose++; /* * Good {morning,afternoon,evening,night}. */ printf(version); earlysetcpuclass(); startrtclock(); printcpuinfo(); panicifcpuunsupported(); #ifdef PERFMON perfmon_init(); #endif printf("real memory = %u (%uK bytes)\n", ptoa(Maxmem), ptoa(Maxmem) / 1024); /* * Display any holes after the first chunk of extended memory. */ if (bootverbose) { int indx; printf("Physical memory chunk(s):\n"); for (indx = 0; phys_avail[indx + 1] != 0; indx += 2) { int size1 = phys_avail[indx + 1] - phys_avail[indx]; printf("0x%08x - 0x%08x, %u bytes (%u pages)\n", phys_avail[indx], phys_avail[indx + 1] - 1, size1, size1 / PAGE_SIZE); } } /* * Calculate callout wheel size */ for (callwheelsize = 1, callwheelbits = 0; callwheelsize < ncallout; callwheelsize <<= 1, ++callwheelbits) ; callwheelmask = callwheelsize - 1; /* * Allocate space for system data structures. * The first available kernel virtual address is in "v". * As pages of kernel virtual memory are allocated, "v" is incremented. * As pages of memory are allocated and cleared, * "firstaddr" is incremented. * An index into the kernel page table corresponding to the * virtual memory address maintained in "v" is kept in "mapaddr". */ /* * Make two passes. The first pass calculates how much memory is * needed and allocates it. The second pass assigns virtual * addresses to the various data structures. */ firstaddr = 0; again: v = (caddr_t)firstaddr; #define valloc(name, type, num) \ (name) = (type *)v; v = (caddr_t)((name)+(num)) #define valloclim(name, type, num, lim) \ (name) = (type *)v; v = (caddr_t)((lim) = ((name)+(num))) valloc(callout, struct callout, ncallout); valloc(callwheel, struct callout_tailq, callwheelsize); #ifdef SYSVSHM valloc(shmsegs, struct shmid_ds, shminfo.shmmni); #endif #ifdef SYSVSEM valloc(sema, struct semid_ds, seminfo.semmni); valloc(sem, struct sem, seminfo.semmns); /* This is pretty disgusting! */ valloc(semu, int, (seminfo.semmnu * seminfo.semusz) / sizeof(int)); #endif #ifdef SYSVMSG valloc(msgpool, char, msginfo.msgmax); valloc(msgmaps, struct msgmap, msginfo.msgseg); valloc(msghdrs, struct msg, msginfo.msgtql); valloc(msqids, struct msqid_ds, msginfo.msgmni); #endif if (nbuf == 0) { nbuf = 30; if( physmem > 1024) nbuf += min((physmem - 1024) / 8, 2048); if( physmem > 65536) nbuf += (physmem - 65536) / 20; } nswbuf = max(min(nbuf/4, 256), 16); valloc(swbuf, struct buf, nswbuf); valloc(buf, struct buf, nbuf); v = bufhashinit(v); /* * End of first pass, size has been calculated so allocate memory */ if (firstaddr == 0) { size = (vm_size_t)(v - firstaddr); firstaddr = (int)kmem_alloc(kernel_map, round_page(size)); if (firstaddr == 0) panic("startup: no room for tables"); goto again; } /* * End of second pass, addresses have been assigned */ if ((vm_size_t)(v - firstaddr) != size) panic("startup: table size inconsistency"); clean_map = kmem_suballoc(kernel_map, &clean_sva, &clean_eva, (nbuf*BKVASIZE) + (nswbuf*MAXPHYS) + pager_map_size); buffer_map = kmem_suballoc(clean_map, &buffer_sva, &buffer_eva, (nbuf*BKVASIZE)); pager_map = kmem_suballoc(clean_map, &pager_sva, &pager_eva, (nswbuf*MAXPHYS) + pager_map_size); pager_map->system_map = 1; exec_map = kmem_suballoc(kernel_map, &minaddr, &maxaddr, (16*(ARG_MAX+(PAGE_SIZE*3)))); /* * Finally, allocate mbuf pool. Since mclrefcnt is an off-size * we use the more space efficient malloc in place of kmem_alloc. */ { vm_offset_t mb_map_size; mb_map_size = nmbufs * MSIZE + nmbclusters * MCLBYTES; mb_map_size = roundup2(mb_map_size, max(MCLBYTES, PAGE_SIZE)); mclrefcnt = malloc(mb_map_size / MCLBYTES, M_MBUF, M_NOWAIT); bzero(mclrefcnt, mb_map_size / MCLBYTES); mb_map = kmem_suballoc(kmem_map, (vm_offset_t *)&mbutl, &maxaddr, mb_map_size); mb_map->system_map = 1; } /* * Initialize callouts */ SLIST_INIT(&callfree); for (i = 0; i < ncallout; i++) { callout_init(&callout[i]); callout[i].c_flags = CALLOUT_LOCAL_ALLOC; SLIST_INSERT_HEAD(&callfree, &callout[i], c_links.sle); } for (i = 0; i < callwheelsize; i++) { TAILQ_INIT(&callwheel[i]); } #if defined(USERCONFIG) userconfig(); cninit(); /* the preferred console may have changed */ #endif printf("avail memory = %u (%uK bytes)\n", ptoa(cnt.v_free_count), ptoa(cnt.v_free_count) / 1024); /* * Set up buffers, so they can be used to read disk labels. */ bufinit(); vm_pager_bufferinit(); #ifdef SMP /* * OK, enough kmem_alloc/malloc state should be up, lets get on with it! */ mp_start(); /* fire up the APs and APICs */ mp_announce(); #endif /* SMP */ } int register_netisr(num, handler) int num; netisr_t *handler; { if (num < 0 || num >= (sizeof(netisrs)/sizeof(*netisrs)) ) { printf("register_netisr: bad isr number: %d\n", num); return (EINVAL); } netisrs[num] = handler; return (0); } void netisr_sysinit(data) void *data; { const struct netisrtab *nit; nit = (const struct netisrtab *)data; register_netisr(nit->nit_num, nit->nit_isr); } /* * Send an interrupt to process. * * Stack is set up to allow sigcode stored * at top to call routine, followed by kcall * to sigreturn routine below. After sigreturn * resets the signal mask, the stack, and the * frame pointer, it returns to the user * specified pc, psl. */ void sendsig(catcher, sig, mask, code) sig_t catcher; int sig, mask; u_long code; { register struct proc *p = curproc; register struct trapframe *regs; register struct sigframe *fp; struct sigframe sf; struct sigacts *psp = p->p_sigacts; int oonstack; regs = p->p_md.md_regs; oonstack = psp->ps_sigstk.ss_flags & SS_ONSTACK; /* * Allocate and validate space for the signal handler context. */ if ((psp->ps_flags & SAS_ALTSTACK) && !oonstack && (psp->ps_sigonstack & sigmask(sig))) { fp = (struct sigframe *)(psp->ps_sigstk.ss_sp + psp->ps_sigstk.ss_size - sizeof(struct sigframe)); psp->ps_sigstk.ss_flags |= SS_ONSTACK; } else { fp = (struct sigframe *)regs->tf_esp - 1; } /* * grow() will return FALSE if the fp will not fit inside the stack * and the stack can not be grown. useracc will return FALSE * if access is denied. */ if ((grow_stack (p, (int)fp) == FALSE) || (useracc((caddr_t)fp, sizeof(struct sigframe), B_WRITE) == FALSE)) { /* * Process has trashed its stack; give it an illegal * instruction to halt it in its tracks. */ #ifdef DEBUG printf("process %d has trashed its stack\n", p->p_pid); #endif SIGACTION(p, SIGILL) = SIG_DFL; sig = sigmask(SIGILL); p->p_sigignore &= ~sig; p->p_sigcatch &= ~sig; p->p_sigmask &= ~sig; psignal(p, SIGILL); return; } /* * Build the argument list for the signal handler. */ if (p->p_sysent->sv_sigtbl) { if (sig < p->p_sysent->sv_sigsize) sig = p->p_sysent->sv_sigtbl[sig]; else sig = p->p_sysent->sv_sigsize + 1; } sf.sf_signum = sig; sf.sf_scp = (register_t)&fp->sf_siginfo.si_sc; if (p->p_sigacts->ps_siginfo & sigmask(sig)) { /* * Signal handler installed with SA_SIGINFO. */ sf.sf_arg2 = (register_t)&fp->sf_siginfo; sf.sf_siginfo.si_signo = sig; sf.sf_siginfo.si_code = code; sf.sf_ahu.sf_action = (__siginfohandler_t *)catcher; } else { /* * Old FreeBSD-style arguments. */ sf.sf_arg2 = code; sf.sf_ahu.sf_handler = catcher; } sf.sf_addr = (char *) regs->tf_err; /* save scratch registers */ sf.sf_siginfo.si_sc.sc_eax = regs->tf_eax; sf.sf_siginfo.si_sc.sc_ebx = regs->tf_ebx; sf.sf_siginfo.si_sc.sc_ecx = regs->tf_ecx; sf.sf_siginfo.si_sc.sc_edx = regs->tf_edx; sf.sf_siginfo.si_sc.sc_esi = regs->tf_esi; sf.sf_siginfo.si_sc.sc_edi = regs->tf_edi; sf.sf_siginfo.si_sc.sc_cs = regs->tf_cs; sf.sf_siginfo.si_sc.sc_ds = regs->tf_ds; sf.sf_siginfo.si_sc.sc_ss = regs->tf_ss; sf.sf_siginfo.si_sc.sc_es = regs->tf_es; sf.sf_siginfo.si_sc.sc_fs = regs->tf_fs; sf.sf_siginfo.si_sc.sc_isp = regs->tf_isp; /* * Build the signal context to be used by sigreturn. */ sf.sf_siginfo.si_sc.sc_onstack = oonstack; sf.sf_siginfo.si_sc.sc_mask = mask; sf.sf_siginfo.si_sc.sc_sp = regs->tf_esp; sf.sf_siginfo.si_sc.sc_fp = regs->tf_ebp; sf.sf_siginfo.si_sc.sc_pc = regs->tf_eip; sf.sf_siginfo.si_sc.sc_ps = regs->tf_eflags; sf.sf_siginfo.si_sc.sc_trapno = regs->tf_trapno; sf.sf_siginfo.si_sc.sc_err = regs->tf_err; /* * If we're a vm86 process, we want to save the segment registers. * We also change eflags to be our emulated eflags, not the actual * eflags. */ if (regs->tf_eflags & PSL_VM) { struct trapframe_vm86 *tf = (struct trapframe_vm86 *)regs; struct vm86_kernel *vm86 = &p->p_addr->u_pcb.pcb_ext->ext_vm86; sf.sf_siginfo.si_sc.sc_gs = tf->tf_vm86_gs; sf.sf_siginfo.si_sc.sc_fs = tf->tf_vm86_fs; sf.sf_siginfo.si_sc.sc_es = tf->tf_vm86_es; sf.sf_siginfo.si_sc.sc_ds = tf->tf_vm86_ds; if (vm86->vm86_has_vme == 0) sf.sf_siginfo.si_sc.sc_ps = (tf->tf_eflags & ~(PSL_VIF | PSL_VIP)) | (vm86->vm86_eflags & (PSL_VIF | PSL_VIP)); /* * We should never have PSL_T set when returning from vm86 * mode. It may be set here if we deliver a signal before * getting to vm86 mode, so turn it off. * * Clear PSL_NT to inhibit T_TSSFLT faults on return from * syscalls made by the signal handler. This just avoids * wasting time for our lazy fixup of such faults. PSL_NT * does nothing in vm86 mode, but vm86 programs can set it * almost legitimately in probes for old cpu types. */ tf->tf_eflags &= ~(PSL_VM | PSL_NT | PSL_T | PSL_VIF | PSL_VIP); } /* * Copy the sigframe out to the user's stack. */ if (copyout(&sf, fp, sizeof(struct sigframe)) != 0) { /* * Something is wrong with the stack pointer. * ...Kill the process. */ sigexit(p, SIGILL); } regs->tf_esp = (int)fp; regs->tf_eip = PS_STRINGS - *(p->p_sysent->sv_szsigcode); regs->tf_cs = _ucodesel; regs->tf_ds = _udatasel; regs->tf_es = _udatasel; regs->tf_fs = _udatasel; regs->tf_ss = _udatasel; } /* * System call to cleanup state after a signal * has been taken. Reset signal mask and * stack state from context left by sendsig (above). * Return to previous pc and psl as specified by * context left by sendsig. Check carefully to * make sure that the user has not modified the * state to gain improper privileges. */ int sigreturn(p, uap) struct proc *p; struct sigreturn_args /* { struct sigcontext *sigcntxp; } */ *uap; { register struct sigcontext *scp; register struct sigframe *fp; register struct trapframe *regs = p->p_md.md_regs; int eflags; /* * (XXX old comment) regs->tf_esp points to the return address. * The user scp pointer is above that. * The return address is faked in the signal trampoline code * for consistency. */ scp = uap->sigcntxp; fp = (struct sigframe *) ((caddr_t)scp - offsetof(struct sigframe, sf_siginfo.si_sc)); if (useracc((caddr_t)fp, sizeof (*fp), B_WRITE) == 0) return(EFAULT); eflags = scp->sc_ps; if (eflags & PSL_VM) { struct trapframe_vm86 *tf = (struct trapframe_vm86 *)regs; struct vm86_kernel *vm86; /* * if pcb_ext == 0 or vm86_inited == 0, the user hasn't * set up the vm86 area, and we can't enter vm86 mode. */ if (p->p_addr->u_pcb.pcb_ext == 0) return (EINVAL); vm86 = &p->p_addr->u_pcb.pcb_ext->ext_vm86; if (vm86->vm86_inited == 0) return (EINVAL); /* go back to user mode if both flags are set */ if ((eflags & PSL_VIP) && (eflags & PSL_VIF)) trapsignal(p, SIGBUS, 0); if (vm86->vm86_has_vme) { eflags = (tf->tf_eflags & ~VME_USERCHANGE) | (eflags & VME_USERCHANGE) | PSL_VM; } else { vm86->vm86_eflags = eflags; /* save VIF, VIP */ eflags = (tf->tf_eflags & ~VM_USERCHANGE) | (eflags & VM_USERCHANGE) | PSL_VM; } tf->tf_vm86_ds = scp->sc_ds; tf->tf_vm86_es = scp->sc_es; tf->tf_vm86_fs = scp->sc_fs; tf->tf_vm86_gs = scp->sc_gs; tf->tf_ds = _udatasel; tf->tf_es = _udatasel; tf->tf_fs = _udatasel; } else { /* * Don't allow users to change privileged or reserved flags. */ #define EFLAGS_SECURE(ef, oef) ((((ef) ^ (oef)) & ~PSL_USERCHANGE) == 0) /* * XXX do allow users to change the privileged flag PSL_RF. * The cpu sets PSL_RF in tf_eflags for faults. Debuggers * should sometimes set it there too. tf_eflags is kept in * the signal context during signal handling and there is no * other place to remember it, so the PSL_RF bit may be * corrupted by the signal handler without us knowing. * Corruption of the PSL_RF bit at worst causes one more or * one less debugger trap, so allowing it is fairly harmless. */ if (!EFLAGS_SECURE(eflags & ~PSL_RF, regs->tf_eflags & ~PSL_RF)) { #ifdef DEBUG printf("sigreturn: eflags = 0x%x\n", eflags); #endif return(EINVAL); } /* * Don't allow users to load a valid privileged %cs. Let the * hardware check for invalid selectors, excess privilege in * other selectors, invalid %eip's and invalid %esp's. */ #define CS_SECURE(cs) (ISPL(cs) == SEL_UPL) if (!CS_SECURE(scp->sc_cs)) { #ifdef DEBUG printf("sigreturn: cs = 0x%x\n", scp->sc_cs); #endif trapsignal(p, SIGBUS, T_PROTFLT); return(EINVAL); } regs->tf_ds = scp->sc_ds; regs->tf_es = scp->sc_es; regs->tf_fs = scp->sc_fs; } /* restore scratch registers */ regs->tf_eax = scp->sc_eax; regs->tf_ebx = scp->sc_ebx; regs->tf_ecx = scp->sc_ecx; regs->tf_edx = scp->sc_edx; regs->tf_esi = scp->sc_esi; regs->tf_edi = scp->sc_edi; regs->tf_cs = scp->sc_cs; regs->tf_ss = scp->sc_ss; regs->tf_isp = scp->sc_isp; if (useracc((caddr_t)scp, sizeof (*scp), B_WRITE) == 0) return(EINVAL); if (scp->sc_onstack & 01) p->p_sigacts->ps_sigstk.ss_flags |= SS_ONSTACK; else p->p_sigacts->ps_sigstk.ss_flags &= ~SS_ONSTACK; p->p_sigmask = scp->sc_mask & ~sigcantmask; regs->tf_ebp = scp->sc_fp; regs->tf_esp = scp->sc_sp; regs->tf_eip = scp->sc_pc; regs->tf_eflags = eflags; return(EJUSTRETURN); } /* * Machine dependent boot() routine * * I haven't seen anything to put here yet * Possibly some stuff might be grafted back here from boot() */ void cpu_boot(int howto) { } /* * Shutdown the CPU as much as possible */ void cpu_halt(void) { for (;;) __asm__ ("hlt"); } /* * Clear registers on exec */ void setregs(p, entry, stack, ps_strings) struct proc *p; u_long entry; u_long stack; u_long ps_strings; { struct trapframe *regs = p->p_md.md_regs; struct pcb *pcb = &p->p_addr->u_pcb; #ifdef USER_LDT /* was i386_user_cleanup() in NetBSD */ if (pcb->pcb_ldt) { if (pcb == curpcb) { lldt(_default_ldt); currentldt = _default_ldt; } kmem_free(kernel_map, (vm_offset_t)pcb->pcb_ldt, pcb->pcb_ldt_len * sizeof(union descriptor)); pcb->pcb_ldt_len = (int)pcb->pcb_ldt = 0; } #endif bzero((char *)regs, sizeof(struct trapframe)); regs->tf_eip = entry; regs->tf_esp = stack; regs->tf_eflags = PSL_USER | (regs->tf_eflags & PSL_T); regs->tf_ss = _udatasel; regs->tf_ds = _udatasel; regs->tf_es = _udatasel; regs->tf_fs = _udatasel; regs->tf_cs = _ucodesel; /* PS_STRINGS value for BSD/OS binaries. It is 0 for non-BSD/OS. */ regs->tf_ebx = ps_strings; /* reset %gs as well */ pcb->pcb_gs = _udatasel; if (pcb == curpcb) { load_gs(_udatasel); } /* * Initialize the math emulator (if any) for the current process. * Actually, just clear the bit that says that the emulator has * been initialized. Initialization is delayed until the process * traps to the emulator (if it is done at all) mainly because * emulators don't provide an entry point for initialization. */ p->p_addr->u_pcb.pcb_flags &= ~FP_SOFTFP; /* * Arrange to trap the next npx or `fwait' instruction (see npx.c * for why fwait must be trapped at least if there is an npx or an * emulator). This is mainly to handle the case where npx0 is not * configured, since the npx routines normally set up the trap * otherwise. It should be done only at boot time, but doing it * here allows modifying `npx_exists' for testing the emulator on * systems with an npx. */ load_cr0(rcr0() | CR0_MP | CR0_TS); #if NNPX > 0 /* Initialize the npx (if any) for the current process. */ npxinit(__INITIAL_NPXCW__); #endif /* * XXX - Linux emulator * Make sure sure edx is 0x0 on entry. Linux binaries depend * on it. */ p->p_retval[1] = 0; } static int sysctl_machdep_adjkerntz SYSCTL_HANDLER_ARGS { int error; error = sysctl_handle_int(oidp, oidp->oid_arg1, oidp->oid_arg2, req); if (!error && req->newptr) resettodr(); return (error); } SYSCTL_PROC(_machdep, CPU_ADJKERNTZ, adjkerntz, CTLTYPE_INT|CTLFLAG_RW, &adjkerntz, 0, sysctl_machdep_adjkerntz, "I", ""); SYSCTL_INT(_machdep, CPU_DISRTCSET, disable_rtc_set, CTLFLAG_RW, &disable_rtc_set, 0, ""); SYSCTL_STRUCT(_machdep, CPU_BOOTINFO, bootinfo, CTLFLAG_RD, &bootinfo, bootinfo, ""); SYSCTL_INT(_machdep, CPU_WALLCLOCK, wall_cmos_clock, CTLFLAG_RW, &wall_cmos_clock, 0, ""); /* * Initialize 386 and configure to run kernel */ /* * Initialize segments & interrupt table */ int _default_ldt; #ifdef SMP union descriptor gdt[NGDT * NCPU]; /* global descriptor table */ #else union descriptor gdt[NGDT]; /* global descriptor table */ #endif static struct gate_descriptor idt0[NIDT]; struct gate_descriptor *idt = &idt0[0]; /* interrupt descriptor table */ union descriptor ldt[NLDT]; /* local descriptor table */ #ifdef SMP /* table descriptors - used to load tables by microp */ struct region_descriptor r_gdt, r_idt; #endif #ifndef SMP extern struct segment_descriptor common_tssd, *tss_gdt; #endif int private_tss; /* flag indicating private tss */ #if defined(I586_CPU) && !defined(NO_F00F_HACK) extern int has_f00f_bug; #endif static struct i386tss dblfault_tss; static char dblfault_stack[PAGE_SIZE]; extern struct user *proc0paddr; /* software prototypes -- in more palatable form */ struct soft_segment_descriptor gdt_segs[] = { /* GNULL_SEL 0 Null Descriptor */ { 0x0, /* segment base address */ 0x0, /* length */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GCODE_SEL 1 Code Descriptor for kernel */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMERA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GDATA_SEL 2 Data Descriptor for kernel */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMRWA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GPRIV_SEL 3 SMP Per-Processor Private Data Descriptor */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMRWA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GPROC0_SEL 4 Proc 0 Tss Descriptor */ { 0x0, /* segment base address */ sizeof(struct i386tss)-1,/* length - all address space */ SDT_SYS386TSS, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* unused - default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GLDT_SEL 5 LDT Descriptor */ { (int) ldt, /* segment base address */ sizeof(ldt)-1, /* length - all address space */ SDT_SYSLDT, /* segment type */ SEL_UPL, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* unused - default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GUSERLDT_SEL 6 User LDT Descriptor per process */ { (int) ldt, /* segment base address */ (512 * sizeof(union descriptor)-1), /* length */ SDT_SYSLDT, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* unused - default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GTGATE_SEL 7 Null Descriptor - Placeholder */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GPANIC_SEL 8 Panic Tss Descriptor */ { (int) &dblfault_tss, /* segment base address */ sizeof(struct i386tss)-1,/* length - all address space */ SDT_SYS386TSS, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* unused - default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* GAPMCODE32_SEL 9 APM BIOS 32-bit interface (32bit Code) */ { 0, /* segment base address (overwritten by APM) */ 0xfffff, /* length */ SDT_MEMERA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GAPMCODE16_SEL 10 APM BIOS 32-bit interface (16bit Code) */ { 0, /* segment base address (overwritten by APM) */ 0xfffff, /* length */ SDT_MEMERA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* GAPMDATA_SEL 11 APM BIOS 32-bit interface (Data) */ { 0, /* segment base address (overwritten by APM) */ 0xfffff, /* length */ SDT_MEMRWA, /* segment type */ 0, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, }; static struct soft_segment_descriptor ldt_segs[] = { /* Null Descriptor - overwritten by call gate */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* Null Descriptor - overwritten by call gate */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* Null Descriptor - overwritten by call gate */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* Code Descriptor for user */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMERA, /* segment type */ SEL_UPL, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, /* Null Descriptor - overwritten by call gate */ { 0x0, /* segment base address */ 0x0, /* length - all address space */ 0, /* segment type */ 0, /* segment descriptor priority level */ 0, /* segment descriptor present */ 0, 0, 0, /* default 32 vs 16 bit size */ 0 /* limit granularity (byte/page units)*/ }, /* Data Descriptor for user */ { 0x0, /* segment base address */ 0xfffff, /* length - all address space */ SDT_MEMRWA, /* segment type */ SEL_UPL, /* segment descriptor priority level */ 1, /* segment descriptor present */ 0, 0, 1, /* default 32 vs 16 bit size */ 1 /* limit granularity (byte/page units)*/ }, }; void setidt(idx, func, typ, dpl, selec) int idx; inthand_t *func; int typ; int dpl; int selec; { struct gate_descriptor *ip; ip = idt + idx; ip->gd_looffset = (int)func; ip->gd_selector = selec; ip->gd_stkcpy = 0; ip->gd_xx = 0; ip->gd_type = typ; ip->gd_dpl = dpl; ip->gd_p = 1; ip->gd_hioffset = ((int)func)>>16 ; } #define IDTVEC(name) __CONCAT(X,name) extern inthand_t IDTVEC(div), IDTVEC(dbg), IDTVEC(nmi), IDTVEC(bpt), IDTVEC(ofl), IDTVEC(bnd), IDTVEC(ill), IDTVEC(dna), IDTVEC(fpusegm), IDTVEC(tss), IDTVEC(missing), IDTVEC(stk), IDTVEC(prot), IDTVEC(page), IDTVEC(mchk), IDTVEC(rsvd), IDTVEC(fpu), IDTVEC(align), IDTVEC(syscall), IDTVEC(int0x80_syscall); void sdtossd(sd, ssd) struct segment_descriptor *sd; struct soft_segment_descriptor *ssd; { ssd->ssd_base = (sd->sd_hibase << 24) | sd->sd_lobase; ssd->ssd_limit = (sd->sd_hilimit << 16) | sd->sd_lolimit; ssd->ssd_type = sd->sd_type; ssd->ssd_dpl = sd->sd_dpl; ssd->ssd_p = sd->sd_p; ssd->ssd_def32 = sd->sd_def32; ssd->ssd_gran = sd->sd_gran; } #define PHYSMAP_SIZE (2 * 8) /* * Populate the (physmap) array with base/bound pairs describing the * available physical memory in the system, then test this memory and * build the phys_avail array describing the actually-available memory. * * If we cannot accurately determine the physical memory map, then use * value from the 0xE801 call, and failing that, the RTC. * * Total memory size may be set by the kernel environment variable * hw.physmem or the compile-time define MAXMEM. */ static void getmemsize(int first) { int i, physmap_idx, pa_indx; u_int basemem, extmem; struct vm86frame vmf; struct vm86context vmc; vm_offset_t pa, physmap[PHYSMAP_SIZE]; pt_entry_t pte; const char *cp; struct { u_int64_t base; u_int64_t length; u_int32_t type; } *smap; bzero(&vmf, sizeof(struct vm86frame)); bzero(physmap, sizeof(physmap)); /* * Perform "base memory" related probes & setup */ vm86_intcall(0x12, &vmf); basemem = vmf.vmf_ax; if (basemem > 640) { printf("Preposterous BIOS basemem of %uK, truncating to 640K\n", basemem); basemem = 640; } /* * XXX if biosbasemem is now < 640, there is a `hole' * between the end of base memory and the start of * ISA memory. The hole may be empty or it may * contain BIOS code or data. Map it read/write so * that the BIOS can write to it. (Memory from 0 to * the physical end of the kernel is mapped read-only * to begin with and then parts of it are remapped. * The parts that aren't remapped form holes that * remain read-only and are unused by the kernel. * The base memory area is below the physical end of * the kernel and right now forms a read-only hole. * The part of it from PAGE_SIZE to * (trunc_page(biosbasemem * 1024) - 1) will be * remapped and used by the kernel later.) * * This code is similar to the code used in * pmap_mapdev, but since no memory needs to be * allocated we simply change the mapping. */ for (pa = trunc_page(basemem * 1024); pa < ISA_HOLE_START; pa += PAGE_SIZE) { pte = (pt_entry_t)vtopte(pa + KERNBASE); *pte = pa | PG_RW | PG_V; } /* * if basemem != 640, map pages r/w into vm86 page table so * that the bios can scribble on it. */ pte = (pt_entry_t)vm86paddr; for (i = basemem / 4; i < 160; i++) pte[i] = (i << PAGE_SHIFT) | PG_V | PG_RW | PG_U; /* * map page 1 R/W into the kernel page table so we can use it * as a buffer. The kernel will unmap this page later. */ pte = (pt_entry_t)vtopte(KERNBASE + (1 << PAGE_SHIFT)); *pte = (1 << PAGE_SHIFT) | PG_RW | PG_V; /* * get memory map with INT 15:E820 */ #define SMAPSIZ sizeof(*smap) #define SMAP_SIG 0x534D4150 /* 'SMAP' */ vmc.npages = 0; smap = (void *)vm86_addpage(&vmc, 1, KERNBASE + (1 << PAGE_SHIFT)); vm86_getptr(&vmc, (vm_offset_t)smap, &vmf.vmf_es, &vmf.vmf_di); physmap_idx = 0; vmf.vmf_ebx = 0; do { vmf.vmf_eax = 0xE820; vmf.vmf_edx = SMAP_SIG; vmf.vmf_ecx = SMAPSIZ; i = vm86_datacall(0x15, &vmf, &vmc); if (i || vmf.vmf_eax != SMAP_SIG) break; if (boothowto & RB_VERBOSE) printf("SMAP type=%02x base=%08x %08x len=%08x %08x\n", smap->type, *(u_int32_t *)((char *)&smap->base + 4), (u_int32_t)smap->base, *(u_int32_t *)((char *)&smap->length + 4), (u_int32_t)smap->length); if (smap->type != 0x01) goto next_run; if (smap->length == 0) goto next_run; if (smap->base >= 0xffffffff) { printf("%uK of memory above 4GB ignored\n", (u_int)(smap->length / 1024)); goto next_run; } for (i = 0; i <= physmap_idx; i += 2) { if (smap->base < physmap[i + 1]) { if (boothowto & RB_VERBOSE) printf( "Overlapping or non-montonic memory region, ignoring second region\n"); goto next_run; } } if (smap->base == physmap[physmap_idx + 1]) { physmap[physmap_idx + 1] += smap->length; goto next_run; } physmap_idx += 2; if (physmap_idx == PHYSMAP_SIZE) { printf( "Too many segments in the physical address map, giving up\n"); break; } physmap[physmap_idx] = smap->base; physmap[physmap_idx + 1] = smap->base + smap->length; next_run: } while (vmf.vmf_ebx != 0); if (physmap[1] != 0) goto physmap_done; /* * If we failed above, try memory map with INT 15:E801 */ vmf.vmf_ax = 0xE801; if (vm86_intcall(0x15, &vmf) == 0) { extmem = vmf.vmf_cx + vmf.vmf_dx * 64; } else { #if 0 vmf.vmf_ah = 0x88; vm86_intcall(0x15, &vmf); extmem = vmf.vmf_ax; #else /* * Prefer the RTC value for extended memory. */ extmem = rtcin(RTC_EXTLO) + (rtcin(RTC_EXTHI) << 8); #endif } /* * Special hack for chipsets that still remap the 384k hole when * there's 16MB of memory - this really confuses people that * are trying to use bus mastering ISA controllers with the * "16MB limit"; they only have 16MB, but the remapping puts * them beyond the limit. * * If extended memory is between 15-16MB (16-17MB phys address range), * chop it to 15MB. */ if ((extmem > 15 * 1024) && (extmem < 16 * 1024)) extmem = 15 * 1024; physmap[0] = 0; physmap[1] = basemem * 1024; physmap_idx = 2; physmap[physmap_idx] = 0x100000; physmap[physmap_idx + 1] = physmap[physmap_idx] + extmem * 1024; physmap_done: /* * Now, physmap contains a map of physical memory. */ #ifdef SMP /* make hole for AP bootstrap code */ physmap[1] = mp_bootaddress(physmap[1] / 1024); /* look for the MP hardware - needed for apic addresses */ mp_probe(); #endif /* * Maxmem isn't the "maximum memory", it's one larger than the * highest page of the physical address space. It should be * called something like "Maxphyspage". We may adjust this * based on ``hw.physmem'' and the results of the memory test. */ Maxmem = atop(physmap[physmap_idx + 1]); #ifdef MAXMEM Maxmem = MAXMEM / 4; #endif /* * hw.maxmem is a size in bytes; we also allow k, m, and g suffixes * for the appropriate modifiers. This overrides MAXMEM. */ if ((cp = getenv("hw.physmem")) != NULL) { u_int64_t AllowMem, sanity; const char *ep; sanity = AllowMem = strtouq(cp, &ep, 0); if ((ep != cp) && (*ep != 0)) { switch(*ep) { case 'g': case 'G': AllowMem <<= 10; case 'm': case 'M': AllowMem <<= 10; case 'k': case 'K': AllowMem <<= 10; break; default: AllowMem = sanity = 0; } if (AllowMem < sanity) AllowMem = 0; } if (AllowMem == 0) printf("Ignoring invalid memory size of '%s'\n", cp); else Maxmem = atop(AllowMem); } if (atop(physmap[physmap_idx + 1]) != Maxmem && (boothowto & RB_VERBOSE)) printf("Physical memory use set to %uK\n", Maxmem * 4); /* * If Maxmem has been increased beyond what the system has detected, * extend the last memory segment to the new limit. */ if (atop(physmap[physmap_idx + 1]) < Maxmem) physmap[physmap_idx + 1] = ptoa(Maxmem); /* call pmap initialization to make new kernel address space */ pmap_bootstrap(first, 0); /* * Size up each available chunk of physical memory. */ physmap[0] = PAGE_SIZE; /* mask off page 0 */ pa_indx = 0; phys_avail[pa_indx++] = physmap[0]; phys_avail[pa_indx] = physmap[0]; #if 0 pte = (pt_entry_t)vtopte(KERNBASE); #else pte = (pt_entry_t)CMAP1; #endif /* * physmap is in bytes, so when converting to page boundaries, * round up the start address and round down the end address. */ for (i = 0; i <= physmap_idx; i += 2) { vm_offset_t end; end = ptoa(Maxmem); if (physmap[i + 1] < end) end = trunc_page(physmap[i + 1]); for (pa = round_page(physmap[i]); pa < end; pa += PAGE_SIZE) { int tmp, page_bad; #if 0 int *ptr = 0; #else int *ptr = (int *)CADDR1; #endif /* * block out kernel memory as not available. */ if (pa >= 0x100000 && pa < first) continue; page_bad = FALSE; /* * map page into kernel: valid, read/write,non-cacheable */ *pte = pa | PG_V | PG_RW | PG_N; invltlb(); tmp = *(int *)ptr; /* * Test for alternating 1's and 0's */ *(volatile int *)ptr = 0xaaaaaaaa; if (*(volatile int *)ptr != 0xaaaaaaaa) { page_bad = TRUE; } /* * Test for alternating 0's and 1's */ *(volatile int *)ptr = 0x55555555; if (*(volatile int *)ptr != 0x55555555) { page_bad = TRUE; } /* * Test for all 1's */ *(volatile int *)ptr = 0xffffffff; if (*(volatile int *)ptr != 0xffffffff) { page_bad = TRUE; } /* * Test for all 0's */ *(volatile int *)ptr = 0x0; if (*(volatile int *)ptr != 0x0) { page_bad = TRUE; } /* * Restore original value. */ *(int *)ptr = tmp; /* * Adjust array of valid/good pages. */ if (page_bad == TRUE) { continue; } /* * If this good page is a continuation of the * previous set of good pages, then just increase * the end pointer. Otherwise start a new chunk. * Note that "end" points one higher than end, * making the range >= start and < end. * If we're also doing a speculative memory * test and we at or past the end, bump up Maxmem * so that we keep going. The first bad page * will terminate the loop. */ if (phys_avail[pa_indx] == pa) { phys_avail[pa_indx] += PAGE_SIZE; } else { pa_indx++; if (pa_indx == PHYS_AVAIL_ARRAY_END) { printf("Too many holes in the physical address space, giving up\n"); pa_indx--; break; } phys_avail[pa_indx++] = pa; /* start */ phys_avail[pa_indx] = pa + PAGE_SIZE; /* end */ } physmem++; } } *pte = 0; invltlb(); /* * XXX * The last chunk must contain at least one page plus the message * buffer to avoid complicating other code (message buffer address * calculation, etc.). */ while (phys_avail[pa_indx - 1] + PAGE_SIZE + round_page(MSGBUF_SIZE) >= phys_avail[pa_indx]) { physmem -= atop(phys_avail[pa_indx] - phys_avail[pa_indx - 1]); phys_avail[pa_indx--] = 0; phys_avail[pa_indx--] = 0; } Maxmem = atop(phys_avail[pa_indx]); /* Trim off space for the message buffer. */ phys_avail[pa_indx] -= round_page(MSGBUF_SIZE); avail_end = phys_avail[pa_indx]; } void init386(first) int first; { int x; struct gate_descriptor *gdp; int gsel_tss; #ifndef SMP /* table descriptors - used to load tables by microp */ struct region_descriptor r_gdt, r_idt; #endif int off; /* * Prevent lowering of the ipl if we call tsleep() early. */ safepri = cpl; proc0.p_addr = proc0paddr; atdevbase = ISA_HOLE_START + KERNBASE; if (bootinfo.bi_modulep) { preload_metadata = (caddr_t)bootinfo.bi_modulep + KERNBASE; preload_bootstrap_relocate(KERNBASE); } if (bootinfo.bi_envp) kern_envp = (caddr_t)bootinfo.bi_envp + KERNBASE; /* * make gdt memory segments, the code segment goes up to end of the * page with etext in it, the data segment goes to the end of * the address space */ /* * XXX text protection is temporarily (?) disabled. The limit was * i386_btop(round_page(etext)) - 1. */ gdt_segs[GCODE_SEL].ssd_limit = i386_btop(0) - 1; gdt_segs[GDATA_SEL].ssd_limit = i386_btop(0) - 1; #ifdef SMP gdt_segs[GPRIV_SEL].ssd_limit = i386_btop(sizeof(struct privatespace)) - 1; gdt_segs[GPRIV_SEL].ssd_base = (int) &SMP_prvspace[0]; gdt_segs[GPROC0_SEL].ssd_base = (int) &SMP_prvspace[0].globaldata.gd_common_tss; SMP_prvspace[0].globaldata.gd_prvspace = &SMP_prvspace[0]; #else gdt_segs[GPRIV_SEL].ssd_limit = i386_btop(0) - 1; gdt_segs[GPROC0_SEL].ssd_base = (int) &common_tss; #endif for (x = 0; x < NGDT; x++) { #ifdef BDE_DEBUGGER /* avoid overwriting db entries with APM ones */ if (x >= GAPMCODE32_SEL && x <= GAPMDATA_SEL) continue; #endif ssdtosd(&gdt_segs[x], &gdt[x].sd); } r_gdt.rd_limit = NGDT * sizeof(gdt[0]) - 1; r_gdt.rd_base = (int) gdt; lgdt(&r_gdt); /* make ldt memory segments */ /* * The data segment limit must not cover the user area because we * don't want the user area to be writable in copyout() etc. (page * level protection is lost in kernel mode on 386's). Also, we * don't want the user area to be writable directly (page level * protection of the user area is not available on 486's with * CR0_WP set, because there is no user-read/kernel-write mode). * * XXX - VM_MAXUSER_ADDRESS is an end address, not a max. And it * should be spelled ...MAX_USER... */ #define VM_END_USER_RW_ADDRESS VM_MAXUSER_ADDRESS /* * The code segment limit has to cover the user area until we move * the signal trampoline out of the user area. This is safe because * the code segment cannot be written to directly. */ #define VM_END_USER_R_ADDRESS (VM_END_USER_RW_ADDRESS + UPAGES * PAGE_SIZE) ldt_segs[LUCODE_SEL].ssd_limit = i386_btop(VM_END_USER_R_ADDRESS) - 1; ldt_segs[LUDATA_SEL].ssd_limit = i386_btop(VM_END_USER_RW_ADDRESS) - 1; for (x = 0; x < sizeof ldt_segs / sizeof ldt_segs[0]; x++) ssdtosd(&ldt_segs[x], &ldt[x].sd); _default_ldt = GSEL(GLDT_SEL, SEL_KPL); lldt(_default_ldt); #ifdef USER_LDT currentldt = _default_ldt; #endif /* exceptions */ for (x = 0; x < NIDT; x++) setidt(x, &IDTVEC(rsvd), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(0, &IDTVEC(div), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(1, &IDTVEC(dbg), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(2, &IDTVEC(nmi), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(3, &IDTVEC(bpt), SDT_SYS386TGT, SEL_UPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(4, &IDTVEC(ofl), SDT_SYS386TGT, SEL_UPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(5, &IDTVEC(bnd), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(6, &IDTVEC(ill), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(7, &IDTVEC(dna), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(8, 0, SDT_SYSTASKGT, SEL_KPL, GSEL(GPANIC_SEL, SEL_KPL)); setidt(9, &IDTVEC(fpusegm), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(10, &IDTVEC(tss), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(11, &IDTVEC(missing), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(12, &IDTVEC(stk), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(13, &IDTVEC(prot), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(14, &IDTVEC(page), SDT_SYS386IGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(15, &IDTVEC(rsvd), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(16, &IDTVEC(fpu), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(17, &IDTVEC(align), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(18, &IDTVEC(mchk), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(0x80, &IDTVEC(int0x80_syscall), SDT_SYS386TGT, SEL_UPL, GSEL(GCODE_SEL, SEL_KPL)); r_idt.rd_limit = sizeof(idt0) - 1; r_idt.rd_base = (int) idt; lidt(&r_idt); /* * Initialize the console before we print anything out. */ cninit(); #include "isa.h" #if NISA >0 isa_defaultirq(); #endif rand_initialize(); #ifdef DDB kdb_init(); if (boothowto & RB_KDB) Debugger("Boot flags requested debugger"); #endif finishidentcpu(); /* Final stage of CPU initialization */ setidt(6, &IDTVEC(ill), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); setidt(13, &IDTVEC(prot), SDT_SYS386TGT, SEL_KPL, GSEL(GCODE_SEL, SEL_KPL)); initializecpu(); /* Initialize CPU registers */ /* make an initial tss so cpu can get interrupt stack on syscall! */ common_tss.tss_esp0 = (int) proc0.p_addr + UPAGES*PAGE_SIZE - 16; common_tss.tss_ss0 = GSEL(GDATA_SEL, SEL_KPL) ; gsel_tss = GSEL(GPROC0_SEL, SEL_KPL); private_tss = 0; tss_gdt = &gdt[GPROC0_SEL].sd; common_tssd = *tss_gdt; common_tss.tss_ioopt = (sizeof common_tss) << 16; ltr(gsel_tss); dblfault_tss.tss_esp = dblfault_tss.tss_esp0 = dblfault_tss.tss_esp1 = dblfault_tss.tss_esp2 = (int) &dblfault_stack[sizeof(dblfault_stack)]; dblfault_tss.tss_ss = dblfault_tss.tss_ss0 = dblfault_tss.tss_ss1 = dblfault_tss.tss_ss2 = GSEL(GDATA_SEL, SEL_KPL); dblfault_tss.tss_cr3 = (int)IdlePTD; dblfault_tss.tss_eip = (int) dblfault_handler; dblfault_tss.tss_eflags = PSL_KERNEL; dblfault_tss.tss_ds = dblfault_tss.tss_es = dblfault_tss.tss_gs = GSEL(GDATA_SEL, SEL_KPL); dblfault_tss.tss_fs = GSEL(GPRIV_SEL, SEL_KPL); dblfault_tss.tss_cs = GSEL(GCODE_SEL, SEL_KPL); dblfault_tss.tss_ldt = GSEL(GLDT_SEL, SEL_KPL); vm86_initialize(); getmemsize(first); /* now running on new page tables, configured,and u/iom is accessible */ /* Map the message buffer. */ for (off = 0; off < round_page(MSGBUF_SIZE); off += PAGE_SIZE) pmap_kenter((vm_offset_t)msgbufp + off, avail_end + off); msgbufinit(msgbufp, MSGBUF_SIZE); /* make a call gate to reenter kernel with */ gdp = &ldt[LSYS5CALLS_SEL].gd; x = (int) &IDTVEC(syscall); gdp->gd_looffset = x++; gdp->gd_selector = GSEL(GCODE_SEL,SEL_KPL); gdp->gd_stkcpy = 1; gdp->gd_type = SDT_SYS386CGT; gdp->gd_dpl = SEL_UPL; gdp->gd_p = 1; gdp->gd_hioffset = ((int) &IDTVEC(syscall)) >>16; /* XXX does this work? */ ldt[LBSDICALLS_SEL] = ldt[LSYS5CALLS_SEL]; ldt[LSOL26CALLS_SEL] = ldt[LSYS5CALLS_SEL]; /* transfer to user mode */ _ucodesel = LSEL(LUCODE_SEL, SEL_UPL); _udatasel = LSEL(LUDATA_SEL, SEL_UPL); /* setup proc 0's pcb */ proc0.p_addr->u_pcb.pcb_flags = 0; proc0.p_addr->u_pcb.pcb_cr3 = (int)IdlePTD; #ifdef SMP proc0.p_addr->u_pcb.pcb_mpnest = 1; #endif proc0.p_addr->u_pcb.pcb_ext = 0; } #if defined(I586_CPU) && !defined(NO_F00F_HACK) static void f00f_hack(void *unused); SYSINIT(f00f_hack, SI_SUB_INTRINSIC, SI_ORDER_FIRST, f00f_hack, NULL); static void f00f_hack(void *unused) { struct gate_descriptor *new_idt; #ifndef SMP struct region_descriptor r_idt; #endif vm_offset_t tmp; if (!has_f00f_bug) return; printf("Intel Pentium detected, installing workaround for F00F bug\n"); r_idt.rd_limit = sizeof(idt0) - 1; tmp = kmem_alloc(kernel_map, PAGE_SIZE * 2); if (tmp == 0) panic("kmem_alloc returned 0"); if (((unsigned int)tmp & (PAGE_SIZE-1)) != 0) panic("kmem_alloc returned non-page-aligned memory"); /* Put the first seven entries in the lower page */ new_idt = (struct gate_descriptor*)(tmp + PAGE_SIZE - (7*8)); bcopy(idt, new_idt, sizeof(idt0)); r_idt.rd_base = (int)new_idt; lidt(&r_idt); idt = new_idt; if (vm_map_protect(kernel_map, tmp, tmp + PAGE_SIZE, VM_PROT_READ, FALSE) != KERN_SUCCESS) panic("vm_map_protect failed"); return; } #endif /* defined(I586_CPU) && !NO_F00F_HACK */ int ptrace_set_pc(p, addr) struct proc *p; unsigned long addr; { p->p_md.md_regs->tf_eip = addr; return (0); } int ptrace_single_step(p) struct proc *p; { p->p_md.md_regs->tf_eflags |= PSL_T; return (0); } int ptrace_read_u_check(p, addr, len) struct proc *p; vm_offset_t addr; size_t len; { vm_offset_t gap; if ((vm_offset_t) (addr + len) < addr) return EPERM; if ((vm_offset_t) (addr + len) <= sizeof(struct user)) return 0; gap = (char *) p->p_md.md_regs - (char *) p->p_addr; if ((vm_offset_t) addr < gap) return EPERM; if ((vm_offset_t) (addr + len) <= (vm_offset_t) (gap + sizeof(struct trapframe))) return 0; return EPERM; } int ptrace_write_u(p, off, data) struct proc *p; vm_offset_t off; long data; { struct trapframe frame_copy; vm_offset_t min; struct trapframe *tp; /* * Privileged kernel state is scattered all over the user area. * Only allow write access to parts of regs and to fpregs. */ min = (char *)p->p_md.md_regs - (char *)p->p_addr; if (off >= min && off <= min + sizeof(struct trapframe) - sizeof(int)) { tp = p->p_md.md_regs; frame_copy = *tp; *(int *)((char *)&frame_copy + (off - min)) = data; if (!EFLAGS_SECURE(frame_copy.tf_eflags, tp->tf_eflags) || !CS_SECURE(frame_copy.tf_cs)) return (EINVAL); *(int*)((char *)p->p_addr + off) = data; return (0); } min = offsetof(struct user, u_pcb) + offsetof(struct pcb, pcb_savefpu); if (off >= min && off <= min + sizeof(struct save87) - sizeof(int)) { *(int*)((char *)p->p_addr + off) = data; return (0); } return (EFAULT); } int fill_regs(p, regs) struct proc *p; struct reg *regs; { struct pcb *pcb; struct trapframe *tp; tp = p->p_md.md_regs; regs->r_fs = tp->tf_fs; regs->r_es = tp->tf_es; regs->r_ds = tp->tf_ds; regs->r_edi = tp->tf_edi; regs->r_esi = tp->tf_esi; regs->r_ebp = tp->tf_ebp; regs->r_ebx = tp->tf_ebx; regs->r_edx = tp->tf_edx; regs->r_ecx = tp->tf_ecx; regs->r_eax = tp->tf_eax; regs->r_eip = tp->tf_eip; regs->r_cs = tp->tf_cs; regs->r_eflags = tp->tf_eflags; regs->r_esp = tp->tf_esp; regs->r_ss = tp->tf_ss; pcb = &p->p_addr->u_pcb; regs->r_gs = pcb->pcb_gs; return (0); } int set_regs(p, regs) struct proc *p; struct reg *regs; { struct pcb *pcb; struct trapframe *tp; tp = p->p_md.md_regs; if (!EFLAGS_SECURE(regs->r_eflags, tp->tf_eflags) || !CS_SECURE(regs->r_cs)) return (EINVAL); tp->tf_fs = regs->r_fs; tp->tf_es = regs->r_es; tp->tf_ds = regs->r_ds; tp->tf_edi = regs->r_edi; tp->tf_esi = regs->r_esi; tp->tf_ebp = regs->r_ebp; tp->tf_ebx = regs->r_ebx; tp->tf_edx = regs->r_edx; tp->tf_ecx = regs->r_ecx; tp->tf_eax = regs->r_eax; tp->tf_eip = regs->r_eip; tp->tf_cs = regs->r_cs; tp->tf_eflags = regs->r_eflags; tp->tf_esp = regs->r_esp; tp->tf_ss = regs->r_ss; pcb = &p->p_addr->u_pcb; pcb->pcb_gs = regs->r_gs; return (0); } int fill_fpregs(p, fpregs) struct proc *p; struct fpreg *fpregs; { bcopy(&p->p_addr->u_pcb.pcb_savefpu, fpregs, sizeof *fpregs); return (0); } int set_fpregs(p, fpregs) struct proc *p; struct fpreg *fpregs; { bcopy(fpregs, &p->p_addr->u_pcb.pcb_savefpu, sizeof *fpregs); + return (0); +} + +int +fill_dbregs(p, dbregs) + struct proc *p; + struct dbreg *dbregs; +{ + struct pcb *pcb; + + pcb = &p->p_addr->u_pcb; + dbregs->dr0 = pcb->pcb_dr0; + dbregs->dr1 = pcb->pcb_dr1; + dbregs->dr2 = pcb->pcb_dr2; + dbregs->dr3 = pcb->pcb_dr3; + dbregs->dr4 = 0; + dbregs->dr5 = 0; + dbregs->dr6 = pcb->pcb_dr6; + dbregs->dr7 = pcb->pcb_dr7; + return (0); +} + +int +set_dbregs(p, dbregs) + struct proc *p; + struct dbreg *dbregs; +{ + struct pcb *pcb; + + pcb = &p->p_addr->u_pcb; + + /* + * Don't let a process set a breakpoint that is not within the + * process's address space. If a process could do this, it + * could halt the system by setting a breakpoint in the kernel + * (if ddb was enabled). Thus, we need to check to make sure + * that no breakpoints are being enabled for addresses outside + * process's address space, unless, perhaps, we were called by + * uid 0. + * + * XXX - what about when the watched area of the user's + * address space is written into from within the kernel + * ... wouldn't that still cause a breakpoint to be generated + * from within kernel mode? + */ + + if (p->p_cred->pc_ucred->cr_uid != 0) { + if (dbregs->dr7 & 0x3) { + /* dr0 is enabled */ + if (dbregs->dr0 >= VM_MAXUSER_ADDRESS) + return (EINVAL); + } + + if (dbregs->dr7 & (0x3<<2)) { + /* dr1 is enabled */ + if (dbregs->dr1 >= VM_MAXUSER_ADDRESS) + return (EINVAL); + } + + if (dbregs->dr7 & (0x3<<4)) { + /* dr2 is enabled */ + if (dbregs->dr2 >= VM_MAXUSER_ADDRESS) + return (EINVAL); + } + + if (dbregs->dr7 & (0x3<<6)) { + /* dr3 is enabled */ + if (dbregs->dr3 >= VM_MAXUSER_ADDRESS) + return (EINVAL); + } + } + + pcb->pcb_dr0 = dbregs->dr0; + pcb->pcb_dr1 = dbregs->dr1; + pcb->pcb_dr2 = dbregs->dr2; + pcb->pcb_dr3 = dbregs->dr3; + pcb->pcb_dr6 = dbregs->dr6; + pcb->pcb_dr7 = dbregs->dr7; + + pcb->pcb_flags |= PCB_DBREGS; + return (0); } #ifndef DDB void Debugger(const char *msg) { printf("Debugger(\"%s\") called.\n", msg); } #endif /* no DDB */ #include /* * Determine the size of the transfer, and make sure it is * within the boundaries of the partition. Adjust transfer * if needed, and signal errors or early completion. */ int bounds_check_with_label(struct buf *bp, struct disklabel *lp, int wlabel) { struct partition *p = lp->d_partitions + dkpart(bp->b_dev); int labelsect = lp->d_partitions[0].p_offset; int maxsz = p->p_size, sz = (bp->b_bcount + DEV_BSIZE - 1) >> DEV_BSHIFT; /* overwriting disk label ? */ /* XXX should also protect bootstrap in first 8K */ if (bp->b_blkno + p->p_offset <= LABELSECTOR + labelsect && #if LABELSECTOR != 0 bp->b_blkno + p->p_offset + sz > LABELSECTOR + labelsect && #endif (bp->b_flags & B_READ) == 0 && wlabel == 0) { bp->b_error = EROFS; goto bad; } #if defined(DOSBBSECTOR) && defined(notyet) /* overwriting master boot record? */ if (bp->b_blkno + p->p_offset <= DOSBBSECTOR && (bp->b_flags & B_READ) == 0 && wlabel == 0) { bp->b_error = EROFS; goto bad; } #endif /* beyond partition? */ if (bp->b_blkno < 0 || bp->b_blkno + sz > maxsz) { /* if exactly at end of disk, return an EOF */ if (bp->b_blkno == maxsz) { bp->b_resid = bp->b_bcount; return(0); } /* or truncate if part of it fits */ sz = maxsz - bp->b_blkno; if (sz <= 0) { bp->b_error = EINVAL; goto bad; } bp->b_bcount = sz << DEV_BSHIFT; } bp->b_pblkno = bp->b_blkno + p->p_offset; return(1); bad: bp->b_flags |= B_ERROR; return(-1); } #ifdef DDB /* * Provide inb() and outb() as functions. They are normally only * available as macros calling inlined functions, thus cannot be * called inside DDB. * * The actual code is stolen from , and de-inlined. */ #undef inb #undef outb /* silence compiler warnings */ u_char inb(u_int); void outb(u_int, u_char); u_char inb(u_int port) { u_char data; /* * We use %%dx and not %1 here because i/o is done at %dx and not at * %edx, while gcc generates inferior code (movw instead of movl) * if we tell it to load (u_short) port. */ __asm __volatile("inb %%dx,%0" : "=a" (data) : "d" (port)); return (data); } void outb(u_int port, u_char data) { u_char al; /* * Use an unnecessary assignment to help gcc's register allocator. * This make a large difference for gcc-1.40 and a tiny difference * for gcc-2.6.0. For gcc-1.40, al had to be ``asm("ax")'' for * best results. gcc-2.6.0 can't handle this. */ al = data; __asm __volatile("outb %0,%%dx" : : "a" (al), "d" (port)); } #endif /* DDB */ Index: head/sys/i386/i386/procfs_machdep.c =================================================================== --- head/sys/i386/i386/procfs_machdep.c (revision 48690) +++ head/sys/i386/i386/procfs_machdep.c (revision 48691) @@ -1,135 +1,158 @@ /* * Copyright (c) 1993 * The Regents of the University of California. All rights reserved. * Copyright (c) 1993 Jan-Simon Pendry * * This code is derived from software contributed to Berkeley by * Jan-Simon Pendry. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)procfs_machdep.c 8.3 (Berkeley) 1/27/94 * * From: - * $Id: procfs_machdep.c,v 1.10 1997/07/20 08:37:22 bde Exp $ + * $Id: procfs_machdep.c,v 1.11 1998/09/14 22:43:33 jdp Exp $ */ /* * Functions to be implemented here are: * * procfs_read_regs(proc, regs) * Get the current user-visible register set from the process * and copy it into the regs structure (). * The process is stopped at the time read_regs is called. * * procfs_write_regs(proc, regs) * Update the current register set from the passed in regs * structure. Take care to avoid clobbering special CPU * registers or privileged bits in the PSL. * Depending on the architecture this may have fix-up work to do, * especially if the IAR or PCW are modified. * The process is stopped at the time write_regs is called. * * procfs_read_fpregs, procfs_write_fpregs * deal with the floating point register set, otherwise as above. * + * procfs_read_dbregs, procfs_write_dbregs + * deal with the processor debug register set, otherwise as above. + * * procfs_sstep(proc) * Arrange for the process to trap after executing a single instruction. * */ #include #include #include #include #include #include #include #include #include #include #include #include #include int procfs_read_regs(p, regs) struct proc *p; struct reg *regs; { if ((p->p_flag & P_INMEM) == 0) return (EIO); return (fill_regs(p, regs)); } int procfs_write_regs(p, regs) struct proc *p; struct reg *regs; { if ((p->p_flag & P_INMEM) == 0) return (EIO); return (set_regs(p, regs)); +} + +int +procfs_read_dbregs(p, dbregs) + struct proc *p; + struct dbreg *dbregs; +{ + if ((p->p_flag & P_INMEM) == 0) + return (EIO); + return (fill_dbregs(p, dbregs)); +} + +int +procfs_write_dbregs(p, dbregs) + struct proc *p; + struct dbreg *dbregs; +{ + if ((p->p_flag & P_INMEM) == 0) + return (EIO); + return (set_dbregs(p, dbregs)); } /* * Ptrace doesn't support fpregs at all, and there are no security holes * or translations for fpregs, so we can just copy them. */ int procfs_read_fpregs(p, fpregs) struct proc *p; struct fpreg *fpregs; { if ((p->p_flag & P_INMEM) == 0) return (EIO); return (fill_fpregs(p, fpregs)); } int procfs_write_fpregs(p, fpregs) struct proc *p; struct fpreg *fpregs; { if ((p->p_flag & P_INMEM) == 0) return (EIO); return (set_fpregs(p, fpregs)); } int procfs_sstep(p) struct proc *p; { if ((p->p_flag & P_INMEM) == 0) return (EIO); return (ptrace_single_step(p)); } Index: head/sys/i386/i386/swtch.s =================================================================== --- head/sys/i386/i386/swtch.s (revision 48690) +++ head/sys/i386/i386/swtch.s (revision 48691) @@ -1,805 +1,843 @@ /*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * - * $Id: swtch.s,v 1.82 1999/06/01 18:19:45 jlemon Exp $ + * $Id: swtch.s,v 1.83 1999/07/03 06:33:24 alc Exp $ */ #include "npx.h" #include "opt_user_ldt.h" #include #include #ifdef SMP #include #include #include /** GRAB_LOPRIO */ #include #include #endif /* SMP */ #include "assym.s" /*****************************************************************************/ /* Scheduling */ /*****************************************************************************/ /* * The following primitives manipulate the run queues. * _whichqs tells which of the 32 queues _qs * have processes in them. setrunqueue puts processes into queues, Remrq * removes them from queues. The running process is on no queue, * other processes are on a queue related to p->p_priority, divided by 4 * actually to shrink the 0-127 range of priorities into the 32 available * queues. */ .data .globl _whichqs, _whichrtqs, _whichidqs _whichqs: .long 0 /* which run queues have data */ _whichrtqs: .long 0 /* which realtime run qs have data */ _whichidqs: .long 0 /* which idletime run qs have data */ .globl _hlt_vector _hlt_vector: .long _default_halt /* pointer to halt routine */ .globl _qs,_cnt,_panic .globl _want_resched _want_resched: .long 0 /* we need to re-run the scheduler */ #if defined(SWTCH_OPTIM_STATS) .globl _swtch_optim_stats, _tlb_flush_count _swtch_optim_stats: .long 0 /* number of _swtch_optims */ _tlb_flush_count: .long 0 #endif .text /* * setrunqueue(p) * * Call should be made at spl6(), and p->p_stat should be SRUN */ ENTRY(setrunqueue) movl 4(%esp),%eax #ifdef DIAGNOSTIC cmpb $SRUN,P_STAT(%eax) je set1 pushl $set2 call _panic set1: #endif cmpw $RTP_PRIO_NORMAL,P_RTPRIO_TYPE(%eax) /* normal priority process? */ je set_nort movzwl P_RTPRIO_PRIO(%eax),%edx cmpw $RTP_PRIO_REALTIME,P_RTPRIO_TYPE(%eax) /* RR realtime priority? */ je set_rt /* RT priority */ cmpw $RTP_PRIO_FIFO,P_RTPRIO_TYPE(%eax) /* FIFO realtime priority? */ jne set_id /* must be idle priority */ set_rt: btsl %edx,_whichrtqs /* set q full bit */ shll $3,%edx addl $_rtqs,%edx /* locate q hdr */ movl %edx,P_FORW(%eax) /* link process on tail of q */ movl P_BACK(%edx),%ecx movl %ecx,P_BACK(%eax) movl %eax,P_BACK(%edx) movl %eax,P_FORW(%ecx) ret set_id: btsl %edx,_whichidqs /* set q full bit */ shll $3,%edx addl $_idqs,%edx /* locate q hdr */ movl %edx,P_FORW(%eax) /* link process on tail of q */ movl P_BACK(%edx),%ecx movl %ecx,P_BACK(%eax) movl %eax,P_BACK(%edx) movl %eax,P_FORW(%ecx) ret set_nort: /* Normal (RTOFF) code */ movzbl P_PRI(%eax),%edx shrl $2,%edx btsl %edx,_whichqs /* set q full bit */ shll $3,%edx addl $_qs,%edx /* locate q hdr */ movl %edx,P_FORW(%eax) /* link process on tail of q */ movl P_BACK(%edx),%ecx movl %ecx,P_BACK(%eax) movl %eax,P_BACK(%edx) movl %eax,P_FORW(%ecx) ret set2: .asciz "setrunqueue" /* * Remrq(p) * * Call should be made at spl6(). */ ENTRY(remrq) movl 4(%esp),%eax cmpw $RTP_PRIO_NORMAL,P_RTPRIO_TYPE(%eax) /* normal priority process? */ je rem_nort movzwl P_RTPRIO_PRIO(%eax),%edx cmpw $RTP_PRIO_REALTIME,P_RTPRIO_TYPE(%eax) /* realtime priority process? */ je rem0rt cmpw $RTP_PRIO_FIFO,P_RTPRIO_TYPE(%eax) /* FIFO realtime priority process? */ jne rem_id rem0rt: btrl %edx,_whichrtqs /* clear full bit, panic if clear already */ jb rem1rt pushl $rem3rt call _panic rem1rt: pushl %edx movl P_FORW(%eax),%ecx /* unlink process */ movl P_BACK(%eax),%edx movl %edx,P_BACK(%ecx) movl P_BACK(%eax),%ecx movl P_FORW(%eax),%edx movl %edx,P_FORW(%ecx) popl %edx movl $_rtqs,%ecx shll $3,%edx addl %edx,%ecx cmpl P_FORW(%ecx),%ecx /* q still has something? */ je rem2rt shrl $3,%edx /* yes, set bit as still full */ btsl %edx,_whichrtqs rem2rt: ret rem_id: btrl %edx,_whichidqs /* clear full bit, panic if clear already */ jb rem1id pushl $rem3id call _panic rem1id: pushl %edx movl P_FORW(%eax),%ecx /* unlink process */ movl P_BACK(%eax),%edx movl %edx,P_BACK(%ecx) movl P_BACK(%eax),%ecx movl P_FORW(%eax),%edx movl %edx,P_FORW(%ecx) popl %edx movl $_idqs,%ecx shll $3,%edx addl %edx,%ecx cmpl P_FORW(%ecx),%ecx /* q still has something? */ je rem2id shrl $3,%edx /* yes, set bit as still full */ btsl %edx,_whichidqs rem2id: ret rem_nort: movzbl P_PRI(%eax),%edx shrl $2,%edx btrl %edx,_whichqs /* clear full bit, panic if clear already */ jb rem1 pushl $rem3 call _panic rem1: pushl %edx movl P_FORW(%eax),%ecx /* unlink process */ movl P_BACK(%eax),%edx movl %edx,P_BACK(%ecx) movl P_BACK(%eax),%ecx movl P_FORW(%eax),%edx movl %edx,P_FORW(%ecx) popl %edx movl $_qs,%ecx shll $3,%edx addl %edx,%ecx cmpl P_FORW(%ecx),%ecx /* q still has something? */ je rem2 shrl $3,%edx /* yes, set bit as still full */ btsl %edx,_whichqs rem2: ret rem3: .asciz "remrq" rem3rt: .asciz "remrq.rt" rem3id: .asciz "remrq.id" /* * When no processes are on the runq, cpu_switch() branches to _idle * to wait for something to come ready. */ ALIGN_TEXT .type _idle,@function _idle: xorl %ebp,%ebp movl %ebp,_switchtime #ifdef SMP /* when called, we have the mplock, intr disabled */ /* use our idleproc's "context" */ movl _IdlePTD, %ecx movl %cr3, %eax cmpl %ecx, %eax je 2f #if defined(SWTCH_OPTIM_STATS) decl _swtch_optim_stats incl _tlb_flush_count #endif movl %ecx, %cr3 2: /* Keep space for nonexisting return addr, or profiling bombs */ movl $gd_idlestack_top-4, %ecx addl %fs:0, %ecx movl %ecx, %esp /* update common_tss.tss_esp0 pointer */ movl %ecx, _common_tss + TSS_ESP0 movl _cpuid, %esi btrl %esi, _private_tss jae 1f movl $gd_common_tssd, %edi addl %fs:0, %edi /* move correct tss descriptor into GDT slot, then reload tr */ movl _tss_gdt, %ebx /* entry in GDT */ movl 0(%edi), %eax movl %eax, 0(%ebx) movl 4(%edi), %eax movl %eax, 4(%ebx) movl $GPROC0_SEL*8, %esi /* GSEL(entry, SEL_KPL) */ ltr %si 1: sti /* * XXX callers of cpu_switch() do a bogus splclock(). Locking should * be left to cpu_switch(). */ call _spl0 cli /* * _REALLY_ free the lock, no matter how deep the prior nesting. * We will recover the nesting on the way out when we have a new * proc to load. * * XXX: we had damn well better be sure we had it before doing this! */ CPL_LOCK /* XXX */ MPLOCKED andl $~SWI_AST_MASK, _ipending /* XXX */ movl $0, _cpl /* XXX Allow ASTs on other CPU */ CPL_UNLOCK /* XXX */ movl $FREE_LOCK, %eax movl %eax, _mp_lock /* do NOT have lock, intrs disabled */ .globl idle_loop idle_loop: cmpl $0,_smp_active jne 1f cmpl $0,_cpuid je 1f jmp 2f 1: cmpl $0,_whichrtqs /* real-time queue */ jne 3f cmpl $0,_whichqs /* normal queue */ jne 3f cmpl $0,_whichidqs /* 'idle' queue */ jne 3f cmpl $0,_do_page_zero_idle je 2f /* XXX appears to cause panics */ /* * Inside zero_idle we enable interrupts and grab the mplock * as needed. It needs to be careful about entry/exit mutexes. */ call _vm_page_zero_idle /* internal locking */ testl %eax, %eax jnz idle_loop 2: /* enable intrs for a halt */ movl $0, lapic_tpr /* 1st candidate for an INT */ sti call *_hlt_vector /* wait for interrupt */ cli jmp idle_loop 3: movl $LOPRIO_LEVEL, lapic_tpr /* arbitrate for INTs */ call _get_mplock CPL_LOCK /* XXX */ movl $SWI_AST_MASK, _cpl /* XXX Disallow ASTs on other CPU */ CPL_UNLOCK /* XXX */ cmpl $0,_whichrtqs /* real-time queue */ CROSSJUMP(jne, sw1a, je) cmpl $0,_whichqs /* normal queue */ CROSSJUMP(jne, nortqr, je) cmpl $0,_whichidqs /* 'idle' queue */ CROSSJUMP(jne, idqr, je) CPL_LOCK /* XXX */ movl $0, _cpl /* XXX Allow ASTs on other CPU */ CPL_UNLOCK /* XXX */ call _rel_mplock jmp idle_loop #else /* !SMP */ movl $HIDENAME(tmpstk),%esp #if defined(OVERLY_CONSERVATIVE_PTD_MGMT) #if defined(SWTCH_OPTIM_STATS) incl _swtch_optim_stats #endif movl _IdlePTD, %ecx movl %cr3, %eax cmpl %ecx, %eax je 2f #if defined(SWTCH_OPTIM_STATS) decl _swtch_optim_stats incl _tlb_flush_count #endif movl %ecx, %cr3 2: #endif /* update common_tss.tss_esp0 pointer */ movl %esp, _common_tss + TSS_ESP0 movl $0, %esi btrl %esi, _private_tss jae 1f movl $_common_tssd, %edi /* move correct tss descriptor into GDT slot, then reload tr */ movl _tss_gdt, %ebx /* entry in GDT */ movl 0(%edi), %eax movl %eax, 0(%ebx) movl 4(%edi), %eax movl %eax, 4(%ebx) movl $GPROC0_SEL*8, %esi /* GSEL(entry, SEL_KPL) */ ltr %si 1: sti /* * XXX callers of cpu_switch() do a bogus splclock(). Locking should * be left to cpu_switch(). */ call _spl0 ALIGN_TEXT idle_loop: cli cmpl $0,_whichrtqs /* real-time queue */ CROSSJUMP(jne, sw1a, je) cmpl $0,_whichqs /* normal queue */ CROSSJUMP(jne, nortqr, je) cmpl $0,_whichidqs /* 'idle' queue */ CROSSJUMP(jne, idqr, je) call _vm_page_zero_idle testl %eax, %eax jnz idle_loop sti call *_hlt_vector /* wait for interrupt */ jmp idle_loop #endif /* SMP */ CROSSJUMPTARGET(_idle) ENTRY(default_halt) #ifndef SMP hlt /* XXX: until a wakeup IPI */ #endif ret /* * cpu_switch() */ ENTRY(cpu_switch) /* switch to new process. first, save context as needed */ movl _curproc,%ecx /* if no process to save, don't bother */ testl %ecx,%ecx je sw1 #ifdef SMP movb P_ONCPU(%ecx), %al /* save "last" cpu */ movb %al, P_LASTCPU(%ecx) movb $0xff, P_ONCPU(%ecx) /* "leave" the cpu */ #endif /* SMP */ movl P_VMSPACE(%ecx), %edx #ifdef SMP movl _cpuid, %eax #else xorl %eax, %eax #endif /* SMP */ btrl %eax, VM_PMAP+PM_ACTIVE(%edx) movl P_ADDR(%ecx),%edx movl (%esp),%eax /* Hardware registers */ movl %eax,PCB_EIP(%edx) movl %ebx,PCB_EBX(%edx) movl %esp,PCB_ESP(%edx) movl %ebp,PCB_EBP(%edx) movl %esi,PCB_ESI(%edx) movl %edi,PCB_EDI(%edx) movl %gs,PCB_GS(%edx) + /* test if debug regisers should be saved */ + movb PCB_FLAGS(%edx),%al + andb $PCB_DBREGS,%al + jz 1f /* no, skip over */ + movl %dr7,%eax /* yes, do the save */ + movl %eax,PCB_DR7(%edx) + andl $0x0000ff00, %eax /* disable all watchpoints */ + movl %eax,%dr7 + movl %dr6,%eax + movl %eax,PCB_DR6(%edx) + movl %dr3,%eax + movl %eax,PCB_DR3(%edx) + movl %dr2,%eax + movl %eax,PCB_DR2(%edx) + movl %dr1,%eax + movl %eax,PCB_DR1(%edx) + movl %dr0,%eax + movl %eax,PCB_DR0(%edx) +1: + #ifdef SMP movl _mp_lock, %eax /* XXX FIXME: we should be saving the local APIC TPR */ #ifdef DIAGNOSTIC cmpl $FREE_LOCK, %eax /* is it free? */ je badsw4 /* yes, bad medicine! */ #endif /* DIAGNOSTIC */ andl $COUNT_FIELD, %eax /* clear CPU portion */ movl %eax, PCB_MPNEST(%edx) /* store it */ #endif /* SMP */ #if NNPX > 0 /* have we used fp, and need a save? */ cmpl %ecx,_npxproc jne 1f addl $PCB_SAVEFPU,%edx /* h/w bugs make saving complicated */ pushl %edx call _npxsave /* do it in a big C function */ popl %eax 1: #endif /* NNPX > 0 */ movl $0,_curproc /* out of process */ /* save is done, now choose a new process or idle */ sw1: cli #ifdef SMP /* Stop scheduling if smp_active goes zero and we are not BSP */ cmpl $0,_smp_active jne 1f cmpl $0,_cpuid je 1f CROSSJUMP(je, _idle, jne) /* wind down */ 1: #endif sw1a: movl _whichrtqs,%edi /* pick next p. from rtqs */ testl %edi,%edi jz nortqr /* no realtime procs */ /* XXX - bsf is sloow */ bsfl %edi,%ebx /* find a full q */ jz nortqr /* no proc on rt q - try normal ... */ /* XX update whichqs? */ btrl %ebx,%edi /* clear q full status */ leal _rtqs(,%ebx,8),%eax /* select q */ movl %eax,%esi movl P_FORW(%eax),%ecx /* unlink from front of process q */ movl P_FORW(%ecx),%edx movl %edx,P_FORW(%eax) movl P_BACK(%ecx),%eax movl %eax,P_BACK(%edx) cmpl P_FORW(%ecx),%esi /* q empty */ je rt3 btsl %ebx,%edi /* nope, set to indicate not empty */ rt3: movl %edi,_whichrtqs /* update q status */ jmp swtch_com /* old sw1a */ /* Normal process priority's */ nortqr: movl _whichqs,%edi 2: /* XXX - bsf is sloow */ bsfl %edi,%ebx /* find a full q */ jz idqr /* if none, idle */ /* XX update whichqs? */ btrl %ebx,%edi /* clear q full status */ leal _qs(,%ebx,8),%eax /* select q */ movl %eax,%esi movl P_FORW(%eax),%ecx /* unlink from front of process q */ movl P_FORW(%ecx),%edx movl %edx,P_FORW(%eax) movl P_BACK(%ecx),%eax movl %eax,P_BACK(%edx) cmpl P_FORW(%ecx),%esi /* q empty */ je 3f btsl %ebx,%edi /* nope, set to indicate not empty */ 3: movl %edi,_whichqs /* update q status */ jmp swtch_com idqr: /* was sw1a */ movl _whichidqs,%edi /* pick next p. from idqs */ /* XXX - bsf is sloow */ bsfl %edi,%ebx /* find a full q */ CROSSJUMP(je, _idle, jne) /* if no proc, idle */ /* XX update whichqs? */ btrl %ebx,%edi /* clear q full status */ leal _idqs(,%ebx,8),%eax /* select q */ movl %eax,%esi movl P_FORW(%eax),%ecx /* unlink from front of process q */ movl P_FORW(%ecx),%edx movl %edx,P_FORW(%eax) movl P_BACK(%ecx),%eax movl %eax,P_BACK(%edx) cmpl P_FORW(%ecx),%esi /* q empty */ je id3 btsl %ebx,%edi /* nope, set to indicate not empty */ id3: movl %edi,_whichidqs /* update q status */ swtch_com: movl $0,%eax movl %eax,_want_resched #ifdef DIAGNOSTIC cmpl %eax,P_WCHAN(%ecx) jne badsw1 cmpb $SRUN,P_STAT(%ecx) jne badsw2 #endif movl %eax,P_BACK(%ecx) /* isolate process to run */ movl P_ADDR(%ecx),%edx #if defined(SWTCH_OPTIM_STATS) incl _swtch_optim_stats #endif /* switch address space */ movl %cr3,%ebx cmpl PCB_CR3(%edx),%ebx je 4f #if defined(SWTCH_OPTIM_STATS) decl _swtch_optim_stats incl _tlb_flush_count #endif movl PCB_CR3(%edx),%ebx movl %ebx,%cr3 4: #ifdef SMP movl _cpuid, %esi #else xorl %esi, %esi #endif cmpl $0, PCB_EXT(%edx) /* has pcb extension? */ je 1f btsl %esi, _private_tss /* mark use of private tss */ movl PCB_EXT(%edx), %edi /* new tss descriptor */ jmp 2f 1: /* update common_tss.tss_esp0 pointer */ movl %edx, %ebx /* pcb */ addl $(UPAGES * PAGE_SIZE - 16), %ebx movl %ebx, _common_tss + TSS_ESP0 btrl %esi, _private_tss jae 3f #ifdef SMP movl $gd_common_tssd, %edi addl %fs:0, %edi #else movl $_common_tssd, %edi #endif 2: /* move correct tss descriptor into GDT slot, then reload tr */ movl _tss_gdt, %ebx /* entry in GDT */ movl 0(%edi), %eax movl %eax, 0(%ebx) movl 4(%edi), %eax movl %eax, 4(%ebx) movl $GPROC0_SEL*8, %esi /* GSEL(entry, SEL_KPL) */ ltr %si 3: movl P_VMSPACE(%ecx), %ebx #ifdef SMP movl _cpuid, %eax #else xorl %eax, %eax #endif btsl %eax, VM_PMAP+PM_ACTIVE(%ebx) /* restore context */ movl PCB_EBX(%edx),%ebx movl PCB_ESP(%edx),%esp movl PCB_EBP(%edx),%ebp movl PCB_ESI(%edx),%esi movl PCB_EDI(%edx),%edi movl PCB_EIP(%edx),%eax movl %eax,(%esp) #ifdef SMP #ifdef GRAB_LOPRIO /* hold LOPRIO for INTs */ #ifdef CHEAP_TPR movl $0, lapic_tpr #else andl $~APIC_TPR_PRIO, lapic_tpr #endif /** CHEAP_TPR */ #endif /** GRAB_LOPRIO */ movl _cpuid,%eax movb %al, P_ONCPU(%ecx) #endif /* SMP */ movl %edx, _curpcb movl %ecx, _curproc /* into next process */ #ifdef SMP movl _cpu_lockid, %eax orl PCB_MPNEST(%edx), %eax /* add next count from PROC */ movl %eax, _mp_lock /* load the mp_lock */ /* XXX FIXME: we should be restoring the local APIC TPR */ #endif /* SMP */ #ifdef USER_LDT cmpl $0, PCB_USERLDT(%edx) jnz 1f movl __default_ldt,%eax cmpl _currentldt,%eax je 2f lldt __default_ldt movl %eax,_currentldt jmp 2f 1: pushl %edx call _set_user_ldt popl %edx 2: #endif /* This must be done after loading the user LDT. */ .globl cpu_switch_load_gs cpu_switch_load_gs: movl PCB_GS(%edx),%gs + + /* test if debug regisers should be restored */ + movb PCB_FLAGS(%edx),%al + andb $PCB_DBREGS,%al + jz 1f /* no, skip over */ + movl PCB_DR6(%edx),%eax /* yes, do the restore */ + movl %eax,%dr6 + movl PCB_DR3(%edx),%eax + movl %eax,%dr3 + movl PCB_DR2(%edx),%eax + movl %eax,%dr2 + movl PCB_DR1(%edx),%eax + movl %eax,%dr1 + movl PCB_DR0(%edx),%eax + movl %eax,%dr0 + movl PCB_DR7(%edx),%eax + movl %eax,%dr7 +1: sti ret CROSSJUMPTARGET(idqr) CROSSJUMPTARGET(nortqr) CROSSJUMPTARGET(sw1a) #ifdef DIAGNOSTIC badsw1: pushl $sw0_1 call _panic sw0_1: .asciz "cpu_switch: has wchan" badsw2: pushl $sw0_2 call _panic sw0_2: .asciz "cpu_switch: not SRUN" #endif #if defined(SMP) && defined(DIAGNOSTIC) badsw4: pushl $sw0_4 call _panic sw0_4: .asciz "cpu_switch: do not have lock" #endif /* SMP && DIAGNOSTIC */ /* * savectx(pcb) * Update pcb, saving current processor state. */ ENTRY(savectx) /* fetch PCB */ movl 4(%esp),%ecx /* caller's return address - child won't execute this routine */ movl (%esp),%eax movl %eax,PCB_EIP(%ecx) movl %ebx,PCB_EBX(%ecx) movl %esp,PCB_ESP(%ecx) movl %ebp,PCB_EBP(%ecx) movl %esi,PCB_ESI(%ecx) movl %edi,PCB_EDI(%ecx) movl %gs,PCB_GS(%ecx) #if NNPX > 0 /* * If npxproc == NULL, then the npx h/w state is irrelevant and the * state had better already be in the pcb. This is true for forks * but not for dumps (the old book-keeping with FP flags in the pcb * always lost for dumps because the dump pcb has 0 flags). * * If npxproc != NULL, then we have to save the npx h/w state to * npxproc's pcb and copy it to the requested pcb, or save to the * requested pcb and reload. Copying is easier because we would * have to handle h/w bugs for reloading. We used to lose the * parent's npx state for forks by forgetting to reload. */ movl _npxproc,%eax testl %eax,%eax je 1f pushl %ecx movl P_ADDR(%eax),%eax leal PCB_SAVEFPU(%eax),%eax pushl %eax pushl %eax call _npxsave addl $4,%esp popl %eax popl %ecx pushl $PCB_SAVEFPU_SIZE leal PCB_SAVEFPU(%ecx),%ecx pushl %ecx pushl %eax call _bcopy addl $12,%esp #endif /* NNPX > 0 */ 1: ret Index: head/sys/i386/include/md_var.h =================================================================== --- head/sys/i386/include/md_var.h (revision 48690) +++ head/sys/i386/include/md_var.h (revision 48691) @@ -1,98 +1,100 @@ /*- * Copyright (c) 1995 Bruce D. Evans. * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the author nor the names of contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * - * $Id: md_var.h,v 1.28 1999/01/08 16:29:58 bde Exp $ + * $Id: md_var.h,v 1.29 1999/04/28 01:04:02 luoqi Exp $ */ #ifndef _MACHINE_MD_VAR_H_ #define _MACHINE_MD_VAR_H_ /* * Miscellaneous machine-dependent declarations. */ extern int Maxmem; extern u_int atdevbase; /* offset in virtual memory of ISA io mem */ extern void (*bcopy_vector) __P((const void *from, void *to, size_t len)); extern int busdma_swi_pending; extern int (*copyin_vector) __P((const void *udaddr, void *kaddr, size_t len)); extern int (*copyout_vector) __P((const void *kaddr, void *udaddr, size_t len)); extern u_int cpu_feature; extern u_int cpu_high; extern u_int cpu_id; extern char cpu_vendor[]; extern u_int cyrix_did; extern char kstack[]; #ifdef PC98 extern int need_pre_dma_flush; extern int need_post_dma_flush; #endif extern void (*netisrs[32]) __P((void)); extern int nfs_diskless_valid; extern void (*ovbcopy_vector) __P((const void *from, void *to, size_t len)); extern char sigcode[]; extern int szsigcode; typedef void alias_for_inthand_t __P((u_int cs, u_int ef, u_int esp, u_int ss)); struct proc; struct reg; struct fpreg; +struct dbreg; void bcopyb __P((const void *from, void *to, size_t len)); void busdma_swi __P((void)); void cpu_halt __P((void)); void cpu_reset __P((void)); void cpu_switch_load_gs __P((void)) __asm(__STRING(cpu_switch_load_gs)); void doreti_iret __P((void)) __asm(__STRING(doreti_iret)); void doreti_iret_fault __P((void)) __asm(__STRING(doreti_iret_fault)); void doreti_popl_ds __P((void)) __asm(__STRING(doreti_popl_ds)); void doreti_popl_ds_fault __P((void)) __asm(__STRING(doreti_popl_ds_fault)); void doreti_popl_es __P((void)) __asm(__STRING(doreti_popl_es)); void doreti_popl_es_fault __P((void)) __asm(__STRING(doreti_popl_es_fault)); void doreti_popl_fs __P((void)) __asm(__STRING(doreti_popl_fs)); void doreti_popl_fs_fault __P((void)) __asm(__STRING(doreti_popl_fs_fault)); int fill_fpregs __P((struct proc *, struct fpreg *)); int fill_regs __P((struct proc *p, struct reg *regs)); +int fill_dbregs __P((struct proc *p, struct dbreg *dbregs)); void fillw __P((int /*u_short*/ pat, void *base, size_t cnt)); void i486_bzero __P((void *buf, size_t len)); void i586_bcopy __P((const void *from, void *to, size_t len)); void i586_bzero __P((void *buf, size_t len)); int i586_copyin __P((const void *udaddr, void *kaddr, size_t len)); int i586_copyout __P((const void *kaddr, void *udaddr, size_t len)); void i686_pagezero __P((void *addr)); int is_physical_memory __P((vm_offset_t addr)); u_long kvtop __P((void *addr)); void setidt __P((int idx, alias_for_inthand_t *func, int typ, int dpl, int selec)); void swi_vm __P((void)); void userconfig __P((void)); int vm_page_zero_idle __P((void)); #endif /* !_MACHINE_MD_VAR_H_ */ Index: head/sys/i386/include/pcb.h =================================================================== --- head/sys/i386/include/pcb.h (revision 48690) +++ head/sys/i386/include/pcb.h (revision 48691) @@ -1,89 +1,98 @@ /*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)pcb.h 5.10 (Berkeley) 5/12/91 - * $Id: pcb.h,v 1.27 1999/04/28 01:04:05 luoqi Exp $ + * $Id: pcb.h,v 1.28 1999/06/01 18:20:06 jlemon Exp $ */ #ifndef _I386_PCB_H_ #define _I386_PCB_H_ /* * Intel 386 process control block */ #include #include struct pcb { int pcb_cr3; int pcb_edi; int pcb_esi; int pcb_ebp; int pcb_esp; int pcb_ebx; int pcb_eip; + + int pcb_dr0; + int pcb_dr1; + int pcb_dr2; + int pcb_dr3; + int pcb_dr6; + int pcb_dr7; + caddr_t pcb_ldt; /* per process (user) LDT */ int pcb_ldt_len; /* number of LDT entries */ struct save87 pcb_savefpu; /* floating point state for 287/387 */ u_char pcb_flags; #define FP_SOFTFP 0x01 /* process using software fltng pnt emulator */ +#define PCB_DBREGS 0x02 /* process using debug registers */ caddr_t pcb_onfault; /* copyin/out fault recovery */ #ifdef SMP u_long pcb_mpnest; #else u_long pcb_mpnest_dontuse; #endif int pcb_gs; struct pcb_ext *pcb_ext; /* optional pcb extension */ u_long __pcb_spare[2]; /* adjust to avoid core dump size changes */ }; /* * The pcb is augmented with machine-dependent additional data for * core dumps. For the i386: ??? */ struct md_coredump { }; #ifdef KERNEL #ifndef curpcb extern struct pcb *curpcb; /* our current running pcb */ #endif void savectx __P((struct pcb *)); #endif #endif /* _I386_PCB_H_ */ Index: head/sys/i386/include/ptrace.h =================================================================== --- head/sys/i386/include/ptrace.h (revision 48690) +++ head/sys/i386/include/ptrace.h (revision 48691) @@ -1,53 +1,55 @@ /* * Copyright (c) 1992, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)ptrace.h 8.1 (Berkeley) 6/11/93 - * $Id: ptrace.h,v 1.5 1997/02/22 09:35:03 peter Exp $ + * $Id: ptrace.h,v 1.6 1998/05/19 00:00:12 tegge Exp $ */ #ifndef _MACHINE_PTRACE_H_ #define _MACHINE_PTRACE_H_ /* * Machine dependent trace commands. */ #define PT_GETREGS (PT_FIRSTMACH + 1) #define PT_SETREGS (PT_FIRSTMACH + 2) #define PT_GETFPREGS (PT_FIRSTMACH + 3) #define PT_SETFPREGS (PT_FIRSTMACH + 4) +#define PT_GETDBREGS (PT_FIRSTMACH + 5) +#define PT_SETDBREGS (PT_FIRSTMACH + 6) #ifdef KERNEL int ptrace_read_u_check __P((struct proc *p, vm_offset_t off, size_t len)); #endif /* !KERNEL */ #endif Index: head/sys/i386/include/reg.h =================================================================== --- head/sys/i386/include/reg.h (revision 48690) +++ head/sys/i386/include/reg.h (revision 48691) @@ -1,130 +1,143 @@ /*- * Copyright (c) 1990 The Regents of the University of California. * All rights reserved. * * This code is derived from software contributed to Berkeley by * William Jolitz. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * from: @(#)reg.h 5.5 (Berkeley) 1/18/91 - * $Id: reg.h,v 1.17 1999/04/03 22:19:59 jdp Exp $ + * $Id: reg.h,v 1.18 1999/04/28 01:04:06 luoqi Exp $ */ #ifndef _MACHINE_REG_H_ #define _MACHINE_REG_H_ /* * Indices for registers in `struct trapframe' and `struct regs'. * * This interface is deprecated. In the kernel, it is only used in FPU * emulators to convert from register numbers encoded in instructions to * register values. Everything else just accesses the relevant struct * members. In userland, debuggers tend to abuse this interface since * they don't understand that `struct regs' is a struct. I hope they have * stopped accessing the registers in the trap frame via PT_{READ,WRITE}_U * and we can stop supporting the user area soon. */ #define tFS (0) #define tES (1) #define tDS (2) #define tEDI (3) #define tESI (4) #define tEBP (5) #define tISP (6) #define tEBX (7) #define tEDX (8) #define tECX (9) #define tEAX (10) #define tERR (12) #define tEIP (13) #define tCS (14) #define tEFLAGS (15) #define tESP (16) #define tSS (17) /* * Indices for registers in `struct regs' only. * * Some registers live in the pcb and are only in an "array" with the * other registers in application interfaces that copy all the registers * to or from a `struct regs'. */ #define tGS (18) /* * Register set accessible via /proc/$pid/regs and PT_{SET,GET}REGS. */ struct reg { unsigned int r_fs; unsigned int r_es; unsigned int r_ds; unsigned int r_edi; unsigned int r_esi; unsigned int r_ebp; unsigned int r_isp; unsigned int r_ebx; unsigned int r_edx; unsigned int r_ecx; unsigned int r_eax; unsigned int r_trapno; unsigned int r_err; unsigned int r_eip; unsigned int r_cs; unsigned int r_eflags; unsigned int r_esp; unsigned int r_ss; unsigned int r_gs; }; /* * Register set accessible via /proc/$pid/fpregs. */ struct fpreg { /* * XXX should get struct from npx.h. Here we give a slightly * simplified struct. This may be too much detail. Perhaps * an array of unsigned longs is best. */ unsigned long fpr_env[7]; unsigned char fpr_acc[8][10]; unsigned long fpr_ex_sw; unsigned char fpr_pad[64]; }; +struct dbreg { + unsigned int dr0; /* debug address register 0 */ + unsigned int dr1; /* debug address register 1 */ + unsigned int dr2; /* debug address register 2 */ + unsigned int dr3; /* debug address register 3 */ + unsigned int dr4; /* reserved */ + unsigned int dr5; /* reserved */ + unsigned int dr6; /* debug status register */ + unsigned int dr7; /* debug control register */ +}; + + #ifdef KERNEL /* * XXX these interfaces are MI, so they should be declared in a MI place. */ int set_fpregs __P((struct proc *, struct fpreg *)); int set_regs __P((struct proc *p, struct reg *regs)); void setregs __P((struct proc *, u_long, u_long, u_long)); +int set_dbregs __P((struct proc *p, struct dbreg *dbregs)); #endif #endif /* !_MACHINE_REG_H_ */ Index: head/sys/kern/sys_process.c =================================================================== --- head/sys/kern/sys_process.c (revision 48690) +++ head/sys/kern/sys_process.c (revision 48691) @@ -1,536 +1,568 @@ /* * Copyright (c) 1994, Sean Eric Fagan * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by Sean Eric Fagan. * 4. The name of the author may not be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * - * $Id: sys_process.c,v 1.45 1999/04/28 11:37:04 phk Exp $ + * $Id: sys_process.c,v 1.46 1999/07/01 22:52:40 peter Exp $ */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include /* use the equivalent procfs code */ #if 0 static int pread (struct proc *procp, unsigned int addr, unsigned int *retval) { int rv; vm_map_t map, tmap; vm_object_t object; vm_offset_t kva = 0; int page_offset; /* offset into page */ vm_offset_t pageno; /* page number */ vm_map_entry_t out_entry; vm_prot_t out_prot; boolean_t wired; vm_pindex_t pindex; /* Map page into kernel space */ map = &procp->p_vmspace->vm_map; page_offset = addr - trunc_page(addr); pageno = trunc_page(addr); tmap = map; rv = vm_map_lookup (&tmap, pageno, VM_PROT_READ, &out_entry, &object, &pindex, &out_prot, &wired); if (rv != KERN_SUCCESS) return EINVAL; vm_map_lookup_done (tmap, out_entry); /* Find space in kernel_map for the page we're interested in */ rv = vm_map_find (kernel_map, object, IDX_TO_OFF(pindex), &kva, PAGE_SIZE, 0, VM_PROT_ALL, VM_PROT_ALL, 0); if (!rv) { vm_object_reference (object); rv = vm_map_pageable (kernel_map, kva, kva + PAGE_SIZE, 0); if (!rv) { *retval = 0; bcopy ((caddr_t)kva + page_offset, retval, sizeof *retval); } vm_map_remove (kernel_map, kva, kva + PAGE_SIZE); } return rv; } static int pwrite (struct proc *procp, unsigned int addr, unsigned int datum) { int rv; vm_map_t map, tmap; vm_object_t object; vm_offset_t kva = 0; int page_offset; /* offset into page */ vm_offset_t pageno; /* page number */ vm_map_entry_t out_entry; vm_prot_t out_prot; boolean_t wired; vm_pindex_t pindex; boolean_t fix_prot = 0; /* Map page into kernel space */ map = &procp->p_vmspace->vm_map; page_offset = addr - trunc_page(addr); pageno = trunc_page(addr); /* * Check the permissions for the area we're interested in. */ if (vm_map_check_protection (map, pageno, pageno + PAGE_SIZE, VM_PROT_WRITE) == FALSE) { /* * If the page was not writable, we make it so. * XXX It is possible a page may *not* be read/executable, * if a process changes that! */ fix_prot = 1; /* The page isn't writable, so let's try making it so... */ if ((rv = vm_map_protect (map, pageno, pageno + PAGE_SIZE, VM_PROT_ALL, 0)) != KERN_SUCCESS) return EFAULT; /* I guess... */ } /* * Now we need to get the page. out_entry, out_prot, wired, and * single_use aren't used. One would think the vm code would be * a *bit* nicer... We use tmap because vm_map_lookup() can * change the map argument. */ tmap = map; rv = vm_map_lookup (&tmap, pageno, VM_PROT_WRITE, &out_entry, &object, &pindex, &out_prot, &wired); if (rv != KERN_SUCCESS) { return EINVAL; } /* * Okay, we've got the page. Let's release tmap. */ vm_map_lookup_done (tmap, out_entry); /* * Fault the page in... */ rv = vm_fault(map, pageno, VM_PROT_WRITE|VM_PROT_READ, FALSE); if (rv != KERN_SUCCESS) return EFAULT; /* Find space in kernel_map for the page we're interested in */ rv = vm_map_find (kernel_map, object, IDX_TO_OFF(pindex), &kva, PAGE_SIZE, 0, VM_PROT_ALL, VM_PROT_ALL, 0); if (!rv) { vm_object_reference (object); rv = vm_map_pageable (kernel_map, kva, kva + PAGE_SIZE, 0); if (!rv) { bcopy (&datum, (caddr_t)kva + page_offset, sizeof datum); } vm_map_remove (kernel_map, kva, kva + PAGE_SIZE); } if (fix_prot) vm_map_protect (map, pageno, pageno + PAGE_SIZE, VM_PROT_READ|VM_PROT_EXECUTE, 0); return rv; } #endif /* * Process debugging system call. */ #ifndef _SYS_SYSPROTO_H_ struct ptrace_args { int req; pid_t pid; caddr_t addr; int data; }; #endif int ptrace(curp, uap) struct proc *curp; struct ptrace_args *uap; { struct proc *p; struct iovec iov; struct uio uio; int error = 0; int write; int s; write = 0; if (uap->req == PT_TRACE_ME) p = curp; else { if ((p = pfind(uap->pid)) == NULL) return ESRCH; } if (!PRISON_CHECK(curp, p)) return (ESRCH); /* * Permissions check */ switch (uap->req) { case PT_TRACE_ME: /* Always legal. */ break; case PT_ATTACH: /* Self */ if (p->p_pid == curp->p_pid) return EINVAL; /* Already traced */ if (p->p_flag & P_TRACED) return EBUSY; /* not owned by you, has done setuid (unless you're root) */ if ((p->p_cred->p_ruid != curp->p_cred->p_ruid) || (p->p_flag & P_SUGID)) { if ((error = suser(curp)) != 0) return error; } /* can't trace init when securelevel > 0 */ if (securelevel > 0 && p->p_pid == 1) return EPERM; /* OK */ break; case PT_READ_I: case PT_READ_D: case PT_READ_U: case PT_WRITE_I: case PT_WRITE_D: case PT_WRITE_U: case PT_CONTINUE: case PT_KILL: case PT_STEP: case PT_DETACH: #ifdef PT_GETREGS case PT_GETREGS: #endif #ifdef PT_SETREGS case PT_SETREGS: #endif #ifdef PT_GETFPREGS case PT_GETFPREGS: #endif #ifdef PT_SETFPREGS case PT_SETFPREGS: #endif +#ifdef PT_GETDBREGS + case PT_GETDBREGS: +#endif +#ifdef PT_SETDBREGS + case PT_SETDBREGS: +#endif /* not being traced... */ if ((p->p_flag & P_TRACED) == 0) return EPERM; /* not being traced by YOU */ if (p->p_pptr != curp) return EBUSY; /* not currently stopped */ if (p->p_stat != SSTOP || (p->p_flag & P_WAITED) == 0) return EBUSY; /* OK */ break; default: return EINVAL; } #ifdef FIX_SSTEP /* * Single step fixup ala procfs */ FIX_SSTEP(p); #endif /* * Actually do the requests */ curp->p_retval[0] = 0; switch (uap->req) { case PT_TRACE_ME: /* set my trace flag and "owner" so it can read/write me */ p->p_flag |= P_TRACED; p->p_oppid = p->p_pptr->p_pid; return 0; case PT_ATTACH: /* security check done above */ p->p_flag |= P_TRACED; p->p_oppid = p->p_pptr->p_pid; if (p->p_pptr != curp) proc_reparent(p, curp); uap->data = SIGSTOP; goto sendsig; /* in PT_CONTINUE below */ case PT_STEP: case PT_CONTINUE: case PT_DETACH: if ((unsigned)uap->data >= NSIG) return EINVAL; PHOLD(p); if (uap->req == PT_STEP) { if ((error = ptrace_single_step (p))) { PRELE(p); return error; } } if (uap->addr != (caddr_t)1) { fill_eproc (p, &p->p_addr->u_kproc.kp_eproc); if ((error = ptrace_set_pc (p, (u_long)(uintfptr_t)uap->addr))) { PRELE(p); return error; } } PRELE(p); if (uap->req == PT_DETACH) { /* reset process parent */ if (p->p_oppid != p->p_pptr->p_pid) { struct proc *pp; pp = pfind(p->p_oppid); proc_reparent(p, pp ? pp : initproc); } p->p_flag &= ~(P_TRACED | P_WAITED); p->p_oppid = 0; /* should we send SIGCHLD? */ } sendsig: /* deliver or queue signal */ s = splhigh(); if (p->p_stat == SSTOP) { p->p_xstat = uap->data; setrunnable(p); } else if (uap->data) { psignal(p, uap->data); } splx(s); return 0; case PT_WRITE_I: case PT_WRITE_D: write = 1; /* fallthrough */ case PT_READ_I: case PT_READ_D: /* write = 0 set above */ iov.iov_base = write ? (caddr_t)&uap->data : (caddr_t)curp->p_retval; iov.iov_len = sizeof(int); uio.uio_iov = &iov; uio.uio_iovcnt = 1; uio.uio_offset = (off_t)(uintptr_t)uap->addr; uio.uio_resid = sizeof(int); uio.uio_segflg = UIO_SYSSPACE; /* ie: the uap */ uio.uio_rw = write ? UIO_WRITE : UIO_READ; uio.uio_procp = p; error = procfs_domem(curp, p, NULL, &uio); if (uio.uio_resid != 0) { /* * XXX procfs_domem() doesn't currently return ENOSPC, * so I think write() can bogusly return 0. * XXX what happens for short writes? We don't want * to write partial data. * XXX procfs_domem() returns EPERM for other invalid * addresses. Convert this to EINVAL. Does this * clobber returns of EPERM for other reasons? */ if (error == 0 || error == ENOSPC || error == EPERM) error = EINVAL; /* EOF */ } return (error); case PT_READ_U: if ((uintptr_t)uap->addr > UPAGES * PAGE_SIZE - sizeof(int)) { return EFAULT; } if ((uintptr_t)uap->addr & (sizeof(int) - 1)) { return EFAULT; } if (ptrace_read_u_check(p,(vm_offset_t) uap->addr, sizeof(int)) && !procfs_kmemaccess(curp)) { return EFAULT; } error = 0; PHOLD(p); /* user had damn well better be incore! */ if (p->p_flag & P_INMEM) { p->p_addr->u_kproc.kp_proc = *p; fill_eproc (p, &p->p_addr->u_kproc.kp_eproc); curp->p_retval[0] = *(int *) ((uintptr_t)p->p_addr + (uintptr_t)uap->addr); } else { curp->p_retval[0] = 0; error = EFAULT; } PRELE(p); return error; case PT_WRITE_U: PHOLD(p); /* user had damn well better be incore! */ if (p->p_flag & P_INMEM) { p->p_addr->u_kproc.kp_proc = *p; fill_eproc (p, &p->p_addr->u_kproc.kp_eproc); error = ptrace_write_u(p, (vm_offset_t)uap->addr, uap->data); } else { error = EFAULT; } PRELE(p); return error; case PT_KILL: uap->data = SIGKILL; goto sendsig; /* in PT_CONTINUE above */ #ifdef PT_SETREGS case PT_SETREGS: write = 1; /* fallthrough */ #endif /* PT_SETREGS */ #ifdef PT_GETREGS case PT_GETREGS: /* write = 0 above */ #endif /* PT_SETREGS */ #if defined(PT_SETREGS) || defined(PT_GETREGS) if (!procfs_validregs(p)) /* no P_SYSTEM procs please */ return EINVAL; else { iov.iov_base = uap->addr; iov.iov_len = sizeof(struct reg); uio.uio_iov = &iov; uio.uio_iovcnt = 1; uio.uio_offset = 0; uio.uio_resid = sizeof(struct reg); uio.uio_segflg = UIO_USERSPACE; uio.uio_rw = write ? UIO_WRITE : UIO_READ; uio.uio_procp = curp; return (procfs_doregs(curp, p, NULL, &uio)); } #endif /* defined(PT_SETREGS) || defined(PT_GETREGS) */ #ifdef PT_SETFPREGS case PT_SETFPREGS: write = 1; /* fallthrough */ #endif /* PT_SETFPREGS */ #ifdef PT_GETFPREGS case PT_GETFPREGS: /* write = 0 above */ #endif /* PT_SETFPREGS */ #if defined(PT_SETFPREGS) || defined(PT_GETFPREGS) if (!procfs_validfpregs(p)) /* no P_SYSTEM procs please */ return EINVAL; else { iov.iov_base = uap->addr; iov.iov_len = sizeof(struct fpreg); uio.uio_iov = &iov; uio.uio_iovcnt = 1; uio.uio_offset = 0; uio.uio_resid = sizeof(struct fpreg); uio.uio_segflg = UIO_USERSPACE; uio.uio_rw = write ? UIO_WRITE : UIO_READ; uio.uio_procp = curp; return (procfs_dofpregs(curp, p, NULL, &uio)); } #endif /* defined(PT_SETFPREGS) || defined(PT_GETFPREGS) */ + +#ifdef PT_SETDBREGS + case PT_SETDBREGS: + write = 1; + /* fallthrough */ +#endif /* PT_SETDBREGS */ +#ifdef PT_GETDBREGS + case PT_GETDBREGS: + /* write = 0 above */ +#endif /* PT_SETDBREGS */ +#if defined(PT_SETDBREGS) || defined(PT_GETDBREGS) + if (!procfs_validdbregs(p)) /* no P_SYSTEM procs please */ + return EINVAL; + else { + iov.iov_base = uap->addr; + iov.iov_len = sizeof(struct dbreg); + uio.uio_iov = &iov; + uio.uio_iovcnt = 1; + uio.uio_offset = 0; + uio.uio_resid = sizeof(struct dbreg); + uio.uio_segflg = UIO_USERSPACE; + uio.uio_rw = write ? UIO_WRITE : UIO_READ; + uio.uio_procp = curp; + return (procfs_dodbregs(curp, p, NULL, &uio)); + } +#endif /* defined(PT_SETDBREGS) || defined(PT_GETDBREGS) */ default: break; } return 0; } int trace_req(p) struct proc *p; { return 1; } /* * stopevent() * Stop a process because of a procfs event; * stay stopped until p->p_step is cleared * (cleared by PIOCCONT in procfs). */ void stopevent(struct proc *p, unsigned int event, unsigned int val) { p->p_step = 1; do { p->p_xstat = val; p->p_stype = event; /* Which event caused the stop? */ wakeup(&p->p_stype); /* Wake up any PIOCWAIT'ing procs */ tsleep(&p->p_step, PWAIT, "stopevent", 0); } while (p->p_step); } Index: head/sys/miscfs/procfs/procfs.h =================================================================== --- head/sys/miscfs/procfs/procfs.h (revision 48690) +++ head/sys/miscfs/procfs/procfs.h (revision 48691) @@ -1,168 +1,174 @@ /* * Copyright (c) 1993 Jan-Simon Pendry * Copyright (c) 1993 * The Regents of the University of California. All rights reserved. * * This code is derived from software contributed to Berkeley by * Jan-Simon Pendry. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)procfs.h 8.9 (Berkeley) 5/14/95 * * From: - * $Id: procfs.h,v 1.25 1999/05/04 08:00:10 phk Exp $ + * $Id: procfs.h,v 1.26 1999/06/13 20:53:13 phk Exp $ */ /* * The different types of node in a procfs filesystem */ typedef enum { Proot, /* the filesystem root */ Pcurproc, /* symbolic link for curproc */ Pproc, /* a process-specific sub-directory */ Pfile, /* the executable file */ Pmem, /* the process's memory image */ Pregs, /* the process's register set */ Pfpregs, /* the process's FP register set */ + Pdbregs, /* the process's debug register set */ Pctl, /* process control */ Pstatus, /* process status */ Pnote, /* process notifier */ Pnotepg, /* process group notifier */ Pmap, /* memory map */ Ptype, /* executable type */ Pcmdline, /* command line */ Prlimit /* resource limits */ } pfstype; /* * control data for the proc file system. */ struct pfsnode { struct pfsnode *pfs_next; /* next on list */ struct vnode *pfs_vnode; /* vnode associated with this pfsnode */ pfstype pfs_type; /* type of procfs node */ pid_t pfs_pid; /* associated process */ u_short pfs_mode; /* mode bits for stat() */ u_long pfs_flags; /* open flags */ u_long pfs_fileno; /* unique file id */ pid_t pfs_lockowner; /* pfs lock owner */ }; #define PROCFS_NOTELEN 64 /* max length of a note (/proc/$pid/note) */ #define PROCFS_CTLLEN 8 /* max length of a ctl msg (/proc/$pid/ctl */ #define PROCFS_NAMELEN 8 /* max length of a filename component */ /* * Kernel stuff follows */ #ifdef KERNEL #define CNEQ(cnp, s, len) \ ((cnp)->cn_namelen == (len) && \ (bcmp((s), (cnp)->cn_nameptr, (len)) == 0)) #define KMEM_GROUP 2 /* * Check to see whether access to target process is allowed * Evaluates to 1 if access is allowed. */ #define CHECKIO(p1, p2) \ (PRISON_CHECK(p1, p2) && \ ((((p1)->p_cred->pc_ucred->cr_uid == (p2)->p_cred->p_ruid) && \ ((p1)->p_cred->p_ruid == (p2)->p_cred->p_ruid) && \ ((p1)->p_cred->p_svuid == (p2)->p_cred->p_ruid) && \ ((p2)->p_flag & P_SUGID) == 0) || \ (suser_xxx(0, (p1), PRISON_ROOT) == 0))) #define PROCFS_FILENO(pid, type) \ (((type) < Pproc) ? \ ((type) + 2) : \ ((((pid)+1) << 4) + ((int) (type)))) /* * Convert between pfsnode vnode */ #define VTOPFS(vp) ((struct pfsnode *)(vp)->v_data) #define PFSTOV(pfs) ((pfs)->pfs_vnode) typedef struct vfs_namemap vfs_namemap_t; struct vfs_namemap { const char *nm_name; int nm_val; }; int vfs_getuserstr __P((struct uio *, char *, int *)); vfs_namemap_t *vfs_findname __P((vfs_namemap_t *, char *, int)); /* */ struct reg; struct fpreg; +struct dbreg; #define PFIND(pid) ((pid) ? pfind(pid) : &proc0) void procfs_exit __P((struct proc *)); int procfs_freevp __P((struct vnode *)); int procfs_allocvp __P((struct mount *, struct vnode **, long, pfstype)); struct vnode *procfs_findtextvp __P((struct proc *)); int procfs_sstep __P((struct proc *)); void procfs_fix_sstep __P((struct proc *)); int procfs_read_regs __P((struct proc *, struct reg *)); int procfs_write_regs __P((struct proc *, struct reg *)); int procfs_read_fpregs __P((struct proc *, struct fpreg *)); int procfs_write_fpregs __P((struct proc *, struct fpreg *)); +int procfs_read_dbregs __P((struct proc *, struct dbreg *)); +int procfs_write_dbregs __P((struct proc *, struct dbreg *)); int procfs_donote __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_doregs __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_dofpregs __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); +int procfs_dodbregs __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_domem __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_doctl __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_dostatus __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_domap __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_dotype __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_docmdline __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); int procfs_dorlimit __P((struct proc *, struct proc *, struct pfsnode *pfsp, struct uio *uio)); /* Return 1 if process has special kernel digging privileges */ int procfs_kmemaccess __P((struct proc *)); /* functions to check whether or not files should be displayed */ int procfs_validfile __P((struct proc *)); int procfs_validfpregs __P((struct proc *)); int procfs_validregs __P((struct proc *)); +int procfs_validdbregs __P((struct proc *)); int procfs_validmap __P((struct proc *)); int procfs_validtype __P((struct proc *)); #define PROCFS_LOCKED 0x01 #define PROCFS_WANT 0x02 extern vop_t **procfs_vnodeop_p; int procfs_root __P((struct mount *, struct vnode **)); int procfs_rw __P((struct vop_read_args *)); #endif /* KERNEL */ Index: head/sys/miscfs/procfs/procfs_subr.c =================================================================== --- head/sys/miscfs/procfs/procfs_subr.c (revision 48690) +++ head/sys/miscfs/procfs/procfs_subr.c (revision 48691) @@ -1,397 +1,402 @@ /* * Copyright (c) 1993 Jan-Simon Pendry * Copyright (c) 1993 * The Regents of the University of California. All rights reserved. * * This code is derived from software contributed to Berkeley by * Jan-Simon Pendry. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)procfs_subr.c 8.6 (Berkeley) 5/14/95 * - * $Id: procfs_subr.c,v 1.23 1999/01/27 22:42:07 dillon Exp $ + * $Id: procfs_subr.c,v 1.24 1999/04/30 13:04:21 phk Exp $ */ #include #include #include #include #include #include static struct pfsnode *pfshead; static int pfsvplock; /* * allocate a pfsnode/vnode pair. the vnode is * referenced, but not locked. * * the pid, pfs_type, and mount point uniquely * identify a pfsnode. the mount point is needed * because someone might mount this filesystem * twice. * * all pfsnodes are maintained on a singly-linked * list. new nodes are only allocated when they cannot * be found on this list. entries on the list are * removed when the vfs reclaim entry is called. * * a single lock is kept for the entire list. this is * needed because the getnewvnode() function can block * waiting for a vnode to become free, in which case there * may be more than one process trying to get the same * vnode. this lock is only taken if we are going to * call getnewvnode, since the kernel itself is single-threaded. * * if an entry is found on the list, then call vget() to * take a reference. this is done because there may be * zero references to it and so it needs to removed from * the vnode free list. */ int procfs_allocvp(mp, vpp, pid, pfs_type) struct mount *mp; struct vnode **vpp; long pid; pfstype pfs_type; { struct proc *p = curproc; /* XXX */ struct pfsnode *pfs; struct vnode *vp; struct pfsnode **pp; int error; loop: for (pfs = pfshead; pfs != 0; pfs = pfs->pfs_next) { vp = PFSTOV(pfs); if (pfs->pfs_pid == pid && pfs->pfs_type == pfs_type && vp->v_mount == mp) { if (vget(vp, 0, p)) goto loop; *vpp = vp; return (0); } } /* * otherwise lock the vp list while we call getnewvnode * since that can block. */ if (pfsvplock & PROCFS_LOCKED) { pfsvplock |= PROCFS_WANT; (void) tsleep((caddr_t) &pfsvplock, PINOD, "pfsavp", 0); goto loop; } pfsvplock |= PROCFS_LOCKED; /* * Do the MALLOC before the getnewvnode since doing so afterward * might cause a bogus v_data pointer to get dereferenced * elsewhere if MALLOC should block. */ MALLOC(pfs, struct pfsnode *, sizeof(struct pfsnode), M_TEMP, M_WAITOK); if ((error = getnewvnode(VT_PROCFS, mp, procfs_vnodeop_p, vpp)) != 0) { FREE(pfs, M_TEMP); goto out; } vp = *vpp; vp->v_data = pfs; pfs->pfs_next = 0; pfs->pfs_pid = (pid_t) pid; pfs->pfs_type = pfs_type; pfs->pfs_vnode = vp; pfs->pfs_flags = 0; pfs->pfs_lockowner = 0; pfs->pfs_fileno = PROCFS_FILENO(pid, pfs_type); switch (pfs_type) { case Proot: /* /proc = dr-xr-xr-x */ pfs->pfs_mode = (VREAD|VEXEC) | (VREAD|VEXEC) >> 3 | (VREAD|VEXEC) >> 6; vp->v_type = VDIR; vp->v_flag = VROOT; break; case Pcurproc: /* /proc/curproc = lr--r--r-- */ pfs->pfs_mode = (VREAD) | (VREAD >> 3) | (VREAD >> 6); vp->v_type = VLNK; break; case Pproc: pfs->pfs_mode = (VREAD|VEXEC) | (VREAD|VEXEC) >> 3 | (VREAD|VEXEC) >> 6; vp->v_type = VDIR; break; case Pfile: case Pmem: pfs->pfs_mode = (VREAD|VWRITE) | (VREAD) >> 3;; vp->v_type = VREG; break; case Pregs: case Pfpregs: + case Pdbregs: pfs->pfs_mode = (VREAD|VWRITE); vp->v_type = VREG; break; case Pctl: case Pnote: case Pnotepg: pfs->pfs_mode = (VWRITE); vp->v_type = VREG; break; case Ptype: case Pmap: case Pstatus: case Pcmdline: case Prlimit: pfs->pfs_mode = (VREAD) | (VREAD >> 3) | (VREAD >> 6); vp->v_type = VREG; break; default: panic("procfs_allocvp"); } /* add to procfs vnode list */ for (pp = &pfshead; *pp; pp = &(*pp)->pfs_next) continue; *pp = pfs; out: pfsvplock &= ~PROCFS_LOCKED; if (pfsvplock & PROCFS_WANT) { pfsvplock &= ~PROCFS_WANT; wakeup((caddr_t) &pfsvplock); } return (error); } int procfs_freevp(vp) struct vnode *vp; { struct pfsnode **pfspp; struct pfsnode *pfs = VTOPFS(vp); for (pfspp = &pfshead; *pfspp != 0; pfspp = &(*pfspp)->pfs_next) { if (*pfspp == pfs) { *pfspp = pfs->pfs_next; break; } } FREE(vp->v_data, M_TEMP); vp->v_data = 0; return (0); } int procfs_rw(ap) struct vop_read_args *ap; { struct vnode *vp = ap->a_vp; struct uio *uio = ap->a_uio; struct proc *curp = uio->uio_procp; struct pfsnode *pfs = VTOPFS(vp); struct proc *p; int rtval; p = PFIND(pfs->pfs_pid); if (p == 0) return (EINVAL); if (p->p_pid == 1 && securelevel > 0 && uio->uio_rw == UIO_WRITE) return (EACCES); while (pfs->pfs_lockowner) { tsleep(&pfs->pfs_lockowner, PRIBIO, "pfslck", 0); } pfs->pfs_lockowner = curproc->p_pid; switch (pfs->pfs_type) { case Pnote: case Pnotepg: rtval = procfs_donote(curp, p, pfs, uio); break; case Pregs: rtval = procfs_doregs(curp, p, pfs, uio); break; case Pfpregs: rtval = procfs_dofpregs(curp, p, pfs, uio); break; + + case Pdbregs: + rtval = procfs_dodbregs(curp, p, pfs, uio); + break; case Pctl: rtval = procfs_doctl(curp, p, pfs, uio); break; case Pstatus: rtval = procfs_dostatus(curp, p, pfs, uio); break; case Pmap: rtval = procfs_domap(curp, p, pfs, uio); break; case Pmem: rtval = procfs_domem(curp, p, pfs, uio); break; case Ptype: rtval = procfs_dotype(curp, p, pfs, uio); break; case Pcmdline: rtval = procfs_docmdline(curp, p, pfs, uio); break; case Prlimit: rtval = procfs_dorlimit(curp, p, pfs, uio); break; default: rtval = EOPNOTSUPP; break; } pfs->pfs_lockowner = 0; wakeup(&pfs->pfs_lockowner); return rtval; } /* * Get a string from userland into (buf). Strip a trailing * nl character (to allow easy access from the shell). * The buffer should be *buflenp + 1 chars long. vfs_getuserstr * will automatically add a nul char at the end. * * Returns 0 on success or the following errors * * EINVAL: file offset is non-zero. * EMSGSIZE: message is longer than kernel buffer * EFAULT: user i/o buffer is not addressable */ int vfs_getuserstr(uio, buf, buflenp) struct uio *uio; char *buf; int *buflenp; { int xlen; int error; if (uio->uio_offset != 0) return (EINVAL); xlen = *buflenp; /* must be able to read the whole string in one go */ if (xlen < uio->uio_resid) return (EMSGSIZE); xlen = uio->uio_resid; if ((error = uiomove(buf, xlen, uio)) != 0) return (error); /* allow multiple writes without seeks */ uio->uio_offset = 0; /* cleanup string and remove trailing newline */ buf[xlen] = '\0'; xlen = strlen(buf); if (xlen > 0 && buf[xlen-1] == '\n') buf[--xlen] = '\0'; *buflenp = xlen; return (0); } vfs_namemap_t * vfs_findname(nm, buf, buflen) vfs_namemap_t *nm; char *buf; int buflen; { for (; nm->nm_name; nm++) if (bcmp(buf, nm->nm_name, buflen+1) == 0) return (nm); return (0); } void procfs_exit(struct proc *p) { struct pfsnode *pfs; pid_t pid = p->p_pid; /* * The reason for this loop is not obvious -- basicly, * procfs_freevp(), which is called via vgone() (eventually), * removes the specified procfs node from the pfshead list. * It does this by *pfsp = pfs->pfs_next, meaning that it * overwrites the node. So when we do pfs = pfs->next, we * end up skipping the node that replaces the one that was * vgone'd. Since it may have been the last one on the list, * it may also have been set to null -- but *our* pfs pointer, * here, doesn't see this. So the loop starts from the beginning * again. * * This is not a for() loop because the final event * would be "pfs = pfs->pfs_next"; in the case where * pfs is set to pfshead again, that would mean that * pfshead is skipped over. * */ pfs = pfshead; while (pfs) { if (pfs->pfs_pid == pid) { vgone(PFSTOV(pfs)); pfs = pfshead; } else pfs = pfs->pfs_next; } } Index: head/sys/miscfs/procfs/procfs_vnops.c =================================================================== --- head/sys/miscfs/procfs/procfs_vnops.c (revision 48690) +++ head/sys/miscfs/procfs/procfs_vnops.c (revision 48691) @@ -1,1024 +1,1030 @@ /* * Copyright (c) 1993, 1995 Jan-Simon Pendry * Copyright (c) 1993, 1995 * The Regents of the University of California. All rights reserved. * * This code is derived from software contributed to Berkeley by * Jan-Simon Pendry. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)procfs_vnops.c 8.18 (Berkeley) 5/21/95 * - * $Id: procfs_vnops.c,v 1.68 1999/05/04 08:01:55 phk Exp $ + * $Id: procfs_vnops.c,v 1.69 1999/06/13 20:53:16 phk Exp $ */ /* * procfs vnode interface */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include static int procfs_abortop __P((struct vop_abortop_args *)); static int procfs_access __P((struct vop_access_args *)); static int procfs_badop __P((void)); static int procfs_bmap __P((struct vop_bmap_args *)); static int procfs_close __P((struct vop_close_args *)); static int procfs_getattr __P((struct vop_getattr_args *)); static int procfs_inactive __P((struct vop_inactive_args *)); static int procfs_ioctl __P((struct vop_ioctl_args *)); static int procfs_lookup __P((struct vop_lookup_args *)); static int procfs_open __P((struct vop_open_args *)); static int procfs_print __P((struct vop_print_args *)); static int procfs_readdir __P((struct vop_readdir_args *)); static int procfs_readlink __P((struct vop_readlink_args *)); static int procfs_reclaim __P((struct vop_reclaim_args *)); static int procfs_setattr __P((struct vop_setattr_args *)); /* * This is a list of the valid names in the * process-specific sub-directories. It is * used in procfs_lookup and procfs_readdir */ static struct proc_target { u_char pt_type; u_char pt_namlen; char *pt_name; pfstype pt_pfstype; int (*pt_valid) __P((struct proc *p)); } proc_targets[] = { #define N(s) sizeof(s)-1, s /* name type validp */ { DT_DIR, N("."), Pproc, NULL }, { DT_DIR, N(".."), Proot, NULL }, { DT_REG, N("file"), Pfile, procfs_validfile }, { DT_REG, N("mem"), Pmem, NULL }, { DT_REG, N("regs"), Pregs, procfs_validregs }, { DT_REG, N("fpregs"), Pfpregs, procfs_validfpregs }, + { DT_REG, N("dbregs"), Pdbregs, procfs_validdbregs }, { DT_REG, N("ctl"), Pctl, NULL }, { DT_REG, N("status"), Pstatus, NULL }, { DT_REG, N("note"), Pnote, NULL }, { DT_REG, N("notepg"), Pnotepg, NULL }, { DT_REG, N("map"), Pmap, procfs_validmap }, { DT_REG, N("etype"), Ptype, procfs_validtype }, { DT_REG, N("cmdline"), Pcmdline, NULL }, { DT_REG, N("rlimit"), Prlimit, NULL }, #undef N }; static const int nproc_targets = sizeof(proc_targets) / sizeof(proc_targets[0]); static pid_t atopid __P((const char *, u_int)); /* * set things up for doing i/o on * the pfsnode (vp). (vp) is locked * on entry, and should be left locked * on exit. * * for procfs we don't need to do anything * in particular for i/o. all that is done * is to support exclusive open on process * memory images. */ static int procfs_open(ap) struct vop_open_args /* { struct vnode *a_vp; int a_mode; struct ucred *a_cred; struct proc *a_p; } */ *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); struct proc *p1, *p2; p2 = PFIND(pfs->pfs_pid); if (p2 == NULL) return (ENOENT); if (!PRISON_CHECK(ap->a_p, p2)) return (ENOENT); switch (pfs->pfs_type) { case Pmem: if (((pfs->pfs_flags & FWRITE) && (ap->a_mode & O_EXCL)) || ((pfs->pfs_flags & O_EXCL) && (ap->a_mode & FWRITE))) return (EBUSY); p1 = ap->a_p; if (!CHECKIO(p1, p2) && !procfs_kmemaccess(p1)) return (EPERM); if (ap->a_mode & FWRITE) pfs->pfs_flags = ap->a_mode & (FWRITE|O_EXCL); return (0); default: break; } return (0); } /* * close the pfsnode (vp) after doing i/o. * (vp) is not locked on entry or exit. * * nothing to do for procfs other than undo * any exclusive open flag (see _open above). */ static int procfs_close(ap) struct vop_close_args /* { struct vnode *a_vp; int a_fflag; struct ucred *a_cred; struct proc *a_p; } */ *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); struct proc *p; switch (pfs->pfs_type) { case Pmem: if ((ap->a_fflag & FWRITE) && (pfs->pfs_flags & O_EXCL)) pfs->pfs_flags &= ~(FWRITE|O_EXCL); /* * This rather complicated-looking code is trying to * determine if this was the last close on this particular * vnode. While one would expect v_usecount to be 1 at * that point, it seems that (according to John Dyson) * the VM system will bump up the usecount. So: if the * usecount is 2, and VOBJBUF is set, then this is really * the last close. Otherwise, if the usecount is < 2 * then it is definitely the last close. * If this is the last close, then it checks to see if * the target process has PF_LINGER set in p_pfsflags, * if this is *not* the case, then the process' stop flags * are cleared, and the process is woken up. This is * to help prevent the case where a process has been * told to stop on an event, but then the requesting process * has gone away or forgotten about it. */ if ((ap->a_vp->v_usecount < 2) && (p = pfind(pfs->pfs_pid)) && !(p->p_pfsflags & PF_LINGER)) { p->p_stops = 0; p->p_step = 0; wakeup(&p->p_step); } break; default: break; } return (0); } /* * do an ioctl operation on a pfsnode (vp). * (vp) is not locked on entry or exit. */ static int procfs_ioctl(ap) struct vop_ioctl_args *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); struct proc *procp, *p; int error; int signo; struct procfs_status *psp; unsigned char flags; p = ap->a_p; procp = pfind(pfs->pfs_pid); if (procp == NULL) { return ENOTTY; } if (!CHECKIO(p, procp)) return EPERM; switch (ap->a_command) { case PIOCBIS: procp->p_stops |= *(unsigned int*)ap->a_data; break; case PIOCBIC: procp->p_stops &= ~*(unsigned int*)ap->a_data; break; case PIOCSFL: /* * NFLAGS is "non-suser_xxx flags" -- currently, only * PFS_ISUGID ("ignore set u/g id"); */ #define NFLAGS (PF_ISUGID) flags = (unsigned char)*(unsigned int*)ap->a_data; if (flags & NFLAGS && (error = suser(p))) return error; procp->p_pfsflags = flags; break; case PIOCGFL: *(unsigned int*)ap->a_data = (unsigned int)procp->p_pfsflags; case PIOCSTATUS: psp = (struct procfs_status *)ap->a_data; psp->state = (procp->p_step == 0); psp->flags = procp->p_pfsflags; psp->events = procp->p_stops; if (procp->p_step) { psp->why = procp->p_stype; psp->val = procp->p_xstat; } else { psp->why = psp->val = 0; /* Not defined values */ } break; case PIOCWAIT: psp = (struct procfs_status *)ap->a_data; if (procp->p_step == 0) { error = tsleep(&procp->p_stype, PWAIT | PCATCH, "piocwait", 0); if (error) return error; } psp->state = 1; /* It stopped */ psp->flags = procp->p_pfsflags; psp->events = procp->p_stops; psp->why = procp->p_stype; /* why it stopped */ psp->val = procp->p_xstat; /* any extra info */ break; case PIOCCONT: /* Restart a proc */ if (procp->p_step == 0) return EINVAL; /* Can only start a stopped process */ if ((signo = *(int*)ap->a_data) != 0) { if (signo >= NSIG || signo <= 0) return EINVAL; psignal(procp, signo); } procp->p_step = 0; wakeup(&procp->p_step); break; default: return (ENOTTY); } return 0; } /* * do block mapping for pfsnode (vp). * since we don't use the buffer cache * for procfs this function should never * be called. in any case, it's not clear * what part of the kernel ever makes use * of this function. for sanity, this is the * usual no-op bmap, although returning * (EIO) would be a reasonable alternative. */ static int procfs_bmap(ap) struct vop_bmap_args /* { struct vnode *a_vp; daddr_t a_bn; struct vnode **a_vpp; daddr_t *a_bnp; int *a_runp; } */ *ap; { if (ap->a_vpp != NULL) *ap->a_vpp = ap->a_vp; if (ap->a_bnp != NULL) *ap->a_bnp = ap->a_bn; if (ap->a_runp != NULL) *ap->a_runp = 0; return (0); } /* * procfs_inactive is called when the pfsnode * is vrele'd and the reference count goes * to zero. (vp) will be on the vnode free * list, so to get it back vget() must be * used. * * (vp) is locked on entry, but must be unlocked on exit. */ static int procfs_inactive(ap) struct vop_inactive_args /* { struct vnode *a_vp; } */ *ap; { struct vnode *vp = ap->a_vp; VOP_UNLOCK(vp, 0, ap->a_p); return (0); } /* * _reclaim is called when getnewvnode() * wants to make use of an entry on the vnode * free list. at this time the filesystem needs * to free any private data and remove the node * from any private lists. */ static int procfs_reclaim(ap) struct vop_reclaim_args /* { struct vnode *a_vp; } */ *ap; { return (procfs_freevp(ap->a_vp)); } /* * _print is used for debugging. * just print a readable description * of (vp). */ static int procfs_print(ap) struct vop_print_args /* { struct vnode *a_vp; } */ *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); printf("tag VT_PROCFS, type %d, pid %ld, mode %x, flags %lx\n", pfs->pfs_type, (long)pfs->pfs_pid, pfs->pfs_mode, pfs->pfs_flags); return (0); } /* * _abortop is called when operations such as * rename and create fail. this entry is responsible * for undoing any side-effects caused by the lookup. * this will always include freeing the pathname buffer. */ static int procfs_abortop(ap) struct vop_abortop_args /* { struct vnode *a_dvp; struct componentname *a_cnp; } */ *ap; { if ((ap->a_cnp->cn_flags & (HASBUF | SAVESTART)) == HASBUF) zfree(namei_zone, ap->a_cnp->cn_pnbuf); return (0); } /* * generic entry point for unsupported operations */ static int procfs_badop() { return (EIO); } /* * Invent attributes for pfsnode (vp) and store * them in (vap). * Directories lengths are returned as zero since * any real length would require the genuine size * to be computed, and nothing cares anyway. * * this is relatively minimal for procfs. */ static int procfs_getattr(ap) struct vop_getattr_args /* { struct vnode *a_vp; struct vattr *a_vap; struct ucred *a_cred; struct proc *a_p; } */ *ap; { struct pfsnode *pfs = VTOPFS(ap->a_vp); struct vattr *vap = ap->a_vap; struct proc *procp; int error; /* * First make sure that the process and its credentials * still exist. */ switch (pfs->pfs_type) { case Proot: case Pcurproc: procp = 0; break; default: procp = PFIND(pfs->pfs_pid); if (procp == 0 || procp->p_cred == NULL || procp->p_ucred == NULL) return (ENOENT); } error = 0; /* start by zeroing out the attributes */ VATTR_NULL(vap); /* next do all the common fields */ vap->va_type = ap->a_vp->v_type; vap->va_mode = pfs->pfs_mode; vap->va_fileid = pfs->pfs_fileno; vap->va_flags = 0; vap->va_blocksize = PAGE_SIZE; vap->va_bytes = vap->va_size = 0; /* * Make all times be current TOD. * It would be possible to get the process start * time from the p_stat structure, but there's * no "file creation" time stamp anyway, and the * p_stat structure is not addressible if u. gets * swapped out for that process. */ nanotime(&vap->va_ctime); vap->va_atime = vap->va_mtime = vap->va_ctime; /* * If the process has exercised some setuid or setgid * privilege, then rip away read/write permission so * that only root can gain access. */ switch (pfs->pfs_type) { case Pctl: case Pregs: case Pfpregs: + case Pdbregs: if (procp->p_flag & P_SUGID) vap->va_mode &= ~((VREAD|VWRITE)| ((VREAD|VWRITE)>>3)| ((VREAD|VWRITE)>>6)); break; case Pmem: /* Retain group kmem readablity. */ if (procp->p_flag & P_SUGID) vap->va_mode &= ~(VREAD|VWRITE); break; default: break; } /* * now do the object specific fields * * The size could be set from struct reg, but it's hardly * worth the trouble, and it puts some (potentially) machine * dependent data into this machine-independent code. If it * becomes important then this function should break out into * a per-file stat function in the corresponding .c file. */ vap->va_nlink = 1; if (procp) { vap->va_uid = procp->p_ucred->cr_uid; vap->va_gid = procp->p_ucred->cr_gid; } switch (pfs->pfs_type) { case Proot: /* * Set nlink to 1 to tell fts(3) we don't actually know. */ vap->va_nlink = 1; vap->va_uid = 0; vap->va_gid = 0; vap->va_size = vap->va_bytes = DEV_BSIZE; break; case Pcurproc: { char buf[16]; /* should be enough */ vap->va_uid = 0; vap->va_gid = 0; vap->va_size = vap->va_bytes = snprintf(buf, sizeof(buf), "%ld", (long)curproc->p_pid); break; } case Pproc: vap->va_nlink = nproc_targets; vap->va_size = vap->va_bytes = DEV_BSIZE; break; case Pfile: error = EOPNOTSUPP; break; case Pmem: /* * If we denied owner access earlier, then we have to * change the owner to root - otherwise 'ps' and friends * will break even though they are setgid kmem. *SIGH* */ if (procp->p_flag & P_SUGID) vap->va_uid = 0; else vap->va_uid = procp->p_ucred->cr_uid; vap->va_gid = KMEM_GROUP; break; case Pregs: vap->va_bytes = vap->va_size = sizeof(struct reg); break; case Pfpregs: vap->va_bytes = vap->va_size = sizeof(struct fpreg); break; + + case Pdbregs: + vap->va_bytes = vap->va_size = sizeof(struct dbreg); + break; case Ptype: case Pmap: case Pctl: case Pstatus: case Pnote: case Pnotepg: case Pcmdline: case Prlimit: break; default: panic("procfs_getattr"); } return (error); } static int procfs_setattr(ap) struct vop_setattr_args /* { struct vnode *a_vp; struct vattr *a_vap; struct ucred *a_cred; struct proc *a_p; } */ *ap; { if (ap->a_vap->va_flags != VNOVAL) return (EOPNOTSUPP); /* * just fake out attribute setting * it's not good to generate an error * return, otherwise things like creat() * will fail when they try to set the * file length to 0. worse, this means * that echo $note > /proc/$pid/note will fail. */ return (0); } /* * implement access checking. * * something very similar to this code is duplicated * throughout the 4bsd kernel and should be moved * into kern/vfs_subr.c sometime. * * actually, the check for super-user is slightly * broken since it will allow read access to write-only * objects. this doesn't cause any particular trouble * but does mean that the i/o entry points need to check * that the operation really does make sense. */ static int procfs_access(ap) struct vop_access_args /* { struct vnode *a_vp; int a_mode; struct ucred *a_cred; struct proc *a_p; } */ *ap; { struct vattr *vap; struct vattr vattr; int error; /* * If you're the super-user, * you always get access. */ if (ap->a_cred->cr_uid == 0) return (0); vap = &vattr; error = VOP_GETATTR(ap->a_vp, vap, ap->a_cred, ap->a_p); if (error) return (error); /* * Access check is based on only one of owner, group, public. * If not owner, then check group. If not a member of the * group, then check public access. */ if (ap->a_cred->cr_uid != vap->va_uid) { gid_t *gp; int i; ap->a_mode >>= 3; gp = ap->a_cred->cr_groups; for (i = 0; i < ap->a_cred->cr_ngroups; i++, gp++) if (vap->va_gid == *gp) goto found; ap->a_mode >>= 3; found: ; } if ((vap->va_mode & ap->a_mode) == ap->a_mode) return (0); return (EACCES); } /* * lookup. this is incredibly complicated in the * general case, however for most pseudo-filesystems * very little needs to be done. * * unless you want to get a migraine, just make sure your * filesystem doesn't do any locking of its own. otherwise * read and inwardly digest ufs_lookup(). */ static int procfs_lookup(ap) struct vop_lookup_args /* { struct vnode * a_dvp; struct vnode ** a_vpp; struct componentname * a_cnp; } */ *ap; { struct componentname *cnp = ap->a_cnp; struct vnode **vpp = ap->a_vpp; struct vnode *dvp = ap->a_dvp; char *pname = cnp->cn_nameptr; struct proc *curp = cnp->cn_proc; struct proc_target *pt; struct vnode *fvp; pid_t pid; struct pfsnode *pfs; struct proc *p; int i; *vpp = NULL; if (cnp->cn_nameiop == DELETE || cnp->cn_nameiop == RENAME) return (EROFS); if (cnp->cn_namelen == 1 && *pname == '.') { *vpp = dvp; VREF(dvp); /* vn_lock(dvp, LK_EXCLUSIVE | LK_RETRY, curp); */ return (0); } pfs = VTOPFS(dvp); switch (pfs->pfs_type) { case Proot: if (cnp->cn_flags & ISDOTDOT) return (EIO); if (CNEQ(cnp, "curproc", 7)) return (procfs_allocvp(dvp->v_mount, vpp, 0, Pcurproc)); pid = atopid(pname, cnp->cn_namelen); if (pid == NO_PID) break; p = PFIND(pid); if (p == 0) break; return (procfs_allocvp(dvp->v_mount, vpp, pid, Pproc)); case Pproc: if (cnp->cn_flags & ISDOTDOT) return (procfs_root(dvp->v_mount, vpp)); p = PFIND(pfs->pfs_pid); if (p == 0) break; for (pt = proc_targets, i = 0; i < nproc_targets; pt++, i++) { if (cnp->cn_namelen == pt->pt_namlen && bcmp(pt->pt_name, pname, cnp->cn_namelen) == 0 && (pt->pt_valid == NULL || (*pt->pt_valid)(p))) goto found; } break; found: if (pt->pt_pfstype == Pfile) { fvp = procfs_findtextvp(p); /* We already checked that it exists. */ VREF(fvp); vn_lock(fvp, LK_EXCLUSIVE | LK_RETRY, curp); *vpp = fvp; return (0); } return (procfs_allocvp(dvp->v_mount, vpp, pfs->pfs_pid, pt->pt_pfstype)); default: return (ENOTDIR); } return (cnp->cn_nameiop == LOOKUP ? ENOENT : EROFS); } /* * Does this process have a text file? */ int procfs_validfile(p) struct proc *p; { return (procfs_findtextvp(p) != NULLVP); } /* * readdir() returns directory entries from pfsnode (vp). * * We generate just one directory entry at a time, as it would probably * not pay off to buffer several entries locally to save uiomove calls. */ static int procfs_readdir(ap) struct vop_readdir_args /* { struct vnode *a_vp; struct uio *a_uio; struct ucred *a_cred; int *a_eofflag; int *a_ncookies; u_long **a_cookies; } */ *ap; { struct uio *uio = ap->a_uio; struct dirent d; struct dirent *dp = &d; struct pfsnode *pfs; int count, error, i, off; static u_int delen; if (!delen) { d.d_namlen = PROCFS_NAMELEN; delen = GENERIC_DIRSIZ(&d); } pfs = VTOPFS(ap->a_vp); off = (int)uio->uio_offset; if (off != uio->uio_offset || off < 0 || off % delen != 0 || uio->uio_resid < delen) return (EINVAL); error = 0; count = 0; i = off / delen; switch (pfs->pfs_type) { /* * this is for the process-specific sub-directories. * all that is needed to is copy out all the entries * from the procent[] table (top of this file). */ case Pproc: { struct proc *p; struct proc_target *pt; p = PFIND(pfs->pfs_pid); if (p == NULL) break; if (!PRISON_CHECK(curproc, p)) break; for (pt = &proc_targets[i]; uio->uio_resid >= delen && i < nproc_targets; pt++, i++) { if (pt->pt_valid && (*pt->pt_valid)(p) == 0) continue; dp->d_reclen = delen; dp->d_fileno = PROCFS_FILENO(pfs->pfs_pid, pt->pt_pfstype); dp->d_namlen = pt->pt_namlen; bcopy(pt->pt_name, dp->d_name, pt->pt_namlen + 1); dp->d_type = pt->pt_type; if ((error = uiomove((caddr_t)dp, delen, uio)) != 0) break; } break; } /* * this is for the root of the procfs filesystem * what is needed is a special entry for "curproc" * followed by an entry for each process on allproc #ifdef PROCFS_ZOMBIE * and zombproc. #endif */ case Proot: { #ifdef PROCFS_ZOMBIE int doingzomb = 0; #endif int pcnt = 0; volatile struct proc *p = allproc.lh_first; for (; p && uio->uio_resid >= delen; i++, pcnt++) { bzero((char *) dp, delen); dp->d_reclen = delen; switch (i) { case 0: /* `.' */ case 1: /* `..' */ dp->d_fileno = PROCFS_FILENO(0, Proot); dp->d_namlen = i + 1; bcopy("..", dp->d_name, dp->d_namlen); dp->d_name[i + 1] = '\0'; dp->d_type = DT_DIR; break; case 2: dp->d_fileno = PROCFS_FILENO(0, Pcurproc); dp->d_namlen = 7; bcopy("curproc", dp->d_name, 8); dp->d_type = DT_LNK; break; default: while (pcnt < i) { p = p->p_list.le_next; if (!p) goto done; if (!PRISON_CHECK(curproc, p)) continue; pcnt++; } while (!PRISON_CHECK(curproc, p)) { p = p->p_list.le_next; if (!p) goto done; } dp->d_fileno = PROCFS_FILENO(p->p_pid, Pproc); dp->d_namlen = sprintf(dp->d_name, "%ld", (long)p->p_pid); dp->d_type = DT_REG; p = p->p_list.le_next; break; } if ((error = uiomove((caddr_t)dp, delen, uio)) != 0) break; } done: #ifdef PROCFS_ZOMBIE if (p == 0 && doingzomb == 0) { doingzomb = 1; p = zombproc.lh_first; goto again; } #endif break; } default: error = ENOTDIR; break; } uio->uio_offset = i * delen; return (error); } /* * readlink reads the link of `curproc' */ static int procfs_readlink(ap) struct vop_readlink_args *ap; { char buf[16]; /* should be enough */ int len; if (VTOPFS(ap->a_vp)->pfs_fileno != PROCFS_FILENO(0, Pcurproc)) return (EINVAL); len = snprintf(buf, sizeof(buf), "%ld", (long)curproc->p_pid); return (uiomove((caddr_t)buf, len, ap->a_uio)); } /* * convert decimal ascii to pid_t */ static pid_t atopid(b, len) const char *b; u_int len; { pid_t p = 0; while (len--) { char c = *b++; if (c < '0' || c > '9') return (NO_PID); p = 10 * p + (c - '0'); if (p > PID_MAX) return (NO_PID); } return (p); } /* * procfs vnode operations. */ vop_t **procfs_vnodeop_p; static struct vnodeopv_entry_desc procfs_vnodeop_entries[] = { { &vop_default_desc, (vop_t *) vop_defaultop }, { &vop_abortop_desc, (vop_t *) procfs_abortop }, { &vop_access_desc, (vop_t *) procfs_access }, { &vop_advlock_desc, (vop_t *) procfs_badop }, { &vop_bmap_desc, (vop_t *) procfs_bmap }, { &vop_close_desc, (vop_t *) procfs_close }, { &vop_create_desc, (vop_t *) procfs_badop }, { &vop_getattr_desc, (vop_t *) procfs_getattr }, { &vop_inactive_desc, (vop_t *) procfs_inactive }, { &vop_link_desc, (vop_t *) procfs_badop }, { &vop_lookup_desc, (vop_t *) procfs_lookup }, { &vop_mkdir_desc, (vop_t *) procfs_badop }, { &vop_mknod_desc, (vop_t *) procfs_badop }, { &vop_open_desc, (vop_t *) procfs_open }, { &vop_pathconf_desc, (vop_t *) vop_stdpathconf }, { &vop_print_desc, (vop_t *) procfs_print }, { &vop_read_desc, (vop_t *) procfs_rw }, { &vop_readdir_desc, (vop_t *) procfs_readdir }, { &vop_readlink_desc, (vop_t *) procfs_readlink }, { &vop_reclaim_desc, (vop_t *) procfs_reclaim }, { &vop_remove_desc, (vop_t *) procfs_badop }, { &vop_rename_desc, (vop_t *) procfs_badop }, { &vop_rmdir_desc, (vop_t *) procfs_badop }, { &vop_setattr_desc, (vop_t *) procfs_setattr }, { &vop_symlink_desc, (vop_t *) procfs_badop }, { &vop_write_desc, (vop_t *) procfs_rw }, { &vop_ioctl_desc, (vop_t *) procfs_ioctl }, { NULL, NULL } }; static struct vnodeopv_desc procfs_vnodeop_opv_desc = { &procfs_vnodeop_p, procfs_vnodeop_entries }; VNODEOP_SET(procfs_vnodeop_opv_desc); Index: head/sys/powerpc/include/ptrace.h =================================================================== --- head/sys/powerpc/include/ptrace.h (revision 48690) +++ head/sys/powerpc/include/ptrace.h (revision 48691) @@ -1,53 +1,55 @@ /* * Copyright (c) 1992, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * @(#)ptrace.h 8.1 (Berkeley) 6/11/93 - * $Id: ptrace.h,v 1.5 1997/02/22 09:35:03 peter Exp $ + * $Id: ptrace.h,v 1.6 1998/05/19 00:00:12 tegge Exp $ */ #ifndef _MACHINE_PTRACE_H_ #define _MACHINE_PTRACE_H_ /* * Machine dependent trace commands. */ #define PT_GETREGS (PT_FIRSTMACH + 1) #define PT_SETREGS (PT_FIRSTMACH + 2) #define PT_GETFPREGS (PT_FIRSTMACH + 3) #define PT_SETFPREGS (PT_FIRSTMACH + 4) +#define PT_GETDBREGS (PT_FIRSTMACH + 5) +#define PT_SETDBREGS (PT_FIRSTMACH + 6) #ifdef KERNEL int ptrace_read_u_check __P((struct proc *p, vm_offset_t off, size_t len)); #endif /* !KERNEL */ #endif