[BACK]Return to locore.s CVS log [TXT][DIR] Up to [cvs.NetBSD.org] / src / sys / arch / sparc / sparc

Annotation of src/sys/arch/sparc/sparc/locore.s, Revision 1.198

1.198   ! pk          1: /*     $NetBSD: locore.s,v 1.197 2004/02/13 11:36:18 wiz Exp $ */
1.70      mrg         2:
1.1       deraadt     3: /*
1.52      pk          4:  * Copyright (c) 1996 Paul Kranenburg
                      5:  * Copyright (c) 1996
1.55      abrown      6:  *     The President and Fellows of Harvard College. All rights reserved.
1.1       deraadt     7:  * Copyright (c) 1992, 1993
                      8:  *     The Regents of the University of California.  All rights reserved.
                      9:  *
                     10:  * This software was developed by the Computer Systems Engineering group
                     11:  * at Lawrence Berkeley Laboratory under DARPA contract BG 91-66 and
                     12:  * contributed to Berkeley.
                     13:  *
                     14:  * All advertising materials mentioning features or use of this software
                     15:  * must display the following acknowledgement:
                     16:  *     This product includes software developed by the University of
                     17:  *     California, Lawrence Berkeley Laboratory.
1.52      pk         18:  *     This product includes software developed by Harvard University.
1.1       deraadt    19:  *
                     20:  * Redistribution and use in source and binary forms, with or without
                     21:  * modification, are permitted provided that the following conditions
                     22:  * are met:
                     23:  * 1. Redistributions of source code must retain the above copyright
                     24:  *    notice, this list of conditions and the following disclaimer.
                     25:  * 2. Redistributions in binary form must reproduce the above copyright
                     26:  *    notice, this list of conditions and the following disclaimer in the
                     27:  *    documentation and/or other materials provided with the distribution.
                     28:  * 3. All advertising materials mentioning features or use of this software
                     29:  *    must display the following acknowledgement:
                     30:  *     This product includes software developed by the University of
                     31:  *     California, Berkeley and its contributors.
1.52      pk         32:  *     This product includes software developed by Harvard University.
                     33:  *     This product includes software developed by Paul Kranenburg.
1.1       deraadt    34:  * 4. Neither the name of the University nor the names of its contributors
                     35:  *    may be used to endorse or promote products derived from this software
                     36:  *    without specific prior written permission.
                     37:  *
                     38:  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
                     39:  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
                     40:  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
                     41:  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
                     42:  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
                     43:  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
                     44:  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
                     45:  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
                     46:  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
                     47:  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
                     48:  * SUCH DAMAGE.
                     49:  *
1.10      deraadt    50:  *     @(#)locore.s    8.4 (Berkeley) 12/10/93
1.1       deraadt    51:  */
                     52:
1.85      jonathan   53: #include "opt_ddb.h"
1.140     pk         54: #include "opt_kgdb.h"
1.84      thorpej    55: #include "opt_compat_svr4.h"
1.116     christos   56: #include "opt_compat_sunos.h"
1.97      pk         57: #include "opt_multiprocessor.h"
1.134     pk         58: #include "opt_lockdebug.h"
1.80      mrg        59:
1.47      mycroft    60: #include "assym.h"
1.52      pk         61: #include <machine/param.h>
1.111     pk         62: #include <machine/asm.h>
1.1       deraadt    63: #include <sparc/sparc/intreg.h>
                     64: #include <sparc/sparc/timerreg.h>
1.52      pk         65: #include <sparc/sparc/vaddrs.h>
1.1       deraadt    66: #ifdef notyet
                     67: #include <sparc/dev/zsreg.h>
                     68: #endif
                     69: #include <machine/ctlreg.h>
1.173     pk         70: #include <machine/intr.h>
1.1       deraadt    71: #include <machine/psl.h>
                     72: #include <machine/signal.h>
                     73: #include <machine/trap.h>
1.92      pk         74: #include <sys/syscall.h>
1.1       deraadt    75:
                     76: /*
                     77:  * GNU assembler does not understand `.empty' directive; Sun assembler
                     78:  * gripes about labels without it.  To allow cross-compilation using
                     79:  * the Sun assembler, and because .empty directives are useful documentation,
                     80:  * we use this trick.
                     81:  */
                     82: #ifdef SUN_AS
                     83: #define        EMPTY   .empty
                     84: #else
                     85: #define        EMPTY   /* .empty */
                     86: #endif
                     87:
                     88: /* use as needed to align things on longword boundaries */
1.52      pk         89: #define        _ALIGN  .align 4
1.1       deraadt    90:
                     91: /*
                     92:  * CCFSZ (C Compiler Frame SiZe) is the size of a stack frame required if
                     93:  * a function is to call C code.  It should be just 64, but Sun defined
                     94:  * their frame with space to hold arguments 0 through 5 (plus some junk),
1.63      pk         95:  * and varargs routines (such as printf) demand this, and gcc uses this
1.1       deraadt    96:  * area at times anyway.
                     97:  */
                     98: #define        CCFSZ   96
                     99:
1.195     pk        100: /* We rely on the fact that %lo(CPUINFO_VA) is zero */
                    101: .if CPUINFO_VA & 0x1fff
                    102: BARF
                    103: .endif
                    104:
1.1       deraadt   105: /*
                    106:  * A handy macro for maintaining instrumentation counters.
                    107:  * Note that this clobbers %o0 and %o1.  Normal usage is
                    108:  * something like:
                    109:  *     foointr:
                    110:  *             TRAP_SETUP(...)         ! makes %o registers safe
1.111     pk        111:  *             INCR(cnt+V_FOO) ! count a foo
1.1       deraadt   112:  */
                    113: #define INCR(what) \
                    114:        sethi   %hi(what), %o0; \
                    115:        ld      [%o0 + %lo(what)], %o1; \
                    116:        inc     %o1; \
                    117:        st      %o1, [%o0 + %lo(what)]
                    118:
                    119: /*
                    120:  * Another handy macro: load one register window, given `base' address.
                    121:  * This can be either a simple register (e.g., %sp) or include an initial
                    122:  * offset (e.g., %g6 + PCB_RW).
                    123:  */
                    124: #define        LOADWIN(addr) \
                    125:        ldd     [addr], %l0; \
                    126:        ldd     [addr + 8], %l2; \
                    127:        ldd     [addr + 16], %l4; \
                    128:        ldd     [addr + 24], %l6; \
                    129:        ldd     [addr + 32], %i0; \
                    130:        ldd     [addr + 40], %i2; \
                    131:        ldd     [addr + 48], %i4; \
                    132:        ldd     [addr + 56], %i6
                    133:
                    134: /*
                    135:  * To return from trap we need the two-instruction sequence
                    136:  * `jmp %l1; rett %l2', which is defined here for convenience.
                    137:  */
                    138: #define        RETT    jmp %l1; rett %l2
                    139:
                    140:        .data
                    141: /*
                    142:  * The interrupt stack.
                    143:  *
                    144:  * This is the very first thing in the data segment, and therefore has
                    145:  * the lowest kernel stack address.  We count on this in the interrupt
                    146:  * trap-frame setup code, since we may need to switch from the kernel
                    147:  * stack to the interrupt stack (iff we are not already on the interrupt
                    148:  * stack).  One sethi+cmp is all we need since this is so carefully
                    149:  * arranged.
1.98      pk        150:  *
                    151:  * In SMP kernels, each CPU has its own interrupt stack and the computation
                    152:  * to determine whether we're already on the interrupt stack is slightly
                    153:  * more time consuming (see INTR_SETUP() below).
1.1       deraadt   154:  */
1.111     pk        155:        .globl  _C_LABEL(intstack)
                    156:        .globl  _C_LABEL(eintstack)
                    157: _C_LABEL(intstack):
1.98      pk        158:        .skip   INT_STACK_SIZE          ! 16k = 128 128-byte stack frames
1.111     pk        159: _C_LABEL(eintstack):
1.1       deraadt   160:
1.101     pk        161: _EINTSTACKP = CPUINFO_VA + CPUINFO_EINTSTACK
                    162:
1.1       deraadt   163: /*
1.131     thorpej   164:  * CPUINFO_VA is a CPU-local virtual address; cpi->ci_self is a global
                    165:  * virtual address for the same structure.  It must be stored in p->p_cpu
                    166:  * upon context switch.
                    167:  */
1.179     pk        168: _CISELFP       = CPUINFO_VA + CPUINFO_SELF
                    169: _CIFLAGS       = CPUINFO_VA + CPUINFO_FLAGS
                    170:
1.197     wiz       171: /* Per-CPU AST and reschedule requests */
1.179     pk        172: _WANT_AST      = CPUINFO_VA + CPUINFO_WANT_AST
                    173: _WANT_RESCHED  = CPUINFO_VA + CPUINFO_WANT_RESCHED
1.131     thorpej   174:
                    175: /*
1.1       deraadt   176:  * When a process exits and its u. area goes away, we set cpcb to point
                    177:  * to this `u.', leaving us with something to use for an interrupt stack,
                    178:  * and letting all the register save code have a pcb_uw to examine.
                    179:  * This is also carefully arranged (to come just before u0, so that
                    180:  * process 0's kernel stack can quietly overrun into it during bootup, if
                    181:  * we feel like doing that).
                    182:  */
1.111     pk        183:        .globl  _C_LABEL(idle_u)
                    184: _C_LABEL(idle_u):
1.13      deraadt   185:        .skip   USPACE
1.99      pk        186: /*
                    187:  * On SMP kernels, there's an idle u-area for each CPU and we must
                    188:  * read its location from cpuinfo.
                    189:  */
1.111     pk        190: IDLE_UP = CPUINFO_VA + CPUINFO_IDLE_U
1.1       deraadt   191:
                    192: /*
                    193:  * Process 0's u.
                    194:  *
                    195:  * This must be aligned on an 8 byte boundary.
                    196:  */
1.111     pk        197:        .globl  _C_LABEL(u0)
                    198: _C_LABEL(u0):  .skip   USPACE
1.1       deraadt   199: estack0:
                    200:
                    201: #ifdef KGDB
                    202: /*
                    203:  * Another item that must be aligned, easiest to put it here.
                    204:  */
                    205: KGDB_STACK_SIZE = 2048
1.111     pk        206:        .globl  _C_LABEL(kgdb_stack)
                    207: _C_LABEL(kgdb_stack):
1.1       deraadt   208:        .skip   KGDB_STACK_SIZE         ! hope this is enough
                    209: #endif
                    210:
                    211: /*
1.111     pk        212:  * cpcb points to the current pcb (and hence u. area).
1.1       deraadt   213:  * Initially this is the special one.
                    214:  */
1.111     pk        215: cpcb = CPUINFO_VA + CPUINFO_CURPCB
1.1       deraadt   216:
1.185     thorpej   217: /* curlwp points to the current LWP that has the CPU */
                    218: curlwp = CPUINFO_VA + CPUINFO_CURLWP
1.104     pk        219:
1.52      pk        220: /*
1.197     wiz       221:  * cputyp is the current CPU type, used to distinguish between
1.13      deraadt   222:  * the many variations of different sun4* machines. It contains
                    223:  * the value CPU_SUN4, CPU_SUN4C, or CPU_SUN4M.
1.9       deraadt   224:  */
1.111     pk        225:        .globl  _C_LABEL(cputyp)
                    226: _C_LABEL(cputyp):
1.9       deraadt   227:        .word   1
1.52      pk        228:
1.18      deraadt   229: #if defined(SUN4C) || defined(SUN4M)
1.111     pk        230: cputypval:
1.18      deraadt   231:        .asciz  "sun4c"
                    232:        .ascii  "     "
1.111     pk        233: cputypvar:
1.37      pk        234:        .asciz  "compatible"
1.52      pk        235:        _ALIGN
1.18      deraadt   236: #endif
                    237:
1.13      deraadt   238: /*
                    239:  * There variables are pointed to by the cpp symbols PGSHIFT, NBPG,
                    240:  * and PGOFSET.
                    241:  */
1.111     pk        242:        .globl  _C_LABEL(pgshift), _C_LABEL(nbpg), _C_LABEL(pgofset)
                    243: _C_LABEL(pgshift):
1.52      pk        244:        .word   0
1.111     pk        245: _C_LABEL(nbpg):
1.52      pk        246:        .word   0
1.111     pk        247: _C_LABEL(pgofset):
1.52      pk        248:        .word   0
                    249:
1.111     pk        250:        .globl  _C_LABEL(trapbase)
                    251: _C_LABEL(trapbase):
1.52      pk        252:        .word   0
1.9       deraadt   253:
1.75      pk        254: #if 0
1.9       deraadt   255: #if defined(SUN4M)
                    256: _mapme:
                    257:        .asciz "0 0 f8000000 15c6a0 map-pages"
                    258: #endif
1.75      pk        259: #endif
1.9       deraadt   260:
1.158     thorpej   261: #if !defined(SUN4D)
                    262: sun4d_notsup:
                    263:        .asciz  "cr .( NetBSD/sparc: this kernel does not support the sun4d) cr"
                    264: #endif
1.9       deraadt   265: #if !defined(SUN4M)
                    266: sun4m_notsup:
1.20      deraadt   267:        .asciz  "cr .( NetBSD/sparc: this kernel does not support the sun4m) cr"
1.9       deraadt   268: #endif
1.13      deraadt   269: #if !defined(SUN4C)
1.9       deraadt   270: sun4c_notsup:
1.20      deraadt   271:        .asciz  "cr .( NetBSD/sparc: this kernel does not support the sun4c) cr"
1.13      deraadt   272: #endif
                    273: #if !defined(SUN4)
                    274: sun4_notsup:
1.20      deraadt   275:        ! the extra characters at the end are to ensure the zs fifo drains
                    276:        ! before we halt. Sick, eh?
                    277:        .asciz  "NetBSD/sparc: this kernel does not support the sun4\n\r \b"
1.9       deraadt   278: #endif
1.52      pk        279:        _ALIGN
1.9       deraadt   280:
1.1       deraadt   281:        .text
                    282:
                    283: /*
1.26      deraadt   284:  * The first thing in the real text segment is the trap vector table,
                    285:  * which must be aligned on a 4096 byte boundary.  The text segment
                    286:  * starts beyond page 0 of KERNBASE so that there is a red zone
                    287:  * between user and kernel space.  Since the boot ROM loads us at
1.119     christos  288:  * PROM_LOADADDR, it is far easier to start at KERNBASE+PROM_LOADADDR than to
1.26      deraadt   289:  * buck the trend.  This is two or four pages in (depending on if
                    290:  * pagesize is 8192 or 4096).    We place two items in this area:
1.75      pk        291:  * the message buffer (phys addr 0) and the cpu_softc structure for
                    292:  * the first processor in the system (phys addr 0x2000).
                    293:  * Because the message buffer is in our "red zone" between user and
1.26      deraadt   294:  * kernel space we remap it in configure() to another location and
                    295:  * invalidate the mapping at KERNBASE.
                    296:  */
                    297:
1.1       deraadt   298: /*
                    299:  * Each trap has room for four instructions, of which one perforce must
                    300:  * be a branch.  On entry the hardware has copied pc and npc to %l1 and
                    301:  * %l2 respectively.  We use two more to read the psr into %l0, and to
                    302:  * put the trap type value into %l3 (with a few exceptions below).
                    303:  * We could read the trap type field of %tbr later in the code instead,
                    304:  * but there is no need, and that would require more instructions
                    305:  * (read+mask, vs 1 `mov' here).
                    306:  *
                    307:  * I used to generate these numbers by address arithmetic, but gas's
                    308:  * expression evaluator has about as much sense as your average slug
                    309:  * (oddly enough, the code looks about as slimy too).  Thus, all the
                    310:  * trap numbers are given as arguments to the trap macros.  This means
                    311:  * there is one line per trap.  Sigh.
                    312:  *
                    313:  * Note that only the local registers may be used, since the trap
                    314:  * window is potentially the last window.  Its `in' registers are
                    315:  * the previous window's outs (as usual), but more important, its
                    316:  * `out' registers may be in use as the `topmost' window's `in' registers.
                    317:  * The global registers are of course verboten (well, until we save
                    318:  * them away).
                    319:  *
                    320:  * Hardware interrupt vectors can be `linked'---the linkage is to regular
                    321:  * C code---or rewired to fast in-window handlers.  The latter are good
                    322:  * for unbuffered hardware like the Zilog serial chip and the AMD audio
                    323:  * chip, where many interrupts can be handled trivially with pseudo-DMA or
                    324:  * similar.  Only one `fast' interrupt can be used per level, however, and
                    325:  * direct and `fast' interrupts are incompatible.  Routines in intr.c
                    326:  * handle setting these, with optional paranoia.
                    327:  */
                    328:
                    329:        /* regular vectored traps */
                    330: #define        VTRAP(type, label) \
                    331:        mov (type), %l3; b label; mov %psr, %l0; nop
                    332:
                    333:        /* hardware interrupts (can be linked or made `fast') */
1.52      pk        334: #define        HARDINT44C(lev) \
1.111     pk        335:        mov (lev), %l3; b _C_LABEL(sparc_interrupt44c); mov %psr, %l0; nop
1.52      pk        336:
                    337:        /* hardware interrupts (can be linked or made `fast') */
                    338: #define        HARDINT4M(lev) \
1.111     pk        339:        mov (lev), %l3; b _C_LABEL(sparc_interrupt4m); mov %psr, %l0; nop
1.1       deraadt   340:
                    341:        /* software interrupts (may not be made direct, sorry---but you
                    342:           should not be using them trivially anyway) */
1.52      pk        343: #define        SOFTINT44C(lev, bit) \
                    344:        mov (lev), %l3; mov (bit), %l4; b softintr_sun44c; mov %psr, %l0
                    345:
                    346:        /* There's no SOFTINT4M(): both hard and soft vector the same way */
1.1       deraadt   347:
                    348:        /* traps that just call trap() */
                    349: #define        TRAP(type)      VTRAP(type, slowtrap)
                    350:
                    351:        /* architecturally undefined traps (cause panic) */
                    352: #define        UTRAP(type)     VTRAP(type, slowtrap)
                    353:
                    354:        /* software undefined traps (may be replaced) */
                    355: #define        STRAP(type)     VTRAP(type, slowtrap)
                    356:
                    357: /* breakpoint acts differently under kgdb */
                    358: #ifdef KGDB
                    359: #define        BPT             VTRAP(T_BREAKPOINT, bpt)
1.52      pk        360: #define        BPT_KGDB_EXEC   VTRAP(T_KGDB_EXEC, bpt)
                    361: #else
                    362: #define        BPT             TRAP(T_BREAKPOINT)
                    363: #define        BPT_KGDB_EXEC   TRAP(T_KGDB_EXEC)
                    364: #endif
                    365:
                    366: /* special high-speed 1-instruction-shaved-off traps (get nothing in %l3) */
1.122     christos  367: #define        SYSCALL         b _C_LABEL(_syscall); mov %psr, %l0; nop; nop
1.52      pk        368: #define        WINDOW_OF       b window_of; mov %psr, %l0; nop; nop
                    369: #define        WINDOW_UF       b window_uf; mov %psr, %l0; nop; nop
                    370: #ifdef notyet
                    371: #define        ZS_INTERRUPT    b zshard; mov %psr, %l0; nop; nop
                    372: #else
                    373: #define        ZS_INTERRUPT44C HARDINT44C(12)
                    374: #define        ZS_INTERRUPT4M  HARDINT4M(12)
                    375: #endif
                    376:
1.173     pk        377: #ifdef DEBUG
                    378: #define TRAP_TRACE(tt, tmp)                                    \
                    379:        sethi   %hi(CPUINFO_VA + CPUINFO_TT), tmp;              \
                    380:        st      tt, [tmp + %lo(CPUINFO_VA + CPUINFO_TT)];
                    381: #define TRAP_TRACE2(tt, tmp1, tmp2)                            \
                    382:        mov     tt, tmp1;                                       \
                    383:        TRAP_TRACE(tmp1, tmp2)
                    384: #else /* DEBUG */
                    385: #define TRAP_TRACE(tt,tmp)             /**/
                    386: #define TRAP_TRACE2(tt,tmp1,tmp2)      /**/
                    387: #endif /* DEBUG */
                    388:
1.111     pk        389:        .globl  _ASM_LABEL(start), _C_LABEL(kernel_text)
                    390:        _C_LABEL(kernel_text) = start           ! for kvm_mkdb(8)
                    391: _ASM_LABEL(start):
1.52      pk        392: /*
                    393:  * Put sun4 traptable first, since it needs the most stringent aligment (8192)
                    394:  */
                    395: #if defined(SUN4)
                    396: trapbase_sun4:
                    397:        /* trap 0 is special since we cannot receive it */
                    398:        b dostart; nop; nop; nop        ! 00 = reset (fake)
                    399:        VTRAP(T_TEXTFAULT, memfault_sun4)       ! 01 = instr. fetch fault
                    400:        TRAP(T_ILLINST)                 ! 02 = illegal instruction
                    401:        TRAP(T_PRIVINST)                ! 03 = privileged instruction
                    402:        TRAP(T_FPDISABLED)              ! 04 = fp instr, but EF bit off in psr
                    403:        WINDOW_OF                       ! 05 = window overflow
                    404:        WINDOW_UF                       ! 06 = window underflow
                    405:        TRAP(T_ALIGN)                   ! 07 = address alignment error
                    406:        VTRAP(T_FPE, fp_exception)      ! 08 = fp exception
                    407:        VTRAP(T_DATAFAULT, memfault_sun4)       ! 09 = data fetch fault
                    408:        TRAP(T_TAGOF)                   ! 0a = tag overflow
                    409:        UTRAP(0x0b)
                    410:        UTRAP(0x0c)
                    411:        UTRAP(0x0d)
                    412:        UTRAP(0x0e)
                    413:        UTRAP(0x0f)
                    414:        UTRAP(0x10)
                    415:        SOFTINT44C(1, IE_L1)            ! 11 = level 1 interrupt
                    416:        HARDINT44C(2)                   ! 12 = level 2 interrupt
                    417:        HARDINT44C(3)                   ! 13 = level 3 interrupt
                    418:        SOFTINT44C(4, IE_L4)            ! 14 = level 4 interrupt
                    419:        HARDINT44C(5)                   ! 15 = level 5 interrupt
                    420:        SOFTINT44C(6, IE_L6)            ! 16 = level 6 interrupt
                    421:        HARDINT44C(7)                   ! 17 = level 7 interrupt
                    422:        HARDINT44C(8)                   ! 18 = level 8 interrupt
                    423:        HARDINT44C(9)                   ! 19 = level 9 interrupt
                    424:        HARDINT44C(10)                  ! 1a = level 10 interrupt
                    425:        HARDINT44C(11)                  ! 1b = level 11 interrupt
                    426:        ZS_INTERRUPT44C                 ! 1c = level 12 (zs) interrupt
                    427:        HARDINT44C(13)                  ! 1d = level 13 interrupt
                    428:        HARDINT44C(14)                  ! 1e = level 14 interrupt
                    429:        VTRAP(15, nmi_sun4)             ! 1f = nonmaskable interrupt
                    430:        UTRAP(0x20)
                    431:        UTRAP(0x21)
                    432:        UTRAP(0x22)
                    433:        UTRAP(0x23)
                    434:        TRAP(T_CPDISABLED)      ! 24 = coprocessor instr, EC bit off in psr
                    435:        UTRAP(0x25)
                    436:        UTRAP(0x26)
                    437:        UTRAP(0x27)
                    438:        TRAP(T_CPEXCEPTION)     ! 28 = coprocessor exception
                    439:        UTRAP(0x29)
                    440:        UTRAP(0x2a)
                    441:        UTRAP(0x2b)
                    442:        UTRAP(0x2c)
                    443:        UTRAP(0x2d)
                    444:        UTRAP(0x2e)
                    445:        UTRAP(0x2f)
                    446:        UTRAP(0x30)
                    447:        UTRAP(0x31)
                    448:        UTRAP(0x32)
                    449:        UTRAP(0x33)
                    450:        UTRAP(0x34)
                    451:        UTRAP(0x35)
                    452:        UTRAP(0x36)
                    453:        UTRAP(0x37)
                    454:        UTRAP(0x38)
                    455:        UTRAP(0x39)
                    456:        UTRAP(0x3a)
                    457:        UTRAP(0x3b)
                    458:        UTRAP(0x3c)
                    459:        UTRAP(0x3d)
                    460:        UTRAP(0x3e)
                    461:        UTRAP(0x3f)
                    462:        UTRAP(0x40)
                    463:        UTRAP(0x41)
                    464:        UTRAP(0x42)
                    465:        UTRAP(0x43)
                    466:        UTRAP(0x44)
                    467:        UTRAP(0x45)
                    468:        UTRAP(0x46)
                    469:        UTRAP(0x47)
                    470:        UTRAP(0x48)
                    471:        UTRAP(0x49)
                    472:        UTRAP(0x4a)
                    473:        UTRAP(0x4b)
                    474:        UTRAP(0x4c)
                    475:        UTRAP(0x4d)
                    476:        UTRAP(0x4e)
                    477:        UTRAP(0x4f)
                    478:        UTRAP(0x50)
                    479:        UTRAP(0x51)
                    480:        UTRAP(0x52)
                    481:        UTRAP(0x53)
                    482:        UTRAP(0x54)
                    483:        UTRAP(0x55)
                    484:        UTRAP(0x56)
                    485:        UTRAP(0x57)
                    486:        UTRAP(0x58)
                    487:        UTRAP(0x59)
                    488:        UTRAP(0x5a)
                    489:        UTRAP(0x5b)
                    490:        UTRAP(0x5c)
                    491:        UTRAP(0x5d)
                    492:        UTRAP(0x5e)
                    493:        UTRAP(0x5f)
                    494:        UTRAP(0x60)
                    495:        UTRAP(0x61)
                    496:        UTRAP(0x62)
                    497:        UTRAP(0x63)
                    498:        UTRAP(0x64)
                    499:        UTRAP(0x65)
                    500:        UTRAP(0x66)
                    501:        UTRAP(0x67)
                    502:        UTRAP(0x68)
                    503:        UTRAP(0x69)
                    504:        UTRAP(0x6a)
                    505:        UTRAP(0x6b)
                    506:        UTRAP(0x6c)
                    507:        UTRAP(0x6d)
                    508:        UTRAP(0x6e)
                    509:        UTRAP(0x6f)
                    510:        UTRAP(0x70)
                    511:        UTRAP(0x71)
                    512:        UTRAP(0x72)
                    513:        UTRAP(0x73)
                    514:        UTRAP(0x74)
                    515:        UTRAP(0x75)
                    516:        UTRAP(0x76)
                    517:        UTRAP(0x77)
                    518:        UTRAP(0x78)
                    519:        UTRAP(0x79)
                    520:        UTRAP(0x7a)
                    521:        UTRAP(0x7b)
                    522:        UTRAP(0x7c)
                    523:        UTRAP(0x7d)
                    524:        UTRAP(0x7e)
                    525:        UTRAP(0x7f)
                    526:        SYSCALL                 ! 80 = sun syscall
                    527:        BPT                     ! 81 = pseudo breakpoint instruction
                    528:        TRAP(T_DIV0)            ! 82 = divide by zero
                    529:        TRAP(T_FLUSHWIN)        ! 83 = flush windows
                    530:        TRAP(T_CLEANWIN)        ! 84 = provide clean windows
                    531:        TRAP(T_RANGECHECK)      ! 85 = ???
                    532:        TRAP(T_FIXALIGN)        ! 86 = fix up unaligned accesses
                    533:        TRAP(T_INTOF)           ! 87 = integer overflow
                    534:        SYSCALL                 ! 88 = svr4 syscall
                    535:        SYSCALL                 ! 89 = bsd syscall
                    536:        BPT_KGDB_EXEC           ! 8a = enter kernel gdb on kernel startup
                    537:        STRAP(0x8b)
                    538:        STRAP(0x8c)
                    539:        STRAP(0x8d)
                    540:        STRAP(0x8e)
                    541:        STRAP(0x8f)
                    542:        STRAP(0x90)
                    543:        STRAP(0x91)
                    544:        STRAP(0x92)
                    545:        STRAP(0x93)
                    546:        STRAP(0x94)
                    547:        STRAP(0x95)
                    548:        STRAP(0x96)
                    549:        STRAP(0x97)
                    550:        STRAP(0x98)
                    551:        STRAP(0x99)
                    552:        STRAP(0x9a)
                    553:        STRAP(0x9b)
                    554:        STRAP(0x9c)
                    555:        STRAP(0x9d)
                    556:        STRAP(0x9e)
                    557:        STRAP(0x9f)
                    558:        STRAP(0xa0)
                    559:        STRAP(0xa1)
                    560:        STRAP(0xa2)
                    561:        STRAP(0xa3)
                    562:        STRAP(0xa4)
                    563:        STRAP(0xa5)
                    564:        STRAP(0xa6)
                    565:        STRAP(0xa7)
                    566:        STRAP(0xa8)
                    567:        STRAP(0xa9)
                    568:        STRAP(0xaa)
                    569:        STRAP(0xab)
                    570:        STRAP(0xac)
                    571:        STRAP(0xad)
                    572:        STRAP(0xae)
                    573:        STRAP(0xaf)
                    574:        STRAP(0xb0)
                    575:        STRAP(0xb1)
                    576:        STRAP(0xb2)
                    577:        STRAP(0xb3)
                    578:        STRAP(0xb4)
                    579:        STRAP(0xb5)
                    580:        STRAP(0xb6)
                    581:        STRAP(0xb7)
                    582:        STRAP(0xb8)
                    583:        STRAP(0xb9)
                    584:        STRAP(0xba)
                    585:        STRAP(0xbb)
                    586:        STRAP(0xbc)
                    587:        STRAP(0xbd)
                    588:        STRAP(0xbe)
                    589:        STRAP(0xbf)
                    590:        STRAP(0xc0)
                    591:        STRAP(0xc1)
                    592:        STRAP(0xc2)
                    593:        STRAP(0xc3)
                    594:        STRAP(0xc4)
                    595:        STRAP(0xc5)
                    596:        STRAP(0xc6)
                    597:        STRAP(0xc7)
                    598:        STRAP(0xc8)
                    599:        STRAP(0xc9)
                    600:        STRAP(0xca)
                    601:        STRAP(0xcb)
                    602:        STRAP(0xcc)
                    603:        STRAP(0xcd)
                    604:        STRAP(0xce)
                    605:        STRAP(0xcf)
                    606:        STRAP(0xd0)
                    607:        STRAP(0xd1)
                    608:        STRAP(0xd2)
                    609:        STRAP(0xd3)
                    610:        STRAP(0xd4)
                    611:        STRAP(0xd5)
                    612:        STRAP(0xd6)
                    613:        STRAP(0xd7)
                    614:        STRAP(0xd8)
                    615:        STRAP(0xd9)
                    616:        STRAP(0xda)
                    617:        STRAP(0xdb)
                    618:        STRAP(0xdc)
                    619:        STRAP(0xdd)
                    620:        STRAP(0xde)
                    621:        STRAP(0xdf)
                    622:        STRAP(0xe0)
                    623:        STRAP(0xe1)
                    624:        STRAP(0xe2)
                    625:        STRAP(0xe3)
                    626:        STRAP(0xe4)
                    627:        STRAP(0xe5)
                    628:        STRAP(0xe6)
                    629:        STRAP(0xe7)
                    630:        STRAP(0xe8)
                    631:        STRAP(0xe9)
                    632:        STRAP(0xea)
                    633:        STRAP(0xeb)
                    634:        STRAP(0xec)
                    635:        STRAP(0xed)
                    636:        STRAP(0xee)
                    637:        STRAP(0xef)
                    638:        STRAP(0xf0)
                    639:        STRAP(0xf1)
                    640:        STRAP(0xf2)
                    641:        STRAP(0xf3)
                    642:        STRAP(0xf4)
                    643:        STRAP(0xf5)
                    644:        STRAP(0xf6)
                    645:        STRAP(0xf7)
                    646:        STRAP(0xf8)
                    647:        STRAP(0xf9)
                    648:        STRAP(0xfa)
                    649:        STRAP(0xfb)
                    650:        STRAP(0xfc)
                    651:        STRAP(0xfd)
                    652:        STRAP(0xfe)
                    653:        STRAP(0xff)
                    654: #endif
                    655:
                    656: #if defined(SUN4C)
                    657: trapbase_sun4c:
                    658: /* trap 0 is special since we cannot receive it */
                    659:        b dostart; nop; nop; nop        ! 00 = reset (fake)
                    660:        VTRAP(T_TEXTFAULT, memfault_sun4c)      ! 01 = instr. fetch fault
                    661:        TRAP(T_ILLINST)                 ! 02 = illegal instruction
                    662:        TRAP(T_PRIVINST)                ! 03 = privileged instruction
                    663:        TRAP(T_FPDISABLED)              ! 04 = fp instr, but EF bit off in psr
                    664:        WINDOW_OF                       ! 05 = window overflow
                    665:        WINDOW_UF                       ! 06 = window underflow
                    666:        TRAP(T_ALIGN)                   ! 07 = address alignment error
                    667:        VTRAP(T_FPE, fp_exception)      ! 08 = fp exception
                    668:        VTRAP(T_DATAFAULT, memfault_sun4c)      ! 09 = data fetch fault
                    669:        TRAP(T_TAGOF)                   ! 0a = tag overflow
                    670:        UTRAP(0x0b)
                    671:        UTRAP(0x0c)
                    672:        UTRAP(0x0d)
                    673:        UTRAP(0x0e)
                    674:        UTRAP(0x0f)
                    675:        UTRAP(0x10)
                    676:        SOFTINT44C(1, IE_L1)            ! 11 = level 1 interrupt
                    677:        HARDINT44C(2)                   ! 12 = level 2 interrupt
                    678:        HARDINT44C(3)                   ! 13 = level 3 interrupt
                    679:        SOFTINT44C(4, IE_L4)            ! 14 = level 4 interrupt
                    680:        HARDINT44C(5)                   ! 15 = level 5 interrupt
                    681:        SOFTINT44C(6, IE_L6)            ! 16 = level 6 interrupt
                    682:        HARDINT44C(7)                   ! 17 = level 7 interrupt
                    683:        HARDINT44C(8)                   ! 18 = level 8 interrupt
                    684:        HARDINT44C(9)                   ! 19 = level 9 interrupt
                    685:        HARDINT44C(10)                  ! 1a = level 10 interrupt
                    686:        HARDINT44C(11)                  ! 1b = level 11 interrupt
                    687:        ZS_INTERRUPT44C                 ! 1c = level 12 (zs) interrupt
                    688:        HARDINT44C(13)                  ! 1d = level 13 interrupt
                    689:        HARDINT44C(14)                  ! 1e = level 14 interrupt
                    690:        VTRAP(15, nmi_sun4c)            ! 1f = nonmaskable interrupt
                    691:        UTRAP(0x20)
                    692:        UTRAP(0x21)
                    693:        UTRAP(0x22)
                    694:        UTRAP(0x23)
                    695:        TRAP(T_CPDISABLED)      ! 24 = coprocessor instr, EC bit off in psr
                    696:        UTRAP(0x25)
                    697:        UTRAP(0x26)
                    698:        UTRAP(0x27)
                    699:        TRAP(T_CPEXCEPTION)     ! 28 = coprocessor exception
                    700:        UTRAP(0x29)
                    701:        UTRAP(0x2a)
                    702:        UTRAP(0x2b)
                    703:        UTRAP(0x2c)
                    704:        UTRAP(0x2d)
                    705:        UTRAP(0x2e)
                    706:        UTRAP(0x2f)
                    707:        UTRAP(0x30)
                    708:        UTRAP(0x31)
                    709:        UTRAP(0x32)
                    710:        UTRAP(0x33)
                    711:        UTRAP(0x34)
                    712:        UTRAP(0x35)
                    713:        UTRAP(0x36)
                    714:        UTRAP(0x37)
                    715:        UTRAP(0x38)
                    716:        UTRAP(0x39)
                    717:        UTRAP(0x3a)
                    718:        UTRAP(0x3b)
                    719:        UTRAP(0x3c)
                    720:        UTRAP(0x3d)
                    721:        UTRAP(0x3e)
                    722:        UTRAP(0x3f)
                    723:        UTRAP(0x40)
                    724:        UTRAP(0x41)
                    725:        UTRAP(0x42)
                    726:        UTRAP(0x43)
                    727:        UTRAP(0x44)
                    728:        UTRAP(0x45)
                    729:        UTRAP(0x46)
                    730:        UTRAP(0x47)
                    731:        UTRAP(0x48)
                    732:        UTRAP(0x49)
                    733:        UTRAP(0x4a)
                    734:        UTRAP(0x4b)
                    735:        UTRAP(0x4c)
                    736:        UTRAP(0x4d)
                    737:        UTRAP(0x4e)
                    738:        UTRAP(0x4f)
                    739:        UTRAP(0x50)
                    740:        UTRAP(0x51)
                    741:        UTRAP(0x52)
                    742:        UTRAP(0x53)
                    743:        UTRAP(0x54)
                    744:        UTRAP(0x55)
                    745:        UTRAP(0x56)
                    746:        UTRAP(0x57)
                    747:        UTRAP(0x58)
                    748:        UTRAP(0x59)
                    749:        UTRAP(0x5a)
                    750:        UTRAP(0x5b)
                    751:        UTRAP(0x5c)
                    752:        UTRAP(0x5d)
                    753:        UTRAP(0x5e)
                    754:        UTRAP(0x5f)
                    755:        UTRAP(0x60)
                    756:        UTRAP(0x61)
                    757:        UTRAP(0x62)
                    758:        UTRAP(0x63)
                    759:        UTRAP(0x64)
                    760:        UTRAP(0x65)
                    761:        UTRAP(0x66)
                    762:        UTRAP(0x67)
                    763:        UTRAP(0x68)
                    764:        UTRAP(0x69)
                    765:        UTRAP(0x6a)
                    766:        UTRAP(0x6b)
                    767:        UTRAP(0x6c)
                    768:        UTRAP(0x6d)
                    769:        UTRAP(0x6e)
                    770:        UTRAP(0x6f)
                    771:        UTRAP(0x70)
                    772:        UTRAP(0x71)
                    773:        UTRAP(0x72)
                    774:        UTRAP(0x73)
                    775:        UTRAP(0x74)
                    776:        UTRAP(0x75)
                    777:        UTRAP(0x76)
                    778:        UTRAP(0x77)
                    779:        UTRAP(0x78)
                    780:        UTRAP(0x79)
                    781:        UTRAP(0x7a)
                    782:        UTRAP(0x7b)
                    783:        UTRAP(0x7c)
                    784:        UTRAP(0x7d)
                    785:        UTRAP(0x7e)
                    786:        UTRAP(0x7f)
                    787:        SYSCALL                 ! 80 = sun syscall
                    788:        BPT                     ! 81 = pseudo breakpoint instruction
                    789:        TRAP(T_DIV0)            ! 82 = divide by zero
                    790:        TRAP(T_FLUSHWIN)        ! 83 = flush windows
                    791:        TRAP(T_CLEANWIN)        ! 84 = provide clean windows
                    792:        TRAP(T_RANGECHECK)      ! 85 = ???
                    793:        TRAP(T_FIXALIGN)        ! 86 = fix up unaligned accesses
                    794:        TRAP(T_INTOF)           ! 87 = integer overflow
                    795:        SYSCALL                 ! 88 = svr4 syscall
                    796:        SYSCALL                 ! 89 = bsd syscall
                    797:        BPT_KGDB_EXEC           ! 8a = enter kernel gdb on kernel startup
                    798:        STRAP(0x8b)
                    799:        STRAP(0x8c)
                    800:        STRAP(0x8d)
                    801:        STRAP(0x8e)
                    802:        STRAP(0x8f)
                    803:        STRAP(0x90)
                    804:        STRAP(0x91)
                    805:        STRAP(0x92)
                    806:        STRAP(0x93)
                    807:        STRAP(0x94)
                    808:        STRAP(0x95)
                    809:        STRAP(0x96)
                    810:        STRAP(0x97)
                    811:        STRAP(0x98)
                    812:        STRAP(0x99)
                    813:        STRAP(0x9a)
                    814:        STRAP(0x9b)
                    815:        STRAP(0x9c)
                    816:        STRAP(0x9d)
                    817:        STRAP(0x9e)
                    818:        STRAP(0x9f)
                    819:        STRAP(0xa0)
                    820:        STRAP(0xa1)
                    821:        STRAP(0xa2)
                    822:        STRAP(0xa3)
                    823:        STRAP(0xa4)
                    824:        STRAP(0xa5)
                    825:        STRAP(0xa6)
                    826:        STRAP(0xa7)
                    827:        STRAP(0xa8)
                    828:        STRAP(0xa9)
                    829:        STRAP(0xaa)
                    830:        STRAP(0xab)
                    831:        STRAP(0xac)
                    832:        STRAP(0xad)
                    833:        STRAP(0xae)
                    834:        STRAP(0xaf)
                    835:        STRAP(0xb0)
                    836:        STRAP(0xb1)
                    837:        STRAP(0xb2)
                    838:        STRAP(0xb3)
                    839:        STRAP(0xb4)
                    840:        STRAP(0xb5)
                    841:        STRAP(0xb6)
                    842:        STRAP(0xb7)
                    843:        STRAP(0xb8)
                    844:        STRAP(0xb9)
                    845:        STRAP(0xba)
                    846:        STRAP(0xbb)
                    847:        STRAP(0xbc)
                    848:        STRAP(0xbd)
                    849:        STRAP(0xbe)
                    850:        STRAP(0xbf)
                    851:        STRAP(0xc0)
                    852:        STRAP(0xc1)
                    853:        STRAP(0xc2)
                    854:        STRAP(0xc3)
                    855:        STRAP(0xc4)
                    856:        STRAP(0xc5)
                    857:        STRAP(0xc6)
                    858:        STRAP(0xc7)
                    859:        STRAP(0xc8)
                    860:        STRAP(0xc9)
                    861:        STRAP(0xca)
                    862:        STRAP(0xcb)
                    863:        STRAP(0xcc)
                    864:        STRAP(0xcd)
                    865:        STRAP(0xce)
                    866:        STRAP(0xcf)
                    867:        STRAP(0xd0)
                    868:        STRAP(0xd1)
                    869:        STRAP(0xd2)
                    870:        STRAP(0xd3)
                    871:        STRAP(0xd4)
                    872:        STRAP(0xd5)
                    873:        STRAP(0xd6)
                    874:        STRAP(0xd7)
                    875:        STRAP(0xd8)
                    876:        STRAP(0xd9)
                    877:        STRAP(0xda)
                    878:        STRAP(0xdb)
                    879:        STRAP(0xdc)
                    880:        STRAP(0xdd)
                    881:        STRAP(0xde)
                    882:        STRAP(0xdf)
                    883:        STRAP(0xe0)
                    884:        STRAP(0xe1)
                    885:        STRAP(0xe2)
                    886:        STRAP(0xe3)
                    887:        STRAP(0xe4)
                    888:        STRAP(0xe5)
                    889:        STRAP(0xe6)
                    890:        STRAP(0xe7)
                    891:        STRAP(0xe8)
                    892:        STRAP(0xe9)
                    893:        STRAP(0xea)
                    894:        STRAP(0xeb)
                    895:        STRAP(0xec)
                    896:        STRAP(0xed)
                    897:        STRAP(0xee)
                    898:        STRAP(0xef)
                    899:        STRAP(0xf0)
                    900:        STRAP(0xf1)
                    901:        STRAP(0xf2)
                    902:        STRAP(0xf3)
                    903:        STRAP(0xf4)
                    904:        STRAP(0xf5)
                    905:        STRAP(0xf6)
                    906:        STRAP(0xf7)
                    907:        STRAP(0xf8)
                    908:        STRAP(0xf9)
                    909:        STRAP(0xfa)
                    910:        STRAP(0xfb)
                    911:        STRAP(0xfc)
                    912:        STRAP(0xfd)
                    913:        STRAP(0xfe)
                    914:        STRAP(0xff)
1.1       deraadt   915: #endif
                    916:
1.52      pk        917: #if defined(SUN4M)
                    918: trapbase_sun4m:
1.1       deraadt   919: /* trap 0 is special since we cannot receive it */
                    920:        b dostart; nop; nop; nop        ! 00 = reset (fake)
1.52      pk        921:        VTRAP(T_TEXTFAULT, memfault_sun4m)      ! 01 = instr. fetch fault
1.1       deraadt   922:        TRAP(T_ILLINST)                 ! 02 = illegal instruction
                    923:        TRAP(T_PRIVINST)                ! 03 = privileged instruction
                    924:        TRAP(T_FPDISABLED)              ! 04 = fp instr, but EF bit off in psr
                    925:        WINDOW_OF                       ! 05 = window overflow
                    926:        WINDOW_UF                       ! 06 = window underflow
                    927:        TRAP(T_ALIGN)                   ! 07 = address alignment error
                    928:        VTRAP(T_FPE, fp_exception)      ! 08 = fp exception
1.52      pk        929:        VTRAP(T_DATAFAULT, memfault_sun4m)      ! 09 = data fetch fault
1.1       deraadt   930:        TRAP(T_TAGOF)                   ! 0a = tag overflow
                    931:        UTRAP(0x0b)
                    932:        UTRAP(0x0c)
                    933:        UTRAP(0x0d)
                    934:        UTRAP(0x0e)
                    935:        UTRAP(0x0f)
                    936:        UTRAP(0x10)
1.52      pk        937:        HARDINT4M(1)                    ! 11 = level 1 interrupt
                    938:        HARDINT4M(2)                    ! 12 = level 2 interrupt
                    939:        HARDINT4M(3)                    ! 13 = level 3 interrupt
                    940:        HARDINT4M(4)                    ! 14 = level 4 interrupt
                    941:        HARDINT4M(5)                    ! 15 = level 5 interrupt
                    942:        HARDINT4M(6)                    ! 16 = level 6 interrupt
                    943:        HARDINT4M(7)                    ! 17 = level 7 interrupt
                    944:        HARDINT4M(8)                    ! 18 = level 8 interrupt
                    945:        HARDINT4M(9)                    ! 19 = level 9 interrupt
                    946:        HARDINT4M(10)                   ! 1a = level 10 interrupt
                    947:        HARDINT4M(11)                   ! 1b = level 11 interrupt
                    948:        ZS_INTERRUPT4M                  ! 1c = level 12 (zs) interrupt
                    949:        HARDINT4M(13)                   ! 1d = level 13 interrupt
                    950:        HARDINT4M(14)                   ! 1e = level 14 interrupt
                    951:        VTRAP(15, nmi_sun4m)            ! 1f = nonmaskable interrupt
1.1       deraadt   952:        UTRAP(0x20)
1.190     pk        953:        VTRAP(T_TEXTERROR, memfault_sun4m)      ! 21 = instr. fetch error
1.1       deraadt   954:        UTRAP(0x22)
                    955:        UTRAP(0x23)
1.25      deraadt   956:        TRAP(T_CPDISABLED)      ! 24 = coprocessor instr, EC bit off in psr
1.1       deraadt   957:        UTRAP(0x25)
                    958:        UTRAP(0x26)
                    959:        UTRAP(0x27)
1.25      deraadt   960:        TRAP(T_CPEXCEPTION)     ! 28 = coprocessor exception
1.190     pk        961:        VTRAP(T_DATAERROR, memfault_sun4m)      ! 29 = data fetch error
1.1       deraadt   962:        UTRAP(0x2a)
1.52      pk        963:        VTRAP(T_STOREBUFFAULT, memfault_sun4m) ! 2b = SuperSPARC store buffer fault
1.1       deraadt   964:        UTRAP(0x2c)
                    965:        UTRAP(0x2d)
                    966:        UTRAP(0x2e)
                    967:        UTRAP(0x2f)
                    968:        UTRAP(0x30)
                    969:        UTRAP(0x31)
                    970:        UTRAP(0x32)
                    971:        UTRAP(0x33)
                    972:        UTRAP(0x34)
                    973:        UTRAP(0x35)
1.25      deraadt   974:        UTRAP(0x36)
1.1       deraadt   975:        UTRAP(0x37)
                    976:        UTRAP(0x38)
                    977:        UTRAP(0x39)
                    978:        UTRAP(0x3a)
                    979:        UTRAP(0x3b)
                    980:        UTRAP(0x3c)
                    981:        UTRAP(0x3d)
                    982:        UTRAP(0x3e)
                    983:        UTRAP(0x3f)
1.25      deraadt   984:        UTRAP(0x40)
1.1       deraadt   985:        UTRAP(0x41)
                    986:        UTRAP(0x42)
                    987:        UTRAP(0x43)
                    988:        UTRAP(0x44)
                    989:        UTRAP(0x45)
                    990:        UTRAP(0x46)
                    991:        UTRAP(0x47)
                    992:        UTRAP(0x48)
                    993:        UTRAP(0x49)
                    994:        UTRAP(0x4a)
                    995:        UTRAP(0x4b)
                    996:        UTRAP(0x4c)
                    997:        UTRAP(0x4d)
                    998:        UTRAP(0x4e)
                    999:        UTRAP(0x4f)
                   1000:        UTRAP(0x50)
                   1001:        UTRAP(0x51)
                   1002:        UTRAP(0x52)
                   1003:        UTRAP(0x53)
                   1004:        UTRAP(0x54)
                   1005:        UTRAP(0x55)
                   1006:        UTRAP(0x56)
                   1007:        UTRAP(0x57)
                   1008:        UTRAP(0x58)
                   1009:        UTRAP(0x59)
                   1010:        UTRAP(0x5a)
                   1011:        UTRAP(0x5b)
                   1012:        UTRAP(0x5c)
                   1013:        UTRAP(0x5d)
                   1014:        UTRAP(0x5e)
                   1015:        UTRAP(0x5f)
                   1016:        UTRAP(0x60)
                   1017:        UTRAP(0x61)
                   1018:        UTRAP(0x62)
                   1019:        UTRAP(0x63)
                   1020:        UTRAP(0x64)
                   1021:        UTRAP(0x65)
                   1022:        UTRAP(0x66)
                   1023:        UTRAP(0x67)
                   1024:        UTRAP(0x68)
                   1025:        UTRAP(0x69)
                   1026:        UTRAP(0x6a)
                   1027:        UTRAP(0x6b)
                   1028:        UTRAP(0x6c)
                   1029:        UTRAP(0x6d)
                   1030:        UTRAP(0x6e)
                   1031:        UTRAP(0x6f)
                   1032:        UTRAP(0x70)
                   1033:        UTRAP(0x71)
                   1034:        UTRAP(0x72)
                   1035:        UTRAP(0x73)
                   1036:        UTRAP(0x74)
                   1037:        UTRAP(0x75)
                   1038:        UTRAP(0x76)
                   1039:        UTRAP(0x77)
                   1040:        UTRAP(0x78)
                   1041:        UTRAP(0x79)
                   1042:        UTRAP(0x7a)
                   1043:        UTRAP(0x7b)
                   1044:        UTRAP(0x7c)
                   1045:        UTRAP(0x7d)
                   1046:        UTRAP(0x7e)
                   1047:        UTRAP(0x7f)
1.3       deraadt  1048:        SYSCALL                 ! 80 = sun syscall
1.1       deraadt  1049:        BPT                     ! 81 = pseudo breakpoint instruction
                   1050:        TRAP(T_DIV0)            ! 82 = divide by zero
                   1051:        TRAP(T_FLUSHWIN)        ! 83 = flush windows
                   1052:        TRAP(T_CLEANWIN)        ! 84 = provide clean windows
                   1053:        TRAP(T_RANGECHECK)      ! 85 = ???
                   1054:        TRAP(T_FIXALIGN)        ! 86 = fix up unaligned accesses
                   1055:        TRAP(T_INTOF)           ! 87 = integer overflow
1.33      christos 1056:        SYSCALL                 ! 88 = svr4 syscall
1.1       deraadt  1057:        SYSCALL                 ! 89 = bsd syscall
1.33      christos 1058:        BPT_KGDB_EXEC           ! 8a = enter kernel gdb on kernel startup
1.171     pk       1059:        TRAP(T_DBPAUSE)         ! 8b = hold CPU for kernel debugger
1.1       deraadt  1060:        STRAP(0x8c)
                   1061:        STRAP(0x8d)
                   1062:        STRAP(0x8e)
                   1063:        STRAP(0x8f)
                   1064:        STRAP(0x90)
                   1065:        STRAP(0x91)
                   1066:        STRAP(0x92)
                   1067:        STRAP(0x93)
                   1068:        STRAP(0x94)
                   1069:        STRAP(0x95)
                   1070:        STRAP(0x96)
                   1071:        STRAP(0x97)
                   1072:        STRAP(0x98)
                   1073:        STRAP(0x99)
                   1074:        STRAP(0x9a)
                   1075:        STRAP(0x9b)
                   1076:        STRAP(0x9c)
                   1077:        STRAP(0x9d)
                   1078:        STRAP(0x9e)
                   1079:        STRAP(0x9f)
                   1080:        STRAP(0xa0)
                   1081:        STRAP(0xa1)
                   1082:        STRAP(0xa2)
                   1083:        STRAP(0xa3)
                   1084:        STRAP(0xa4)
                   1085:        STRAP(0xa5)
                   1086:        STRAP(0xa6)
                   1087:        STRAP(0xa7)
                   1088:        STRAP(0xa8)
                   1089:        STRAP(0xa9)
                   1090:        STRAP(0xaa)
                   1091:        STRAP(0xab)
                   1092:        STRAP(0xac)
                   1093:        STRAP(0xad)
                   1094:        STRAP(0xae)
                   1095:        STRAP(0xaf)
                   1096:        STRAP(0xb0)
                   1097:        STRAP(0xb1)
                   1098:        STRAP(0xb2)
                   1099:        STRAP(0xb3)
                   1100:        STRAP(0xb4)
                   1101:        STRAP(0xb5)
                   1102:        STRAP(0xb6)
                   1103:        STRAP(0xb7)
                   1104:        STRAP(0xb8)
                   1105:        STRAP(0xb9)
                   1106:        STRAP(0xba)
                   1107:        STRAP(0xbb)
                   1108:        STRAP(0xbc)
                   1109:        STRAP(0xbd)
                   1110:        STRAP(0xbe)
                   1111:        STRAP(0xbf)
                   1112:        STRAP(0xc0)
                   1113:        STRAP(0xc1)
                   1114:        STRAP(0xc2)
                   1115:        STRAP(0xc3)
                   1116:        STRAP(0xc4)
                   1117:        STRAP(0xc5)
                   1118:        STRAP(0xc6)
                   1119:        STRAP(0xc7)
                   1120:        STRAP(0xc8)
                   1121:        STRAP(0xc9)
                   1122:        STRAP(0xca)
                   1123:        STRAP(0xcb)
                   1124:        STRAP(0xcc)
                   1125:        STRAP(0xcd)
                   1126:        STRAP(0xce)
                   1127:        STRAP(0xcf)
                   1128:        STRAP(0xd0)
                   1129:        STRAP(0xd1)
                   1130:        STRAP(0xd2)
                   1131:        STRAP(0xd3)
                   1132:        STRAP(0xd4)
                   1133:        STRAP(0xd5)
                   1134:        STRAP(0xd6)
                   1135:        STRAP(0xd7)
                   1136:        STRAP(0xd8)
                   1137:        STRAP(0xd9)
                   1138:        STRAP(0xda)
                   1139:        STRAP(0xdb)
                   1140:        STRAP(0xdc)
                   1141:        STRAP(0xdd)
                   1142:        STRAP(0xde)
                   1143:        STRAP(0xdf)
                   1144:        STRAP(0xe0)
                   1145:        STRAP(0xe1)
                   1146:        STRAP(0xe2)
                   1147:        STRAP(0xe3)
                   1148:        STRAP(0xe4)
                   1149:        STRAP(0xe5)
                   1150:        STRAP(0xe6)
                   1151:        STRAP(0xe7)
                   1152:        STRAP(0xe8)
                   1153:        STRAP(0xe9)
                   1154:        STRAP(0xea)
                   1155:        STRAP(0xeb)
                   1156:        STRAP(0xec)
                   1157:        STRAP(0xed)
                   1158:        STRAP(0xee)
                   1159:        STRAP(0xef)
                   1160:        STRAP(0xf0)
                   1161:        STRAP(0xf1)
                   1162:        STRAP(0xf2)
                   1163:        STRAP(0xf3)
                   1164:        STRAP(0xf4)
                   1165:        STRAP(0xf5)
                   1166:        STRAP(0xf6)
                   1167:        STRAP(0xf7)
                   1168:        STRAP(0xf8)
                   1169:        STRAP(0xf9)
                   1170:        STRAP(0xfa)
                   1171:        STRAP(0xfb)
                   1172:        STRAP(0xfc)
                   1173:        STRAP(0xfd)
                   1174:        STRAP(0xfe)
                   1175:        STRAP(0xff)
1.52      pk       1176: #endif
1.1       deraadt  1177:
1.20      deraadt  1178: /*
1.52      pk       1179:  * Pad the trap table to max page size.
                   1180:  * Trap table size is 0x100 * 4instr * 4byte/instr = 4096 bytes;
                   1181:  * need to .skip 4096 to pad to page size iff. the number of trap tables
                   1182:  * defined above is odd.
1.20      deraadt  1183:  */
1.65      mycroft  1184: #if (defined(SUN4) + defined(SUN4C) + defined(SUN4M)) % 2 == 1
1.20      deraadt  1185:        .skip   4096
1.52      pk       1186: #endif
1.20      deraadt  1187:
1.173     pk       1188: /* redzones don't work currently in multi-processor mode */
                   1189: #if defined(DEBUG) && !defined(MULTIPROCESSOR)
1.1       deraadt  1190: /*
                   1191:  * A hardware red zone is impossible.  We simulate one in software by
                   1192:  * keeping a `red zone' pointer; if %sp becomes less than this, we panic.
                   1193:  * This is expensive and is only enabled when debugging.
                   1194:  */
1.97      pk       1195:
1.99      pk       1196: /* `redzone' is located in the per-CPU information structure */
1.97      pk       1197: _redzone = CPUINFO_VA + CPUINFO_REDZONE
                   1198:        .data
1.1       deraadt  1199: #define        REDSTACK 2048           /* size of `panic: stack overflow' region */
                   1200: _redstack:
                   1201:        .skip   REDSTACK
                   1202:        .text
                   1203: Lpanic_red:
                   1204:        .asciz  "stack overflow"
1.52      pk       1205:        _ALIGN
1.1       deraadt  1206:
                   1207:        /* set stack pointer redzone to base+minstack; alters base */
                   1208: #define        SET_SP_REDZONE(base, tmp) \
                   1209:        add     base, REDSIZE, base; \
                   1210:        sethi   %hi(_redzone), tmp; \
                   1211:        st      base, [tmp + %lo(_redzone)]
                   1212:
                   1213:        /* variant with a constant */
                   1214: #define        SET_SP_REDZONE_CONST(const, tmp1, tmp2) \
                   1215:        set     (const) + REDSIZE, tmp1; \
                   1216:        sethi   %hi(_redzone), tmp2; \
                   1217:        st      tmp1, [tmp2 + %lo(_redzone)]
                   1218:
1.97      pk       1219:        /* variant with a variable & offset */
                   1220: #define        SET_SP_REDZONE_VAR(var, offset, tmp1, tmp2) \
                   1221:        sethi   %hi(var), tmp1; \
                   1222:        ld      [tmp1 + %lo(var)], tmp1; \
                   1223:        sethi   %hi(offset), tmp2; \
                   1224:        add     tmp1, tmp2, tmp1; \
                   1225:        SET_SP_REDZONE(tmp1, tmp2)
                   1226:
1.1       deraadt  1227:        /* check stack pointer against redzone (uses two temps) */
                   1228: #define        CHECK_SP_REDZONE(t1, t2) \
                   1229:        sethi   %hi(_redzone), t1; \
                   1230:        ld      [t1 + %lo(_redzone)], t2; \
                   1231:        cmp     %sp, t2;        /* if sp >= t2, not in red zone */ \
                   1232:        bgeu    7f; nop;        /* and can continue normally */ \
                   1233:        /* move to panic stack */ \
                   1234:        st      %g0, [t1 + %lo(_redzone)]; \
                   1235:        set     _redstack + REDSTACK - 96, %sp; \
                   1236:        /* prevent panic() from lowering ipl */ \
1.121     christos 1237:        sethi   %hi(_C_LABEL(panicstr)), t2; \
1.1       deraadt  1238:        set     Lpanic_red, t2; \
1.121     christos 1239:        st      t2, [t1 + %lo(_C_LABEL(panicstr))]; \
1.1       deraadt  1240:        rd      %psr, t1;               /* t1 = splhigh() */ \
                   1241:        or      t1, PSR_PIL, t2; \
                   1242:        wr      t2, 0, %psr; \
                   1243:        wr      t2, PSR_ET, %psr;       /* turn on traps */ \
                   1244:        nop; nop; nop; \
1.4       deraadt  1245:        save    %sp, -CCFSZ, %sp;       /* preserve current window */ \
1.1       deraadt  1246:        sethi   %hi(Lpanic_red), %o0; \
1.121     christos 1247:        call    _C_LABEL(panic); or %o0, %lo(Lpanic_red), %o0; \
1.1       deraadt  1248: 7:
                   1249:
                   1250: #else
                   1251:
                   1252: #define        SET_SP_REDZONE(base, tmp)
                   1253: #define        SET_SP_REDZONE_CONST(const, t1, t2)
1.98      pk       1254: #define        SET_SP_REDZONE_VAR(var, offset, t1, t2)
1.1       deraadt  1255: #define        CHECK_SP_REDZONE(t1, t2)
1.97      pk       1256: #endif /* DEBUG */
1.1       deraadt  1257:
                   1258: /*
                   1259:  * The window code must verify user stack addresses before using them.
                   1260:  * A user stack pointer is invalid if:
                   1261:  *     - it is not on an 8 byte boundary;
                   1262:  *     - its pages (a register window, being 64 bytes, can occupy
                   1263:  *       two pages) are not readable or writable.
                   1264:  * We define three separate macros here for testing user stack addresses.
                   1265:  *
                   1266:  * PTE_OF_ADDR locates a PTE, branching to a `bad address'
                   1267:  *     handler if the stack pointer points into the hole in the
                   1268:  *     address space (i.e., top 3 bits are not either all 1 or all 0);
                   1269:  * CMP_PTE_USER_READ compares the located PTE against `user read' mode;
                   1270:  * CMP_PTE_USER_WRITE compares the located PTE against `user write' mode.
                   1271:  * The compares give `equal' if read or write is OK.
                   1272:  *
                   1273:  * Note that the user stack pointer usually points into high addresses
                   1274:  * (top 3 bits all 1), so that is what we check first.
                   1275:  *
                   1276:  * The code below also assumes that PTE_OF_ADDR is safe in a delay
                   1277:  * slot; it is, at it merely sets its `pte' register to a temporary value.
                   1278:  */
1.52      pk       1279: #if defined(SUN4) || defined(SUN4C)
1.1       deraadt  1280:        /* input: addr, output: pte; aux: bad address label */
1.52      pk       1281: #define        PTE_OF_ADDR4_4C(addr, pte, bad, page_offset) \
1.1       deraadt  1282:        sra     addr, PG_VSHIFT, pte; \
                   1283:        cmp     pte, -1; \
1.13      deraadt  1284:        be,a    1f; andn addr, page_offset, pte; \
1.1       deraadt  1285:        tst     pte; \
                   1286:        bne     bad; EMPTY; \
1.13      deraadt  1287:        andn    addr, page_offset, pte; \
1.1       deraadt  1288: 1:
                   1289:
                   1290:        /* input: pte; output: condition codes */
1.52      pk       1291: #define        CMP_PTE_USER_READ4_4C(pte) \
1.1       deraadt  1292:        lda     [pte] ASI_PTE, pte; \
                   1293:        srl     pte, PG_PROTSHIFT, pte; \
                   1294:        andn    pte, (PG_W >> PG_PROTSHIFT), pte; \
                   1295:        cmp     pte, PG_PROTUREAD
                   1296:
                   1297:        /* input: pte; output: condition codes */
1.52      pk       1298: #define        CMP_PTE_USER_WRITE4_4C(pte) \
1.1       deraadt  1299:        lda     [pte] ASI_PTE, pte; \
                   1300:        srl     pte, PG_PROTSHIFT, pte; \
                   1301:        cmp     pte, PG_PROTUWRITE
1.9       deraadt  1302: #endif
1.1       deraadt  1303:
                   1304: /*
1.52      pk       1305:  * The Sun4M does not have the memory hole that the 4C does. Thus all
                   1306:  * we need to do here is clear the page offset from addr.
                   1307:  */
                   1308: #if defined(SUN4M)
                   1309: #define        PTE_OF_ADDR4M(addr, pte, bad, page_offset) \
                   1310:        andn    addr, page_offset, pte
                   1311:
1.94      pk       1312: /*
                   1313:  * After obtaining the PTE through ASI_SRMMUFP, we read the Sync Fault
                   1314:  * Status register. This is necessary on Hypersparcs which stores and
                   1315:  * locks the fault address and status registers if the translation
                   1316:  * fails (thanks to Chris Torek for finding this quirk).
                   1317:  */
1.59      pk       1318: /* note: pmap currently does not use the PPROT_R_R and PPROT_RW_RW cases */
1.94      pk       1319: #define CMP_PTE_USER_READ4M(pte, tmp) \
1.52      pk       1320:        or      pte, ASI_SRMMUFP_L3, pte; \
                   1321:        lda     [pte] ASI_SRMMUFP, pte; \
1.94      pk       1322:        set     SRMMU_SFSR, tmp; \
1.58      pk       1323:        and     pte, (SRMMU_TETYPE | SRMMU_PROT_MASK), pte; \
1.59      pk       1324:        cmp     pte, (SRMMU_TEPTE | PPROT_RWX_RWX); \
1.94      pk       1325:        be      8f; \
                   1326:         lda    [tmp] ASI_SRMMU, %g0; \
1.59      pk       1327:        cmp     pte, (SRMMU_TEPTE | PPROT_RX_RX); \
                   1328: 8:
1.52      pk       1329:
1.58      pk       1330:
                   1331: /* note: PTE bit 4 set implies no user writes */
1.94      pk       1332: #define CMP_PTE_USER_WRITE4M(pte, tmp) \
1.52      pk       1333:        or      pte, ASI_SRMMUFP_L3, pte; \
                   1334:        lda     [pte] ASI_SRMMUFP, pte; \
1.94      pk       1335:        set     SRMMU_SFSR, tmp; \
                   1336:        lda     [tmp] ASI_SRMMU, %g0; \
1.58      pk       1337:        and     pte, (SRMMU_TETYPE | 0x14), pte; \
                   1338:        cmp     pte, (SRMMU_TEPTE | PPROT_WRITE)
1.52      pk       1339: #endif /* 4m */
                   1340:
                   1341: #if defined(SUN4M) && !(defined(SUN4C) || defined(SUN4))
1.64      pk       1342:
1.62      pk       1343: #define PTE_OF_ADDR(addr, pte, bad, page_offset, label) \
                   1344:        PTE_OF_ADDR4M(addr, pte, bad, page_offset)
1.94      pk       1345: #define CMP_PTE_USER_WRITE(pte, tmp, label)    CMP_PTE_USER_WRITE4M(pte,tmp)
                   1346: #define CMP_PTE_USER_READ(pte, tmp, label)     CMP_PTE_USER_READ4M(pte,tmp)
1.64      pk       1347:
1.52      pk       1348: #elif (defined(SUN4C) || defined(SUN4)) && !defined(SUN4M)
1.64      pk       1349:
1.62      pk       1350: #define PTE_OF_ADDR(addr, pte, bad, page_offset,label) \
                   1351:        PTE_OF_ADDR4_4C(addr, pte, bad, page_offset)
                   1352: #define CMP_PTE_USER_WRITE(pte, tmp, label)    CMP_PTE_USER_WRITE4_4C(pte)
                   1353: #define CMP_PTE_USER_READ(pte, tmp, label)     CMP_PTE_USER_READ4_4C(pte)
1.64      pk       1354:
1.52      pk       1355: #else /* both defined, ugh */
1.64      pk       1356:
1.62      pk       1357: #define        PTE_OF_ADDR(addr, pte, bad, page_offset, label) \
                   1358: label: b,a     2f; \
                   1359:        PTE_OF_ADDR4M(addr, pte, bad, page_offset); \
                   1360:        b,a     3f; \
                   1361: 2: \
                   1362:        PTE_OF_ADDR4_4C(addr, pte, bad, page_offset); \
                   1363: 3:
1.52      pk       1364:
1.62      pk       1365: #define CMP_PTE_USER_READ(pte, tmp, label) \
                   1366: label: b,a     1f; \
1.94      pk       1367:        CMP_PTE_USER_READ4M(pte,tmp); \
1.62      pk       1368:        b,a     2f; \
                   1369: 1: \
                   1370:        CMP_PTE_USER_READ4_4C(pte); \
                   1371: 2:
1.52      pk       1372:
1.62      pk       1373: #define CMP_PTE_USER_WRITE(pte, tmp, label) \
                   1374: label: b,a     1f; \
1.94      pk       1375:        CMP_PTE_USER_WRITE4M(pte,tmp); \
1.62      pk       1376:        b,a     2f; \
                   1377: 1: \
                   1378:        CMP_PTE_USER_WRITE4_4C(pte); \
                   1379: 2:
1.52      pk       1380: #endif
                   1381:
                   1382:
                   1383: /*
1.1       deraadt  1384:  * The calculations in PTE_OF_ADDR and CMP_PTE_USER_* are rather slow:
                   1385:  * in particular, according to Gordon Irlam of the University of Adelaide
                   1386:  * in Australia, these consume at least 18 cycles on an SS1 and 37 on an
                   1387:  * SS2.  Hence, we try to avoid them in the common case.
                   1388:  *
                   1389:  * A chunk of 64 bytes is on a single page if and only if:
                   1390:  *
1.13      deraadt  1391:  *     ((base + 64 - 1) & ~(NBPG-1)) == (base & ~(NBPG-1))
1.1       deraadt  1392:  *
                   1393:  * Equivalently (and faster to test), the low order bits (base & 4095) must
                   1394:  * be small enough so that the sum (base + 63) does not carry out into the
                   1395:  * upper page-address bits, i.e.,
                   1396:  *
1.13      deraadt  1397:  *     (base & (NBPG-1)) < (NBPG - 63)
1.1       deraadt  1398:  *
                   1399:  * so we allow testing that here.  This macro is also assumed to be safe
                   1400:  * in a delay slot (modulo overwriting its temporary).
                   1401:  */
1.13      deraadt  1402: #define        SLT_IF_1PAGE_RW(addr, tmp, page_offset) \
                   1403:        and     addr, page_offset, tmp; \
                   1404:        sub     page_offset, 62, page_offset; \
                   1405:        cmp     tmp, page_offset
1.1       deraadt  1406:
                   1407: /*
                   1408:  * Every trap that enables traps must set up stack space.
                   1409:  * If the trap is from user mode, this involves switching to the kernel
                   1410:  * stack for the current process, and we must also set cpcb->pcb_uw
                   1411:  * so that the window overflow handler can tell user windows from kernel
                   1412:  * windows.
                   1413:  *
                   1414:  * The number of user windows is:
                   1415:  *
                   1416:  *     cpcb->pcb_uw = (cpcb->pcb_wim - 1 - CWP) % nwindows
                   1417:  *
                   1418:  * (where pcb_wim = log2(current %wim) and CWP = low 5 bits of %psr).
                   1419:  * We compute this expression by table lookup in uwtab[CWP - pcb_wim],
                   1420:  * which has been set up as:
                   1421:  *
                   1422:  *     for i in [-nwin+1 .. nwin-1]
                   1423:  *             uwtab[i] = (nwin - 1 - i) % nwin;
                   1424:  *
                   1425:  * (If you do not believe this works, try it for yourself.)
                   1426:  *
                   1427:  * We also keep one or two more tables:
                   1428:  *
                   1429:  *     for i in 0..nwin-1
                   1430:  *             wmask[i] = 1 << ((i + 1) % nwindows);
                   1431:  *
                   1432:  * wmask[CWP] tells whether a `rett' would return into the invalid window.
                   1433:  */
                   1434:        .data
                   1435:        .skip   32                      ! alignment byte & negative indicies
                   1436: uwtab: .skip   32                      ! u_char uwtab[-31..31];
                   1437: wmask: .skip   32                      ! u_char wmask[0..31];
                   1438:
                   1439:        .text
                   1440: /*
                   1441:  * Things begin to grow uglier....
                   1442:  *
                   1443:  * Each trap handler may (always) be running in the trap window.
                   1444:  * If this is the case, it cannot enable further traps until it writes
                   1445:  * the register windows into the stack (or, if the stack is no good,
                   1446:  * the current pcb).
                   1447:  *
                   1448:  * ASSUMPTIONS: TRAP_SETUP() is called with:
                   1449:  *     %l0 = %psr
                   1450:  *     %l1 = return pc
                   1451:  *     %l2 = return npc
                   1452:  *     %l3 = (some value that must not be altered)
                   1453:  * which means we have 4 registers to work with.
                   1454:  *
                   1455:  * The `stackspace' argument is the number of stack bytes to allocate
                   1456:  * for register-saving, and must be at least -64 (and typically more,
                   1457:  * for global registers and %y).
                   1458:  *
                   1459:  * Trapframes should use -CCFSZ-80.  (80 = sizeof(struct trapframe);
                   1460:  * see trap.h.  This basically means EVERYONE.  Interrupt frames could
                   1461:  * get away with less, but currently do not.)
                   1462:  *
                   1463:  * The basic outline here is:
                   1464:  *
                   1465:  *     if (trap came from kernel mode) {
                   1466:  *             if (we are in the trap window)
                   1467:  *                     save it away;
                   1468:  *             %sp = %fp - stackspace;
                   1469:  *     } else {
                   1470:  *             compute the number of user windows;
                   1471:  *             if (we are in the trap window)
                   1472:  *                     save it away;
                   1473:  *             %sp = (top of kernel stack) - stackspace;
                   1474:  *     }
                   1475:  *
                   1476:  * Again, the number of user windows is:
                   1477:  *
                   1478:  *     cpcb->pcb_uw = (cpcb->pcb_wim - 1 - CWP) % nwindows
                   1479:  *
                   1480:  * (where pcb_wim = log2(current %wim) and CWP is the low 5 bits of %psr),
                   1481:  * and this is computed as `uwtab[CWP - pcb_wim]'.
                   1482:  *
                   1483:  * NOTE: if you change this code, you will have to look carefully
                   1484:  * at the window overflow and underflow handlers and make sure they
                   1485:  * have similar changes made as needed.
                   1486:  */
                   1487: #define        CALL_CLEAN_TRAP_WINDOW \
                   1488:        sethi   %hi(clean_trap_window), %l7; \
                   1489:        jmpl    %l7 + %lo(clean_trap_window), %l4; \
                   1490:         mov    %g7, %l7        /* save %g7 in %l7 for clean_trap_window */
                   1491:
                   1492: #define        TRAP_SETUP(stackspace) \
1.173     pk       1493:        TRAP_TRACE(%l3,%l5); \
1.1       deraadt  1494:        rd      %wim, %l4; \
                   1495:        mov     1, %l5; \
                   1496:        sll     %l5, %l0, %l5; \
                   1497:        btst    PSR_PS, %l0; \
                   1498:        bz      1f; \
                   1499:         btst   %l5, %l4; \
                   1500:        /* came from kernel mode; cond codes indicate trap window */ \
                   1501:        bz,a    3f; \
                   1502:         add    %fp, stackspace, %sp;   /* want to just set %sp */ \
                   1503:        CALL_CLEAN_TRAP_WINDOW;         /* but maybe need to clean first */ \
                   1504:        b       3f; \
                   1505:         add    %fp, stackspace, %sp; \
                   1506: 1: \
                   1507:        /* came from user mode: compute pcb_nw */ \
1.111     pk       1508:        sethi   %hi(cpcb), %l6; \
                   1509:        ld      [%l6 + %lo(cpcb)], %l6; \
1.1       deraadt  1510:        ld      [%l6 + PCB_WIM], %l5; \
                   1511:        and     %l0, 31, %l4; \
                   1512:        sub     %l4, %l5, %l5; \
                   1513:        set     uwtab, %l4; \
                   1514:        ldub    [%l4 + %l5], %l5; \
                   1515:        st      %l5, [%l6 + PCB_UW]; \
                   1516:        /* cond codes still indicate whether in trap window */ \
                   1517:        bz,a    2f; \
1.13      deraadt  1518:         sethi  %hi(USPACE+(stackspace)), %l5; \
1.1       deraadt  1519:        /* yes, in trap window; must clean it */ \
                   1520:        CALL_CLEAN_TRAP_WINDOW; \
1.111     pk       1521:        sethi   %hi(cpcb), %l6; \
                   1522:        ld      [%l6 + %lo(cpcb)], %l6; \
1.13      deraadt  1523:        sethi   %hi(USPACE+(stackspace)), %l5; \
1.1       deraadt  1524: 2: \
                   1525:        /* trap window is (now) clean: set %sp */ \
1.13      deraadt  1526:        or      %l5, %lo(USPACE+(stackspace)), %l5; \
1.1       deraadt  1527:        add     %l6, %l5, %sp; \
                   1528:        SET_SP_REDZONE(%l6, %l5); \
                   1529: 3: \
                   1530:        CHECK_SP_REDZONE(%l6, %l5)
                   1531:
                   1532: /*
                   1533:  * Interrupt setup is almost exactly like trap setup, but we need to
                   1534:  * go to the interrupt stack if (a) we came from user mode or (b) we
                   1535:  * came from kernel mode on the kernel stack.
                   1536:  */
1.142     mrg      1537: #if defined(MULTIPROCESSOR)
1.98      pk       1538: /*
                   1539:  * SMP kernels: read `eintstack' from cpuinfo structure. Since the
                   1540:  * location of the interrupt stack is not known in advance, we need
                   1541:  * to check the current %fp against both ends of the stack space.
                   1542:  */
1.97      pk       1543: #define        INTR_SETUP(stackspace) \
1.173     pk       1544:        TRAP_TRACE(%l3,%l5); \
1.97      pk       1545:        rd      %wim, %l4; \
                   1546:        mov     1, %l5; \
                   1547:        sll     %l5, %l0, %l5; \
                   1548:        btst    PSR_PS, %l0; \
                   1549:        bz      1f; \
                   1550:         btst   %l5, %l4; \
                   1551:        /* came from kernel mode; cond codes still indicate trap window */ \
                   1552:        bz,a    0f; \
1.101     pk       1553:         sethi  %hi(_EINTSTACKP), %l7; \
1.97      pk       1554:        CALL_CLEAN_TRAP_WINDOW; \
1.101     pk       1555:        sethi   %hi(_EINTSTACKP), %l7; \
1.97      pk       1556: 0:     /* now if not intstack > %fp >= eintstack, we were on the kernel stack */ \
1.101     pk       1557:        ld      [%l7 + %lo(_EINTSTACKP)], %l7; \
1.97      pk       1558:        cmp     %fp, %l7; \
                   1559:        bge,a   3f;                     /* %fp >= eintstack */ \
                   1560:         add    %l7, stackspace, %sp;   /* so switch to intstack */ \
                   1561:        sethi   %hi(INT_STACK_SIZE), %l6; \
1.98      pk       1562:        sub     %l7, %l6, %l6; \
                   1563:        cmp     %fp, %l6; \
1.97      pk       1564:        blu,a   3f;                     /* %fp < intstack */ \
                   1565:         add    %l7, stackspace, %sp;   /* so switch to intstack */ \
                   1566:        b       4f; \
                   1567:         add    %fp, stackspace, %sp;   /* else stay on intstack */ \
                   1568: 1: \
                   1569:        /* came from user mode: compute pcb_nw */ \
1.111     pk       1570:        sethi   %hi(cpcb), %l6; \
                   1571:        ld      [%l6 + %lo(cpcb)], %l6; \
1.97      pk       1572:        ld      [%l6 + PCB_WIM], %l5; \
                   1573:        and     %l0, 31, %l4; \
                   1574:        sub     %l4, %l5, %l5; \
                   1575:        set     uwtab, %l4; \
                   1576:        ldub    [%l4 + %l5], %l5; \
                   1577:        st      %l5, [%l6 + PCB_UW]; \
                   1578:        /* cond codes still indicate whether in trap window */ \
                   1579:        bz,a    2f; \
1.101     pk       1580:         sethi  %hi(_EINTSTACKP), %l7; \
1.97      pk       1581:        /* yes, in trap window; must save regs */ \
                   1582:        CALL_CLEAN_TRAP_WINDOW; \
1.101     pk       1583:        sethi   %hi(_EINTSTACKP), %l7; \
1.97      pk       1584: 2: \
1.101     pk       1585:        ld      [%l7 + %lo(_EINTSTACKP)], %l7; \
1.97      pk       1586:        add     %l7, stackspace, %sp; \
                   1587: 3: \
1.101     pk       1588:        SET_SP_REDZONE_VAR(_EINTSTACKP, -INT_STACK_SIZE, %l6, %l5); \
1.97      pk       1589: 4: \
                   1590:        CHECK_SP_REDZONE(%l6, %l5)
1.98      pk       1591:
1.97      pk       1592: #else /* MULTIPROCESSOR */
1.98      pk       1593:
1.1       deraadt  1594: #define        INTR_SETUP(stackspace) \
1.173     pk       1595:        TRAP_TRACE(%l3,%l5); \
1.1       deraadt  1596:        rd      %wim, %l4; \
                   1597:        mov     1, %l5; \
                   1598:        sll     %l5, %l0, %l5; \
                   1599:        btst    PSR_PS, %l0; \
                   1600:        bz      1f; \
                   1601:         btst   %l5, %l4; \
                   1602:        /* came from kernel mode; cond codes still indicate trap window */ \
                   1603:        bz,a    0f; \
1.111     pk       1604:         sethi  %hi(_C_LABEL(eintstack)), %l7; \
1.1       deraadt  1605:        CALL_CLEAN_TRAP_WINDOW; \
1.111     pk       1606:        sethi   %hi(_C_LABEL(eintstack)), %l7; \
1.1       deraadt  1607: 0:     /* now if %fp >= eintstack, we were on the kernel stack */ \
                   1608:        cmp     %fp, %l7; \
                   1609:        bge,a   3f; \
                   1610:         add    %l7, stackspace, %sp;   /* so switch to intstack */ \
                   1611:        b       4f; \
                   1612:         add    %fp, stackspace, %sp;   /* else stay on intstack */ \
                   1613: 1: \
                   1614:        /* came from user mode: compute pcb_nw */ \
1.111     pk       1615:        sethi   %hi(cpcb), %l6; \
                   1616:        ld      [%l6 + %lo(cpcb)], %l6; \
1.1       deraadt  1617:        ld      [%l6 + PCB_WIM], %l5; \
                   1618:        and     %l0, 31, %l4; \
                   1619:        sub     %l4, %l5, %l5; \
                   1620:        set     uwtab, %l4; \
                   1621:        ldub    [%l4 + %l5], %l5; \
                   1622:        st      %l5, [%l6 + PCB_UW]; \
                   1623:        /* cond codes still indicate whether in trap window */ \
                   1624:        bz,a    2f; \
1.111     pk       1625:         sethi  %hi(_C_LABEL(eintstack)), %l7; \
1.1       deraadt  1626:        /* yes, in trap window; must save regs */ \
                   1627:        CALL_CLEAN_TRAP_WINDOW; \
1.111     pk       1628:        sethi   %hi(_C_LABEL(eintstack)), %l7; \
1.1       deraadt  1629: 2: \
                   1630:        add     %l7, stackspace, %sp; \
                   1631: 3: \
1.111     pk       1632:        SET_SP_REDZONE_CONST(_C_LABEL(intstack), %l6, %l5); \
1.1       deraadt  1633: 4: \
                   1634:        CHECK_SP_REDZONE(%l6, %l5)
1.97      pk       1635: #endif /* MULTIPROCESSOR */
1.1       deraadt  1636:
                   1637: /*
                   1638:  * Handler for making the trap window shiny clean.
                   1639:  *
                   1640:  * On entry:
                   1641:  *     cpcb->pcb_nw = number of user windows
                   1642:  *     %l0 = %psr
                   1643:  *     %l1 must not be clobbered
                   1644:  *     %l2 must not be clobbered
                   1645:  *     %l3 must not be clobbered
                   1646:  *     %l4 = address for `return'
                   1647:  *     %l7 = saved %g7 (we put this in a delay slot above, to save work)
                   1648:  *
                   1649:  * On return:
                   1650:  *     %wim has changed, along with cpcb->pcb_wim
                   1651:  *     %g7 has been restored
                   1652:  *
                   1653:  * Normally, we push only one window.
                   1654:  */
                   1655: clean_trap_window:
                   1656:        mov     %g5, %l5                ! save %g5
                   1657:        mov     %g6, %l6                ! ... and %g6
                   1658: /*     mov     %g7, %l7                ! ... and %g7 (already done for us) */
1.111     pk       1659:        sethi   %hi(cpcb), %g6          ! get current pcb
                   1660:        ld      [%g6 + %lo(cpcb)], %g6
1.1       deraadt  1661:
                   1662:        /* Figure out whether it is a user window (cpcb->pcb_uw > 0). */
                   1663:        ld      [%g6 + PCB_UW], %g7
                   1664:        deccc   %g7
                   1665:        bge     ctw_user
                   1666:         save   %g0, %g0, %g0           ! in any case, enter window to save
                   1667:
                   1668:        /* The window to be pushed is a kernel window. */
                   1669:        std     %l0, [%sp + (0*8)]
                   1670: ctw_merge:
                   1671:        std     %l2, [%sp + (1*8)]
                   1672:        std     %l4, [%sp + (2*8)]
                   1673:        std     %l6, [%sp + (3*8)]
                   1674:        std     %i0, [%sp + (4*8)]
                   1675:        std     %i2, [%sp + (5*8)]
                   1676:        std     %i4, [%sp + (6*8)]
                   1677:        std     %i6, [%sp + (7*8)]
                   1678:
                   1679:        /* Set up new window invalid mask, and update cpcb->pcb_wim. */
                   1680:        rd      %psr, %g7               ! g7 = (junk << 5) + new_cwp
                   1681:        mov     1, %g5                  ! g5 = 1 << new_cwp;
                   1682:        sll     %g5, %g7, %g5
                   1683:        wr      %g5, 0, %wim            ! setwim(g5);
                   1684:        and     %g7, 31, %g7            ! cpcb->pcb_wim = g7 & 31;
1.111     pk       1685:        sethi   %hi(cpcb), %g6          ! re-get current pcb
                   1686:        ld      [%g6 + %lo(cpcb)], %g6
1.1       deraadt  1687:        st      %g7, [%g6 + PCB_WIM]
                   1688:        nop
                   1689:        restore                         ! back to trap window
                   1690:
                   1691:        mov     %l5, %g5                ! restore g5
                   1692:        mov     %l6, %g6                ! ... and g6
                   1693:        jmp     %l4 + 8                 ! return to caller
                   1694:         mov    %l7, %g7                ! ... and g7
                   1695:        /* NOTREACHED */
                   1696:
                   1697: ctw_user:
                   1698:        /*
                   1699:         * The window to be pushed is a user window.
                   1700:         * We must verify the stack pointer (alignment & permissions).
                   1701:         * See comments above definition of PTE_OF_ADDR.
                   1702:         */
                   1703:        st      %g7, [%g6 + PCB_UW]     ! cpcb->pcb_uw--;
                   1704:        btst    7, %sp                  ! if not aligned,
                   1705:        bne     ctw_invalid             ! choke on it
                   1706:         EMPTY
1.13      deraadt  1707:
1.111     pk       1708:        sethi   %hi(_C_LABEL(pgofset)), %g6     ! trash %g6=curpcb
                   1709:        ld      [%g6 + %lo(_C_LABEL(pgofset))], %g6
1.62      pk       1710:        PTE_OF_ADDR(%sp, %g7, ctw_invalid, %g6, NOP_ON_4M_1)
                   1711:        CMP_PTE_USER_WRITE(%g7, %g5, NOP_ON_4M_2) ! likewise if not writable
1.1       deraadt  1712:        bne     ctw_invalid
                   1713:         EMPTY
1.52      pk       1714:        /* Note side-effect of SLT_IF_1PAGE_RW: decrements %g6 by 62 */
1.13      deraadt  1715:        SLT_IF_1PAGE_RW(%sp, %g7, %g6)
1.1       deraadt  1716:        bl,a    ctw_merge               ! all ok if only 1
                   1717:         std    %l0, [%sp]
                   1718:        add     %sp, 7*8, %g5           ! check last addr too
1.154     thorpej  1719:        add     %g6, 62, %g6            /* restore %g6 to `pgofset' */
1.62      pk       1720:        PTE_OF_ADDR(%g5, %g7, ctw_invalid, %g6, NOP_ON_4M_3)
                   1721:        CMP_PTE_USER_WRITE(%g7, %g6, NOP_ON_4M_4)
1.1       deraadt  1722:        be,a    ctw_merge               ! all ok: store <l0,l1> and merge
                   1723:         std    %l0, [%sp]
                   1724:
                   1725:        /*
                   1726:         * The window we wanted to push could not be pushed.
                   1727:         * Instead, save ALL user windows into the pcb.
                   1728:         * We will notice later that we did this, when we
                   1729:         * get ready to return from our trap or syscall.
                   1730:         *
                   1731:         * The code here is run rarely and need not be optimal.
                   1732:         */
                   1733: ctw_invalid:
                   1734:        /*
                   1735:         * Reread cpcb->pcb_uw.  We decremented this earlier,
                   1736:         * so it is off by one.
                   1737:         */
1.111     pk       1738:        sethi   %hi(cpcb), %g6          ! re-get current pcb
                   1739:        ld      [%g6 + %lo(cpcb)], %g6
1.13      deraadt  1740:
1.1       deraadt  1741:        ld      [%g6 + PCB_UW], %g7     ! (number of user windows) - 1
                   1742:        add     %g6, PCB_RW, %g5
                   1743:
                   1744:        /* save g7+1 windows, starting with the current one */
                   1745: 1:                                     ! do {
                   1746:        std     %l0, [%g5 + (0*8)]      !       rw->rw_local[0] = l0;
                   1747:        std     %l2, [%g5 + (1*8)]      !       ...
                   1748:        std     %l4, [%g5 + (2*8)]
                   1749:        std     %l6, [%g5 + (3*8)]
                   1750:        std     %i0, [%g5 + (4*8)]
                   1751:        std     %i2, [%g5 + (5*8)]
                   1752:        std     %i4, [%g5 + (6*8)]
                   1753:        std     %i6, [%g5 + (7*8)]
                   1754:        deccc   %g7                     !       if (n > 0) save(), rw++;
                   1755:        bge,a   1b                      ! } while (--n >= 0);
                   1756:         save   %g5, 64, %g5
                   1757:
                   1758:        /* stash sp for bottommost window */
                   1759:        st      %sp, [%g5 + 64 + (7*8)]
                   1760:
                   1761:        /* set up new wim */
                   1762:        rd      %psr, %g7               ! g7 = (junk << 5) + new_cwp;
                   1763:        mov     1, %g5                  ! g5 = 1 << new_cwp;
                   1764:        sll     %g5, %g7, %g5
                   1765:        wr      %g5, 0, %wim            ! wim = g5;
                   1766:        and     %g7, 31, %g7
                   1767:        st      %g7, [%g6 + PCB_WIM]    ! cpcb->pcb_wim = new_cwp;
                   1768:
                   1769:        /* fix up pcb fields */
                   1770:        ld      [%g6 + PCB_UW], %g7     ! n = cpcb->pcb_uw;
                   1771:        add     %g7, 1, %g5
                   1772:        st      %g5, [%g6 + PCB_NSAVED] ! cpcb->pcb_nsaved = n + 1;
                   1773:        st      %g0, [%g6 + PCB_UW]     ! cpcb->pcb_uw = 0;
                   1774:
                   1775:        /* return to trap window */
                   1776: 1:     deccc   %g7                     ! do {
                   1777:        bge     1b                      !       restore();
                   1778:         restore                        ! } while (--n >= 0);
                   1779:
                   1780:        mov     %l5, %g5                ! restore g5, g6, & g7, and return
                   1781:        mov     %l6, %g6
                   1782:        jmp     %l4 + 8
                   1783:         mov    %l7, %g7
                   1784:        /* NOTREACHED */
                   1785:
                   1786:
                   1787: /*
                   1788:  * Each memory access (text or data) fault, from user or kernel mode,
                   1789:  * comes here.  We read the error register and figure out what has
                   1790:  * happened.
                   1791:  *
                   1792:  * This cannot be done from C code since we must not enable traps (and
                   1793:  * hence may not use the `save' instruction) until we have decided that
                   1794:  * the error is or is not an asynchronous one that showed up after a
                   1795:  * synchronous error, but which must be handled before the sync err.
                   1796:  *
                   1797:  * Most memory faults are user mode text or data faults, which can cause
                   1798:  * signal delivery or ptracing, for which we must build a full trapframe.
                   1799:  * It does not seem worthwhile to work to avoid this in the other cases,
                   1800:  * so we store all the %g registers on the stack immediately.
                   1801:  *
                   1802:  * On entry:
                   1803:  *     %l0 = %psr
                   1804:  *     %l1 = return pc
                   1805:  *     %l2 = return npc
                   1806:  *     %l3 = T_TEXTFAULT or T_DATAFAULT
                   1807:  *
                   1808:  * Internal:
                   1809:  *     %l4 = %y, until we call mem_access_fault (then onto trapframe)
                   1810:  *     %l5 = IE_reg_addr, if async mem error
                   1811:  *
                   1812:  */
1.52      pk       1813:
                   1814: #if defined(SUN4)
                   1815: memfault_sun4:
1.1       deraadt  1816:        TRAP_SETUP(-CCFSZ-80)
1.111     pk       1817:        INCR(_C_LABEL(uvmexp)+V_FAULTS) ! cnt.v_faults++ (clobbers %o0,%o1)
1.1       deraadt  1818:
                   1819:        st      %g1, [%sp + CCFSZ + 20] ! save g1
                   1820:        rd      %y, %l4                 ! save y
                   1821:
1.19      deraadt  1822:        /*
                   1823:         * registers:
                   1824:         * memerr.ctrl  = memory error control reg., error if 0x80 set
                   1825:         * memerr.vaddr = address of memory error
                   1826:         * buserr       = basically just like sun4c sync error reg but
                   1827:         *                no SER_WRITE bit (have to figure out from code).
                   1828:         */
1.111     pk       1829:        set     _C_LABEL(par_err_reg), %o0 ! memerr ctrl addr -- XXX mapped?
1.20      deraadt  1830:        ld      [%o0], %o0              ! get it
1.19      deraadt  1831:        std     %g2, [%sp + CCFSZ + 24] ! save g2, g3
                   1832:        ld      [%o0], %o1              ! memerr ctrl register
                   1833:        inc     4, %o0                  ! now VA of memerr vaddr register
                   1834:        std     %g4, [%sp + CCFSZ + 32] ! (sneak g4,g5 in here)
                   1835:        ld      [%o0], %o2              ! memerr virt addr
                   1836:        st      %g0, [%o0]              ! NOTE: this clears latching!!!
                   1837:        btst    ME_REG_IERR, %o1        ! memory error?
                   1838:                                        ! XXX this value may not be correct
                   1839:                                        ! as I got some parity errors and the
                   1840:                                        ! correct bits were not on?
                   1841:        std     %g6, [%sp + CCFSZ + 40]
1.52      pk       1842:        bz,a    0f                      ! no, just a regular fault
1.19      deraadt  1843:         wr     %l0, PSR_ET, %psr       ! (and reenable traps)
                   1844:
                   1845:        /* memory error = death for now XXX */
                   1846:        clr     %o3
                   1847:        clr     %o4
1.111     pk       1848:        call    _C_LABEL(memerr4_4c)    ! memerr(0, ser, sva, 0, 0)
1.19      deraadt  1849:         clr    %o0
1.111     pk       1850:        call    _C_LABEL(prom_halt)
1.19      deraadt  1851:         nop
                   1852:
1.52      pk       1853: 0:
1.19      deraadt  1854:        /*
                   1855:         * have to make SUN4 emulate SUN4C.   4C code expects
                   1856:         * SER in %o1 and the offending VA in %o2, everything else is ok.
                   1857:         * (must figure out if SER_WRITE should be set)
                   1858:         */
                   1859:        set     AC_BUS_ERR, %o0         ! bus error register
                   1860:        cmp     %l3, T_TEXTFAULT        ! text fault always on PC
1.50      pk       1861:        be      normal_mem_fault        ! go
1.21      deraadt  1862:         lduba  [%o0] ASI_CONTROL, %o1  ! get its value
1.19      deraadt  1863:
                   1864: #define STORE_BIT 21 /* bit that indicates a store instruction for sparc */
                   1865:        ld      [%l1], %o3              ! offending instruction in %o3 [l1=pc]
                   1866:        srl     %o3, STORE_BIT, %o3     ! get load/store bit (wont fit simm13)
                   1867:        btst    1, %o3                  ! test for store operation
                   1868:
                   1869:        bz      normal_mem_fault        ! if (z) is a load (so branch)
                   1870:         sethi  %hi(SER_WRITE), %o5     ! damn SER_WRITE wont fit simm13
                   1871: !      or      %lo(SER_WRITE), %o5, %o5! not necessary since %lo is zero
                   1872:        or      %o5, %o1, %o1           ! set SER_WRITE
                   1873: #if defined(SUN4C) || defined(SUN4M)
1.52      pk       1874:        ba,a    normal_mem_fault
                   1875:         !!nop                          ! XXX make efficient later
1.19      deraadt  1876: #endif /* SUN4C || SUN4M */
                   1877: #endif /* SUN4 */
1.52      pk       1878:
                   1879: memfault_sun4c:
                   1880: #if defined(SUN4C)
                   1881:        TRAP_SETUP(-CCFSZ-80)
1.111     pk       1882:        INCR(_C_LABEL(uvmexp)+V_FAULTS) ! cnt.v_faults++ (clobbers %o0,%o1)
1.52      pk       1883:
                   1884:        st      %g1, [%sp + CCFSZ + 20] ! save g1
                   1885:        rd      %y, %l4                 ! save y
                   1886:
                   1887:        /*
                   1888:         * We know about the layout of the error registers here.
                   1889:         *      addr    reg
                   1890:         *      ----    ---
                   1891:         *      a       AC_SYNC_ERR
                   1892:         *      a+4     AC_SYNC_VA
                   1893:         *      a+8     AC_ASYNC_ERR
                   1894:         *      a+12    AC_ASYNC_VA
                   1895:         */
1.19      deraadt  1896:
1.1       deraadt  1897: #if AC_SYNC_ERR + 4 != AC_SYNC_VA || \
                   1898:     AC_SYNC_ERR + 8 != AC_ASYNC_ERR || AC_SYNC_ERR + 12 != AC_ASYNC_VA
                   1899:        help help help          ! I, I, I wanna be a lifeguard
                   1900: #endif
                   1901:        set     AC_SYNC_ERR, %o0
                   1902:        std     %g2, [%sp + CCFSZ + 24] ! save g2, g3
                   1903:        lda     [%o0] ASI_CONTROL, %o1  ! sync err reg
                   1904:        inc     4, %o0
                   1905:        std     %g4, [%sp + CCFSZ + 32] ! (sneak g4,g5 in here)
                   1906:        lda     [%o0] ASI_CONTROL, %o2  ! sync virt addr
                   1907:        btst    SER_MEMERR, %o1         ! memory error?
                   1908:        std     %g6, [%sp + CCFSZ + 40]
                   1909:        bz,a    normal_mem_fault        ! no, just a regular fault
                   1910:         wr     %l0, PSR_ET, %psr       ! (and reenable traps)
                   1911:
                   1912:        /*
                   1913:         * We got a synchronous memory error.  It could be one that
                   1914:         * happened because there were two stores in a row, and the
                   1915:         * first went into the write buffer, and the second caused this
                   1916:         * synchronous trap; so there could now be a pending async error.
                   1917:         * This is in fact the case iff the two va's differ.
                   1918:         */
                   1919:        inc     4, %o0
                   1920:        lda     [%o0] ASI_CONTROL, %o3  ! async err reg
                   1921:        inc     4, %o0
                   1922:        lda     [%o0] ASI_CONTROL, %o4  ! async virt addr
                   1923:        cmp     %o2, %o4
                   1924:        be,a    1f                      ! no, not an async err
                   1925:         wr     %l0, PSR_ET, %psr       ! (and reenable traps)
                   1926:
                   1927:        /*
                   1928:         * Handle the async error; ignore the sync error for now
                   1929:         * (we may end up getting it again, but so what?).
                   1930:         * This code is essentially the same as that at `nmi' below,
                   1931:         * but the register usage is different and we cannot merge.
                   1932:         */
1.62      pk       1933:        sethi   %hi(INTRREG_VA), %l5    ! ienab_bic(IE_ALLIE);
                   1934:        ldub    [%l5 + %lo(INTRREG_VA)], %o0
1.1       deraadt  1935:        andn    %o0, IE_ALLIE, %o0
1.62      pk       1936:        stb     %o0, [%l5 + %lo(INTRREG_VA)]
1.1       deraadt  1937:
                   1938:        /*
                   1939:         * Now reenable traps and call C code.
                   1940:         * %o1 through %o4 still hold the error reg contents.
                   1941:         * If memerr() returns, return from the trap.
                   1942:         */
                   1943:        wr      %l0, PSR_ET, %psr
1.111     pk       1944:        call    _C_LABEL(memerr4_4c)    ! memerr(0, ser, sva, aer, ava)
1.1       deraadt  1945:         clr    %o0
                   1946:
                   1947:        ld      [%sp + CCFSZ + 20], %g1 ! restore g1 through g7
                   1948:        wr      %l0, 0, %psr            ! and disable traps, 3 instr delay
                   1949:        ldd     [%sp + CCFSZ + 24], %g2
                   1950:        ldd     [%sp + CCFSZ + 32], %g4
                   1951:        ldd     [%sp + CCFSZ + 40], %g6
                   1952:        /* now safe to set IE_ALLIE again */
1.62      pk       1953:        ldub    [%l5 + %lo(INTRREG_VA)], %o1
1.1       deraadt  1954:        or      %o1, IE_ALLIE, %o1
1.62      pk       1955:        stb     %o1, [%l5 + %lo(INTRREG_VA)]
1.1       deraadt  1956:        b       return_from_trap
                   1957:         wr     %l4, 0, %y              ! restore y
                   1958:
                   1959:        /*
                   1960:         * Trap was a synchronous memory error.
                   1961:         * %o1 through %o4 still hold the error reg contents.
                   1962:         */
                   1963: 1:
1.111     pk       1964:        call    _C_LABEL(memerr4_4c)    ! memerr(1, ser, sva, aer, ava)
1.1       deraadt  1965:         mov    1, %o0
                   1966:
                   1967:        ld      [%sp + CCFSZ + 20], %g1 ! restore g1 through g7
                   1968:        ldd     [%sp + CCFSZ + 24], %g2
                   1969:        ldd     [%sp + CCFSZ + 32], %g4
                   1970:        ldd     [%sp + CCFSZ + 40], %g6
                   1971:        wr      %l4, 0, %y              ! restore y
                   1972:        b       return_from_trap
                   1973:         wr     %l0, 0, %psr
                   1974:        /* NOTREACHED */
1.52      pk       1975: #endif /* SUN4C */
                   1976:
                   1977: #if defined(SUN4M)
                   1978: memfault_sun4m:
1.94      pk       1979:        sethi   %hi(CPUINFO_VA), %l4
                   1980:        ld      [%l4 + %lo(CPUINFO_VA+CPUINFO_GETSYNCFLT)], %l5
                   1981:        jmpl    %l5, %l7
                   1982:         or     %l4, %lo(CPUINFO_SYNCFLTDUMP), %l4
1.52      pk       1983:        TRAP_SETUP(-CCFSZ-80)
1.111     pk       1984:        INCR(_C_LABEL(uvmexp)+V_FAULTS) ! cnt.v_faults++ (clobbers %o0,%o1)
1.52      pk       1985:
                   1986:        st      %g1, [%sp + CCFSZ + 20] ! save g1
                   1987:        rd      %y, %l4                 ! save y
                   1988:
                   1989:        std     %g2, [%sp + CCFSZ + 24] ! save g2, g3
1.62      pk       1990:        std     %g4, [%sp + CCFSZ + 32] ! save g4, g5
1.94      pk       1991:        std     %g6, [%sp + CCFSZ + 40] ! sneak in g6, g7
1.52      pk       1992:
1.94      pk       1993:        ! retrieve sync fault status/address
                   1994:        sethi   %hi(CPUINFO_VA+CPUINFO_SYNCFLTDUMP), %o0
                   1995:        ld      [%o0 + %lo(CPUINFO_VA+CPUINFO_SYNCFLTDUMP)], %o1
                   1996:        ld      [%o0 + %lo(CPUINFO_VA+CPUINFO_SYNCFLTDUMP+4)], %o2
1.52      pk       1997:
                   1998:        wr      %l0, PSR_ET, %psr       ! reenable traps
                   1999:
                   2000:        /* Finish stackframe, call C trap handler */
                   2001:        std     %l0, [%sp + CCFSZ + 0]  ! set tf.tf_psr, tf.tf_pc
                   2002:        mov     %l3, %o0                ! (argument: type)
                   2003:        st      %l2, [%sp + CCFSZ + 8]  ! set tf.tf_npc
                   2004:        st      %l4, [%sp + CCFSZ + 12] ! set tf.tf_y
                   2005:        std     %i0, [%sp + CCFSZ + 48] ! tf.tf_out[0], etc
                   2006:        std     %i2, [%sp + CCFSZ + 56]
                   2007:        std     %i4, [%sp + CCFSZ + 64]
                   2008:        std     %i6, [%sp + CCFSZ + 72]
1.111     pk       2009:                                        ! mem_access_fault(type,sfsr,sfva,&tf);
                   2010:        call    _C_LABEL(mem_access_fault4m)
1.94      pk       2011:         add    %sp, CCFSZ, %o3         ! (argument: &tf)
1.52      pk       2012:
                   2013:        ldd     [%sp + CCFSZ + 0], %l0  ! load new values
                   2014:        ldd     [%sp + CCFSZ + 8], %l2
                   2015:        wr      %l3, 0, %y
                   2016:        ld      [%sp + CCFSZ + 20], %g1
                   2017:        ldd     [%sp + CCFSZ + 24], %g2
                   2018:        ldd     [%sp + CCFSZ + 32], %g4
                   2019:        ldd     [%sp + CCFSZ + 40], %g6
                   2020:        ldd     [%sp + CCFSZ + 48], %i0
                   2021:        ldd     [%sp + CCFSZ + 56], %i2
                   2022:        ldd     [%sp + CCFSZ + 64], %i4
                   2023:        ldd     [%sp + CCFSZ + 72], %i6
                   2024:
                   2025:        b       return_from_trap        ! go return
                   2026:         wr     %l0, 0, %psr            ! (but first disable traps again)
                   2027: #endif /* SUN4M */
1.1       deraadt  2028:
                   2029: normal_mem_fault:
                   2030:        /*
                   2031:         * Trap was some other error; call C code to deal with it.
                   2032:         * Must finish trap frame (psr,pc,npc,%y,%o0..%o7) in case
                   2033:         * we decide to deliver a signal or ptrace the process.
                   2034:         * %g1..%g7 were already set up above.
                   2035:         */
                   2036:        std     %l0, [%sp + CCFSZ + 0]  ! set tf.tf_psr, tf.tf_pc
                   2037:        mov     %l3, %o0                ! (argument: type)
                   2038:        st      %l2, [%sp + CCFSZ + 8]  ! set tf.tf_npc
                   2039:        st      %l4, [%sp + CCFSZ + 12] ! set tf.tf_y
                   2040:        mov     %l1, %o3                ! (argument: pc)
                   2041:        std     %i0, [%sp + CCFSZ + 48] ! tf.tf_out[0], etc
                   2042:        std     %i2, [%sp + CCFSZ + 56]
                   2043:        mov     %l0, %o4                ! (argument: psr)
                   2044:        std     %i4, [%sp + CCFSZ + 64]
                   2045:        std     %i6, [%sp + CCFSZ + 72]
1.111     pk       2046:        call    _C_LABEL(mem_access_fault)! mem_access_fault(type, ser, sva,
1.1       deraadt  2047:                                        !               pc, psr, &tf);
                   2048:         add    %sp, CCFSZ, %o5         ! (argument: &tf)
                   2049:
                   2050:        ldd     [%sp + CCFSZ + 0], %l0  ! load new values
                   2051:        ldd     [%sp + CCFSZ + 8], %l2
                   2052:        wr      %l3, 0, %y
                   2053:        ld      [%sp + CCFSZ + 20], %g1
                   2054:        ldd     [%sp + CCFSZ + 24], %g2
                   2055:        ldd     [%sp + CCFSZ + 32], %g4
                   2056:        ldd     [%sp + CCFSZ + 40], %g6
                   2057:        ldd     [%sp + CCFSZ + 48], %i0
                   2058:        ldd     [%sp + CCFSZ + 56], %i2
                   2059:        ldd     [%sp + CCFSZ + 64], %i4
                   2060:        ldd     [%sp + CCFSZ + 72], %i6
                   2061:
                   2062:        b       return_from_trap        ! go return
                   2063:         wr     %l0, 0, %psr            ! (but first disable traps again)
                   2064:
                   2065:
                   2066: /*
                   2067:  * fp_exception has to check to see if we are trying to save
                   2068:  * the FP state, and if so, continue to save the FP state.
                   2069:  *
                   2070:  * We do not even bother checking to see if we were in kernel mode,
                   2071:  * since users have no access to the special_fp_store instruction.
                   2072:  *
                   2073:  * This whole idea was stolen from Sprite.
                   2074:  */
                   2075: fp_exception:
                   2076:        set     special_fp_store, %l4   ! see if we came from the special one
                   2077:        cmp     %l1, %l4                ! pc == special_fp_store?
                   2078:        bne     slowtrap                ! no, go handle per usual
                   2079:         EMPTY
                   2080:        sethi   %hi(savefpcont), %l4    ! yes, "return" to the special code
                   2081:        or      %lo(savefpcont), %l4, %l4
                   2082:        jmp     %l4
                   2083:         rett   %l4 + 4
                   2084:
                   2085: /*
                   2086:  * slowtrap() builds a trap frame and calls trap().
                   2087:  * This is called `slowtrap' because it *is*....
                   2088:  * We have to build a full frame for ptrace(), for instance.
                   2089:  *
                   2090:  * Registers:
                   2091:  *     %l0 = %psr
                   2092:  *     %l1 = return pc
                   2093:  *     %l2 = return npc
                   2094:  *     %l3 = trap code
                   2095:  */
                   2096: slowtrap:
                   2097:        TRAP_SETUP(-CCFSZ-80)
                   2098:        /*
                   2099:         * Phew, ready to enable traps and call C code.
                   2100:         */
                   2101:        mov     %l3, %o0                ! put type in %o0 for later
                   2102: Lslowtrap_reenter:
                   2103:        wr      %l0, PSR_ET, %psr       ! traps on again
                   2104:        std     %l0, [%sp + CCFSZ]      ! tf.tf_psr = psr; tf.tf_pc = ret_pc;
                   2105:        rd      %y, %l3
                   2106:        std     %l2, [%sp + CCFSZ + 8]  ! tf.tf_npc = return_npc; tf.tf_y = %y;
                   2107:        st      %g1, [%sp + CCFSZ + 20]
                   2108:        std     %g2, [%sp + CCFSZ + 24]
                   2109:        std     %g4, [%sp + CCFSZ + 32]
                   2110:        std     %g6, [%sp + CCFSZ + 40]
                   2111:        std     %i0, [%sp + CCFSZ + 48]
                   2112:        mov     %l0, %o1                ! (psr)
                   2113:        std     %i2, [%sp + CCFSZ + 56]
                   2114:        mov     %l1, %o2                ! (pc)
                   2115:        std     %i4, [%sp + CCFSZ + 64]
                   2116:        add     %sp, CCFSZ, %o3         ! (&tf)
1.111     pk       2117:        call    _C_LABEL(trap)          ! trap(type, psr, pc, &tf)
1.1       deraadt  2118:         std    %i6, [%sp + CCFSZ + 72]
                   2119:
                   2120:        ldd     [%sp + CCFSZ], %l0      ! load new values
                   2121:        ldd     [%sp + CCFSZ + 8], %l2
                   2122:        wr      %l3, 0, %y
                   2123:        ld      [%sp + CCFSZ + 20], %g1
                   2124:        ldd     [%sp + CCFSZ + 24], %g2
                   2125:        ldd     [%sp + CCFSZ + 32], %g4
                   2126:        ldd     [%sp + CCFSZ + 40], %g6
                   2127:        ldd     [%sp + CCFSZ + 48], %i0
                   2128:        ldd     [%sp + CCFSZ + 56], %i2
                   2129:        ldd     [%sp + CCFSZ + 64], %i4
                   2130:        ldd     [%sp + CCFSZ + 72], %i6
                   2131:        b       return_from_trap
                   2132:         wr     %l0, 0, %psr
                   2133:
                   2134: /*
                   2135:  * Do a `software' trap by re-entering the trap code, possibly first
                   2136:  * switching from interrupt stack to kernel stack.  This is used for
                   2137:  * scheduling and signal ASTs (which generally occur from softclock or
                   2138:  * tty or net interrupts) and register window saves (which might occur
                   2139:  * from anywhere).
                   2140:  *
                   2141:  * The current window is the trap window, and it is by definition clean.
                   2142:  * We enter with the trap type in %o0.  All we have to do is jump to
                   2143:  * Lslowtrap_reenter above, but maybe after switching stacks....
                   2144:  */
                   2145: softtrap:
1.142     mrg      2146: #if defined(MULTIPROCESSOR)
1.97      pk       2147:        /*
                   2148:         * The interrupt stack is not at a fixed location
                   2149:         * and %sp must be checked against both ends.
                   2150:         */
1.173     pk       2151:        sethi   %hi(_EINTSTACKP), %l6
                   2152:        ld      [%l6 + %lo(_EINTSTACKP)], %l7
1.97      pk       2153:        cmp     %sp, %l7
                   2154:        bge     Lslowtrap_reenter
                   2155:         EMPTY
                   2156:        set     INT_STACK_SIZE, %l6
                   2157:        sub     %l7, %l6, %l7
                   2158:        cmp     %sp, %l7
                   2159:        blu     Lslowtrap_reenter
                   2160:         EMPTY
                   2161: #else
1.111     pk       2162:        sethi   %hi(_C_LABEL(eintstack)), %l7
1.1       deraadt  2163:        cmp     %sp, %l7
                   2164:        bge     Lslowtrap_reenter
                   2165:         EMPTY
1.97      pk       2166: #endif
1.111     pk       2167:        sethi   %hi(cpcb), %l6
                   2168:        ld      [%l6 + %lo(cpcb)], %l6
1.13      deraadt  2169:        set     USPACE-CCFSZ-80, %l5
1.1       deraadt  2170:        add     %l6, %l5, %l7
                   2171:        SET_SP_REDZONE(%l6, %l5)
                   2172:        b       Lslowtrap_reenter
                   2173:         mov    %l7, %sp
                   2174:
                   2175: #ifdef KGDB
                   2176: /*
                   2177:  * bpt is entered on all breakpoint traps.
                   2178:  * If this is a kernel breakpoint, we do not want to call trap().
                   2179:  * Among other reasons, this way we can set breakpoints in trap().
                   2180:  */
                   2181: bpt:
                   2182:        btst    PSR_PS, %l0             ! breakpoint from kernel?
                   2183:        bz      slowtrap                ! no, go do regular trap
                   2184:         nop
                   2185:
1.137     mrg      2186: /* XXXSMP */
1.1       deraadt  2187:        /*
                   2188:         * Build a trap frame for kgdb_trap_glue to copy.
                   2189:         * Enable traps but set ipl high so that we will not
                   2190:         * see interrupts from within breakpoints.
                   2191:         */
                   2192:        TRAP_SETUP(-CCFSZ-80)
                   2193:        or      %l0, PSR_PIL, %l4       ! splhigh()
                   2194:        wr      %l4, 0, %psr            ! the manual claims that this
                   2195:        wr      %l4, PSR_ET, %psr       ! song and dance is necessary
                   2196:        std     %l0, [%sp + CCFSZ + 0]  ! tf.tf_psr, tf.tf_pc
                   2197:        mov     %l3, %o0                ! trap type arg for kgdb_trap_glue
                   2198:        rd      %y, %l3
                   2199:        std     %l2, [%sp + CCFSZ + 8]  ! tf.tf_npc, tf.tf_y
                   2200:        rd      %wim, %l3
                   2201:        st      %l3, [%sp + CCFSZ + 16] ! tf.tf_wim (a kgdb-only r/o field)
                   2202:        st      %g1, [%sp + CCFSZ + 20] ! tf.tf_global[1]
                   2203:        std     %g2, [%sp + CCFSZ + 24] ! etc
                   2204:        std     %g4, [%sp + CCFSZ + 32]
                   2205:        std     %g6, [%sp + CCFSZ + 40]
                   2206:        std     %i0, [%sp + CCFSZ + 48] ! tf.tf_in[0..1]
                   2207:        std     %i2, [%sp + CCFSZ + 56] ! etc
                   2208:        std     %i4, [%sp + CCFSZ + 64]
                   2209:        std     %i6, [%sp + CCFSZ + 72]
                   2210:
                   2211:        /*
                   2212:         * Now call kgdb_trap_glue(); if it returns, call trap().
                   2213:         */
                   2214:        mov     %o0, %l3                ! gotta save trap type
1.111     pk       2215:        call    _C_LABEL(kgdb_trap_glue)! kgdb_trap_glue(type, &trapframe)
1.1       deraadt  2216:         add    %sp, CCFSZ, %o1         ! (&trapframe)
                   2217:
                   2218:        /*
                   2219:         * Use slowtrap to call trap---but first erase our tracks
                   2220:         * (put the registers back the way they were).
                   2221:         */
                   2222:        mov     %l3, %o0                ! slowtrap will need trap type
                   2223:        ld      [%sp + CCFSZ + 12], %l3
                   2224:        wr      %l3, 0, %y
                   2225:        ld      [%sp + CCFSZ + 20], %g1
                   2226:        ldd     [%sp + CCFSZ + 24], %g2
                   2227:        ldd     [%sp + CCFSZ + 32], %g4
                   2228:        b       Lslowtrap_reenter
                   2229:         ldd    [%sp + CCFSZ + 40], %g6
                   2230:
                   2231: /*
                   2232:  * Enter kernel breakpoint.  Write all the windows (not including the
                   2233:  * current window) into the stack, so that backtrace works.  Copy the
                   2234:  * supplied trap frame to the kgdb stack and switch stacks.
                   2235:  *
                   2236:  * kgdb_trap_glue(type, tf0)
                   2237:  *     int type;
                   2238:  *     struct trapframe *tf0;
                   2239:  */
1.111     pk       2240: _ENTRY(_C_LABEL(kgdb_trap_glue))
1.1       deraadt  2241:        save    %sp, -CCFSZ, %sp
                   2242:
1.111     pk       2243:        call    _C_LABEL(write_all_windows)
1.1       deraadt  2244:         mov    %sp, %l4                ! %l4 = current %sp
                   2245:
                   2246:        /* copy trapframe to top of kgdb stack */
1.127     pk       2247:        set     _C_LABEL(kgdb_stack) + KGDB_STACK_SIZE - 80, %l0
1.1       deraadt  2248:                                        ! %l0 = tfcopy -> end_of_kgdb_stack
                   2249:        mov     80, %l1
                   2250: 1:     ldd     [%i1], %l2
                   2251:        inc     8, %i1
                   2252:        deccc   8, %l1
                   2253:        std     %l2, [%l0]
                   2254:        bg      1b
                   2255:         inc    8, %l0
                   2256:
                   2257: #ifdef DEBUG
                   2258:        /* save old red zone and then turn it off */
                   2259:        sethi   %hi(_redzone), %l7
                   2260:        ld      [%l7 + %lo(_redzone)], %l6
                   2261:        st      %g0, [%l7 + %lo(_redzone)]
                   2262: #endif
                   2263:        /* switch to kgdb stack */
                   2264:        add     %l0, -CCFSZ-80, %sp
                   2265:
                   2266:        /* if (kgdb_trap(type, tfcopy)) kgdb_rett(tfcopy); */
                   2267:        mov     %i0, %o0
1.111     pk       2268:        call    _C_LABEL(kgdb_trap)
1.1       deraadt  2269:        add     %l0, -80, %o1
                   2270:        tst     %o0
                   2271:        bnz,a   kgdb_rett
                   2272:         add    %l0, -80, %g1
                   2273:
                   2274:        /*
                   2275:         * kgdb_trap() did not handle the trap at all so the stack is
                   2276:         * still intact.  A simple `restore' will put everything back,
                   2277:         * after we reset the stack pointer.
                   2278:         */
                   2279:        mov     %l4, %sp
                   2280: #ifdef DEBUG
                   2281:        st      %l6, [%l7 + %lo(_redzone)]      ! restore red zone
                   2282: #endif
                   2283:        ret
                   2284:        restore
                   2285:
                   2286: /*
                   2287:  * Return from kgdb trap.  This is sort of special.
                   2288:  *
                   2289:  * We know that kgdb_trap_glue wrote the window above it, so that we will
                   2290:  * be able to (and are sure to have to) load it up.  We also know that we
                   2291:  * came from kernel land and can assume that the %fp (%i6) we load here
                   2292:  * is proper.  We must also be sure not to lower ipl (it is at splhigh())
                   2293:  * until we have traps disabled, due to the SPARC taking traps at the
                   2294:  * new ipl before noticing that PSR_ET has been turned off.  We are on
                   2295:  * the kgdb stack, so this could be disastrous.
                   2296:  *
                   2297:  * Note that the trapframe argument in %g1 points into the current stack
                   2298:  * frame (current window).  We abandon this window when we move %g1->tf_psr
                   2299:  * into %psr, but we will not have loaded the new %sp yet, so again traps
                   2300:  * must be disabled.
                   2301:  */
                   2302: kgdb_rett:
                   2303:        rd      %psr, %g4               ! turn off traps
                   2304:        wr      %g4, PSR_ET, %psr
                   2305:        /* use the three-instruction delay to do something useful */
                   2306:        ld      [%g1], %g2              ! pick up new %psr
                   2307:        ld      [%g1 + 12], %g3         ! set %y
                   2308:        wr      %g3, 0, %y
                   2309: #ifdef DEBUG
                   2310:        st      %l6, [%l7 + %lo(_redzone)] ! and restore red zone
                   2311: #endif
                   2312:        wr      %g0, 0, %wim            ! enable window changes
                   2313:        nop; nop; nop
                   2314:        /* now safe to set the new psr (changes CWP, leaves traps disabled) */
                   2315:        wr      %g2, 0, %psr            ! set rett psr (including cond codes)
                   2316:        /* 3 instruction delay before we can use the new window */
                   2317: /*1*/  ldd     [%g1 + 24], %g2         ! set new %g2, %g3
                   2318: /*2*/  ldd     [%g1 + 32], %g4         ! set new %g4, %g5
                   2319: /*3*/  ldd     [%g1 + 40], %g6         ! set new %g6, %g7
                   2320:
                   2321:        /* now we can use the new window */
                   2322:        mov     %g1, %l4
                   2323:        ld      [%l4 + 4], %l1          ! get new pc
                   2324:        ld      [%l4 + 8], %l2          ! get new npc
                   2325:        ld      [%l4 + 20], %g1         ! set new %g1
                   2326:
                   2327:        /* set up returnee's out registers, including its %sp */
                   2328:        ldd     [%l4 + 48], %i0
                   2329:        ldd     [%l4 + 56], %i2
                   2330:        ldd     [%l4 + 64], %i4
                   2331:        ldd     [%l4 + 72], %i6
                   2332:
                   2333:        /* load returnee's window, making the window above it be invalid */
                   2334:        restore
                   2335:        restore %g0, 1, %l1             ! move to inval window and set %l1 = 1
                   2336:        rd      %psr, %l0
                   2337:        sll     %l1, %l0, %l1
                   2338:        wr      %l1, 0, %wim            ! %wim = 1 << (%psr & 31)
1.111     pk       2339:        sethi   %hi(cpcb), %l1
                   2340:        ld      [%l1 + %lo(cpcb)], %l1
1.1       deraadt  2341:        and     %l0, 31, %l0            ! CWP = %psr & 31;
                   2342:        st      %l0, [%l1 + PCB_WIM]    ! cpcb->pcb_wim = CWP;
                   2343:        save    %g0, %g0, %g0           ! back to window to reload
                   2344:        LOADWIN(%sp)
                   2345:        save    %g0, %g0, %g0           ! back to trap window
                   2346:        /* note, we have not altered condition codes; safe to just rett */
                   2347:        RETT
                   2348: #endif
                   2349:
                   2350: /*
                   2351:  * syscall() builds a trap frame and calls syscall().
                   2352:  * sun_syscall is same but delivers sun system call number
                   2353:  * XXX should not have to save&reload ALL the registers just for
                   2354:  *     ptrace...
                   2355:  */
1.122     christos 2356: _C_LABEL(_syscall):
1.1       deraadt  2357:        TRAP_SETUP(-CCFSZ-80)
1.173     pk       2358: #ifdef DEBUG
                   2359:        or      %g1, 0x1000, %l6        ! mark syscall
                   2360:        TRAP_TRACE(%l6,%l5)
                   2361: #endif
1.1       deraadt  2362:        wr      %l0, PSR_ET, %psr
                   2363:        std     %l0, [%sp + CCFSZ + 0]  ! tf_psr, tf_pc
                   2364:        rd      %y, %l3
                   2365:        std     %l2, [%sp + CCFSZ + 8]  ! tf_npc, tf_y
                   2366:        st      %g1, [%sp + CCFSZ + 20] ! tf_g[1]
                   2367:        std     %g2, [%sp + CCFSZ + 24] ! tf_g[2], tf_g[3]
                   2368:        std     %g4, [%sp + CCFSZ + 32] ! etc
                   2369:        std     %g6, [%sp + CCFSZ + 40]
                   2370:        mov     %g1, %o0                ! (code)
                   2371:        std     %i0, [%sp + CCFSZ + 48]
                   2372:        add     %sp, CCFSZ, %o1         ! (&tf)
                   2373:        std     %i2, [%sp + CCFSZ + 56]
                   2374:        mov     %l1, %o2                ! (pc)
                   2375:        std     %i4, [%sp + CCFSZ + 64]
1.111     pk       2376:        call    _C_LABEL(syscall)       ! syscall(code, &tf, pc, suncompat)
1.1       deraadt  2377:         std    %i6, [%sp + CCFSZ + 72]
                   2378:        ! now load em all up again, sigh
                   2379:        ldd     [%sp + CCFSZ + 0], %l0  ! new %psr, new pc
                   2380:        ldd     [%sp + CCFSZ + 8], %l2  ! new npc, new %y
                   2381:        wr      %l3, 0, %y
1.51      pk       2382:        /* see `proc_trampoline' for the reason for this label */
                   2383: return_from_syscall:
1.1       deraadt  2384:        ld      [%sp + CCFSZ + 20], %g1
                   2385:        ldd     [%sp + CCFSZ + 24], %g2
                   2386:        ldd     [%sp + CCFSZ + 32], %g4
                   2387:        ldd     [%sp + CCFSZ + 40], %g6
                   2388:        ldd     [%sp + CCFSZ + 48], %i0
                   2389:        ldd     [%sp + CCFSZ + 56], %i2
                   2390:        ldd     [%sp + CCFSZ + 64], %i4
                   2391:        ldd     [%sp + CCFSZ + 72], %i6
                   2392:        b       return_from_trap
                   2393:         wr     %l0, 0, %psr
                   2394:
                   2395: /*
                   2396:  * Interrupts.  Software interrupts must be cleared from the software
                   2397:  * interrupt enable register.  Rather than calling ienab_bic for each,
                   2398:  * we do them in-line before enabling traps.
                   2399:  *
                   2400:  * After preliminary setup work, the interrupt is passed to each
                   2401:  * registered handler in turn.  These are expected to return nonzero if
                   2402:  * they took care of the interrupt.  If a handler claims the interrupt,
                   2403:  * we exit (hardware interrupts are latched in the requestor so we'll
                   2404:  * just take another interrupt in the unlikely event of simultaneous
                   2405:  * interrupts from two different devices at the same level).  If we go
                   2406:  * through all the registered handlers and no one claims it, we report a
                   2407:  * stray interrupt.  This is more or less done as:
                   2408:  *
                   2409:  *     for (ih = intrhand[intlev]; ih; ih = ih->ih_next)
                   2410:  *             if ((*ih->ih_fun)(ih->ih_arg ? ih->ih_arg : &frame))
                   2411:  *                     return;
                   2412:  *     strayintr(&frame);
                   2413:  *
                   2414:  * Software interrupts are almost the same with three exceptions:
                   2415:  * (1) we clear the interrupt from the software interrupt enable
                   2416:  *     register before calling any handler (we have to clear it first
                   2417:  *     to avoid an interrupt-losing race),
                   2418:  * (2) we always call all the registered handlers (there is no way
                   2419:  *     to tell if the single bit in the software interrupt register
                   2420:  *     represents one or many requests)
                   2421:  * (3) we never announce a stray interrupt (because of (1), another
                   2422:  *     interrupt request can come in while we're in the handler.  If
1.52      pk       2423:  *     the handler deals with everything for both the original & the
1.1       deraadt  2424:  *     new request, we'll erroneously report a stray interrupt when
                   2425:  *     we take the software interrupt for the new request.
                   2426:  *
                   2427:  * Inputs:
                   2428:  *     %l0 = %psr
                   2429:  *     %l1 = return pc
                   2430:  *     %l2 = return npc
                   2431:  *     %l3 = interrupt level
                   2432:  *     (software interrupt only) %l4 = bits to clear in interrupt register
                   2433:  *
                   2434:  * Internal:
                   2435:  *     %l4, %l5: local variables
                   2436:  *     %l6 = %y
                   2437:  *     %l7 = %g1
                   2438:  *     %g2..%g7 go to stack
                   2439:  *
                   2440:  * An interrupt frame is built in the space for a full trapframe;
                   2441:  * this contains the psr, pc, npc, and interrupt level.
                   2442:  */
1.52      pk       2443: softintr_sun44c:
1.62      pk       2444:        sethi   %hi(INTRREG_VA), %l6
                   2445:        ldub    [%l6 + %lo(INTRREG_VA)], %l5
1.1       deraadt  2446:        andn    %l5, %l4, %l5
1.62      pk       2447:        stb     %l5, [%l6 + %lo(INTRREG_VA)]
1.52      pk       2448:
                   2449: softintr_common:
1.1       deraadt  2450:        INTR_SETUP(-CCFSZ-80)
                   2451:        std     %g2, [%sp + CCFSZ + 24] ! save registers
1.181     uwe      2452:        INCR(_C_LABEL(uvmexp)+V_SOFT)   ! cnt.v_intr++; (clobbers %o0,%o1)
1.1       deraadt  2453:        mov     %g1, %l7
                   2454:        rd      %y, %l6
                   2455:        std     %g4, [%sp + CCFSZ + 32]
                   2456:        andn    %l0, PSR_PIL, %l4       ! %l4 = psr & ~PSR_PIL |
                   2457:        sll     %l3, 8, %l5             !       intlev << IPLSHIFT
                   2458:        std     %g6, [%sp + CCFSZ + 40]
                   2459:        or      %l5, %l4, %l4           !                       ;
                   2460:        wr      %l4, 0, %psr            ! the manual claims this
                   2461:        wr      %l4, PSR_ET, %psr       ! song and dance is necessary
                   2462:        std     %l0, [%sp + CCFSZ + 0]  ! set up intrframe/clockframe
                   2463:        sll     %l3, 2, %l5
1.111     pk       2464:        set     _C_LABEL(intrcnt), %l4  ! intrcnt[intlev]++;
1.1       deraadt  2465:        ld      [%l4 + %l5], %o0
                   2466:        std     %l2, [%sp + CCFSZ + 8]
                   2467:        inc     %o0
                   2468:        st      %o0, [%l4 + %l5]
1.169     pk       2469:        set     _C_LABEL(sintrhand), %l4! %l4 = sintrhand[intlev];
1.1       deraadt  2470:        ld      [%l4 + %l5], %l4
1.175     pk       2471:
                   2472: #if defined(MULTIPROCESSOR)
1.177     pk       2473:        /* Grab the kernel lock for interrupt levels <= IPL_CLOCK */
                   2474:        cmp     %l3, IPL_CLOCK
1.183     pk       2475:        bgeu    3f
1.177     pk       2476:         st     %fp, [%sp + CCFSZ + 16]
1.175     pk       2477:        call    _C_LABEL(intr_lock_kernel)
                   2478:         nop
                   2479: #endif
                   2480:
1.1       deraadt  2481:        b       3f
                   2482:         st     %fp, [%sp + CCFSZ + 16]
                   2483:
1.166     pk       2484: 1:     ld      [%l4 + 12], %o2         ! ih->ih_classipl
                   2485:        rd      %psr, %o3               !  (bits already shifted to PIL field)
                   2486:        andn    %o3, PSR_PIL, %o3       ! %o3 = psr & ~PSR_PIL
                   2487:        wr      %o3, %o2, %psr          ! splraise(ih->ih_classipl)
                   2488:        ld      [%l4], %o1
1.1       deraadt  2489:        ld      [%l4 + 4], %o0
1.166     pk       2490:        nop                             ! one more isns before touching ICC
1.1       deraadt  2491:        tst     %o0
                   2492:        bz,a    2f
                   2493:         add    %sp, CCFSZ, %o0
                   2494: 2:     jmpl    %o1, %o7                !       (void)(*ih->ih_fun)(...)
                   2495:         ld     [%l4 + 8], %l4          !       and ih = ih->ih_next
                   2496: 3:     tst     %l4                     ! while ih != NULL
                   2497:        bnz     1b
                   2498:         nop
1.175     pk       2499:
                   2500: #if defined(MULTIPROCESSOR)
1.177     pk       2501:        cmp     %l3, IPL_CLOCK
1.183     pk       2502:        bgeu    0f
1.175     pk       2503:         nop
                   2504:        call    _C_LABEL(intr_unlock_kernel)
                   2505:         nop
                   2506: 0:
                   2507: #endif
                   2508:
1.1       deraadt  2509:        mov     %l7, %g1
                   2510:        wr      %l6, 0, %y
                   2511:        ldd     [%sp + CCFSZ + 24], %g2
                   2512:        ldd     [%sp + CCFSZ + 32], %g4
                   2513:        ldd     [%sp + CCFSZ + 40], %g6
                   2514:        b       return_from_trap
                   2515:         wr     %l0, 0, %psr
                   2516:
                   2517:        /*
1.52      pk       2518:         * _sparc_interrupt{44c,4m} is exported for paranoia checking
                   2519:         * (see intr.c).
1.1       deraadt  2520:         */
1.52      pk       2521: #if defined(SUN4M)
1.111     pk       2522: _ENTRY(_C_LABEL(sparc_interrupt4m))
1.149     uwe      2523: #if !defined(MSIIEP)   /* "normal" sun4m */
1.96      pk       2524:        sethi   %hi(CPUINFO_VA+CPUINFO_INTREG), %l6
                   2525:        ld      [%l6 + %lo(CPUINFO_VA+CPUINFO_INTREG)], %l6
1.160     uwe      2526:        mov     1, %l4
1.96      pk       2527:        ld      [%l6 + ICR_PI_PEND_OFFSET], %l5 ! get pending interrupts
1.160     uwe      2528:        sll     %l4, %l3, %l4   ! hw intr bits are in the lower halfword
                   2529:
                   2530:        btst    %l4, %l5        ! has pending hw intr at this level?
                   2531:        bnz     sparc_interrupt_common
1.52      pk       2532:         nop
                   2533:
1.160     uwe      2534:        ! both softint pending and clear bits are in upper halfwords of
                   2535:        ! their respective registers so shift the test bit in %l4 up there
                   2536:        sll     %l4, 16, %l4
1.161     uwe      2537: #ifdef DIAGNOSTIC
1.160     uwe      2538:        btst    %l4, %l5        ! make sure softint pending bit is set
                   2539:        bnz     softintr_common
                   2540:         st     %l4, [%l6 + ICR_PI_CLR_OFFSET]
                   2541:        /* FALLTHROUGH to sparc_interrupt4m_bogus */
                   2542: #else
                   2543:        b       softintr_common
                   2544:         st     %l4, [%l6 + ICR_PI_CLR_OFFSET]
                   2545: #endif
                   2546:
1.149     uwe      2547: #else /* MSIIEP */
                   2548:        sethi   %hi(MSIIEP_PCIC_VA), %l6
                   2549:        mov     1, %l4
                   2550:        ld      [%l6 + PCIC_PROC_IPR_REG], %l5 ! get pending interrupts
1.160     uwe      2551:        sll     %l4, %l3, %l4   ! hw intr bits are in the lower halfword
                   2552:
                   2553:        btst    %l4, %l5        ! has pending hw intr at this level?
1.149     uwe      2554:        bnz     sparc_interrupt_common
                   2555:         nop
                   2556:
1.160     uwe      2557: #ifdef DIAGNOSTIC
                   2558:        ! softint pending bits are in the upper halfword, but softint
                   2559:        ! clear bits are in the lower halfword so we want the bit in %l4
                   2560:        ! kept in the lower half and instead shift pending bits right
                   2561:        srl     %l5, 16, %l7
                   2562:        btst    %l4, %l7        ! make sure softint pending bit is set
                   2563:        bnz     softintr_common
                   2564:         sth    %l4, [%l6 + PCIC_SOFT_INTR_CLEAR_REG]
                   2565:        /* FALLTHROUGH to sparc_interrupt4m_bogus */
                   2566: #else
1.149     uwe      2567:        b       softintr_common
                   2568:         sth    %l4, [%l6 + PCIC_SOFT_INTR_CLEAR_REG]
1.160     uwe      2569: #endif
                   2570:
1.149     uwe      2571: #endif /* MSIIEP */
1.160     uwe      2572:
                   2573: #ifdef DIAGNOSTIC
                   2574:        /*
                   2575:         * sparc_interrupt4m detected that neither hardware nor software
                   2576:         * interrupt pending bit is set for this interrupt.  Report this
                   2577:         * situation, this is most probably a symptom of a driver bug.
                   2578:         */
                   2579: sparc_interrupt4m_bogus:
                   2580:        INTR_SETUP(-CCFSZ-80)
                   2581:        std     %g2, [%sp + CCFSZ + 24] ! save registers
                   2582:        INCR(_C_LABEL(uvmexp)+V_INTR)   ! cnt.v_intr++; (clobbers %o0,%o1)
                   2583:        mov     %g1, %l7
                   2584:        rd      %y, %l6
                   2585:        std     %g4, [%sp + CCFSZ + 32]
                   2586:        andn    %l0, PSR_PIL, %l4       ! %l4 = psr & ~PSR_PIL |
                   2587:        sll     %l3, 8, %l5             !       intlev << IPLSHIFT
                   2588:        std     %g6, [%sp + CCFSZ + 40]
                   2589:        or      %l5, %l4, %l4           !                       ;
                   2590:        wr      %l4, 0, %psr            ! the manual claims this
                   2591:        wr      %l4, PSR_ET, %psr       ! song and dance is necessary
                   2592:        std     %l0, [%sp + CCFSZ + 0]  ! set up intrframe/clockframe
                   2593:        sll     %l3, 2, %l5
                   2594:        set     _C_LABEL(intrcnt), %l4  ! intrcnt[intlev]++;
                   2595:        ld      [%l4 + %l5], %o0
                   2596:        std     %l2, [%sp + CCFSZ + 8]  ! set up intrframe/clockframe
                   2597:        inc     %o0
                   2598:        st      %o0, [%l4 + %l5]
                   2599:
                   2600:        st      %fp, [%sp + CCFSZ + 16]
                   2601:
                   2602:        /* Unhandled interrupts while cold cause IPL to be raised to `high' */
                   2603:        sethi   %hi(_C_LABEL(cold)), %o0
                   2604:        ld      [%o0 + %lo(_C_LABEL(cold))], %o0
                   2605:        tst     %o0                     ! if (cold) {
                   2606:        bnz,a   1f                      !       splhigh();
                   2607:         or     %l0, 0xf00, %l0         ! } else
                   2608:
                   2609:        call    _C_LABEL(bogusintr)     !       strayintr(&intrframe)
                   2610:         add    %sp, CCFSZ, %o0
                   2611:        /* all done: restore registers and go return */
                   2612: 1:
                   2613:        mov     %l7, %g1
                   2614:        wr      %l6, 0, %y
                   2615:        ldd     [%sp + CCFSZ + 24], %g2
                   2616:        ldd     [%sp + CCFSZ + 32], %g4
                   2617:        ldd     [%sp + CCFSZ + 40], %g6
                   2618:        b       return_from_trap
                   2619:         wr     %l0, 0, %psr
                   2620: #endif /* DIAGNOSTIC */
1.149     uwe      2621: #endif /* SUN4M */
1.52      pk       2622:
1.111     pk       2623: _ENTRY(_C_LABEL(sparc_interrupt44c))
                   2624: sparc_interrupt_common:
1.1       deraadt  2625:        INTR_SETUP(-CCFSZ-80)
                   2626:        std     %g2, [%sp + CCFSZ + 24] ! save registers
1.111     pk       2627:        INCR(_C_LABEL(uvmexp)+V_INTR)   ! cnt.v_intr++; (clobbers %o0,%o1)
1.1       deraadt  2628:        mov     %g1, %l7
                   2629:        rd      %y, %l6
                   2630:        std     %g4, [%sp + CCFSZ + 32]
                   2631:        andn    %l0, PSR_PIL, %l4       ! %l4 = psr & ~PSR_PIL |
                   2632:        sll     %l3, 8, %l5             !       intlev << IPLSHIFT
                   2633:        std     %g6, [%sp + CCFSZ + 40]
                   2634:        or      %l5, %l4, %l4           !                       ;
                   2635:        wr      %l4, 0, %psr            ! the manual claims this
                   2636:        wr      %l4, PSR_ET, %psr       ! song and dance is necessary
                   2637:        std     %l0, [%sp + CCFSZ + 0]  ! set up intrframe/clockframe
                   2638:        sll     %l3, 2, %l5
1.111     pk       2639:        set     _C_LABEL(intrcnt), %l4  ! intrcnt[intlev]++;
1.1       deraadt  2640:        ld      [%l4 + %l5], %o0
                   2641:        std     %l2, [%sp + CCFSZ + 8]  ! set up intrframe/clockframe
                   2642:        inc     %o0
                   2643:        st      %o0, [%l4 + %l5]
1.111     pk       2644:        set     _C_LABEL(intrhand), %l4 ! %l4 = intrhand[intlev];
1.1       deraadt  2645:        ld      [%l4 + %l5], %l4
1.137     mrg      2646:
1.175     pk       2647: #if defined(MULTIPROCESSOR)
1.177     pk       2648:        /* Grab the kernel lock for interrupt levels <= IPL_CLOCK */
                   2649:        cmp     %l3, IPL_CLOCK
1.183     pk       2650:        bgeu    3f
1.177     pk       2651:         st     %fp, [%sp + CCFSZ + 16]
1.137     mrg      2652:        call    _C_LABEL(intr_lock_kernel)
                   2653:         nop
                   2654: #endif
1.1       deraadt  2655:        b       3f
                   2656:         st     %fp, [%sp + CCFSZ + 16]
                   2657:
1.166     pk       2658: 1:     ld      [%l4 + 12], %o2         ! ih->ih_classipl
                   2659:        rd      %psr, %o3               !  (bits already shifted to PIL field)
                   2660:        andn    %o3, PSR_PIL, %o3       ! %o3 = psr & ~PSR_PIL
                   2661:        wr      %o3, %o2, %psr          ! splraise(ih->ih_classipl)
                   2662:        ld      [%l4], %o1
1.1       deraadt  2663:        ld      [%l4 + 4], %o0
1.166     pk       2664:        nop                             ! one more isns before touching ICC
1.1       deraadt  2665:        tst     %o0
                   2666:        bz,a    2f
                   2667:         add    %sp, CCFSZ, %o0
                   2668: 2:     jmpl    %o1, %o7                !       handled = (*ih->ih_fun)(...)
                   2669:         ld     [%l4 + 8], %l4          !       and ih = ih->ih_next
                   2670:        tst     %o0
                   2671:        bnz     4f                      ! if (handled) break
                   2672:         nop
                   2673: 3:     tst     %l4
                   2674:        bnz     1b                      ! while (ih)
                   2675:         nop
1.76      pk       2676:
                   2677:        /* Unhandled interrupts while cold cause IPL to be raised to `high' */
1.111     pk       2678:        sethi   %hi(_C_LABEL(cold)), %o0
                   2679:        ld      [%o0 + %lo(_C_LABEL(cold))], %o0
1.76      pk       2680:        tst     %o0                     ! if (cold) {
                   2681:        bnz,a   4f                      !       splhigh();
                   2682:         or     %l0, 0xf00, %l0         ! } else
                   2683:
1.111     pk       2684:        call    _C_LABEL(strayintr)     !       strayintr(&intrframe)
1.1       deraadt  2685:         add    %sp, CCFSZ, %o0
                   2686:        /* all done: restore registers and go return */
1.137     mrg      2687: 4:
1.175     pk       2688: #if defined(MULTIPROCESSOR)
1.177     pk       2689:        cmp     %l3, IPL_CLOCK
1.183     pk       2690:        bgeu    0f
1.170     pk       2691:         nop
1.137     mrg      2692:        call    _C_LABEL(intr_unlock_kernel)
                   2693:         nop
1.170     pk       2694: 0:
1.137     mrg      2695: #endif
                   2696:        mov     %l7, %g1
1.1       deraadt  2697:        wr      %l6, 0, %y
                   2698:        ldd     [%sp + CCFSZ + 24], %g2
                   2699:        ldd     [%sp + CCFSZ + 32], %g4
                   2700:        ldd     [%sp + CCFSZ + 40], %g6
                   2701:        b       return_from_trap
                   2702:         wr     %l0, 0, %psr
                   2703:
                   2704: #ifdef notyet
                   2705: /*
                   2706:  * Level 12 (ZS serial) interrupt.  Handle it quickly, schedule a
                   2707:  * software interrupt, and get out.  Do the software interrupt directly
                   2708:  * if we would just take it on the way out.
                   2709:  *
                   2710:  * Input:
                   2711:  *     %l0 = %psr
                   2712:  *     %l1 = return pc
                   2713:  *     %l2 = return npc
                   2714:  * Internal:
                   2715:  *     %l3 = zs device
                   2716:  *     %l4, %l5 = temporary
                   2717:  *     %l6 = rr3 (or temporary data) + 0x100 => need soft int
                   2718:  *     %l7 = zs soft status
                   2719:  */
                   2720: zshard:
                   2721: #endif /* notyet */
                   2722:
                   2723: /*
                   2724:  * Level 15 interrupt.  An async memory error has occurred;
                   2725:  * take care of it (typically by panicking, but hey...).
                   2726:  *     %l0 = %psr
                   2727:  *     %l1 = return pc
                   2728:  *     %l2 = return npc
                   2729:  *     %l3 = 15 * 4 (why? just because!)
                   2730:  *
                   2731:  * Internal:
                   2732:  *     %l4 = %y
                   2733:  *     %l5 = %g1
                   2734:  *     %l6 = %g6
                   2735:  *     %l7 = %g7
                   2736:  *  g2, g3, g4, g5 go to stack
                   2737:  *
                   2738:  * This code is almost the same as that in mem_access_fault,
                   2739:  * except that we already know the problem is not a `normal' fault,
                   2740:  * and that we must be extra-careful with interrupt enables.
                   2741:  */
1.52      pk       2742:
                   2743: #if defined(SUN4)
                   2744: nmi_sun4:
1.1       deraadt  2745:        INTR_SETUP(-CCFSZ-80)
1.111     pk       2746:        INCR(_C_LABEL(uvmexp)+V_INTR)   ! cnt.v_intr++; (clobbers %o0,%o1)
1.1       deraadt  2747:        /*
                   2748:         * Level 15 interrupts are nonmaskable, so with traps off,
                   2749:         * disable all interrupts to prevent recursion.
                   2750:         */
1.62      pk       2751:        sethi   %hi(INTRREG_VA), %o0
                   2752:        ldub    [%o0 + %lo(INTRREG_VA)], %o1
1.157     uwe      2753:        andn    %o1, IE_ALLIE, %o1
1.62      pk       2754:        stb     %o1, [%o0 + %lo(INTRREG_VA)]
1.1       deraadt  2755:        wr      %l0, PSR_ET, %psr       ! okay, turn traps on again
                   2756:
                   2757:        std     %g2, [%sp + CCFSZ + 0]  ! save g2, g3
                   2758:        rd      %y, %l4                 ! save y
                   2759:
1.19      deraadt  2760:        std     %g4, [%sp + CCFSZ + 8]  ! save g4, g5
                   2761:        mov     %g1, %l5                ! save g1, g6, g7
                   2762:        mov     %g6, %l6
                   2763:        mov     %g7, %l7
                   2764: #if defined(SUN4C) || defined(SUN4M)
1.52      pk       2765:        b,a     nmi_common
1.19      deraadt  2766: #endif /* SUN4C || SUN4M */
1.52      pk       2767: #endif
                   2768:
                   2769: #if defined(SUN4C)
                   2770: nmi_sun4c:
                   2771:        INTR_SETUP(-CCFSZ-80)
1.111     pk       2772:        INCR(_C_LABEL(uvmexp)+V_INTR)   ! cnt.v_intr++; (clobbers %o0,%o1)
1.52      pk       2773:        /*
                   2774:         * Level 15 interrupts are nonmaskable, so with traps off,
                   2775:         * disable all interrupts to prevent recursion.
                   2776:         */
1.62      pk       2777:        sethi   %hi(INTRREG_VA), %o0
                   2778:        ldub    [%o0 + %lo(INTRREG_VA)], %o1
1.157     uwe      2779:        andn    %o1, IE_ALLIE, %o1
1.62      pk       2780:        stb     %o1, [%o0 + %lo(INTRREG_VA)]
1.52      pk       2781:        wr      %l0, PSR_ET, %psr       ! okay, turn traps on again
                   2782:
                   2783:        std     %g2, [%sp + CCFSZ + 0]  ! save g2, g3
                   2784:        rd      %y, %l4                 ! save y
                   2785:
                   2786:        ! must read the sync error register too.
1.1       deraadt  2787:        set     AC_SYNC_ERR, %o0
                   2788:        lda     [%o0] ASI_CONTROL, %o1  ! sync err reg
                   2789:        inc     4, %o0
                   2790:        lda     [%o0] ASI_CONTROL, %o2  ! sync virt addr
                   2791:        std     %g4, [%sp + CCFSZ + 8]  ! save g4,g5
                   2792:        mov     %g1, %l5                ! save g1,g6,g7
                   2793:        mov     %g6, %l6
                   2794:        mov     %g7, %l7
                   2795:        inc     4, %o0
                   2796:        lda     [%o0] ASI_CONTROL, %o3  ! async err reg
                   2797:        inc     4, %o0
                   2798:        lda     [%o0] ASI_CONTROL, %o4  ! async virt addr
1.52      pk       2799: #if defined(SUN4M)
                   2800:        !!b,a   nmi_common
                   2801: #endif /* SUN4M */
                   2802: #endif /* SUN4C */
                   2803:
                   2804: nmi_common:
1.1       deraadt  2805:        ! and call C code
1.111     pk       2806:        call    _C_LABEL(memerr4_4c)    ! memerr(0, ser, sva, aer, ava)
1.95      pk       2807:         clr    %o0
1.1       deraadt  2808:
                   2809:        mov     %l5, %g1                ! restore g1 through g7
                   2810:        ldd     [%sp + CCFSZ + 0], %g2
                   2811:        ldd     [%sp + CCFSZ + 8], %g4
                   2812:        wr      %l0, 0, %psr            ! re-disable traps
                   2813:        mov     %l6, %g6
                   2814:        mov     %l7, %g7
                   2815:
                   2816:        ! set IE_ALLIE again (safe, we disabled traps again above)
1.62      pk       2817:        sethi   %hi(INTRREG_VA), %o0
                   2818:        ldub    [%o0 + %lo(INTRREG_VA)], %o1
1.1       deraadt  2819:        or      %o1, IE_ALLIE, %o1
1.62      pk       2820:        stb     %o1, [%o0 + %lo(INTRREG_VA)]
1.1       deraadt  2821:        b       return_from_trap
                   2822:         wr     %l4, 0, %y              ! restore y
                   2823:
1.52      pk       2824: #if defined(SUN4M)
                   2825: nmi_sun4m:
                   2826:        INTR_SETUP(-CCFSZ-80)
1.111     pk       2827:        INCR(_C_LABEL(uvmexp)+V_INTR)   ! cnt.v_intr++; (clobbers %o0,%o1)
1.94      pk       2828:
                   2829:        /* Read the Pending Interrupts register */
1.96      pk       2830:        sethi   %hi(CPUINFO_VA+CPUINFO_INTREG), %l6
                   2831:        ld      [%l6 + %lo(CPUINFO_VA+CPUINFO_INTREG)], %l6
                   2832:        ld      [%l6 + ICR_PI_PEND_OFFSET], %l5 ! get pending interrupts
                   2833:
1.111     pk       2834:        set     _C_LABEL(nmi_soft), %o3         ! assume a softint
1.105     pk       2835:        set     PINTR_IC, %o1                   ! hard lvl 15 bit
                   2836:        sethi   %hi(PINTR_SINTRLEV(15)), %o0    ! soft lvl 15 bit
1.94      pk       2837:        btst    %o0, %l5                ! soft level 15?
1.101     pk       2838:        bnz,a   1f                      !
1.105     pk       2839:         mov    %o0, %o1                ! shift int clear bit to SOFTINT 15
                   2840:
1.154     thorpej  2841:        set     _C_LABEL(nmi_hard), %o3 /* it's a hardint; switch handler */
1.94      pk       2842:
1.52      pk       2843:        /*
                   2844:         * Level 15 interrupts are nonmaskable, so with traps off,
                   2845:         * disable all interrupts to prevent recursion.
                   2846:         */
                   2847:        sethi   %hi(ICR_SI_SET), %o0
1.101     pk       2848:        set     SINTR_MA, %o2
                   2849:        st      %o2, [%o0 + %lo(ICR_SI_SET)]
1.142     mrg      2850: #if defined(MULTIPROCESSOR) && defined(DDB)
                   2851:        b       2f
                   2852:         clr    %o0
                   2853: #endif
1.52      pk       2854:
1.101     pk       2855: 1:
1.142     mrg      2856: #if defined(MULTIPROCESSOR) && defined(DDB)
                   2857:        /*
                   2858:         * Setup a trapframe for nmi_soft; this might be an IPI telling
                   2859:         * us to pause, so lets save some state for DDB to get at.
                   2860:         */
                   2861:        std     %l0, [%sp + CCFSZ]      ! tf.tf_psr = psr; tf.tf_pc = ret_pc;
                   2862:        rd      %y, %l3
                   2863:        std     %l2, [%sp + CCFSZ + 8]  ! tf.tf_npc = return_npc; tf.tf_y = %y;
                   2864:        st      %g1, [%sp + CCFSZ + 20]
                   2865:        std     %g2, [%sp + CCFSZ + 24]
                   2866:        std     %g4, [%sp + CCFSZ + 32]
                   2867:        std     %g6, [%sp + CCFSZ + 40]
                   2868:        std     %i0, [%sp + CCFSZ + 48]
                   2869:        std     %i2, [%sp + CCFSZ + 56]
                   2870:        std     %i4, [%sp + CCFSZ + 64]
                   2871:        std     %i6, [%sp + CCFSZ + 72]
                   2872:        add     %sp, CCFSZ, %o0
                   2873: 2:
                   2874: #else
                   2875:        clr     %o0
                   2876: #endif
1.105     pk       2877:        /*
                   2878:         * Now clear the NMI. Apparently, we must allow some time
                   2879:         * to let the bits sink in..
                   2880:         */
1.96      pk       2881:        st      %o1, [%l6 + ICR_PI_CLR_OFFSET]
1.105     pk       2882:         nop; nop; nop;
                   2883:        ld      [%l6 + ICR_PI_PEND_OFFSET], %g0 ! drain register!?
1.172     pk       2884:         nop;
1.52      pk       2885:
1.172     pk       2886:        or      %l0, PSR_PIL, %o4       ! splhigh()
                   2887:        wr      %o4, 0, %psr            !
                   2888:        wr      %o4, PSR_ET, %psr       ! turn traps on again
1.52      pk       2889:
1.142     mrg      2890:        std     %g2, [%sp + CCFSZ + 80] ! save g2, g3
1.52      pk       2891:        rd      %y, %l4                 ! save y
1.142     mrg      2892:        std     %g4, [%sp + CCFSZ + 88] ! save g4,g5
1.52      pk       2893:
                   2894:        /* Finish stackframe, call C trap handler */
                   2895:        mov     %g1, %l5                ! save g1,g6,g7
                   2896:        mov     %g6, %l6
                   2897:
1.142     mrg      2898:        jmpl    %o3, %o7                ! nmi_hard(0) or nmi_soft(&tf)
                   2899:         mov    %g7, %l7
1.105     pk       2900:
1.52      pk       2901:        mov     %l5, %g1                ! restore g1 through g7
1.142     mrg      2902:        ldd     [%sp + CCFSZ + 80], %g2
                   2903:        ldd     [%sp + CCFSZ + 88], %g4
1.52      pk       2904:        wr      %l0, 0, %psr            ! re-disable traps
                   2905:        mov     %l6, %g6
                   2906:        mov     %l7, %g7
                   2907:
1.105     pk       2908:        !cmp    %o0, 0                  ! was this a soft nmi
                   2909:        !be     4f
1.154     thorpej  2910:        /* XXX - we need to unblock `mask all ints' only on a hard nmi */
1.101     pk       2911:
1.52      pk       2912:        ! enable interrupts again (safe, we disabled traps again above)
                   2913:        sethi   %hi(ICR_SI_CLR), %o0
                   2914:        set     SINTR_MA, %o1
                   2915:        st      %o1, [%o0 + %lo(ICR_SI_CLR)]
                   2916:
1.101     pk       2917: 4:
1.52      pk       2918:        b       return_from_trap
                   2919:         wr     %l4, 0, %y              ! restore y
                   2920: #endif /* SUN4M */
                   2921:
                   2922: #ifdef GPROF
                   2923:        .globl  window_of, winof_user
                   2924:        .globl  window_uf, winuf_user, winuf_ok, winuf_invalid
                   2925:        .globl  return_from_trap, rft_kernel, rft_user, rft_invalid
                   2926:        .globl  softtrap, slowtrap
1.122     christos 2927:        .globl  clean_trap_window, _C_LABEL(_syscall)
1.52      pk       2928: #endif
1.1       deraadt  2929:
                   2930: /*
                   2931:  * Window overflow trap handler.
                   2932:  *     %l0 = %psr
                   2933:  *     %l1 = return pc
                   2934:  *     %l2 = return npc
                   2935:  */
                   2936: window_of:
                   2937: #ifdef TRIVIAL_WINDOW_OVERFLOW_HANDLER
                   2938:        /* a trivial version that assumes %sp is ok */
                   2939:        /* (for testing only!) */
                   2940:        save    %g0, %g0, %g0
                   2941:        std     %l0, [%sp + (0*8)]
                   2942:        rd      %psr, %l0
                   2943:        mov     1, %l1
                   2944:        sll     %l1, %l0, %l0
                   2945:        wr      %l0, 0, %wim
                   2946:        std     %l2, [%sp + (1*8)]
                   2947:        std     %l4, [%sp + (2*8)]
                   2948:        std     %l6, [%sp + (3*8)]
                   2949:        std     %i0, [%sp + (4*8)]
                   2950:        std     %i2, [%sp + (5*8)]
                   2951:        std     %i4, [%sp + (6*8)]
                   2952:        std     %i6, [%sp + (7*8)]
                   2953:        restore
                   2954:        RETT
                   2955: #else
                   2956:        /*
                   2957:         * This is similar to TRAP_SETUP, but we do not want to spend
                   2958:         * a lot of time, so we have separate paths for kernel and user.
                   2959:         * We also know for sure that the window has overflowed.
                   2960:         */
1.173     pk       2961:        TRAP_TRACE2(5,%l6,%l5)
1.1       deraadt  2962:        btst    PSR_PS, %l0
                   2963:        bz      winof_user
                   2964:         sethi  %hi(clean_trap_window), %l7
                   2965:
                   2966:        /*
                   2967:         * Overflow from kernel mode.  Call clean_trap_window to
                   2968:         * do the dirty work, then just return, since we know prev
                   2969:         * window is valid.  clean_trap_windows might dump all *user*
                   2970:         * windows into the pcb, but we do not care: there is at
                   2971:         * least one kernel window (a trap or interrupt frame!)
                   2972:         * above us.
                   2973:         */
                   2974:        jmpl    %l7 + %lo(clean_trap_window), %l4
                   2975:         mov    %g7, %l7                ! for clean_trap_window
                   2976:
                   2977:        wr      %l0, 0, %psr            ! put back the @%*! cond. codes
                   2978:        nop                             ! (let them settle in)
                   2979:        RETT
                   2980:
                   2981: winof_user:
                   2982:        /*
                   2983:         * Overflow from user mode.
                   2984:         * If clean_trap_window dumps the registers into the pcb,
                   2985:         * rft_user will need to call trap(), so we need space for
                   2986:         * a trap frame.  We also have to compute pcb_nw.
                   2987:         *
                   2988:         * SHOULD EXPAND IN LINE TO AVOID BUILDING TRAP FRAME ON
                   2989:         * `EASY' SAVES
                   2990:         */
1.111     pk       2991:        sethi   %hi(cpcb), %l6
                   2992:        ld      [%l6 + %lo(cpcb)], %l6
1.1       deraadt  2993:        ld      [%l6 + PCB_WIM], %l5
                   2994:        and     %l0, 31, %l3
                   2995:        sub     %l3, %l5, %l5           /* l5 = CWP - pcb_wim */
                   2996:        set     uwtab, %l4
                   2997:        ldub    [%l4 + %l5], %l5        /* l5 = uwtab[l5] */
                   2998:        st      %l5, [%l6 + PCB_UW]
                   2999:        jmpl    %l7 + %lo(clean_trap_window), %l4
                   3000:         mov    %g7, %l7                ! for clean_trap_window
1.111     pk       3001:        sethi   %hi(cpcb), %l6
                   3002:        ld      [%l6 + %lo(cpcb)], %l6
1.13      deraadt  3003:        set     USPACE-CCFSZ-80, %l5
1.1       deraadt  3004:        add     %l6, %l5, %sp           /* over to kernel stack */
                   3005:        CHECK_SP_REDZONE(%l6, %l5)
                   3006:
                   3007:        /*
                   3008:         * Copy return_from_trap far enough to allow us
                   3009:         * to jump directly to rft_user_or_recover_pcb_windows
                   3010:         * (since we know that is where we are headed).
                   3011:         */
                   3012: !      and     %l0, 31, %l3            ! still set (clean_trap_window
                   3013:                                        ! leaves this register alone)
                   3014:        set     wmask, %l6
                   3015:        ldub    [%l6 + %l3], %l5        ! %l5 = 1 << ((CWP + 1) % nwindows)
                   3016:        b       rft_user_or_recover_pcb_windows
                   3017:         rd     %wim, %l4               ! (read %wim first)
                   3018: #endif /* end `real' version of window overflow trap handler */
                   3019:
                   3020: /*
                   3021:  * Window underflow trap handler.
                   3022:  *     %l0 = %psr
                   3023:  *     %l1 = return pc
                   3024:  *     %l2 = return npc
                   3025:  *
                   3026:  * A picture:
                   3027:  *
                   3028:  *       T R I X
                   3029:  *     0 0 0 1 0 0 0   (%wim)
                   3030:  * [bit numbers increase towards the right;
                   3031:  * `restore' moves right & `save' moves left]
                   3032:  *
                   3033:  * T is the current (Trap) window, R is the window that attempted
                   3034:  * a `Restore' instruction, I is the Invalid window, and X is the
                   3035:  * window we want to make invalid before we return.
                   3036:  *
                   3037:  * Since window R is valid, we cannot use rft_user to restore stuff
                   3038:  * for us.  We have to duplicate its logic.  YUCK.
                   3039:  *
                   3040:  * Incidentally, TRIX are for kids.  Silly rabbit!
                   3041:  */
                   3042: window_uf:
                   3043: #ifdef TRIVIAL_WINDOW_UNDERFLOW_HANDLER
                   3044:        wr      %g0, 0, %wim            ! allow us to enter I
                   3045:        restore                         ! to R
                   3046:        nop
                   3047:        nop
                   3048:        restore                         ! to I
                   3049:        restore %g0, 1, %l1             ! to X
                   3050:        rd      %psr, %l0
                   3051:        sll     %l1, %l0, %l0
                   3052:        wr      %l0, 0, %wim
                   3053:        save    %g0, %g0, %g0           ! back to I
                   3054:        LOADWIN(%sp)
                   3055:        save    %g0, %g0, %g0           ! back to R
                   3056:        save    %g0, %g0, %g0           ! back to T
                   3057:        RETT
                   3058: #else
1.173     pk       3059:        TRAP_TRACE2(6,%l6,%l5)
1.1       deraadt  3060:        wr      %g0, 0, %wim            ! allow us to enter I
                   3061:        btst    PSR_PS, %l0
                   3062:        restore                         ! enter window R
                   3063:        bz      winuf_user
                   3064:         restore                        ! enter window I
                   3065:
                   3066:        /*
                   3067:         * Underflow from kernel mode.  Just recover the
                   3068:         * registers and go (except that we have to update
                   3069:         * the blasted user pcb fields).
                   3070:         */
                   3071:        restore %g0, 1, %l1             ! enter window X, then set %l1 to 1
                   3072:        rd      %psr, %l0               ! cwp = %psr & 31;
                   3073:        and     %l0, 31, %l0
                   3074:        sll     %l1, %l0, %l1           ! wim = 1 << cwp;
                   3075:        wr      %l1, 0, %wim            ! setwim(wim);
1.111     pk       3076:        sethi   %hi(cpcb), %l1
                   3077:        ld      [%l1 + %lo(cpcb)], %l1
1.1       deraadt  3078:        st      %l0, [%l1 + PCB_WIM]    ! cpcb->pcb_wim = cwp;
                   3079:        save    %g0, %g0, %g0           ! back to window I
                   3080:        LOADWIN(%sp)
                   3081:        save    %g0, %g0, %g0           ! back to R
                   3082:        save    %g0, %g0, %g0           ! and then to T
                   3083:        wr      %l0, 0, %psr            ! fix those cond codes....
                   3084:        nop                             ! (let them settle in)
                   3085:        RETT
                   3086:
                   3087: winuf_user:
                   3088:        /*
                   3089:         * Underflow from user mode.
                   3090:         *
                   3091:         * We cannot use rft_user (as noted above) because
                   3092:         * we must re-execute the `restore' instruction.
                   3093:         * Since it could be, e.g., `restore %l0,0,%l0',
                   3094:         * it is not okay to touch R's registers either.
                   3095:         *
                   3096:         * We are now in window I.
                   3097:         */
                   3098:        btst    7, %sp                  ! if unaligned, it is invalid
                   3099:        bne     winuf_invalid
                   3100:         EMPTY
                   3101:
1.111     pk       3102:        sethi   %hi(_C_LABEL(pgofset)), %l4
                   3103:        ld      [%l4 + %lo(_C_LABEL(pgofset))], %l4
1.62      pk       3104:        PTE_OF_ADDR(%sp, %l7, winuf_invalid, %l4, NOP_ON_4M_5)
                   3105:        CMP_PTE_USER_READ(%l7, %l5, NOP_ON_4M_6) ! if first page not readable,
1.1       deraadt  3106:        bne     winuf_invalid           ! it is invalid
                   3107:         EMPTY
1.13      deraadt  3108:        SLT_IF_1PAGE_RW(%sp, %l7, %l4)  ! first page is readable
1.1       deraadt  3109:        bl,a    winuf_ok                ! if only one page, enter window X
                   3110:         restore %g0, 1, %l1            ! and goto ok, & set %l1 to 1
                   3111:        add     %sp, 7*8, %l5
1.13      deraadt  3112:        add     %l4, 62, %l4
1.62      pk       3113:        PTE_OF_ADDR(%l5, %l7, winuf_invalid, %l4, NOP_ON_4M_7)
                   3114:        CMP_PTE_USER_READ(%l7, %l5, NOP_ON_4M_8) ! check second page too
1.1       deraadt  3115:        be,a    winuf_ok                ! enter window X and goto ok
                   3116:         restore %g0, 1, %l1            ! (and then set %l1 to 1)
                   3117:
                   3118: winuf_invalid:
                   3119:        /*
                   3120:         * We were unable to restore the window because %sp
                   3121:         * is invalid or paged out.  Return to the trap window
                   3122:         * and call trap(T_WINUF).  This will save R to the user
                   3123:         * stack, then load both R and I into the pcb rw[] area,
                   3124:         * and return with pcb_nsaved set to -1 for success, 0 for
                   3125:         * failure.  `Failure' indicates that someone goofed with the
                   3126:         * trap registers (e.g., signals), so that we need to return
                   3127:         * from the trap as from a syscall (probably to a signal handler)
                   3128:         * and let it retry the restore instruction later.  Note that
                   3129:         * window R will have been pushed out to user space, and thus
                   3130:         * be the invalid window, by the time we get back here.  (We
                   3131:         * continue to label it R anyway.)  We must also set %wim again,
                   3132:         * and set pcb_uw to 1, before enabling traps.  (Window R is the
                   3133:         * only window, and it is a user window).
                   3134:         */
                   3135:        save    %g0, %g0, %g0           ! back to R
                   3136:        save    %g0, 1, %l4             ! back to T, then %l4 = 1
1.111     pk       3137:        sethi   %hi(cpcb), %l6
                   3138:        ld      [%l6 + %lo(cpcb)], %l6
1.1       deraadt  3139:        st      %l4, [%l6 + PCB_UW]     ! pcb_uw = 1
                   3140:        ld      [%l6 + PCB_WIM], %l5    ! get log2(%wim)
                   3141:        sll     %l4, %l5, %l4           ! %l4 = old %wim
                   3142:        wr      %l4, 0, %wim            ! window I is now invalid again
1.13      deraadt  3143:        set     USPACE-CCFSZ-80, %l5
1.1       deraadt  3144:        add     %l6, %l5, %sp           ! get onto kernel stack
                   3145:        CHECK_SP_REDZONE(%l6, %l5)
                   3146:
                   3147:        /*
                   3148:         * Okay, call trap(T_WINUF, psr, pc, &tf).
                   3149:         * See `slowtrap' above for operation.
                   3150:         */
                   3151:        wr      %l0, PSR_ET, %psr
                   3152:        std     %l0, [%sp + CCFSZ + 0]  ! tf.tf_psr, tf.tf_pc
                   3153:        rd      %y, %l3
                   3154:        std     %l2, [%sp + CCFSZ + 8]  ! tf.tf_npc, tf.tf_y
                   3155:        mov     T_WINUF, %o0
                   3156:        st      %g1, [%sp + CCFSZ + 20] ! tf.tf_global[1]
                   3157:        mov     %l0, %o1
                   3158:        std     %g2, [%sp + CCFSZ + 24] ! etc
                   3159:        mov     %l1, %o2
                   3160:        std     %g4, [%sp + CCFSZ + 32]
                   3161:        add     %sp, CCFSZ, %o3
                   3162:        std     %g6, [%sp + CCFSZ + 40]
                   3163:        std     %i0, [%sp + CCFSZ + 48] ! tf.tf_out[0], etc
                   3164:        std     %i2, [%sp + CCFSZ + 56]
                   3165:        std     %i4, [%sp + CCFSZ + 64]
1.111     pk       3166:        call    _C_LABEL(trap)          ! trap(T_WINUF, pc, psr, &tf)
1.1       deraadt  3167:         std    %i6, [%sp + CCFSZ + 72] ! tf.tf_out[6]
                   3168:
                   3169:        ldd     [%sp + CCFSZ + 0], %l0  ! new psr, pc
                   3170:        ldd     [%sp + CCFSZ + 8], %l2  ! new npc, %y
                   3171:        wr      %l3, 0, %y
                   3172:        ld      [%sp + CCFSZ + 20], %g1
                   3173:        ldd     [%sp + CCFSZ + 24], %g2
                   3174:        ldd     [%sp + CCFSZ + 32], %g4
                   3175:        ldd     [%sp + CCFSZ + 40], %g6
                   3176:        ldd     [%sp + CCFSZ + 48], %i0 ! %o0 for window R, etc
                   3177:        ldd     [%sp + CCFSZ + 56], %i2
                   3178:        ldd     [%sp + CCFSZ + 64], %i4
                   3179:        wr      %l0, 0, %psr            ! disable traps: test must be atomic
                   3180:        ldd     [%sp + CCFSZ + 72], %i6
1.111     pk       3181:        sethi   %hi(cpcb), %l6
                   3182:        ld      [%l6 + %lo(cpcb)], %l6
1.1       deraadt  3183:        ld      [%l6 + PCB_NSAVED], %l7 ! if nsaved is -1, we have our regs
                   3184:        tst     %l7
                   3185:        bl,a    1f                      ! got them
                   3186:         wr     %g0, 0, %wim            ! allow us to enter windows R, I
                   3187:        b,a     return_from_trap
                   3188:
                   3189:        /*
                   3190:         * Got 'em.  Load 'em up.
                   3191:         */
                   3192: 1:
                   3193:        mov     %g6, %l3                ! save %g6; set %g6 = cpcb
                   3194:        mov     %l6, %g6
                   3195:        st      %g0, [%g6 + PCB_NSAVED] ! and clear magic flag
                   3196:        restore                         ! from T to R
                   3197:        restore                         ! from R to I
                   3198:        restore %g0, 1, %l1             ! from I to X, then %l1 = 1
                   3199:        rd      %psr, %l0               ! cwp = %psr;
                   3200:        sll     %l1, %l0, %l1
                   3201:        wr      %l1, 0, %wim            ! make window X invalid
                   3202:        and     %l0, 31, %l0
                   3203:        st      %l0, [%g6 + PCB_WIM]    ! cpcb->pcb_wim = cwp;
                   3204:        nop                             ! unnecessary? old wim was 0...
                   3205:        save    %g0, %g0, %g0           ! back to I
                   3206:        LOADWIN(%g6 + PCB_RW + 64)      ! load from rw[1]
                   3207:        save    %g0, %g0, %g0           ! back to R
                   3208:        LOADWIN(%g6 + PCB_RW)           ! load from rw[0]
                   3209:        save    %g0, %g0, %g0           ! back to T
                   3210:        wr      %l0, 0, %psr            ! restore condition codes
                   3211:        mov     %l3, %g6                ! fix %g6
                   3212:        RETT
                   3213:
                   3214:        /*
                   3215:         * Restoring from user stack, but everything has checked out
                   3216:         * as good.  We are now in window X, and %l1 = 1.  Window R
                   3217:         * is still valid and holds user values.
                   3218:         */
                   3219: winuf_ok:
                   3220:        rd      %psr, %l0
                   3221:        sll     %l1, %l0, %l1
                   3222:        wr      %l1, 0, %wim            ! make this one invalid
1.111     pk       3223:        sethi   %hi(cpcb), %l2
                   3224:        ld      [%l2 + %lo(cpcb)], %l2
1.1       deraadt  3225:        and     %l0, 31, %l0
                   3226:        st      %l0, [%l2 + PCB_WIM]    ! cpcb->pcb_wim = cwp;
                   3227:        save    %g0, %g0, %g0           ! back to I
                   3228:        LOADWIN(%sp)
                   3229:        save    %g0, %g0, %g0           ! back to R
                   3230:        save    %g0, %g0, %g0           ! back to T
                   3231:        wr      %l0, 0, %psr            ! restore condition codes
                   3232:        nop                             ! it takes three to tangle
                   3233:        RETT
                   3234: #endif /* end `real' version of window underflow trap handler */
                   3235:
                   3236: /*
                   3237:  * Various return-from-trap routines (see return_from_trap).
                   3238:  */
                   3239:
                   3240: /*
                   3241:  * Return from trap, to kernel.
                   3242:  *     %l0 = %psr
                   3243:  *     %l1 = return pc
                   3244:  *     %l2 = return npc
                   3245:  *     %l4 = %wim
                   3246:  *     %l5 = bit for previous window
                   3247:  */
                   3248: rft_kernel:
                   3249:        btst    %l5, %l4                ! if (wim & l5)
                   3250:        bnz     1f                      !       goto reload;
                   3251:         wr     %l0, 0, %psr            ! but first put !@#*% cond codes back
                   3252:
                   3253:        /* previous window is valid; just rett */
                   3254:        nop                             ! wait for cond codes to settle in
                   3255:        RETT
                   3256:
                   3257:        /*
                   3258:         * Previous window is invalid.
                   3259:         * Update %wim and then reload l0..i7 from frame.
                   3260:         *
                   3261:         *        T I X
                   3262:         *      0 0 1 0 0   (%wim)
                   3263:         * [see picture in window_uf handler]
                   3264:         *
                   3265:         * T is the current (Trap) window, I is the Invalid window,
                   3266:         * and X is the window we want to make invalid.  Window X
                   3267:         * currently has no useful values.
                   3268:         */
                   3269: 1:
                   3270:        wr      %g0, 0, %wim            ! allow us to enter window I
                   3271:        nop; nop; nop                   ! (it takes a while)
                   3272:        restore                         ! enter window I
                   3273:        restore %g0, 1, %l1             ! enter window X, then %l1 = 1
                   3274:        rd      %psr, %l0               ! CWP = %psr & 31;
                   3275:        and     %l0, 31, %l0
                   3276:        sll     %l1, %l0, %l1           ! wim = 1 << CWP;
                   3277:        wr      %l1, 0, %wim            ! setwim(wim);
1.111     pk       3278:        sethi   %hi(cpcb), %l1
                   3279:        ld      [%l1 + %lo(cpcb)], %l1
1.1       deraadt  3280:        st      %l0, [%l1 + PCB_WIM]    ! cpcb->pcb_wim = l0 & 31;
                   3281:        save    %g0, %g0, %g0           ! back to window I
                   3282:        LOADWIN(%sp)
                   3283:        save    %g0, %g0, %g0           ! back to window T
                   3284:        /*
                   3285:         * Note that the condition codes are still set from
                   3286:         * the code at rft_kernel; we can simply return.
                   3287:         */
                   3288:        RETT
                   3289:
                   3290: /*
                   3291:  * Return from trap, to user.  Checks for scheduling trap (`ast') first;
                   3292:  * will re-enter trap() if set.  Note that we may have to switch from
                   3293:  * the interrupt stack to the kernel stack in this case.
                   3294:  *     %l0 = %psr
                   3295:  *     %l1 = return pc
                   3296:  *     %l2 = return npc
                   3297:  *     %l4 = %wim
                   3298:  *     %l5 = bit for previous window
                   3299:  *     %l6 = cpcb
                   3300:  * If returning to a valid window, just set psr and return.
                   3301:  */
                   3302: rft_user:
1.179     pk       3303: !      sethi   %hi(_WANT_AST)), %l7    ! (done below)
                   3304:        ld      [%l7 + %lo(_WANT_AST)], %l7
1.1       deraadt  3305:        tst     %l7                     ! want AST trap?
                   3306:        bne,a   softtrap                ! yes, re-enter trap with type T_AST
                   3307:         mov    T_AST, %o0
                   3308:
                   3309:        btst    %l5, %l4                ! if (wim & l5)
                   3310:        bnz     1f                      !       goto reload;
                   3311:         wr     %l0, 0, %psr            ! restore cond codes
                   3312:        nop                             ! (three instruction delay)
                   3313:        RETT
                   3314:
                   3315:        /*
                   3316:         * Previous window is invalid.
                   3317:         * Before we try to load it, we must verify its stack pointer.
                   3318:         * This is much like the underflow handler, but a bit easier
                   3319:         * since we can use our own local registers.
                   3320:         */
                   3321: 1:
                   3322:        btst    7, %fp                  ! if unaligned, address is invalid
                   3323:        bne     rft_invalid
                   3324:         EMPTY
                   3325:
1.111     pk       3326:        sethi   %hi(_C_LABEL(pgofset)), %l3
                   3327:        ld      [%l3 + %lo(_C_LABEL(pgofset))], %l3
1.62      pk       3328:        PTE_OF_ADDR(%fp, %l7, rft_invalid, %l3, NOP_ON_4M_9)
                   3329:        CMP_PTE_USER_READ(%l7, %l5, NOP_ON_4M_10)       ! try first page
1.1       deraadt  3330:        bne     rft_invalid             ! no good
                   3331:         EMPTY
1.13      deraadt  3332:        SLT_IF_1PAGE_RW(%fp, %l7, %l3)
1.1       deraadt  3333:        bl,a    rft_user_ok             ! only 1 page: ok
                   3334:         wr     %g0, 0, %wim
                   3335:        add     %fp, 7*8, %l5
1.13      deraadt  3336:        add     %l3, 62, %l3
1.62      pk       3337:        PTE_OF_ADDR(%l5, %l7, rft_invalid, %l3, NOP_ON_4M_11)
                   3338:        CMP_PTE_USER_READ(%l7, %l5, NOP_ON_4M_12)       ! check 2nd page too
1.1       deraadt  3339:        be,a    rft_user_ok
                   3340:         wr     %g0, 0, %wim
                   3341:
                   3342:        /*
                   3343:         * The window we wanted to pull could not be pulled.  Instead,
                   3344:         * re-enter trap with type T_RWRET.  This will pull the window
                   3345:         * into cpcb->pcb_rw[0] and set cpcb->pcb_nsaved to -1, which we
                   3346:         * will detect when we try to return again.
                   3347:         */
                   3348: rft_invalid:
                   3349:        b       softtrap
                   3350:         mov    T_RWRET, %o0
                   3351:
                   3352:        /*
                   3353:         * The window we want to pull can be pulled directly.
                   3354:         */
                   3355: rft_user_ok:
                   3356: !      wr      %g0, 0, %wim            ! allow us to get into it
                   3357:        wr      %l0, 0, %psr            ! fix up the cond codes now
                   3358:        nop; nop; nop
                   3359:        restore                         ! enter window I
                   3360:        restore %g0, 1, %l1             ! enter window X, then %l1 = 1
                   3361:        rd      %psr, %l0               ! l0 = (junk << 5) + CWP;
                   3362:        sll     %l1, %l0, %l1           ! %wim = 1 << CWP;
                   3363:        wr      %l1, 0, %wim
1.111     pk       3364:        sethi   %hi(cpcb), %l1
                   3365:        ld      [%l1 + %lo(cpcb)], %l1
1.1       deraadt  3366:        and     %l0, 31, %l0
                   3367:        st      %l0, [%l1 + PCB_WIM]    ! cpcb->pcb_wim = l0 & 31;
                   3368:        save    %g0, %g0, %g0           ! back to window I
                   3369:        LOADWIN(%sp)                    ! suck hard
                   3370:        save    %g0, %g0, %g0           ! back to window T
                   3371:        RETT
                   3372:
                   3373: /*
                   3374:  * Return from trap.  Entered after a
                   3375:  *     wr      %l0, 0, %psr
                   3376:  * which disables traps so that we can rett; registers are:
                   3377:  *
                   3378:  *     %l0 = %psr
                   3379:  *     %l1 = return pc
                   3380:  *     %l2 = return npc
                   3381:  *
                   3382:  * (%l3..%l7 anything).
                   3383:  *
                   3384:  * If we are returning to user code, we must:
                   3385:  *  1.  Check for register windows in the pcb that belong on the stack.
                   3386:  *     If there are any, reenter trap with type T_WINOF.
                   3387:  *  2.  Make sure the register windows will not underflow.  This is
                   3388:  *     much easier in kernel mode....
                   3389:  */
                   3390: return_from_trap:
                   3391: !      wr      %l0, 0, %psr            ! disable traps so we can rett
                   3392: ! (someone else did this already)
                   3393:        and     %l0, 31, %l5
                   3394:        set     wmask, %l6
                   3395:        ldub    [%l6 + %l5], %l5        ! %l5 = 1 << ((CWP + 1) % nwindows)
                   3396:        btst    PSR_PS, %l0             ! returning to userland?
                   3397:        bnz     rft_kernel              ! no, go return to kernel
                   3398:         rd     %wim, %l4               ! (read %wim in any case)
                   3399:
                   3400: rft_user_or_recover_pcb_windows:
                   3401:        /*
                   3402:         * (entered with %l4=%wim, %l5=wmask[cwp]; %l0..%l2 as usual)
                   3403:         *
                   3404:         * check cpcb->pcb_nsaved:
                   3405:         * if 0, do a `normal' return to user (see rft_user);
                   3406:         * if > 0, cpcb->pcb_rw[] holds registers to be copied to stack;
                   3407:         * if -1, cpcb->pcb_rw[0] holds user registers for rett window
                   3408:         * from an earlier T_RWRET pseudo-trap.
                   3409:         */
1.111     pk       3410:        sethi   %hi(cpcb), %l6
                   3411:        ld      [%l6 + %lo(cpcb)], %l6
1.1       deraadt  3412:        ld      [%l6 + PCB_NSAVED], %l7
                   3413:        tst     %l7
                   3414:        bz,a    rft_user
1.179     pk       3415:         sethi  %hi(_WANT_AST), %l7     ! first instr of rft_user
1.1       deraadt  3416:
                   3417:        bg,a    softtrap                ! if (pcb_nsaved > 0)
                   3418:         mov    T_WINOF, %o0            !       trap(T_WINOF);
                   3419:
                   3420:        /*
                   3421:         * To get here, we must have tried to return from a previous
                   3422:         * trap and discovered that it would cause a window underflow.
                   3423:         * We then must have tried to pull the registers out of the
                   3424:         * user stack (from the address in %fp==%i6) and discovered
                   3425:         * that it was either unaligned or not loaded in memory, and
                   3426:         * therefore we ran a trap(T_RWRET), which loaded one set of
                   3427:         * registers into cpcb->pcb_pcb_rw[0] (if it had killed the
                   3428:         * process due to a bad stack, we would not be here).
                   3429:         *
                   3430:         * We want to load pcb_rw[0] into the previous window, which
                   3431:         * we know is currently invalid.  In other words, we want
                   3432:         * %wim to be 1 << ((cwp + 2) % nwindows).
                   3433:         */
                   3434:        wr      %g0, 0, %wim            ! enable restores
                   3435:        mov     %g6, %l3                ! save g6 in l3
                   3436:        mov     %l6, %g6                ! set g6 = &u
                   3437:        st      %g0, [%g6 + PCB_NSAVED] ! clear cpcb->pcb_nsaved
                   3438:        restore                         ! enter window I
                   3439:        restore %g0, 1, %l1             ! enter window X, then %l1 = 1
                   3440:        rd      %psr, %l0
                   3441:        sll     %l1, %l0, %l1           ! %wim = 1 << CWP;
                   3442:        wr      %l1, 0, %wim
                   3443:        and     %l0, 31, %l0
                   3444:        st      %l0, [%g6 + PCB_WIM]    ! cpcb->pcb_wim = CWP;
                   3445:        nop                             ! unnecessary? old wim was 0...
                   3446:        save    %g0, %g0, %g0           ! back to window I
                   3447:        LOADWIN(%g6 + PCB_RW)
                   3448:        save    %g0, %g0, %g0           ! back to window T (trap window)
                   3449:        wr      %l0, 0, %psr            ! cond codes, cond codes everywhere
                   3450:        mov     %l3, %g6                ! restore g6
                   3451:        RETT
                   3452:
                   3453: ! exported end marker for kernel gdb
1.111     pk       3454:        .globl  _C_LABEL(endtrapcode)
                   3455: _C_LABEL(endtrapcode):
1.1       deraadt  3456:
                   3457: /*
                   3458:  * init_tables(nwin) int nwin;
                   3459:  *
                   3460:  * Set up the uwtab and wmask tables.
                   3461:  * We know nwin > 1.
                   3462:  */
                   3463: init_tables:
                   3464:        /*
                   3465:         * for (i = -nwin, j = nwin - 2; ++i < 0; j--)
                   3466:         *      uwtab[i] = j;
                   3467:         * (loop runs at least once)
                   3468:         */
                   3469:        set     uwtab, %o3
                   3470:        sub     %g0, %o0, %o1           ! i = -nwin + 1
                   3471:        inc     %o1
                   3472:        add     %o0, -2, %o2            ! j = nwin - 2;
                   3473: 0:
                   3474:        stb     %o2, [%o3 + %o1]        ! uwtab[i] = j;
                   3475: 1:
                   3476:        inccc   %o1                     ! ++i < 0?
                   3477:        bl      0b                      ! yes, continue loop
                   3478:         dec    %o2                     ! in any case, j--
                   3479:
                   3480:        /*
                   3481:         * (i now equals 0)
                   3482:         * for (j = nwin - 1; i < nwin; i++, j--)
                   3483:         *      uwtab[i] = j;
                   3484:         * (loop runs at least twice)
                   3485:         */
                   3486:        sub     %o0, 1, %o2             ! j = nwin - 1
                   3487: 0:
                   3488:        stb     %o2, [%o3 + %o1]        ! uwtab[i] = j
                   3489:        inc     %o1                     ! i++
                   3490: 1:
                   3491:        cmp     %o1, %o0                ! i < nwin?
                   3492:        bl      0b                      ! yes, continue
                   3493:         dec    %o2                     ! in any case, j--
                   3494:
                   3495:        /*
                   3496:         * We observe that, for i in 0..nwin-2, (i+1)%nwin == i+1;
                   3497:         * for i==nwin-1, (i+1)%nwin == 0.
                   3498:         * To avoid adding 1, we run i from 1 to nwin and set
                   3499:         * wmask[i-1].
                   3500:         *
                   3501:         * for (i = j = 1; i < nwin; i++) {
                   3502:         *      j <<= 1;        (j now == 1 << i)
                   3503:         *      wmask[i - 1] = j;
                   3504:         * }
                   3505:         * (loop runs at least once)
                   3506:         */
                   3507:        set     wmask - 1, %o3
                   3508:        mov     1, %o1                  ! i = 1;
                   3509:        mov     2, %o2                  ! j = 2;
                   3510: 0:
                   3511:        stb     %o2, [%o3 + %o1]        ! (wmask - 1)[i] = j;
                   3512:        inc     %o1                     ! i++
                   3513:        cmp     %o1, %o0                ! i < nwin?
                   3514:        bl,a    0b                      ! yes, continue
                   3515:         sll    %o2, 1, %o2             ! (and j <<= 1)
                   3516:
                   3517:        /*
                   3518:         * Now i==nwin, so we want wmask[i-1] = 1.
                   3519:         */
                   3520:        mov     1, %o2                  ! j = 1;
                   3521:        retl
                   3522:         stb    %o2, [%o3 + %o1]        ! (wmask - 1)[i] = j;
                   3523:
1.13      deraadt  3524:
1.1       deraadt  3525: dostart:
1.32      pk       3526:        /*
                   3527:         * Startup.
                   3528:         *
1.186     pk       3529:         * We may have been loaded in low RAM, at some address which
1.119     christos 3530:         * is page aligned (PROM_LOADADDR actually) rather than where we
                   3531:         * want to run (KERNBASE+PROM_LOADADDR).  Until we get everything set,
1.32      pk       3532:         * we have to be sure to use only pc-relative addressing.
                   3533:         */
                   3534:
1.27      pk       3535:        /*
1.186     pk       3536:         * Find out if the above is the case.
                   3537:         */
                   3538: 0:     call    1f
                   3539:         sethi  %hi(0b), %l0            ! %l0 = virtual address of 0:
                   3540: 1:     or      %l0, %lo(0b), %l0
                   3541:        sub     %l0, %o7, %l7           ! subtract actual physical address of 0:
                   3542:
                   3543:        /*
                   3544:         * If we're already running at our desired virtual load address,
                   3545:         * %l7 will be set to 0, otherwise it will be KERNBASE.
                   3546:         * From now on until the end of locore bootstrap code, %l7 will
                   3547:         * be used to relocate memory references.
                   3548:         */
                   3549: #define RELOCATE(l,r)          \
                   3550:        set     l, r;           \
                   3551:        sub     r, %l7, r
                   3552:
                   3553:        /*
                   3554:         * We use the bootinfo method to pass arguments, and the new
1.153     pk       3555:         * magic number indicates that. A pointer to the kernel top, i.e.
                   3556:         * the first address after the load kernel image (including DDB
                   3557:         * symbols, if any) is passed in %o4[0] and the bootinfo structure
                   3558:         * is passed in %o4[1].
                   3559:         *
                   3560:         * A magic number is passed in %o5 to allow for bootloaders
                   3561:         * that know nothing about the bootinfo structure or previous
                   3562:         * DDB symbol loading conventions.
1.117     christos 3563:         *
                   3564:         * For compatibility with older versions, we check for DDB arguments
1.153     pk       3565:         * if the older magic number is there. The loader passes `kernel_top'
                   3566:         * (previously known as `esym') in %o4.
                   3567:         *
1.40      pk       3568:         * Note: we don't touch %o1-%o3; SunOS bootloaders seem to use them
                   3569:         * for their own mirky business.
1.73      pk       3570:         *
1.153     pk       3571:         * Pre-NetBSD 1.3 bootblocks had KERNBASE compiled in, and used it
                   3572:         * to compute the value of `kernel_top' (previously known as `esym').
                   3573:         * In order to successfully boot a kernel built with a different value
                   3574:         * for KERNBASE using old bootblocks, we fixup `kernel_top' here by
                   3575:         * the difference between KERNBASE and the old value (known to be
                   3576:         * 0xf8000000) compiled into pre-1.3 bootblocks.
1.27      pk       3577:         */
1.117     christos 3578:
                   3579:        set     0x44444232, %l3         ! bootinfo magic
                   3580:        cmp     %o5, %l3
                   3581:        bne     1f
1.118     pk       3582:         nop
                   3583:
                   3584:        /* The loader has passed to us a `bootinfo' structure */
1.153     pk       3585:        ld      [%o4], %l3              ! 1st word is kernel_top
1.186     pk       3586:        add     %l3, %l7, %o5           ! relocate: + KERNBASE
                   3587:        RELOCATE(_C_LABEL(kernel_top),%l3)
                   3588:        st      %o5, [%l3]              ! and store it
1.120     pk       3589:
                   3590:        ld      [%o4 + 4], %l3          ! 2nd word is bootinfo
1.186     pk       3591:        add     %l3, %l7, %o5           ! relocate
                   3592:        RELOCATE(_C_LABEL(bootinfo),%l3)
                   3593:        st      %o5, [%l3]              ! store bootinfo
1.153     pk       3594:        b,a     4f
1.117     christos 3595:
1.118     pk       3596: 1:
1.153     pk       3597: #ifdef DDB
1.120     pk       3598:        /* Check for old-style DDB loader magic */
1.186     pk       3599:        set     KERNBASE, %l4
1.153     pk       3600:        set     0x44444231, %l3         ! Is it DDB_MAGIC1?
1.117     christos 3601:        cmp     %o5, %l3
1.118     pk       3602:        be,a    2f
                   3603:         clr    %l4                     ! if DDB_MAGIC1, clear %l4
1.115     christos 3604:
1.153     pk       3605:        set     0x44444230, %l3         ! Is it DDB_MAGIC0?
                   3606:        cmp     %o5, %l3                ! if so, need to relocate %o4
1.154     thorpej  3607:        bne     3f                      /* if not, there's no bootloader info */
1.73      pk       3608:
1.118     pk       3609:                                        ! note: %l4 set to KERNBASE above.
1.73      pk       3610:        set     0xf8000000, %l5         ! compute correction term:
                   3611:        sub     %l5, %l4, %l4           !  old KERNBASE (0xf8000000 ) - KERNBASE
                   3612:
1.117     christos 3613: 2:
1.40      pk       3614:        tst     %o4                     ! do we have the symbols?
1.117     christos 3615:        bz      3f
1.73      pk       3616:         sub    %o4, %l4, %o4           ! apply compat correction
1.153     pk       3617:        sethi   %hi(_C_LABEL(kernel_top) - KERNBASE), %l3 ! and store it
                   3618:        st      %o4, [%l3 + %lo(_C_LABEL(kernel_top) - KERNBASE)]
                   3619:        b,a     4f
1.117     christos 3620: 3:
1.27      pk       3621: #endif
1.13      deraadt  3622:        /*
1.153     pk       3623:         * The boot loader did not pass in a value for `kernel_top';
                   3624:         * let it default to `end'.
                   3625:         */
                   3626:        set     end, %o4
1.186     pk       3627:        RELOCATE(_C_LABEL(kernel_top),%l3)
                   3628:        st      %o4, [%l3]      ! store kernel_top
1.153     pk       3629:
                   3630: 4:
                   3631:
                   3632:        /*
1.13      deraadt  3633:         * Sun4 passes in the `load address'.  Although possible, its highly
                   3634:         * unlikely that OpenBoot would place the prom vector there.
                   3635:         */
1.119     christos 3636:        set     PROM_LOADADDR, %g7
1.17      pk       3637:        cmp     %o0, %g7
1.50      pk       3638:        be      is_sun4
1.14      deraadt  3639:         nop
                   3640:
1.158     thorpej  3641: #if defined(SUN4C) || defined(SUN4M) || defined(SUN4D)
1.144     uwe      3642:        /*
                   3643:         * Be prepared to get OF client entry in either %o0 or %o3.
1.158     thorpej  3644:         * XXX Will this ever trip on sun4d?  Let's hope not!
1.144     uwe      3645:         */
                   3646:        cmp     %o0, 0
                   3647:        be      is_openfirm
                   3648:         nop
                   3649:
                   3650:        mov     %o0, %g7                ! save romp passed by boot code
1.9       deraadt  3651:
1.109     pk       3652:        /* First, check `romp->pv_magic' */
                   3653:        ld      [%g7 + PV_MAGIC], %o0   ! v = pv->pv_magic
                   3654:        set     OBP_MAGIC, %o1
                   3655:        cmp     %o0, %o1                ! if ( v != OBP_MAGIC) {
1.144     uwe      3656:        bne     is_sun4m                !    assume this is an OPENFIRM machine
1.109     pk       3657:         nop                            ! }
                   3658:
1.13      deraadt  3659:        /*
1.158     thorpej  3660:         * are we on a sun4c or a sun4m or a sun4d?
1.13      deraadt  3661:         */
1.28      deraadt  3662:        ld      [%g7 + PV_NODEOPS], %o4 ! node = pv->pv_nodeops->no_nextnode(0)
                   3663:        ld      [%o4 + NO_NEXTNODE], %o4
1.18      deraadt  3664:        call    %o4
                   3665:         mov    0, %o0                  ! node
1.37      pk       3666:
1.186     pk       3667:        !mov    %o0, %l0
                   3668:        RELOCATE(cputypvar,%o1)         ! name = "compatible"
                   3669:        RELOCATE(cputypval,%l2)         ! buffer ptr (assume buffer long enough)
1.28      deraadt  3670:        ld      [%g7 + PV_NODEOPS], %o4 ! (void)pv->pv_nodeops->no_getprop(...)
                   3671:        ld      [%o4 + NO_GETPROP], %o4
1.18      deraadt  3672:        call     %o4
1.186     pk       3673:         mov    %l2, %o2
                   3674:        !set    cputypval-KERNBASE, %o2 ! buffer ptr
                   3675:        ldub    [%l2 + 4], %o0          ! which is it... "sun4c", "sun4m", "sun4d"?
1.18      deraadt  3676:        cmp     %o0, 'c'
1.50      pk       3677:        be      is_sun4c
1.13      deraadt  3678:         nop
1.18      deraadt  3679:        cmp     %o0, 'm'
1.50      pk       3680:        be      is_sun4m
1.18      deraadt  3681:         nop
1.158     thorpej  3682:        cmp     %o0, 'd'
                   3683:        be      is_sun4d
                   3684:         nop
                   3685: #endif /* SUN4C || SUN4M || SUN4D */
1.18      deraadt  3686:
1.158     thorpej  3687:        /*
                   3688:         * Don't know what type of machine this is; just halt back
                   3689:         * out to the PROM.
                   3690:         */
1.28      deraadt  3691:        ld      [%g7 + PV_HALT], %o1    ! by this kernel, then halt
1.18      deraadt  3692:        call    %o1
                   3693:         nop
                   3694:
1.109     pk       3695: is_openfirm:
1.144     uwe      3696:        ! OF client entry in %o3 (kernel booted directly by PROM?)
                   3697:        mov     %o3, %g7
1.109     pk       3698:        /* FALLTHROUGH to sun4m case */
                   3699:
1.18      deraadt  3700: is_sun4m:
1.13      deraadt  3701: #if defined(SUN4M)
1.52      pk       3702:        set     trapbase_sun4m, %g6
1.13      deraadt  3703:        mov     SUN4CM_PGSHIFT, %g5
                   3704:        b       start_havetype
                   3705:         mov    CPU_SUN4M, %g4
                   3706: #else
1.186     pk       3707:        RELOCATE(sun4m_notsup,%o0)
1.28      deraadt  3708:        ld      [%g7 + PV_EVAL], %o1
1.9       deraadt  3709:        call    %o1                     ! print a message saying that the
                   3710:         nop                            ! sun4m architecture is not supported
1.158     thorpej  3711:        ld      [%g7 + PV_HALT], %o1    ! by this kernel, then halt
                   3712:        call    %o1
                   3713:         nop
                   3714:        /*NOTREACHED*/
                   3715: #endif
                   3716: is_sun4d:
                   3717: #if defined(SUN4D)
1.159     thorpej  3718:        set     trapbase_sun4m, %g6     /* XXXJRT trapbase_sun4d */
1.158     thorpej  3719:        mov     SUN4CM_PGSHIFT, %g5
                   3720:        b       start_havetype
                   3721:         mov    CPU_SUN4D, %g4
                   3722: #else
1.186     pk       3723:        RELOCATE(sun4d_notsup,%o0)
1.158     thorpej  3724:        ld      [%g7 + PV_EVAL], %o1
                   3725:        call    %o1                     ! print a message saying that the
                   3726:         nop                            ! sun4d architecture is not supported
1.28      deraadt  3727:        ld      [%g7 + PV_HALT], %o1    ! by this kernel, then halt
1.9       deraadt  3728:        call    %o1
                   3729:         nop
1.13      deraadt  3730:        /*NOTREACHED*/
                   3731: #endif
                   3732: is_sun4c:
                   3733: #if defined(SUN4C)
1.52      pk       3734:        set     trapbase_sun4c, %g6
1.13      deraadt  3735:        mov     SUN4CM_PGSHIFT, %g5
                   3736:
                   3737:        set     AC_CONTEXT, %g1         ! paranoia: set context to kernel
                   3738:        stba    %g0, [%g1] ASI_CONTROL
                   3739:
                   3740:        b       start_havetype
                   3741:         mov    CPU_SUN4C, %g4          ! XXX CPU_SUN4
1.9       deraadt  3742: #else
1.186     pk       3743:        RELOCATE(sun4c_notsup,%o0)
1.28      deraadt  3744:
                   3745:        ld      [%g7 + PV_ROMVEC_VERS], %o1
                   3746:        cmp     %o1, 0
                   3747:        bne     1f
                   3748:         nop
                   3749:
                   3750:        ! stupid version 0 rom interface is pv_eval(int length, char *string)
                   3751:        mov     %o0, %o1
                   3752: 2:     ldub    [%o0], %o4
1.186     pk       3753:        tst     %o4
1.28      deraadt  3754:        bne     2b
                   3755:         inc    %o0
                   3756:        dec     %o0
                   3757:        sub     %o0, %o1, %o0
                   3758:
                   3759: 1:     ld      [%g7 + PV_EVAL], %o2
                   3760:        call    %o2                     ! print a message saying that the
1.9       deraadt  3761:         nop                            ! sun4c architecture is not supported
1.28      deraadt  3762:        ld      [%g7 + PV_HALT], %o1    ! by this kernel, then halt
1.9       deraadt  3763:        call    %o1
                   3764:         nop
1.13      deraadt  3765:        /*NOTREACHED*/
1.9       deraadt  3766: #endif
1.13      deraadt  3767: is_sun4:
                   3768: #if defined(SUN4)
1.52      pk       3769:        set     trapbase_sun4, %g6
1.13      deraadt  3770:        mov     SUN4_PGSHIFT, %g5
1.1       deraadt  3771:
1.13      deraadt  3772:        set     AC_CONTEXT, %g1         ! paranoia: set context to kernel
                   3773:        stba    %g0, [%g1] ASI_CONTROL
                   3774:
                   3775:        b       start_havetype
1.14      deraadt  3776:         mov    CPU_SUN4, %g4
1.13      deraadt  3777: #else
1.14      deraadt  3778:        set     PROM_BASE, %g7
                   3779:
1.186     pk       3780:        RELOCATE(sun4_notsup,%o0)
1.28      deraadt  3781:        ld      [%g7 + OLDMON_PRINTF], %o1
1.13      deraadt  3782:        call    %o1                     ! print a message saying that the
                   3783:         nop                            ! sun4 architecture is not supported
1.28      deraadt  3784:        ld      [%g7 + OLDMON_HALT], %o1 ! by this kernel, then halt
1.13      deraadt  3785:        call    %o1
                   3786:         nop
                   3787:        /*NOTREACHED*/
                   3788: #endif
                   3789:
                   3790: start_havetype:
1.186     pk       3791:        cmp     %l7, 0
                   3792:        be      startmap_done
                   3793:
1.1       deraadt  3794:        /*
                   3795:         * Step 1: double map low RAM (addresses [0.._end-start-1])
                   3796:         * to KERNBASE (addresses [KERNBASE.._end-1]).  None of these
                   3797:         * are `bad' aliases (since they are all on segment boundaries)
                   3798:         * so we do not have to worry about cache aliasing.
                   3799:         *
                   3800:         * We map in another couple of segments just to have some
                   3801:         * more memory (512K, actually) guaranteed available for
                   3802:         * bootstrap code (pmap_bootstrap needs memory to hold MMU
1.39      pk       3803:         * and context data structures). Note: this is only relevant
                   3804:         * for 2-level MMU sun4/sun4c machines.
1.1       deraadt  3805:         */
                   3806:        clr     %l0                     ! lowva
                   3807:        set     KERNBASE, %l1           ! highva
1.153     pk       3808:
                   3809:        sethi   %hi(_C_LABEL(kernel_top) - KERNBASE), %o0
                   3810:        ld      [%o0 + %lo(_C_LABEL(kernel_top) - KERNBASE)], %o1
                   3811:        set     (2 << 18), %o2          ! add slack for sun4c MMU
                   3812:        add     %o1, %o2, %l2           ! last va that must be remapped
                   3813:
1.13      deraadt  3814:        /*
                   3815:         * Need different initial mapping functions for different
                   3816:         * types of machines.
                   3817:         */
                   3818: #if defined(SUN4C)
                   3819:        cmp     %g4, CPU_SUN4C
1.9       deraadt  3820:        bne     1f
1.14      deraadt  3821:         set    1 << 18, %l3            ! segment size in bytes
1.1       deraadt  3822: 0:
                   3823:        lduba   [%l0] ASI_SEGMAP, %l4   ! segmap[highva] = segmap[lowva];
                   3824:        stba    %l4, [%l1] ASI_SEGMAP
                   3825:        add     %l3, %l1, %l1           ! highva += segsiz;
                   3826:        cmp     %l1, %l2                ! done?
1.34      pk       3827:        blu     0b                      ! no, loop
1.1       deraadt  3828:         add    %l3, %l0, %l0           ! (and lowva += segsz)
1.135     pk       3829:        b,a     startmap_done
1.52      pk       3830: 1:
1.13      deraadt  3831: #endif /* SUN4C */
1.135     pk       3832:
1.13      deraadt  3833: #if defined(SUN4)
                   3834:        cmp     %g4, CPU_SUN4
                   3835:        bne     2f
1.114     pk       3836: #if defined(SUN4_MMU3L)
1.34      pk       3837:        set     AC_IDPROM+1, %l3
                   3838:        lduba   [%l3] ASI_CONTROL, %l3
                   3839:        cmp     %l3, 0x24 ! XXX - SUN4_400
                   3840:        bne     no_3mmu
1.133     pk       3841:         nop
1.135     pk       3842:
                   3843:        /*
                   3844:         * Three-level sun4 MMU.
                   3845:         * Double-map by duplicating a single region entry (which covers
                   3846:         * 16MB) corresponding to the kernel's virtual load address.
                   3847:         */
1.34      pk       3848:        add     %l0, 2, %l0             ! get to proper half-word in RG space
                   3849:        add     %l1, 2, %l1
                   3850:        lduha   [%l0] ASI_REGMAP, %l4   ! regmap[highva] = regmap[lowva];
                   3851:        stha    %l4, [%l1] ASI_REGMAP
1.135     pk       3852:        b,a     startmap_done
1.34      pk       3853: no_3mmu:
                   3854: #endif
1.135     pk       3855:
                   3856:        /*
                   3857:         * Three-level sun4 MMU.
                   3858:         * Double-map by duplicating the required number of segment
                   3859:         * entries corresponding to the kernel's virtual load address.
                   3860:         */
                   3861:        set     1 << 18, %l3            ! segment size in bytes
1.13      deraadt  3862: 0:
                   3863:        lduha   [%l0] ASI_SEGMAP, %l4   ! segmap[highva] = segmap[lowva];
                   3864:        stha    %l4, [%l1] ASI_SEGMAP
                   3865:        add     %l3, %l1, %l1           ! highva += segsiz;
                   3866:        cmp     %l1, %l2                ! done?
1.34      pk       3867:        blu     0b                      ! no, loop
1.13      deraadt  3868:         add    %l3, %l0, %l0           ! (and lowva += segsz)
1.37      pk       3869:        b,a     startmap_done
1.52      pk       3870: 2:
1.13      deraadt  3871: #endif /* SUN4 */
1.135     pk       3872:
1.159     thorpej  3873: #if defined(SUN4M) || defined(SUN4D)
                   3874:        cmp     %g4, CPU_SUN4M
                   3875:        beq     3f
                   3876:         nop
                   3877:        cmp     %g4, CPU_SUN4D
1.164     pk       3878:        bne     4f
1.13      deraadt  3879:
1.159     thorpej  3880: 3:
1.37      pk       3881:        /*
1.38      pk       3882:         * The OBP guarantees us a 16MB mapping using a level 1 PTE at
1.135     pk       3883:         * the start of the memory bank in which we were loaded. All we
                   3884:         * have to do is copy the entry.
                   3885:         * Also, we must check to see if we have a TI Viking in non-mbus mode,
                   3886:         * and if so do appropriate flipping and turning off traps before
1.38      pk       3887:         * we dork with MMU passthrough.  -grrr
1.37      pk       3888:         */
                   3889:
1.38      pk       3890:        sethi   %hi(0x40000000), %o1    ! TI version bit
                   3891:        rd      %psr, %o0
                   3892:        andcc   %o0, %o1, %g0
                   3893:        be      remap_notvik            ! is non-TI normal MBUS module
                   3894:        lda     [%g0] ASI_SRMMU, %o0    ! load MMU
                   3895:        andcc   %o0, 0x800, %g0
                   3896:        bne     remap_notvik            ! It is a viking MBUS module
                   3897:        nop
                   3898:
                   3899:        /*
                   3900:         * Ok, we have a non-Mbus TI Viking, a MicroSparc.
                   3901:         * In this scenerio, in order to play with the MMU
                   3902:         * passthrough safely, we need turn off traps, flip
                   3903:         * the AC bit on in the mmu status register, do our
                   3904:         * passthroughs, then restore the mmu reg and %psr
                   3905:         */
                   3906:        rd      %psr, %o4               ! saved here till done
                   3907:        andn    %o4, 0x20, %o5
                   3908:        wr      %o5, 0x0, %psr
                   3909:        nop; nop; nop;
                   3910:        set     SRMMU_CXTPTR, %o0
                   3911:        lda     [%o0] ASI_SRMMU, %o0    ! get context table ptr
                   3912:        sll     %o0, 4, %o0             ! make physical
                   3913:        lda     [%g0] ASI_SRMMU, %o3    ! hold mmu-sreg here
                   3914:        /* 0x8000 is AC bit in Viking mmu-ctl reg */
                   3915:        set     0x8000, %o2
                   3916:        or      %o3, %o2, %o2
                   3917:        sta     %o2, [%g0] ASI_SRMMU    ! AC bit on
1.135     pk       3918:
1.38      pk       3919:        lda     [%o0] ASI_BYPASS, %o1
                   3920:        srl     %o1, 4, %o1
                   3921:        sll     %o1, 8, %o1             ! get phys addr of l1 entry
                   3922:        lda     [%o1] ASI_BYPASS, %l4
                   3923:        srl     %l1, 22, %o2            ! note: 22 == RGSHIFT - 2
                   3924:        add     %o1, %o2, %o1
                   3925:        sta     %l4, [%o1] ASI_BYPASS
1.135     pk       3926:
1.38      pk       3927:        sta     %o3, [%g0] ASI_SRMMU    ! restore mmu-sreg
                   3928:        wr      %o4, 0x0, %psr          ! restore psr
1.164     pk       3929:        b,a     startmap_done
1.38      pk       3930:
                   3931:        /*
                   3932:         * The following is generic and should work on all
                   3933:         * Mbus based SRMMU's.
                   3934:         */
                   3935: remap_notvik:
                   3936:        set     SRMMU_CXTPTR, %o0
                   3937:        lda     [%o0] ASI_SRMMU, %o0    ! get context table ptr
                   3938:        sll     %o0, 4, %o0             ! make physical
                   3939:        lda     [%o0] ASI_BYPASS, %o1
                   3940:        srl     %o1, 4, %o1
                   3941:        sll     %o1, 8, %o1             ! get phys addr of l1 entry
                   3942:        lda     [%o1] ASI_BYPASS, %l4
                   3943:        srl     %l1, 22, %o2            ! note: 22 == RGSHIFT - 2
                   3944:        add     %o1, %o2, %o1
                   3945:        sta     %l4, [%o1] ASI_BYPASS
1.52      pk       3946:        !b,a    startmap_done
1.163     pk       3947: 4:
1.159     thorpej  3948: #endif /* SUN4M || SUN4D */
1.13      deraadt  3949:        ! botch! We should blow up.
                   3950:
                   3951: startmap_done:
1.1       deraadt  3952:        /*
                   3953:         * All set, fix pc and npc.  Once we are where we should be,
                   3954:         * we can give ourselves a stack and enable traps.
                   3955:         */
1.9       deraadt  3956:        set     1f, %g1
                   3957:        jmp     %g1
1.1       deraadt  3958:         nop
                   3959: 1:
1.197     wiz      3960:        sethi   %hi(_C_LABEL(cputyp)), %o0      ! what type of CPU we are on
1.111     pk       3961:        st      %g4, [%o0 + %lo(_C_LABEL(cputyp))]
1.9       deraadt  3962:
1.111     pk       3963:        sethi   %hi(_C_LABEL(pgshift)), %o0     ! pgshift = log2(nbpg)
                   3964:        st      %g5, [%o0 + %lo(_C_LABEL(pgshift))]
1.13      deraadt  3965:
                   3966:        mov     1, %o0                  ! nbpg = 1 << pgshift
                   3967:        sll     %o0, %g5, %g5
1.111     pk       3968:        sethi   %hi(_C_LABEL(nbpg)), %o0        ! nbpg = bytes in a page
                   3969:        st      %g5, [%o0 + %lo(_C_LABEL(nbpg))]
1.13      deraadt  3970:
                   3971:        sub     %g5, 1, %g5
1.111     pk       3972:        sethi   %hi(_C_LABEL(pgofset)), %o0 ! page offset = bytes in a page - 1
                   3973:        st      %g5, [%o0 + %lo(_C_LABEL(pgofset))]
1.13      deraadt  3974:
1.9       deraadt  3975:        rd      %psr, %g3               ! paranoia: make sure ...
                   3976:        andn    %g3, PSR_ET, %g3        ! we have traps off
                   3977:        wr      %g3, 0, %psr            ! so that we can fiddle safely
                   3978:        nop; nop; nop
                   3979:
                   3980:        wr      %g0, 0, %wim            ! make sure we can set psr
                   3981:        nop; nop; nop
                   3982:        wr      %g0, PSR_S|PSR_PS|PSR_PIL, %psr ! set initial psr
                   3983:         nop; nop; nop
                   3984:
                   3985:        wr      %g0, 2, %wim            ! set initial %wim (w1 invalid)
                   3986:        mov     1, %g1                  ! set pcb_wim (log2(%wim) = 1)
1.111     pk       3987:        sethi   %hi(_C_LABEL(u0) + PCB_WIM), %g2
                   3988:        st      %g1, [%g2 + %lo(_C_LABEL(u0) + PCB_WIM)]
1.9       deraadt  3989:
1.1       deraadt  3990:        set     USRSTACK - CCFSZ, %fp   ! as if called from user code
                   3991:        set     estack0 - CCFSZ - 80, %sp ! via syscall(boot_me_up) or somesuch
                   3992:        rd      %psr, %l0
                   3993:        wr      %l0, PSR_ET, %psr
1.9       deraadt  3994:        nop; nop; nop
1.1       deraadt  3995:
1.52      pk       3996:        /* Export actual trapbase */
1.111     pk       3997:        sethi   %hi(_C_LABEL(trapbase)), %o0
                   3998:        st      %g6, [%o0+%lo(_C_LABEL(trapbase))]
1.52      pk       3999:
1.117     christos 4000: #ifdef notdef
1.1       deraadt  4001:        /*
                   4002:         * Step 2: clear BSS.  This may just be paranoia; the boot
                   4003:         * loader might already do it for us; but what the hell.
                   4004:         */
                   4005:        set     _edata, %o0             ! bzero(edata, end - edata)
                   4006:        set     _end, %o1
1.111     pk       4007:        call    _C_LABEL(bzero)
1.1       deraadt  4008:         sub    %o1, %o0, %o1
1.117     christos 4009: #endif
1.1       deraadt  4010:
                   4011:        /*
                   4012:         * Stash prom vectors now, after bzero, as it lives in bss
                   4013:         * (which we just zeroed).
                   4014:         * This depends on the fact that bzero does not use %g7.
                   4015:         */
1.111     pk       4016:        sethi   %hi(_C_LABEL(romp)), %l0
                   4017:        st      %g7, [%l0 + %lo(_C_LABEL(romp))]
1.1       deraadt  4018:
                   4019:        /*
                   4020:         * Step 3: compute number of windows and set up tables.
                   4021:         * We could do some of this later.
                   4022:         */
                   4023:        save    %sp, -64, %sp
                   4024:        rd      %psr, %g1
                   4025:        restore
                   4026:        and     %g1, 31, %g1            ! want just the CWP bits
                   4027:        add     %g1, 1, %o0             ! compute nwindows
1.111     pk       4028:        sethi   %hi(_C_LABEL(nwindows)), %o1    ! may as well tell everyone
1.1       deraadt  4029:        call    init_tables
1.111     pk       4030:         st     %o0, [%o1 + %lo(_C_LABEL(nwindows))]
1.1       deraadt  4031:
1.148     pk       4032: #if defined(SUN4) || defined(SUN4C)
1.29      deraadt  4033:        /*
1.148     pk       4034:         * Some sun4/sun4c models have fewer than 8 windows. For extra
1.29      deraadt  4035:         * speed, we do not need to save/restore those windows
1.196     pk       4036:         * The save/restore code has 6 "save"'s followed by 6
1.29      deraadt  4037:         * "restore"'s -- we "nop" out the last "save" and first
                   4038:         * "restore"
                   4039:         */
                   4040:        cmp     %o0, 8
1.50      pk       4041:        be      1f
1.29      deraadt  4042: noplab:         nop
1.148     pk       4043:        sethi   %hi(noplab), %l0
                   4044:        ld      [%l0 + %lo(noplab)], %l1
1.29      deraadt  4045:        set     wb1, %l0
1.173     pk       4046:        st      %l1, [%l0 + 5*4]
                   4047:        st      %l1, [%l0 + 6*4]
1.29      deraadt  4048: 1:
                   4049: #endif
                   4050:
1.159     thorpej  4051: #if (defined(SUN4) || defined(SUN4C)) && (defined(SUN4M) || defined(SUN4D))
1.62      pk       4052:
                   4053:        /*
                   4054:         * Patch instructions at specified labels that start
                   4055:         * per-architecture code-paths.
                   4056:         */
                   4057: Lgandul:       nop
                   4058:
                   4059: #define MUNGE(label) \
                   4060:        sethi   %hi(label), %o0; \
                   4061:        st      %l0, [%o0 + %lo(label)]
                   4062:
                   4063:        sethi   %hi(Lgandul), %o0
                   4064:        ld      [%o0 + %lo(Lgandul)], %l0       ! %l0 = NOP
                   4065:
                   4066:        cmp     %g4, CPU_SUN4M
1.159     thorpej  4067:        beq,a   2f
                   4068:         nop
                   4069:
                   4070:        cmp     %g4, CPU_SUN4D
1.62      pk       4071:        bne,a   1f
                   4072:         nop
                   4073:
1.159     thorpej  4074: 2:     ! this should be automated!
1.62      pk       4075:        MUNGE(NOP_ON_4M_1)
                   4076:        MUNGE(NOP_ON_4M_2)
                   4077:        MUNGE(NOP_ON_4M_3)
                   4078:        MUNGE(NOP_ON_4M_4)
                   4079:        MUNGE(NOP_ON_4M_5)
                   4080:        MUNGE(NOP_ON_4M_6)
                   4081:        MUNGE(NOP_ON_4M_7)
                   4082:        MUNGE(NOP_ON_4M_8)
                   4083:        MUNGE(NOP_ON_4M_9)
                   4084:        MUNGE(NOP_ON_4M_10)
                   4085:        MUNGE(NOP_ON_4M_11)
                   4086:        MUNGE(NOP_ON_4M_12)
1.152     pk       4087:        MUNGE(NOP_ON_4M_15)
1.62      pk       4088:        b,a     2f
                   4089:
                   4090: 1:
1.68      mycroft  4091:        MUNGE(NOP_ON_4_4C_1)
1.62      pk       4092:
                   4093: 2:
                   4094:
                   4095: #undef MUNGE
                   4096: #endif
                   4097:
1.1       deraadt  4098:        /*
                   4099:         * Step 4: change the trap base register, now that our trap handlers
                   4100:         * will function (they need the tables we just set up).
1.195     pk       4101:         * This depends on the fact that memset does not use %g6.
1.1       deraadt  4102:         */
1.52      pk       4103:        wr      %g6, 0, %tbr
1.9       deraadt  4104:        nop; nop; nop                   ! paranoia
1.37      pk       4105:
1.195     pk       4106:        /* Clear `cpuinfo': memset(&cpuinfo, 0, sizeof cpuinfo) */
                   4107:        sethi   %hi(CPUINFO_VA), %o0
                   4108:        set     CPUINFO_STRUCTSIZE, %o2
1.192     jdolecek 4109:        call    _C_LABEL(memset)
1.194     martin   4110:         clr    %o1
1.98      pk       4111:
1.131     thorpej  4112:        /*
                   4113:         * Initialize `cpuinfo' fields which are needed early.  Note
                   4114:         * we make the cpuinfo self-reference at the local VA for now.
                   4115:         * It may be changed to reference a global VA later.
                   4116:         */
1.111     pk       4117:        set     _C_LABEL(u0), %o0               ! cpuinfo.curpcb = u0;
                   4118:        sethi   %hi(cpcb), %l0
                   4119:        st      %o0, [%l0 + %lo(cpcb)]
1.98      pk       4120:
1.132     pk       4121:        sethi   %hi(CPUINFO_VA), %o0            ! cpuinfo.ci_self = &cpuinfo;
1.131     thorpej  4122:        sethi   %hi(_CISELFP), %l0
                   4123:        st      %o0, [%l0 + %lo(_CISELFP)]
                   4124:
1.111     pk       4125:        set     _C_LABEL(eintstack), %o0        ! cpuinfo.eintstack= _eintstack;
1.101     pk       4126:        sethi   %hi(_EINTSTACKP), %l0
                   4127:        st      %o0, [%l0 + %lo(_EINTSTACKP)]
1.1       deraadt  4128:
                   4129:        /*
1.11      deraadt  4130:         * Ready to run C code; finish bootstrap.
1.1       deraadt  4131:         */
1.111     pk       4132:        call    _C_LABEL(bootstrap)
1.1       deraadt  4133:         nop
1.11      deraadt  4134:
                   4135:        /*
                   4136:         * Call main.  This returns to us after loading /sbin/init into
                   4137:         * user space.  (If the exec fails, main() does not return.)
                   4138:         */
1.111     pk       4139:        call    _C_LABEL(main)
1.11      deraadt  4140:         clr    %o0                     ! our frame arg is ignored
1.89      pk       4141:        /*NOTREACHED*/
1.164     pk       4142:
1.198   ! pk       4143: /*
        !          4144:  * Openfirmware entry point: openfirmware(void *args)
        !          4145:  */
        !          4146: ENTRY(openfirmware)
        !          4147:        sethi   %hi(_C_LABEL(romp)), %o1
        !          4148:        ld      [%o1 + %lo(_C_LABEL(romp))], %o2
        !          4149:        jmp     %o2
        !          4150:         nop
1.165     pk       4151:
                   4152: #if defined(SUN4M) || defined(SUN4D)
                   4153: /*
                   4154:  * V8 multiply and divide routines, to be copied over the code
                   4155:  * for the V6/V7 routines.  Seems a shame to spend the call, but....
                   4156:  * Note: while .umul and .smul return a 64-bit result in %o1%o0,
                   4157:  * gcc only really cares about the low 32 bits in %o0.  This is
                   4158:  * really just gcc output, cleaned up a bit.
                   4159:  */
1.164     pk       4160:        .globl  _C_LABEL(sparc_v8_muldiv)
                   4161: _C_LABEL(sparc_v8_muldiv):
                   4162:        save    %sp, -CCFSZ, %sp
                   4163:
                   4164: #define        OVERWRITE(rtn, v8_rtn, len)     \
                   4165:        set     v8_rtn, %o0;            \
                   4166:        set     rtn, %o1;               \
                   4167:        call    _C_LABEL(bcopy);        \
                   4168:         mov    len, %o2;               \
                   4169:        /* now flush the insn cache */  \
                   4170:        set     rtn, %o0;               \
                   4171:         mov    len, %o1;               \
                   4172: 0:                                     \
                   4173:        flush   %o0;                    \
                   4174:        subcc   %o1, 8, %o1;            \
                   4175:        bgu     0b;                     \
                   4176:         add    %o0, 8, %o0;            \
                   4177:
1.188     uwe      4178:        OVERWRITE(.mul,  v8_smul, .Lv8_smul_len)
                   4179:        OVERWRITE(.umul, v8_umul, .Lv8_umul_len)
                   4180:        OVERWRITE(.div,  v8_sdiv, .Lv8_sdiv_len)
                   4181:        OVERWRITE(.udiv, v8_udiv, .Lv8_udiv_len)
                   4182:        OVERWRITE(.rem,  v8_srem, .Lv8_srem_len)
                   4183:        OVERWRITE(.urem, v8_urem, .Lv8_urem_len)
1.164     pk       4184: #undef OVERWRITE
                   4185:        ret
                   4186:         restore
                   4187:
                   4188: v8_smul:
                   4189:        retl
                   4190:         smul   %o0, %o1, %o0
1.188     uwe      4191: .Lv8_smul_len = .-v8_smul
1.164     pk       4192: v8_umul:
                   4193:        retl
                   4194:         umul   %o0, %o1, %o0
                   4195: !v8_umul_len = 2 * 4
1.188     uwe      4196: .Lv8_umul_len = .-v8_umul
1.164     pk       4197: v8_sdiv:
                   4198:        sra     %o0, 31, %g2
                   4199:        wr      %g2, 0, %y
                   4200:        nop; nop; nop
                   4201:        retl
                   4202:         sdiv   %o0, %o1, %o0
1.188     uwe      4203: .Lv8_sdiv_len = .-v8_sdiv
1.164     pk       4204: v8_udiv:
                   4205:        wr      %g0, 0, %y
                   4206:        nop; nop; nop
                   4207:        retl
                   4208:         udiv   %o0, %o1, %o0
1.188     uwe      4209: .Lv8_udiv_len = .-v8_udiv
1.164     pk       4210: v8_srem:
                   4211:        sra     %o0, 31, %g3
                   4212:        wr      %g3, 0, %y
                   4213:        nop; nop; nop
                   4214:        sdiv    %o0, %o1, %g2
                   4215:        smul    %g2, %o1, %g2
                   4216:        retl
                   4217:         sub    %o0, %g2, %o0
1.188     uwe      4218: .Lv8_srem_len = .-v8_srem
1.164     pk       4219: v8_urem:
                   4220:        wr      %g0, 0, %y
                   4221:        nop; nop; nop
                   4222:        udiv    %o0, %o1, %g2
                   4223:        smul    %g2, %o1, %g2
                   4224:        retl
                   4225:         sub    %o0, %g2, %o0
1.188     uwe      4226: .Lv8_urem_len = .-v8_urem
1.164     pk       4227:
1.165     pk       4228: #endif /* SUN4M || SUN4D */
1.89      pk       4229:
1.145     mrg      4230: #if defined(MULTIPROCESSOR)
1.89      pk       4231:        /*
                   4232:         * Entry point for non-boot CPUs in MP systems.
                   4233:         */
1.111     pk       4234:        .globl  _C_LABEL(cpu_hatch)
                   4235: _C_LABEL(cpu_hatch):
1.89      pk       4236:        rd      %psr, %g3               ! paranoia: make sure ...
                   4237:        andn    %g3, PSR_ET, %g3        ! we have traps off
                   4238:        wr      %g3, 0, %psr            ! so that we can fiddle safely
                   4239:        nop; nop; nop
                   4240:
                   4241:        wr      %g0, 0, %wim            ! make sure we can set psr
                   4242:        nop; nop; nop
                   4243:        wr      %g0, PSR_S|PSR_PS|PSR_PIL, %psr ! set initial psr
                   4244:        nop; nop; nop
                   4245:
                   4246:        wr      %g0, 2, %wim            ! set initial %wim (w1 invalid)
                   4247:
                   4248:        /* Initialize Trap Base register */
1.111     pk       4249:        sethi   %hi(_C_LABEL(trapbase)), %o0
                   4250:        ld      [%o0+%lo(_C_LABEL(trapbase))], %g6
1.89      pk       4251:        wr      %g6, 0, %tbr
                   4252:        nop; nop; nop                   ! paranoia
                   4253:
                   4254:        /* Set up a stack */
                   4255:        set     USRSTACK - CCFSZ, %fp   ! as if called from user code
1.182     mrg      4256:        sethi   %hi(IDLE_UP), %o0
                   4257:        ld      [%o0 + %lo(IDLE_UP)], %o0
1.102     pk       4258:        set     USPACE - CCFSZ - 80, %sp
                   4259:        add     %sp, %o0, %sp
1.89      pk       4260:
                   4261:        /* Enable traps */
                   4262:        rd      %psr, %l0
                   4263:        wr      %l0, PSR_ET, %psr
1.182     mrg      4264:        nop; nop
1.89      pk       4265:
                   4266:        /* Call C code */
1.111     pk       4267:        call    _C_LABEL(cpu_setup)
1.182     mrg      4268:         nop                            ! 3rd from above
1.89      pk       4269:
1.170     pk       4270:        /* Enable interrupts */
                   4271:        rd      %psr, %l0
                   4272:        andn    %l0, PSR_PIL, %l0       ! psr &= ~PSR_PIL;
                   4273:        wr      %l0, 0, %psr            ! (void) spl0();
                   4274:        nop; nop; nop
                   4275:
1.145     mrg      4276:        /* Wait for go_smp_cpus to go */
                   4277:        set     _C_LABEL(go_smp_cpus), %l1
1.142     mrg      4278:        ld      [%l1], %l0
                   4279: 1:
1.145     mrg      4280:        cmp     %l0, %g0
1.142     mrg      4281:        be      1b
                   4282:         ld     [%l1], %l0
                   4283:
1.173     pk       4284:        mov     PSR_S|PSR_ET, %l1       ! oldpsr = PSR_S | PSR_ET;
                   4285:        sethi   %hi(_C_LABEL(sched_whichqs)), %l2
                   4286:        clr     %l4
                   4287:        sethi   %hi(cpcb), %l6
                   4288:        b       idle_enter
1.185     thorpej  4289:         sethi  %hi(curlwp), %l7
1.145     mrg      4290:
                   4291: #endif /* MULTIPROCESSOR */
1.1       deraadt  4292:
1.141     mrg      4293: #include "sigcode_state.s"
1.122     christos 4294:
1.111     pk       4295:        .globl  _C_LABEL(sigcode)
                   4296:        .globl  _C_LABEL(esigcode)
                   4297: _C_LABEL(sigcode):
1.1       deraadt  4298:
1.122     christos 4299:        SAVE_STATE
                   4300:
1.1       deraadt  4301:        ldd     [%fp + 64], %o0         ! sig, code
                   4302:        ld      [%fp + 76], %o3         ! arg3
                   4303:        call    %g1                     ! (*sa->sa_handler)(sig,code,scp,arg3)
                   4304:         add    %fp, 64 + 16, %o2       ! scp
                   4305:
1.122     christos 4306:        RESTORE_STATE
1.1       deraadt  4307:
1.92      pk       4308:        ! get registers back & set syscall #
1.189     pk       4309:        restore %g0, SYS_compat_16___sigreturn14, %g1
1.1       deraadt  4310:        add     %sp, 64 + 16, %o0       ! compute scp
                   4311:        t       ST_SYSCALL              ! sigreturn(scp)
                   4312:        ! sigreturn does not return unless it fails
                   4313:        mov     SYS_exit, %g1           ! exit(errno)
                   4314:        t       ST_SYSCALL
1.185     thorpej  4315:        /* NOTREACHED */
1.111     pk       4316: _C_LABEL(esigcode):
1.1       deraadt  4317:
                   4318: /*
                   4319:  * Primitives
1.52      pk       4320:  */
1.1       deraadt  4321:
1.63      pk       4322: /*
                   4323:  * General-purpose NULL routine.
                   4324:  */
                   4325: ENTRY(sparc_noop)
                   4326:        retl
                   4327:         nop
1.1       deraadt  4328:
                   4329: /*
1.24      deraadt  4330:  * getfp() - get stack frame pointer
                   4331:  */
                   4332: ENTRY(getfp)
                   4333:        retl
                   4334:         mov %fp, %o0
                   4335:
                   4336: /*
1.1       deraadt  4337:  * copyinstr(fromaddr, toaddr, maxlength, &lencopied)
                   4338:  *
                   4339:  * Copy a null terminated string from the user address space into
                   4340:  * the kernel address space.
                   4341:  */
                   4342: ENTRY(copyinstr)
                   4343:        ! %o0 = fromaddr, %o1 = toaddr, %o2 = maxlen, %o3 = &lencopied
1.126     chs      4344:        mov     %o1, %o5                ! save = toaddr;
                   4345:        tst     %o2                     ! maxlen == 0?
                   4346:        beq,a   Lcstoolong              ! yes, return ENAMETOOLONG
                   4347:         sethi  %hi(cpcb), %o4
                   4348:
1.1       deraadt  4349:        set     KERNBASE, %o4
                   4350:        cmp     %o0, %o4                ! fromaddr < KERNBASE?
1.126     chs      4351:        blu     Lcsdocopy               ! yes, go do it
                   4352:         sethi  %hi(cpcb), %o4          ! (first instr of copy)
1.1       deraadt  4353:
                   4354:        b       Lcsdone                 ! no, return EFAULT
                   4355:         mov    EFAULT, %o0
                   4356:
                   4357: /*
                   4358:  * copyoutstr(fromaddr, toaddr, maxlength, &lencopied)
                   4359:  *
                   4360:  * Copy a null terminated string from the kernel
                   4361:  * address space to the user address space.
                   4362:  */
                   4363: ENTRY(copyoutstr)
                   4364:        ! %o0 = fromaddr, %o1 = toaddr, %o2 = maxlen, %o3 = &lencopied
1.126     chs      4365:        mov     %o1, %o5                ! save = toaddr;
                   4366:        tst     %o2                     ! maxlen == 0?
                   4367:        beq,a   Lcstoolong              ! yes, return ENAMETOOLONG
                   4368:         sethi  %hi(cpcb), %o4
                   4369:
1.1       deraadt  4370:        set     KERNBASE, %o4
                   4371:        cmp     %o1, %o4                ! toaddr < KERNBASE?
1.126     chs      4372:        blu     Lcsdocopy               ! yes, go do it
1.111     pk       4373:         sethi  %hi(cpcb), %o4          ! (first instr of copy)
1.1       deraadt  4374:
                   4375:        b       Lcsdone                 ! no, return EFAULT
                   4376:         mov    EFAULT, %o0
                   4377:
                   4378: Lcsdocopy:
1.111     pk       4379: !      sethi   %hi(cpcb), %o4          ! (done earlier)
                   4380:        ld      [%o4 + %lo(cpcb)], %o4  ! catch faults
1.138     chs      4381:        set     Lcsdone, %g1
1.126     chs      4382:        st      %g1, [%o4 + PCB_ONFAULT]
1.1       deraadt  4383:
                   4384: ! XXX should do this in bigger chunks when possible
                   4385: 0:                                     ! loop:
                   4386:        ldsb    [%o0], %g1              !       c = *fromaddr;
                   4387:        tst     %g1
                   4388:        stb     %g1, [%o1]              !       *toaddr++ = c;
                   4389:        be      1f                      !       if (c == NULL)
                   4390:         inc    %o1                     !               goto ok;
                   4391:        deccc   %o2                     !       if (--len > 0) {
1.126     chs      4392:        bgu     0b                      !               fromaddr++;
1.1       deraadt  4393:         inc    %o0                     !               goto loop;
                   4394:                                        !       }
1.126     chs      4395: Lcstoolong:                            !
1.1       deraadt  4396:        b       Lcsdone                 !       error = ENAMETOOLONG;
                   4397:         mov    ENAMETOOLONG, %o0       !       goto done;
                   4398: 1:                                     ! ok:
                   4399:        clr     %o0                     !    error = 0;
                   4400: Lcsdone:                               ! done:
                   4401:        sub     %o1, %o5, %o1           !       len = to - save;
                   4402:        tst     %o3                     !       if (lencopied)
                   4403:        bnz,a   3f
                   4404:         st     %o1, [%o3]              !               *lencopied = len;
                   4405: 3:
                   4406:        retl                            ! cpcb->pcb_onfault = 0;
                   4407:         st     %g0, [%o4 + PCB_ONFAULT]! return (error);
                   4408:
                   4409: /*
                   4410:  * copystr(fromaddr, toaddr, maxlength, &lencopied)
                   4411:  *
                   4412:  * Copy a null terminated string from one point to another in
                   4413:  * the kernel address space.  (This is a leaf procedure, but
                   4414:  * it does not seem that way to the C compiler.)
                   4415:  */
                   4416: ENTRY(copystr)
                   4417:        mov     %o1, %o5                !       to0 = to;
1.126     chs      4418:        tst     %o2                     ! if (maxlength == 0)
                   4419:        beq,a   2f                      !
                   4420:         mov    ENAMETOOLONG, %o0       !       ret = ENAMETOOLONG; goto done;
                   4421:
1.1       deraadt  4422: 0:                                     ! loop:
                   4423:        ldsb    [%o0], %o4              !       c = *from;
                   4424:        tst     %o4
                   4425:        stb     %o4, [%o1]              !       *to++ = c;
                   4426:        be      1f                      !       if (c == 0)
                   4427:         inc    %o1                     !               goto ok;
                   4428:        deccc   %o2                     !       if (--len > 0) {
1.126     chs      4429:        bgu,a   0b                      !               from++;
1.1       deraadt  4430:         inc    %o0                     !               goto loop;
                   4431:        b       2f                      !       }
                   4432:         mov    ENAMETOOLONG, %o0       !       ret = ENAMETOOLONG; goto done;
                   4433: 1:                                     ! ok:
                   4434:        clr     %o0                     !       ret = 0;
                   4435: 2:
                   4436:        sub     %o1, %o5, %o1           !       len = to - to0;
                   4437:        tst     %o3                     !       if (lencopied)
                   4438:        bnz,a   3f
                   4439:         st     %o1, [%o3]              !               *lencopied = len;
                   4440: 3:
                   4441:        retl
                   4442:         nop
                   4443:
1.52      pk       4444: /*
1.1       deraadt  4445:  * Copyin(src, dst, len)
                   4446:  *
                   4447:  * Copy specified amount of data from user space into the kernel.
                   4448:  */
                   4449: ENTRY(copyin)
                   4450:        set     KERNBASE, %o3
                   4451:        cmp     %o0, %o3                ! src < KERNBASE?
                   4452:        blu,a   Ldocopy                 ! yes, can try it
1.111     pk       4453:         sethi  %hi(cpcb), %o3
1.1       deraadt  4454:
                   4455:        /* source address points into kernel space: return EFAULT */
                   4456:        retl
                   4457:         mov    EFAULT, %o0
                   4458:
                   4459: /*
                   4460:  * Copyout(src, dst, len)
                   4461:  *
                   4462:  * Copy specified amount of data from kernel to user space.
                   4463:  * Just like copyin, except that the `dst' addresses are user space
                   4464:  * rather than the `src' addresses.
                   4465:  */
                   4466: ENTRY(copyout)
                   4467:        set     KERNBASE, %o3
                   4468:        cmp     %o1, %o3                ! dst < KERBASE?
                   4469:        blu,a   Ldocopy
1.111     pk       4470:         sethi  %hi(cpcb), %o3
1.1       deraadt  4471:
                   4472:        /* destination address points into kernel space: return EFAULT */
                   4473:        retl
                   4474:         mov    EFAULT, %o0
                   4475:
                   4476:        /*
                   4477:         * ******NOTE****** this depends on bcopy() not using %g7
                   4478:         */
                   4479: Ldocopy:
1.111     pk       4480: !      sethi   %hi(cpcb), %o3
                   4481:        ld      [%o3 + %lo(cpcb)], %o3
1.1       deraadt  4482:        set     Lcopyfault, %o4
                   4483:        mov     %o7, %g7                ! save return address
1.111     pk       4484:        call    _C_LABEL(bcopy)         ! bcopy(src, dst, len)
1.1       deraadt  4485:         st     %o4, [%o3 + PCB_ONFAULT]
                   4486:
1.111     pk       4487:        sethi   %hi(cpcb), %o3
                   4488:        ld      [%o3 + %lo(cpcb)], %o3
1.1       deraadt  4489:        st      %g0, [%o3 + PCB_ONFAULT]
                   4490:        jmp     %g7 + 8
                   4491:         clr    %o0                     ! return 0
                   4492:
                   4493: ! Copyin or copyout fault.  Clear cpcb->pcb_onfault and return EFAULT.
                   4494: ! Note that although we were in bcopy, there is no state to clean up;
                   4495: ! the only special thing is that we have to return to [g7 + 8] rather than
                   4496: ! [o7 + 8].
                   4497: Lcopyfault:
1.111     pk       4498:        sethi   %hi(cpcb), %o3
                   4499:        ld      [%o3 + %lo(cpcb)], %o3
1.1       deraadt  4500:        jmp     %g7 + 8
1.138     chs      4501:         st     %g0, [%o3 + PCB_ONFAULT]
1.1       deraadt  4502:
                   4503:
                   4504: /*
                   4505:  * Write all user windows presently in the CPU back to the user's stack.
                   4506:  * We just do `save' instructions until pcb_uw == 0.
                   4507:  *
                   4508:  *     p = cpcb;
                   4509:  *     nsaves = 0;
                   4510:  *     while (p->pcb_uw > 0)
                   4511:  *             save(), nsaves++;
                   4512:  *     while (--nsaves >= 0)
                   4513:  *             restore();
                   4514:  */
                   4515: ENTRY(write_user_windows)
1.111     pk       4516:        sethi   %hi(cpcb), %g6
                   4517:        ld      [%g6 + %lo(cpcb)], %g6
1.1       deraadt  4518:        b       2f
                   4519:         clr    %g5
                   4520: 1:
                   4521:        save    %sp, -64, %sp
                   4522: 2:
                   4523:        ld      [%g6 + PCB_UW], %g7
                   4524:        tst     %g7
                   4525:        bg,a    1b
                   4526:         inc    %g5
                   4527: 3:
                   4528:        deccc   %g5
                   4529:        bge,a   3b
                   4530:         restore
                   4531:        retl
                   4532:         nop
                   4533:
                   4534:
                   4535: /*
                   4536:  * Switch statistics (for later tweaking):
                   4537:  *     nswitchdiff = p1 => p2 (i.e., chose different process)
1.10      deraadt  4538:  *     nswitchexit = number of calls to switchexit()
1.111     pk       4539:  *     cnt.v_swtch = total calls to swtch+swtchexit
1.1       deraadt  4540:  */
1.111     pk       4541:        .comm   _C_LABEL(nswitchdiff), 4
                   4542:        .comm   _C_LABEL(nswitchexit), 4
1.1       deraadt  4543:
1.173     pk       4544: /*
                   4545:  * switchexit is called only from cpu_exit() before the current process
                   4546:  * has freed its vmspace and kernel stack; we must schedule them to be
1.185     thorpej  4547:  * freed.  (curlwp is already NULL.)
1.173     pk       4548:  *
                   4549:  * We lay the process to rest by changing to the `idle' kernel stack,
                   4550:  * and note that the `last loaded process' is nonexistent.
                   4551:  */
                   4552: ENTRY(switchexit)
                   4553:        mov     %o0, %g2                ! save proc for exit2() call
1.185     thorpej  4554:        mov     %o1, %g1                ! exit2() or lwp_exit2()
1.173     pk       4555:
                   4556:        /*
                   4557:         * Change pcb to idle u. area, i.e., set %sp to top of stack
                   4558:         * and %psr to PSR_S|PSR_ET, and set cpcb to point to idle_u.
                   4559:         * Once we have left the old stack, we can call exit2() to
                   4560:         * destroy it.  Call it any sooner and the register windows
                   4561:         * go bye-bye.
                   4562:         */
                   4563: #if defined(MULTIPROCESSOR)
                   4564:        sethi   %hi(IDLE_UP), %g5
                   4565:        ld      [%g5 + %lo(IDLE_UP)], %g5
                   4566: #else
                   4567:        set     _C_LABEL(idle_u), %g5
                   4568: #endif
                   4569:        sethi   %hi(cpcb), %g6
                   4570:        mov     1, %g7
                   4571:        wr      %g0, PSR_S, %psr        ! change to window 0, traps off
                   4572:        wr      %g0, 2, %wim            ! and make window 1 the trap window
                   4573:        st      %g5, [%g6 + %lo(cpcb)]  ! cpcb = &idle_u
                   4574:        st      %g7, [%g5 + PCB_WIM]    ! idle_u.pcb_wim = log2(2) = 1
                   4575: #if defined(MULTIPROCESSOR)
                   4576:        set     USPACE-CCFSZ, %o1       !
                   4577:        add     %g5, %o1, %sp           ! set new %sp
                   4578: #else
                   4579:        set     _C_LABEL(idle_u) + USPACE-CCFSZ, %sp    ! set new %sp
                   4580: #endif
                   4581:
                   4582: #ifdef DEBUG
                   4583:        mov     %g5, %l6                ! %l6 = _idle_u
                   4584:        SET_SP_REDZONE(%l6, %l5)
                   4585: #endif
                   4586:        wr      %g0, PSR_S|PSR_ET, %psr ! and then enable traps
1.176     pk       4587:         nop
1.185     thorpej  4588:        call    %g1                     ! {lwp}exit2(p)
1.173     pk       4589:         mov    %g2, %o0
                   4590:
                   4591:        /*
                   4592:         * Now fall through to `the last switch'.  %l6 was set to
                   4593:         * %hi(cpcb), but may have been clobbered in exit2(),
                   4594:         * so all the registers described below will be set here.
                   4595:         *
                   4596:         * REGISTER USAGE AT THIS POINT:
                   4597:         *      %l1 = oldpsr (excluding ipl bits)
                   4598:         *      %l2 = %hi(whichqs)
                   4599:         *      %l4 = lastproc
                   4600:         *      %l6 = %hi(cpcb)
1.185     thorpej  4601:         *      %l7 = %hi(curlwp)
1.173     pk       4602:         *      %o0 = tmp 1
                   4603:         *      %o1 = tmp 2
                   4604:         */
                   4605:
                   4606:        INCR(_C_LABEL(nswitchexit))     ! nswitchexit++;
                   4607:        INCR(_C_LABEL(uvmexp)+V_SWTCH)  ! cnt.v_switch++;
                   4608:
                   4609:        mov     PSR_S|PSR_ET, %l1       ! oldpsr = PSR_S | PSR_ET;
                   4610:        sethi   %hi(_C_LABEL(sched_whichqs)), %l2
1.180     mrg      4611: #if !defined(MULTIPROCESSOR)
1.173     pk       4612:        clr     %l4                     ! lastproc = NULL;
1.180     mrg      4613: #endif
1.173     pk       4614:        sethi   %hi(cpcb), %l6
1.185     thorpej  4615:        sethi   %hi(curlwp), %l7
1.173     pk       4616:        b       idle_enter
1.185     thorpej  4617:         st     %g0, [%l7 + %lo(curlwp)]        ! curlwp = NULL;
1.173     pk       4618:
                   4619: /*
                   4620:  * When no processes are on the runq, switch
                   4621:  * idles here waiting for something to come ready.
                   4622:  * The registers are set up as noted above.
1.184     pk       4623:  *
                   4624:  * There are three entry points into the idle loop.
                   4625:  *     idle_switch:    when a switch to the CPU's idle stack is required
                   4626:  *     idle:           when already on the idle stack, scheduler lock held
                   4627:  *     idle_enter:     when already on the idle stack, scheduler lock not held
1.173     pk       4628:  */
1.184     pk       4629: idle_switch:
                   4630: #if defined(MULTIPROCESSOR)
                   4631:        sethi   %hi(IDLE_UP), %g5
                   4632:        ld      [%g5 + %lo(IDLE_UP)], %g5
                   4633: #else
                   4634:        set     _C_LABEL(idle_u), %g5
                   4635: #endif
                   4636:        mov     %l6, %g6                ! save %hi(cpcb) before changing windows
                   4637:        wr      %g0, PSR_S|PSR_PIL, %psr! change to window 0, traps off
                   4638:        wr      %g0, 2, %wim            ! and make window 1 the trap window
                   4639:        mov     1, %o0
                   4640:        st      %g5, [%g6 + %lo(cpcb)]  ! cpcb = &idle_u
                   4641:        st      %o0, [%g5 + PCB_WIM]    ! idle_u.pcb_wim = log2(2) = 1
                   4642: #if defined(MULTIPROCESSOR)
                   4643:        set     USPACE-CCFSZ, %o1       !
                   4644:        add     %g5, %o1, %sp           ! set new %sp
                   4645: #else
                   4646:        set     _C_LABEL(idle_u) + USPACE-CCFSZ, %sp    ! set new %sp
                   4647: #endif
                   4648:        mov     %g0, %i6                ! paranoid
                   4649:        mov     %g0, %i7                !
                   4650:
                   4651: #ifdef DEBUG
                   4652:        mov     %g5, %o0                ! %o0 = _idle_u
                   4653:        SET_SP_REDZONE(%o0, %o1)
                   4654: #endif
                   4655:        ! enable traps and continue at splsched()
                   4656:        wr      %g0, PSR_S|PSR_ET|(IPL_SCHED<<8), %psr
                   4657:
                   4658:        /* now set up the locals in our new window */
                   4659:        mov     PSR_S|PSR_ET, %l1       ! oldpsr = PSR_S | PSR_ET;
                   4660:        sethi   %hi(_C_LABEL(sched_whichqs)), %l2
                   4661:        clr     %l4                     ! lastproc = NULL;
                   4662:        sethi   %hi(cpcb), %l6
1.185     thorpej  4663:        sethi   %hi(curlwp), %l7
1.184     pk       4664:        /* FALLTHROUGH*/
                   4665:
1.173     pk       4666: idle:
                   4667: #if defined(MULTIPROCESSOR) || defined(LOCKDEBUG)
                   4668:        ! unlock scheduler lock
                   4669:        call    _C_LABEL(sched_unlock_idle)
                   4670:         nop
                   4671: #endif
                   4672:
                   4673: idle_enter:
1.180     mrg      4674: #if defined(MULTIPROCESSOR)
                   4675:        clr     %l4                     ! lastproc = NULL;
                   4676: #endif
1.173     pk       4677:        wr      %l1, 0, %psr            ! (void) spl0();
                   4678: 1:                                     ! spin reading whichqs until nonzero
                   4679:        ld      [%l2 + %lo(_C_LABEL(sched_whichqs))], %o3
                   4680:        tst     %o3
                   4681:        bnz,a   idle_leave
                   4682:         wr     %l1, (IPL_SCHED << 8), %psr     ! (void) splsched();
                   4683:
                   4684:        ! Check uvm.page_idle_zero
                   4685:        sethi   %hi(_C_LABEL(uvm) + UVM_PAGE_IDLE_ZERO), %o3
                   4686:        ld      [%o3 + %lo(_C_LABEL(uvm) + UVM_PAGE_IDLE_ZERO)], %o3
                   4687:        tst     %o3
                   4688:        bz      1b
                   4689:         nop
                   4690:
                   4691:        call    _C_LABEL(uvm_pageidlezero)
                   4692:         nop
                   4693:        b,a     1b
                   4694:
1.184     pk       4695: idle_leave:
                   4696:        ! just wrote to %psr; observe psr delay before doing a `save'
                   4697:        ! or loading sched_whichqs.
                   4698:        nop; nop
1.173     pk       4699: #if defined(MULTIPROCESSOR) || defined(LOCKDEBUG)
                   4700:        /* Before we leave the idle loop, detain the scheduler lock */
                   4701:        call    _C_LABEL(sched_lock_idle)
                   4702:         nop
                   4703: #endif
1.184     pk       4704:        b       Lsw_scan
                   4705:         ld     [%l2 + %lo(_C_LABEL(sched_whichqs))], %o3
1.173     pk       4706:
                   4707: Lsw_panic_rq:
                   4708:        sethi   %hi(1f), %o0
                   4709:        call    _C_LABEL(panic)
                   4710:         or     %lo(1f), %o0, %o0
                   4711: Lsw_panic_wchan:
                   4712:        sethi   %hi(2f), %o0
                   4713:        call    _C_LABEL(panic)
                   4714:         or     %lo(2f), %o0, %o0
                   4715: Lsw_panic_srun:
                   4716:        sethi   %hi(3f), %o0
                   4717:        call    _C_LABEL(panic)
                   4718:         or     %lo(3f), %o0, %o0
                   4719: 1:     .asciz  "switch rq"
                   4720: 2:     .asciz  "switch wchan"
                   4721: 3:     .asciz  "switch SRUN"
                   4722:        _ALIGN
                   4723:
                   4724: /*
                   4725:  * cpu_switch() picks a process to run and runs it, saving the current
                   4726:  * one away.  On the assumption that (since most workstations are
                   4727:  * single user machines) the chances are quite good that the new
                   4728:  * process will turn out to be the current process, we defer saving
                   4729:  * it here until we have found someone to load.  If that someone
                   4730:  * is the current process we avoid both store and load.
                   4731:  *
                   4732:  * cpu_switch() is always entered at splsched.
                   4733:  *
                   4734:  * IT MIGHT BE WORTH SAVING BEFORE ENTERING idle TO AVOID HAVING TO
                   4735:  * SAVE LATER WHEN SOMEONE ELSE IS READY ... MUST MEASURE!
                   4736:  */
                   4737:        .globl  _C_LABEL(__ffstab)
1.185     thorpej  4738: ENTRY(cpu_switch)
1.184     pk       4739: ENTRY(cpu_switchto)
1.173     pk       4740:        /*
                   4741:         * REGISTER USAGE AT THIS POINT:
                   4742:         *      %l1 = oldpsr (excluding ipl bits)
                   4743:         *      %l2 = %hi(whichqs)
                   4744:         *      %l3(%g3) = p
                   4745:         *      %l4(%g4) = lastproc
                   4746:         *      %l5 = tmp 0
                   4747:         *      %l6 = %hi(cpcb)
1.185     thorpej  4748:         *      %l7 = %hi(curlwp)
1.173     pk       4749:         *      %o0 = tmp 1
                   4750:         *      %o1 = tmp 2
                   4751:         *      %o2 = tmp 3
                   4752:         *      %o3 = tmp 4, then at Lsw_scan, whichqs
                   4753:         *      %o4 = tmp 5, then at Lsw_scan, which
                   4754:         *      %o5 = tmp 6, then at Lsw_scan, q
                   4755:         */
                   4756:        save    %sp, -CCFSZ, %sp
                   4757:        mov     %i0, %l4                        ! save p
                   4758:        sethi   %hi(cpcb), %l6
                   4759:        ld      [%l6 + %lo(cpcb)], %o0
                   4760:        std     %i6, [%o0 + PCB_SP]             ! cpcb->pcb_<sp,pc> = <fp,pc>;
                   4761:        rd      %psr, %l1                       ! oldpsr = %psr;
1.185     thorpej  4762:        sethi   %hi(curlwp), %l7
1.173     pk       4763:        st      %l1, [%o0 + PCB_PSR]            ! cpcb->pcb_psr = oldpsr;
                   4764:        andn    %l1, PSR_PIL, %l1               ! oldpsr &= ~PSR_PIL;
1.185     thorpej  4765:        st      %g0, [%l7 + %lo(curlwp)]        ! curlwp = NULL;
1.173     pk       4766:        /*
                   4767:         * Save the old process: write back all windows (excluding
                   4768:         * the current one).  XXX crude; knows nwindows <= 8
                   4769:         */
                   4770: #define        SAVE save %sp, -64, %sp
                   4771: wb1:   SAVE; SAVE; SAVE; SAVE; SAVE; SAVE;     /* 6 of each: */
                   4772:        restore; restore; restore; restore; restore; restore
                   4773:
1.184     pk       4774: #if defined(MULTIPROCESSOR)
                   4775:        /* flush this process's context from TLB (on SUN4M/4D) */
                   4776:        call    _C_LABEL(pmap_deactivate)       ! pmap_deactive(lastproc);
                   4777:         mov    %i0, %o0
                   4778: #endif
                   4779:
1.173     pk       4780:        /* If we've been given a process to switch to, skip the rq stuff */
                   4781:        tst     %i1
                   4782:        bnz,a   Lsw_load
                   4783:         mov    %i1, %l3        ! but move into the expected register first
                   4784:
1.184     pk       4785:        /* If nothing on the rq, wait after switching to idle stack */
1.173     pk       4786:        sethi   %hi(_C_LABEL(sched_whichqs)), %l2
1.184     pk       4787:        ld      [%l2 + %lo(_C_LABEL(sched_whichqs))], %o3
                   4788:        tst     %o3
                   4789:        bz      idle_switch
                   4790:         EMPTY
1.173     pk       4791:
                   4792: Lsw_scan:
                   4793:        /*
1.184     pk       4794:         * Enter here with %o3 set to sched_whichqs.
                   4795:         *
1.173     pk       4796:         * Optimized inline expansion of `which = ffs(whichqs) - 1';
                   4797:         * branches to idle if ffs(whichqs) was 0.
                   4798:         */
                   4799:        set     _C_LABEL(__ffstab), %o2
                   4800:        andcc   %o3, 0xff, %o1          ! byte 0 zero?
                   4801:        bz,a    1f                      ! yes, try byte 1
                   4802:         srl    %o3, 8, %o0
                   4803:        b       2f                      ! ffs = ffstab[byte0]; which = ffs - 1;
                   4804:         ldsb   [%o2 + %o1], %o0
                   4805: 1:     andcc   %o0, 0xff, %o1          ! byte 1 zero?
                   4806:        bz,a    1f                      ! yes, try byte 2
                   4807:         srl    %o0, 8, %o0
                   4808:        ldsb    [%o2 + %o1], %o0        ! which = ffstab[byte1] + 7;
                   4809:        b       3f
                   4810:         add    %o0, 7, %o4
                   4811: 1:     andcc   %o0, 0xff, %o1          ! byte 2 zero?
                   4812:        bz,a    1f                      ! yes, try byte 3
                   4813:         srl    %o0, 8, %o0
                   4814:        ldsb    [%o2 + %o1], %o0        ! which = ffstab[byte2] + 15;
                   4815:        b       3f
                   4816:         add    %o0, 15, %o4
                   4817: 1:     ldsb    [%o2 + %o0], %o0        ! ffs = ffstab[byte3] + 24
                   4818:        addcc   %o0, 24, %o0            ! (note that ffstab[0] == -24)
                   4819:        bz      idle                    ! if answer was 0, go idle
                   4820:         EMPTY
                   4821: 2:     sub     %o0, 1, %o4             ! which = ffs(whichqs) - 1
                   4822: 3:     /* end optimized inline expansion */
                   4823:
                   4824:        /*
                   4825:         * We found a nonempty run queue.  Take its first process.
                   4826:         */
                   4827:        set     _C_LABEL(sched_qs), %o5 ! q = &qs[which];
                   4828:        sll     %o4, 3, %o0
                   4829:        add     %o0, %o5, %o5
                   4830:        ld      [%o5], %l3              ! p = q->ph_link;
                   4831:        cmp     %l3, %o5                ! if (p == q)
                   4832:        be      Lsw_panic_rq            !       panic("switch rq");
                   4833:         EMPTY
                   4834:        ld      [%l3], %o0              ! tmp0 = p->p_forw;
                   4835:        st      %o0, [%o5]              ! q->ph_link = tmp0;
                   4836:        st      %o5, [%o0 + 4]          ! tmp0->p_back = q;
                   4837:        cmp     %o0, %o5                ! if (tmp0 == q)
                   4838:        bne     Lsw_load
                   4839:         EMPTY
                   4840:        mov     1, %o1                  !       whichqs &= ~(1 << which);
                   4841:        sll     %o1, %o4, %o1
                   4842:        andn    %o3, %o1, %o3
                   4843:        st      %o3, [%l2 + %lo(_C_LABEL(sched_whichqs))]
                   4844:
                   4845: Lsw_load:
                   4846:        /*
                   4847:         * PHASE TWO: NEW REGISTER USAGE:
                   4848:         *      %l1 = oldpsr (excluding ipl bits)
                   4849:         *      %l2 =
                   4850:         *      %l3 = p
                   4851:         *      %l4 = lastproc
                   4852:         *      %l5 =
                   4853:         *      %l6 = %hi(cpcb)
1.185     thorpej  4854:         *      %l7 = %hi(curlwp)
1.173     pk       4855:         *      %o0 = tmp 1
                   4856:         *      %o1 = tmp 2
                   4857:         *      %o2 = tmp 3
                   4858:         *      %o3 = vm
                   4859:         */
                   4860:
                   4861:        /* firewalls */
1.185     thorpej  4862:        ld      [%l3 + L_WCHAN], %o0    ! if (p->p_wchan)
1.173     pk       4863:        tst     %o0
                   4864:        bne     Lsw_panic_wchan         !       panic("switch wchan");
                   4865:         EMPTY
1.185     thorpej  4866:        ld      [%l3 + L_STAT], %o0     ! if (p->p_stat != LSRUN)
                   4867:        cmp     %o0, LSRUN
1.173     pk       4868:        bne     Lsw_panic_srun          !       panic("switch SRUN");
                   4869:         EMPTY
                   4870:
                   4871:        /*
                   4872:         * Committed to running process p.
                   4873:         * It may be the same as the one we were running before.
                   4874:         */
1.185     thorpej  4875:        mov     LSONPROC, %o0                   ! p->p_stat = LSONPROC;
                   4876:        st      %o0, [%l3 + L_STAT]
1.173     pk       4877:
                   4878:        /* p->p_cpu initialized in fork1() for single-processor */
                   4879: #if defined(MULTIPROCESSOR)
                   4880:        sethi   %hi(_CISELFP), %o0              ! p->p_cpu = cpuinfo.ci_self;
                   4881:        ld      [%o0 + %lo(_CISELFP)], %o0
1.185     thorpej  4882:        st      %o0, [%l3 + L_CPU]
1.173     pk       4883: #endif
                   4884:
1.185     thorpej  4885:        ld      [%l3 + L_ADDR], %g5             ! newpcb = p->p_addr;
1.173     pk       4886:        st      %g0, [%l3 + 4]                  ! p->p_back = NULL;
1.185     thorpej  4887:        st      %l3, [%l7 + %lo(curlwp)]        ! curlwp = p;
1.173     pk       4888:
                   4889:        /*
                   4890:         * Load the new process.  To load, we must change stacks and
                   4891:         * and alter cpcb. We must also load the CWP and WIM from the
                   4892:         * new process' PCB, since, when we finally return from
                   4893:         * the trap, the CWP of the trap window must match the
                   4894:         * CWP stored in the trap frame.
                   4895:         *
                   4896:         * Once the new CWP is set below our local registers become
                   4897:         * invalid, so:
                   4898:         *
                   4899:         * PHASE THREE: NEW REGISTER USAGE:
                   4900:         *      %g2 = newpsr
                   4901:         *      %g3 = p
                   4902:         *      %g4 = lastproc
                   4903:         *      %g5 = newpcb
1.176     pk       4904:         *      %l0 = return value
1.173     pk       4905:         *      %l1 = oldpsr (excluding ipl bits)
                   4906:         *      %l6 = %hi(cpcb)
                   4907:         *      %o0 = tmp 1
                   4908:         *      %o1 = tmp 2
                   4909:         *      %o2 = tmp 3
                   4910:         *      %o3 = vm
                   4911:         */
                   4912:
                   4913:        mov     %l3, %g3                ! save p and lastproc to globals
                   4914:        mov     %l4, %g4                !
                   4915:        ld      [%g5 + PCB_PSR], %g2    ! newpsr = newpcb->pcb_psr;
                   4916:
                   4917:        /* traps off while we switch to the new stack */
                   4918:        wr      %l1, (IPL_SCHED << 8) | PSR_ET, %psr
                   4919:
                   4920:        /* set new cpcb */
                   4921:        st      %g5, [%l6 + %lo(cpcb)]  ! cpcb = newpcb;
                   4922:
                   4923:        /* compute new wim */
                   4924:        ld      [%g5 + PCB_WIM], %o0
                   4925:        mov     1, %o1
                   4926:        sll     %o1, %o0, %o0
                   4927:        wr      %o0, 0, %wim            ! %wim = 1 << newpcb->pcb_wim;
                   4928:        /* now must not change %psr for 3 more instrs */
                   4929:        /* Clear FP & CP enable bits, as well as the PIL field */
                   4930: /*1,2*/        set     PSR_EF|PSR_EC|PSR_PIL, %o0
                   4931: /*3*/  andn    %g2, %o0, %g2           ! newpsr &= ~(PSR_EF|PSR_EC|PSR_PIL);
                   4932:        /* set new psr, but with traps disabled */
                   4933:        wr      %g2, (IPL_SCHED << 8)|PSR_ET, %psr ! %psr = newpsr ^ PSR_ET;
                   4934:
                   4935:        /* load new stack and return address */
                   4936:        ldd     [%g5 + PCB_SP], %i6     ! <fp,pc> = newpcb->pcb_<sp,pc>
                   4937:        add     %fp, -CCFSZ, %sp        ! set stack frame for this window
                   4938: #ifdef DEBUG
                   4939:        mov     %g5, %o0
                   4940:        SET_SP_REDZONE(%o0, %o1)
                   4941:        CHECK_SP_REDZONE(%o0, %o1)
                   4942: #endif
                   4943:
                   4944:        /* finally, enable traps and continue at splsched() */
                   4945:        wr      %g2, IPL_SCHED << 8 , %psr      ! psr = newpsr;
                   4946:
1.191     pk       4947:        mov     %g3, %l3                ! restore p and lastproc from globals
                   4948:        mov     %g4, %l4                ! (globals will get clobbered by the
                   4949:                                        !  sched_unlock_idle() below)
                   4950:
1.184     pk       4951:        sethi   %hi(_WANT_RESCHED), %o0         ! want_resched = 0;
                   4952: #if defined(MULTIPROCESSOR) || defined(LOCKDEBUG)
                   4953:        /* Done with the run queues; release the scheduler lock */
                   4954:        call    _C_LABEL(sched_unlock_idle)
1.180     mrg      4955: #endif
1.184     pk       4956:        st      %g0, [%o0 + %lo(_WANT_RESCHED)]! delay slot
1.180     mrg      4957:
1.173     pk       4958:        /*
                   4959:         * Now running p.  Make sure it has a context so that it
                   4960:         * can talk about user space stuff.  (Its pcb_uw is currently
                   4961:         * zero so it is safe to have interrupts going here.)
1.176     pk       4962:         *
                   4963:         * On multi-processor machines, the context might have changed
                   4964:         * (e.g. by exec(2)) even if we pick up the same process here.
1.173     pk       4965:         */
1.191     pk       4966:        subcc   %l3, %l4, %l0           ! p == lastproc?
1.176     pk       4967: #if !defined(MULTIPROCESSOR)
1.173     pk       4968:        be      Lsw_sameproc            ! yes, context is still set for p
                   4969:         EMPTY
1.176     pk       4970: #endif
1.173     pk       4971:
1.191     pk       4972:        ld      [%l3 + L_PROC], %o2     ! p = l->l_proc;
1.173     pk       4973:        INCR(_C_LABEL(nswitchdiff))     ! clobbers %o0,%o1
1.185     thorpej  4974:        ld      [%o2 + P_VMSPACE], %o3  ! vm = p->p_vmspace;
1.173     pk       4975:        ld      [%o3 + VM_PMAP], %o3    ! pm = vm->vm_map.vm_pmap;
1.180     mrg      4976: #if defined(MULTIPROCESSOR)
1.197     wiz      4977:        /* Add this CPU to the pmap's CPU set */
1.180     mrg      4978:        sethi   %hi(CPUINFO_VA + CPUINFO_CPUNO), %o0
                   4979:        ld      [%o0 + %lo(CPUINFO_VA + CPUINFO_CPUNO)], %o1
                   4980:        mov     1, %o2
                   4981:        ld      [%o3 + PMAP_CPUSET], %o0
                   4982:        sll     %o2, %o1, %o2
                   4983:        or      %o0, %o2, %o0           ! pm->pm_cpuset |= cpu_number();
                   4984:        st      %o0, [%o3 + PMAP_CPUSET]
                   4985: #endif
1.173     pk       4986:        ld      [%o3 + PMAP_CTX], %o0   ! if (pm->pm_ctx != NULL)
                   4987:        tst     %o0
                   4988:        bnz,a   Lsw_havectx             !       goto havecontext;
                   4989:         ld     [%o3 + PMAP_CTXNUM], %i1        ! load context number
                   4990:
                   4991:        /* p does not have a context: call ctx_alloc to get one */
                   4992:        call    _C_LABEL(ctx_alloc)     ! ctx_alloc(pm);
                   4993:         mov    %o3, %o0
                   4994:
                   4995:        ret
1.176     pk       4996:         restore %g0, %l0, %o0          ! return (p != lastproc)
1.173     pk       4997:
                   4998:        /* p does have a context: just switch to it */
                   4999: Lsw_havectx:
                   5000:        ! context is in %i1
                   5001: #if defined(SUN4M) && (defined(SUN4) || defined(SUN4C))
                   5002: NOP_ON_4M_15:
                   5003:        b,a     1f
                   5004:        b,a     2f
                   5005: #endif
                   5006: 1:
                   5007: #if defined(SUN4) || defined(SUN4C)
                   5008:        set     AC_CONTEXT, %o1
                   5009:        stba    %i1, [%o1] ASI_CONTROL  ! setcontext(vm->vm_pmap.pm_ctxnum);
                   5010:        ret
1.176     pk       5011:         restore %g0, %l0, %o0          ! return (p != lastproc)
1.173     pk       5012: #endif
                   5013: 2:
1.176     pk       5014: #if defined(SUN4M) || defined(SUN4D)
1.173     pk       5015:        /*
                   5016:         * Flush caches that need to be flushed on context switch.
                   5017:         * We know this is currently only necessary on the sun4m hypersparc.
                   5018:         */
                   5019:        sethi   %hi(CPUINFO_VA + CPUINFO_PURE_VCACHE_FLS), %o0
                   5020:        ld      [%o0 + %lo(CPUINFO_VA + CPUINFO_PURE_VCACHE_FLS)], %o2
                   5021:        jmpl    %o2, %o7
                   5022:         set    SRMMU_CXR, %i2
                   5023:        sta     %i1, [%i2] ASI_SRMMU    ! setcontext(vm->vm_pmap.pm_ctxnum);
                   5024:        ret
1.176     pk       5025:         restore %g0, %l0, %o0          ! return (p != lastproc)
1.173     pk       5026: #endif
                   5027:
1.176     pk       5028: #if !defined(MULTIPROCESSOR)
1.173     pk       5029: Lsw_sameproc:
                   5030:        /*
                   5031:         * We are resuming the process that was running at the
1.176     pk       5032:         * call to switch().
1.173     pk       5033:         */
                   5034:        ret
1.176     pk       5035:         restore %g0, %g0, %o0          ! return (0)
                   5036: #endif /* !MULTIPROCESSOR */
1.173     pk       5037:
1.185     thorpej  5038:
1.173     pk       5039: /*
                   5040:  * Snapshot the current process so that stack frames are up to date.
                   5041:  * Only used just before a crash dump.
                   5042:  */
                   5043: ENTRY(snapshot)
                   5044:        std     %o6, [%o0 + PCB_SP]     ! save sp
                   5045:        rd      %psr, %o1               ! save psr
                   5046:        st      %o1, [%o0 + PCB_PSR]
                   5047:
                   5048:        /*
                   5049:         * Just like switch(); same XXX comments apply.
                   5050:         * 7 of each.  Minor tweak: the 7th restore is
                   5051:         * done after a ret.
                   5052:         */
                   5053:        SAVE; SAVE; SAVE; SAVE; SAVE; SAVE; SAVE
                   5054:        restore; restore; restore; restore; restore; restore; ret; restore
                   5055:
                   5056:
                   5057: /*
                   5058:  * cpu_fork() arrange for proc_trampoline() to run after a process gets
                   5059:  * chosen in switch(). The stack frame will contain a function pointer
                   5060:  * in %l0, and an argument to pass to it in %l2.
                   5061:  *
                   5062:  * If the function *(%l0) returns, we arrange for an immediate return
                   5063:  * to user mode. This happens in two known cases: after execve(2) of init,
                   5064:  * and when returning a child to user mode after a fork(2).
                   5065:  *
                   5066:  * If were setting up a kernel thread, the function *(%l0) will not return.
                   5067:  */
                   5068: ENTRY(proc_trampoline)
                   5069:        /*
                   5070:         * Note: cpu_fork() has set up a stack frame for us to run in,
                   5071:         * so we can call other functions from here without using
                   5072:         * `save ... restore'.
                   5073:         */
                   5074: #ifdef MULTIPROCESSOR
                   5075:        /* Finish setup in SMP environment: acquire locks etc. */
                   5076:        call _C_LABEL(proc_trampoline_mp)
                   5077:         nop
                   5078: #endif
                   5079:
                   5080:        /* Reset interrupt level */
1.174     pk       5081:        rd      %psr, %l2
                   5082:        andn    %l2, PSR_PIL, %o0       ! psr &= ~PSR_PIL;
1.173     pk       5083:        wr      %o0, 0, %psr            ! (void) spl0();
                   5084:         nop                            ! psr delay; the next 2 instructions
                   5085:                                        ! can safely be made part of the
                   5086:                                        ! required 3 instructions psr delay
                   5087:        call    %l0
                   5088:         mov    %l1, %o0
                   5089:
                   5090:        /*
                   5091:         * Here we finish up as in syscall, but simplified.
                   5092:         * cpu_fork() (or sendsig(), if we took a pending signal
                   5093:         * in child_return()) will have set the user-space return
                   5094:         * address in tf_pc. In both cases, %npc should be %pc + 4.
                   5095:         */
                   5096:        ld      [%sp + CCFSZ + 4], %l1  ! pc = tf->tf_pc from cpu_fork()
1.174     pk       5097:        and     %l2, PSR_CWP, %o1       ! keep current CWP
1.173     pk       5098:        or      %o1, PSR_S, %l0         ! user psr
                   5099:        b       return_from_syscall
                   5100:         add    %l1, 4, %l2             ! npc = pc+4
                   5101:
1.1       deraadt  5102: /*
                   5103:  * {fu,su}{,i}{byte,word}
                   5104:  */
1.111     pk       5105: _ENTRY(fuiword)
1.1       deraadt  5106: ENTRY(fuword)
                   5107:        set     KERNBASE, %o2
                   5108:        cmp     %o0, %o2                ! if addr >= KERNBASE...
                   5109:        bgeu    Lfsbadaddr
                   5110:        EMPTY
                   5111:        btst    3, %o0                  ! or has low bits set...
                   5112:        bnz     Lfsbadaddr              !       go return -1
                   5113:        EMPTY
1.111     pk       5114:        sethi   %hi(cpcb), %o2          ! cpcb->pcb_onfault = Lfserr;
                   5115:        ld      [%o2 + %lo(cpcb)], %o2
1.1       deraadt  5116:        set     Lfserr, %o3
                   5117:        st      %o3, [%o2 + PCB_ONFAULT]
                   5118:        ld      [%o0], %o0              ! fetch the word
                   5119:        retl                            ! phew, made it, return the word
1.138     chs      5120:         st     %g0, [%o2 + PCB_ONFAULT]! but first clear onfault
1.1       deraadt  5121:
                   5122: Lfserr:
                   5123:        st      %g0, [%o2 + PCB_ONFAULT]! error in r/w, clear pcb_onfault
                   5124: Lfsbadaddr:
                   5125:        retl                            ! and return error indicator
1.21      deraadt  5126:         mov    -1, %o0
1.1       deraadt  5127:
                   5128:        /*
                   5129:         * This is just like Lfserr, but it's a global label that allows
                   5130:         * mem_access_fault() to check to see that we don't want to try to
                   5131:         * page in the fault.  It's used by fuswintr() etc.
                   5132:         */
1.111     pk       5133:        .globl  _C_LABEL(Lfsbail)
                   5134: _C_LABEL(Lfsbail):
1.1       deraadt  5135:        st      %g0, [%o2 + PCB_ONFAULT]! error in r/w, clear pcb_onfault
                   5136:        retl                            ! and return error indicator
1.21      deraadt  5137:         mov    -1, %o0
1.1       deraadt  5138:
                   5139:        /*
                   5140:         * Like fusword but callable from interrupt context.
                   5141:         * Fails if data isn't resident.
                   5142:         */
                   5143: ENTRY(fuswintr)
                   5144:        set     KERNBASE, %o2
                   5145:        cmp     %o0, %o2                ! if addr >= KERNBASE
                   5146:        bgeu    Lfsbadaddr              !       return error
                   5147:        EMPTY
1.111     pk       5148:        sethi   %hi(cpcb), %o2          ! cpcb->pcb_onfault = Lfsbail;
                   5149:        ld      [%o2 + %lo(cpcb)], %o2
                   5150:        set     _C_LABEL(Lfsbail), %o3
1.1       deraadt  5151:        st      %o3, [%o2 + PCB_ONFAULT]
                   5152:        lduh    [%o0], %o0              ! fetch the halfword
                   5153:        retl                            ! made it
                   5154:        st      %g0, [%o2 + PCB_ONFAULT]! but first clear onfault
                   5155:
                   5156: ENTRY(fusword)
                   5157:        set     KERNBASE, %o2
                   5158:        cmp     %o0, %o2                ! if addr >= KERNBASE
                   5159:        bgeu    Lfsbadaddr              !       return error
                   5160:        EMPTY
1.111     pk       5161:        sethi   %hi(cpcb), %o2          ! cpcb->pcb_onfault = Lfserr;
                   5162:        ld      [%o2 + %lo(cpcb)], %o2
1.1       deraadt  5163:        set     Lfserr, %o3
                   5164:        st      %o3, [%o2 + PCB_ONFAULT]
                   5165:        lduh    [%o0], %o0              ! fetch the halfword
                   5166:        retl                            ! made it
                   5167:        st      %g0, [%o2 + PCB_ONFAULT]! but first clear onfault
                   5168:
1.111     pk       5169: _ENTRY(fuibyte)
1.1       deraadt  5170: ENTRY(fubyte)
                   5171:        set     KERNBASE, %o2
                   5172:        cmp     %o0, %o2                ! if addr >= KERNBASE
                   5173:        bgeu    Lfsbadaddr              !       return error
                   5174:        EMPTY
1.111     pk       5175:        sethi   %hi(cpcb), %o2          ! cpcb->pcb_onfault = Lfserr;
                   5176:        ld      [%o2 + %lo(cpcb)], %o2
1.1       deraadt  5177:        set     Lfserr, %o3
                   5178:        st      %o3, [%o2 + PCB_ONFAULT]
                   5179:        ldub    [%o0], %o0              ! fetch the byte
                   5180:        retl                            ! made it
                   5181:        st      %g0, [%o2 + PCB_ONFAULT]! but first clear onfault
                   5182:
1.111     pk       5183: _ENTRY(suiword)
1.1       deraadt  5184: ENTRY(suword)
                   5185:        set     KERNBASE, %o2
                   5186:        cmp     %o0, %o2                ! if addr >= KERNBASE ...
                   5187:        bgeu    Lfsbadaddr
                   5188:        EMPTY
                   5189:        btst    3, %o0                  ! or has low bits set ...
                   5190:        bnz     Lfsbadaddr              !       go return error
                   5191:        EMPTY
1.111     pk       5192:        sethi   %hi(cpcb), %o2          ! cpcb->pcb_onfault = Lfserr;
                   5193:        ld      [%o2 + %lo(cpcb)], %o2
1.1       deraadt  5194:        set     Lfserr, %o3
                   5195:        st      %o3, [%o2 + PCB_ONFAULT]
                   5196:        st      %o1, [%o0]              ! store the word
                   5197:        st      %g0, [%o2 + PCB_ONFAULT]! made it, clear onfault
                   5198:        retl                            ! and return 0
                   5199:        clr     %o0
                   5200:
                   5201: ENTRY(suswintr)
                   5202:        set     KERNBASE, %o2
                   5203:        cmp     %o0, %o2                ! if addr >= KERNBASE
                   5204:        bgeu    Lfsbadaddr              !       go return error
                   5205:        EMPTY
1.111     pk       5206:        sethi   %hi(cpcb), %o2          ! cpcb->pcb_onfault = Lfsbail;
                   5207:        ld      [%o2 + %lo(cpcb)], %o2
                   5208:        set     _C_LABEL(Lfsbail), %o3
1.1       deraadt  5209:        st      %o3, [%o2 + PCB_ONFAULT]
                   5210:        sth     %o1, [%o0]              ! store the halfword
                   5211:        st      %g0, [%o2 + PCB_ONFAULT]! made it, clear onfault
                   5212:        retl                            ! and return 0
                   5213:        clr     %o0
                   5214:
                   5215: ENTRY(susword)
                   5216:        set     KERNBASE, %o2
                   5217:        cmp     %o0, %o2                ! if addr >= KERNBASE
                   5218:        bgeu    Lfsbadaddr              !       go return error
                   5219:        EMPTY
1.111     pk       5220:        sethi   %hi(cpcb), %o2          ! cpcb->pcb_onfault = Lfserr;
                   5221:        ld      [%o2 + %lo(cpcb)], %o2
1.1       deraadt  5222:        set     Lfserr, %o3
                   5223:        st      %o3, [%o2 + PCB_ONFAULT]
                   5224:        sth     %o1, [%o0]              ! store the halfword
                   5225:        st      %g0, [%o2 + PCB_ONFAULT]! made it, clear onfault
                   5226:        retl                            ! and return 0
                   5227:        clr     %o0
                   5228:
1.111     pk       5229: _ENTRY(suibyte)
1.1       deraadt  5230: ENTRY(subyte)
                   5231:        set     KERNBASE, %o2
                   5232:        cmp     %o0, %o2                ! if addr >= KERNBASE
                   5233:        bgeu    Lfsbadaddr              !       go return error
                   5234:        EMPTY
1.111     pk       5235:        sethi   %hi(cpcb), %o2          ! cpcb->pcb_onfault = Lfserr;
                   5236:        ld      [%o2 + %lo(cpcb)], %o2
1.1       deraadt  5237:        set     Lfserr, %o3
                   5238:        st      %o3, [%o2 + PCB_ONFAULT]
                   5239:        stb     %o1, [%o0]              ! store the byte
                   5240:        st      %g0, [%o2 + PCB_ONFAULT]! made it, clear onfault
                   5241:        retl                            ! and return 0
                   5242:        clr     %o0
                   5243:
                   5244: /* probeget and probeset are meant to be used during autoconfiguration */
                   5245:
                   5246: /*
                   5247:  * probeget(addr, size) caddr_t addr; int size;
                   5248:  *
                   5249:  * Read or write a (byte,word,longword) from the given address.
                   5250:  * Like {fu,su}{byte,halfword,word} but our caller is supposed
                   5251:  * to know what he is doing... the address can be anywhere.
                   5252:  *
                   5253:  * We optimize for space, rather than time, here.
                   5254:  */
                   5255: ENTRY(probeget)
                   5256:        ! %o0 = addr, %o1 = (1,2,4)
1.111     pk       5257:        sethi   %hi(cpcb), %o2
                   5258:        ld      [%o2 + %lo(cpcb)], %o2  ! cpcb->pcb_onfault = Lfserr;
1.1       deraadt  5259:        set     Lfserr, %o5
                   5260:        st      %o5, [%o2 + PCB_ONFAULT]
                   5261:        btst    1, %o1
                   5262:        bnz,a   0f                      ! if (len & 1)
                   5263:         ldub   [%o0], %o0              !       value = *(char *)addr;
                   5264: 0:     btst    2, %o1
                   5265:        bnz,a   0f                      ! if (len & 2)
                   5266:         lduh   [%o0], %o0              !       value = *(short *)addr;
                   5267: 0:     btst    4, %o1
                   5268:        bnz,a   0f                      ! if (len & 4)
                   5269:         ld     [%o0], %o0              !       value = *(int *)addr;
                   5270: 0:     retl                            ! made it, clear onfault and return
                   5271:         st     %g0, [%o2 + PCB_ONFAULT]
                   5272:
                   5273: /*
                   5274:  * probeset(addr, size, val) caddr_t addr; int size, val;
                   5275:  *
                   5276:  * As above, but we return 0 on success.
                   5277:  */
                   5278: ENTRY(probeset)
                   5279:        ! %o0 = addr, %o1 = (1,2,4), %o2 = val
1.111     pk       5280:        sethi   %hi(cpcb), %o3
                   5281:        ld      [%o3 + %lo(cpcb)], %o3  ! cpcb->pcb_onfault = Lfserr;
1.1       deraadt  5282:        set     Lfserr, %o5
1.35      pk       5283:        st      %o5, [%o3 + PCB_ONFAULT]
1.1       deraadt  5284:        btst    1, %o1
                   5285:        bnz,a   0f                      ! if (len & 1)
                   5286:         stb    %o2, [%o0]              !       *(char *)addr = value;
                   5287: 0:     btst    2, %o1
                   5288:        bnz,a   0f                      ! if (len & 2)
                   5289:         sth    %o2, [%o0]              !       *(short *)addr = value;
                   5290: 0:     btst    4, %o1
                   5291:        bnz,a   0f                      ! if (len & 4)
                   5292:         st     %o2, [%o0]              !       *(int *)addr = value;
                   5293: 0:     clr     %o0                     ! made it, clear onfault and return 0
                   5294:        retl
1.35      pk       5295:         st     %g0, [%o3 + PCB_ONFAULT]
1.21      deraadt  5296:
                   5297: /*
1.22      deraadt  5298:  * int xldcontrolb(caddr_t, pcb)
                   5299:  *                 %o0     %o1
1.21      deraadt  5300:  *
                   5301:  * read a byte from the specified address in ASI_CONTROL space.
                   5302:  */
1.22      deraadt  5303: ENTRY(xldcontrolb)
1.111     pk       5304:        !sethi  %hi(cpcb), %o2
                   5305:        !ld     [%o2 + %lo(cpcb)], %o2  ! cpcb->pcb_onfault = Lfsbail;
1.22      deraadt  5306:        or      %o1, %g0, %o2           ! %o2 = %o1
1.111     pk       5307:        set     _C_LABEL(Lfsbail), %o5
1.21      deraadt  5308:        st      %o5, [%o2 + PCB_ONFAULT]
                   5309:        lduba   [%o0] ASI_CONTROL, %o0  ! read
                   5310: 0:     retl
1.1       deraadt  5311:         st     %g0, [%o2 + PCB_ONFAULT]
1.78      pk       5312:
                   5313: /*
                   5314:  * int fkbyte(caddr_t, pcb)
                   5315:  *           %o0      %o1
                   5316:  *
                   5317:  * Just like fubyte(), but for kernel space.
                   5318:  * (currently used to work around unexplained transient bus errors
                   5319:  *  when reading the VME interrupt vector)
                   5320:  */
                   5321: ENTRY(fkbyte)
                   5322:        or      %o1, %g0, %o2           ! %o2 = %o1
1.111     pk       5323:        set     _C_LABEL(Lfsbail), %o5
1.78      pk       5324:        st      %o5, [%o2 + PCB_ONFAULT]
                   5325:        ldub    [%o0], %o0              ! fetch the byte
                   5326:        retl                            ! made it
                   5327:         st     %g0, [%o2 + PCB_ONFAULT]! but first clear onfault
1.1       deraadt  5328:
                   5329:
                   5330: /*
                   5331:  * copywords(src, dst, nbytes)
                   5332:  *
                   5333:  * Copy `nbytes' bytes from src to dst, both of which are word-aligned;
                   5334:  * nbytes is a multiple of four.  It may, however, be zero, in which case
                   5335:  * nothing is to be copied.
                   5336:  */
                   5337: ENTRY(copywords)
                   5338:        ! %o0 = src, %o1 = dst, %o2 = nbytes
                   5339:        b       1f
                   5340:        deccc   4, %o2
                   5341: 0:
                   5342:        st      %o3, [%o1 + %o2]
                   5343:        deccc   4, %o2                  ! while ((n -= 4) >= 0)
                   5344: 1:
                   5345:        bge,a   0b                      !    *(int *)(dst+n) = *(int *)(src+n);
                   5346:        ld      [%o0 + %o2], %o3
                   5347:        retl
                   5348:        nop
                   5349:
                   5350: /*
                   5351:  * qcopy(src, dst, nbytes)
                   5352:  *
                   5353:  * (q for `quad' or `quick', as opposed to b for byte/block copy)
                   5354:  *
                   5355:  * Just like copywords, but everything is multiples of 8.
                   5356:  */
                   5357: ENTRY(qcopy)
                   5358:        b       1f
                   5359:        deccc   8, %o2
                   5360: 0:
                   5361:        std     %o4, [%o1 + %o2]
                   5362:        deccc   8, %o2
                   5363: 1:
                   5364:        bge,a   0b
                   5365:        ldd     [%o0 + %o2], %o4
                   5366:        retl
                   5367:        nop
                   5368:
                   5369: /*
                   5370:  * qzero(addr, nbytes)
                   5371:  *
                   5372:  * Zeroes `nbytes' bytes of a quad-aligned virtual address,
                   5373:  * where nbytes is itself a multiple of 8.
                   5374:  */
                   5375: ENTRY(qzero)
                   5376:        ! %o0 = addr, %o1 = len (in bytes)
                   5377:        clr     %g1
                   5378: 0:
                   5379:        deccc   8, %o1                  ! while ((n =- 8) >= 0)
                   5380:        bge,a   0b
                   5381:        std     %g0, [%o0 + %o1]        !       *(quad *)(addr + n) = 0;
                   5382:        retl
                   5383:        nop
                   5384:
                   5385: /*
1.83      mycroft  5386:  * kernel bcopy
1.1       deraadt  5387:  * Assumes regions do not overlap; has no useful return value.
                   5388:  *
                   5389:  * Must not use %g7 (see copyin/copyout above).
                   5390:  */
                   5391:
                   5392: #define        BCOPY_SMALL     32      /* if < 32, copy by bytes */
                   5393:
                   5394: ENTRY(bcopy)
                   5395:        cmp     %o2, BCOPY_SMALL
                   5396: Lbcopy_start:
                   5397:        bge,a   Lbcopy_fancy    ! if >= this many, go be fancy.
                   5398:        btst    7, %o0          ! (part of being fancy)
                   5399:
                   5400:        /*
                   5401:         * Not much to copy, just do it a byte at a time.
                   5402:         */
                   5403:        deccc   %o2             ! while (--len >= 0)
                   5404:        bl      1f
                   5405:        EMPTY
                   5406: 0:
                   5407:        inc     %o0
                   5408:        ldsb    [%o0 - 1], %o4  !       (++dst)[-1] = *src++;
                   5409:        stb     %o4, [%o1]
                   5410:        deccc   %o2
                   5411:        bge     0b
                   5412:        inc     %o1
                   5413: 1:
                   5414:        retl
1.80      mrg      5415:         nop
1.1       deraadt  5416:        /* NOTREACHED */
                   5417:
                   5418:        /*
                   5419:         * Plenty of data to copy, so try to do it optimally.
                   5420:         */
                   5421: Lbcopy_fancy:
                   5422:        ! check for common case first: everything lines up.
                   5423: !      btst    7, %o0          ! done already
                   5424:        bne     1f
                   5425:        EMPTY
                   5426:        btst    7, %o1
                   5427:        be,a    Lbcopy_doubles
                   5428:        dec     8, %o2          ! if all lined up, len -= 8, goto bcopy_doubes
                   5429:
                   5430:        ! If the low bits match, we can make these line up.
                   5431: 1:
                   5432:        xor     %o0, %o1, %o3   ! t = src ^ dst;
                   5433:        btst    1, %o3          ! if (t & 1) {
                   5434:        be,a    1f
                   5435:        btst    1, %o0          ! [delay slot: if (src & 1)]
                   5436:
                   5437:        ! low bits do not match, must copy by bytes.
                   5438: 0:
                   5439:        ldsb    [%o0], %o4      !       do {
                   5440:        inc     %o0             !               (++dst)[-1] = *src++;
                   5441:        inc     %o1
                   5442:        deccc   %o2
                   5443:        bnz     0b              !       } while (--len != 0);
                   5444:        stb     %o4, [%o1 - 1]
                   5445:        retl
1.80      mrg      5446:         nop
1.1       deraadt  5447:        /* NOTREACHED */
                   5448:
                   5449:        ! lowest bit matches, so we can copy by words, if nothing else
                   5450: 1:
                   5451:        be,a    1f              ! if (src & 1) {
                   5452:        btst    2, %o3          ! [delay slot: if (t & 2)]
                   5453:
                   5454:        ! although low bits match, both are 1: must copy 1 byte to align
                   5455:        ldsb    [%o0], %o4      !       *dst++ = *src++;
                   5456:        stb     %o4, [%o1]
                   5457:        inc     %o0
                   5458:        inc     %o1
                   5459:        dec     %o2             !       len--;
                   5460:        btst    2, %o3          ! } [if (t & 2)]
                   5461: 1:
                   5462:        be,a    1f              ! if (t & 2) {
                   5463:        btst    2, %o0          ! [delay slot: if (src & 2)]
                   5464:        dec     2, %o2          !       len -= 2;
                   5465: 0:
                   5466:        ldsh    [%o0], %o4      !       do {
                   5467:        sth     %o4, [%o1]      !               *(short *)dst = *(short *)src;
                   5468:        inc     2, %o0          !               dst += 2, src += 2;
                   5469:        deccc   2, %o2          !       } while ((len -= 2) >= 0);
                   5470:        bge     0b
                   5471:        inc     2, %o1
                   5472:        b       Lbcopy_mopb     !       goto mop_up_byte;
                   5473:        btst    1, %o2          ! } [delay slot: if (len & 1)]
                   5474:        /* NOTREACHED */
                   5475:
                   5476:        ! low two bits match, so we can copy by longwords
                   5477: 1:
                   5478:        be,a    1f              ! if (src & 2) {
                   5479:        btst    4, %o3          ! [delay slot: if (t & 4)]
                   5480:
                   5481:        ! although low 2 bits match, they are 10: must copy one short to align
                   5482:        ldsh    [%o0], %o4      !       (*short *)dst = *(short *)src;
                   5483:        sth     %o4, [%o1]
                   5484:        inc     2, %o0          !       dst += 2;
                   5485:        inc     2, %o1          !       src += 2;
                   5486:        dec     2, %o2          !       len -= 2;
                   5487:        btst    4, %o3          ! } [if (t & 4)]
                   5488: 1:
                   5489:        be,a    1f              ! if (t & 4) {
                   5490:        btst    4, %o0          ! [delay slot: if (src & 4)]
                   5491:        dec     4, %o2          !       len -= 4;
                   5492: 0:
                   5493:        ld      [%o0], %o4      !       do {
                   5494:        st      %o4, [%o1]      !               *(int *)dst = *(int *)src;
                   5495:        inc     4, %o0          !               dst += 4, src += 4;
                   5496:        deccc   4, %o2          !       } while ((len -= 4) >= 0);
                   5497:        bge     0b
                   5498:        inc     4, %o1
                   5499:        b       Lbcopy_mopw     !       goto mop_up_word_and_byte;
                   5500:        btst    2, %o2          ! } [delay slot: if (len & 2)]
                   5501:        /* NOTREACHED */
                   5502:
                   5503:        ! low three bits match, so we can copy by doublewords
                   5504: 1:
                   5505:        be      1f              ! if (src & 4) {
                   5506:        dec     8, %o2          ! [delay slot: len -= 8]
                   5507:        ld      [%o0], %o4      !       *(int *)dst = *(int *)src;
                   5508:        st      %o4, [%o1]
                   5509:        inc     4, %o0          !       dst += 4, src += 4, len -= 4;
                   5510:        inc     4, %o1
                   5511:        dec     4, %o2          ! }
                   5512: 1:
                   5513: Lbcopy_doubles:
                   5514:        ldd     [%o0], %o4      ! do {
                   5515:        std     %o4, [%o1]      !       *(double *)dst = *(double *)src;
                   5516:        inc     8, %o0          !       dst += 8, src += 8;
                   5517:        deccc   8, %o2          ! } while ((len -= 8) >= 0);
                   5518:        bge     Lbcopy_doubles
                   5519:        inc     8, %o1
                   5520:
                   5521:        ! check for a usual case again (save work)
                   5522:        btst    7, %o2          ! if ((len & 7) == 0)
                   5523:        be      Lbcopy_done     !       goto bcopy_done;
                   5524:
                   5525:        btst    4, %o2          ! if ((len & 4)) == 0)
                   5526:        be,a    Lbcopy_mopw     !       goto mop_up_word_and_byte;
                   5527:        btst    2, %o2          ! [delay slot: if (len & 2)]
                   5528:        ld      [%o0], %o4      !       *(int *)dst = *(int *)src;
                   5529:        st      %o4, [%o1]
                   5530:        inc     4, %o0          !       dst += 4;
                   5531:        inc     4, %o1          !       src += 4;
                   5532:        btst    2, %o2          ! } [if (len & 2)]
                   5533:
                   5534: 1:
                   5535:        ! mop up trailing word (if present) and byte (if present).
                   5536: Lbcopy_mopw:
                   5537:        be      Lbcopy_mopb     ! no word, go mop up byte
                   5538:        btst    1, %o2          ! [delay slot: if (len & 1)]
                   5539:        ldsh    [%o0], %o4      ! *(short *)dst = *(short *)src;
                   5540:        be      Lbcopy_done     ! if ((len & 1) == 0) goto done;
                   5541:        sth     %o4, [%o1]
                   5542:        ldsb    [%o0 + 2], %o4  ! dst[2] = src[2];
                   5543:        retl
1.80      mrg      5544:         stb    %o4, [%o1 + 2]
1.1       deraadt  5545:        /* NOTREACHED */
                   5546:
                   5547:        ! mop up trailing byte (if present).
                   5548: Lbcopy_mopb:
                   5549:        bne,a   1f
                   5550:        ldsb    [%o0], %o4
                   5551:
                   5552: Lbcopy_done:
                   5553:        retl
1.80      mrg      5554:         nop
1.1       deraadt  5555:
                   5556: 1:
                   5557:        retl
1.80      mrg      5558:         stb    %o4,[%o1]
1.1       deraadt  5559: /*
                   5560:  * ovbcopy(src, dst, len): like bcopy, but regions may overlap.
                   5561:  */
                   5562: ENTRY(ovbcopy)
                   5563:        cmp     %o0, %o1        ! src < dst?
                   5564:        bgeu    Lbcopy_start    ! no, go copy forwards as via bcopy
                   5565:        cmp     %o2, BCOPY_SMALL! (check length for doublecopy first)
                   5566:
                   5567:        /*
                   5568:         * Since src comes before dst, and the regions might overlap,
                   5569:         * we have to do the copy starting at the end and working backwards.
                   5570:         */
                   5571:        add     %o2, %o0, %o0   ! src += len
                   5572:        add     %o2, %o1, %o1   ! dst += len
                   5573:        bge,a   Lback_fancy     ! if len >= BCOPY_SMALL, go be fancy
                   5574:        btst    3, %o0
                   5575:
                   5576:        /*
                   5577:         * Not much to copy, just do it a byte at a time.
                   5578:         */
                   5579:        deccc   %o2             ! while (--len >= 0)
                   5580:        bl      1f
                   5581:        EMPTY
                   5582: 0:
                   5583:        dec     %o0             !       *--dst = *--src;
                   5584:        ldsb    [%o0], %o4
                   5585:        dec     %o1
                   5586:        deccc   %o2
                   5587:        bge     0b
                   5588:        stb     %o4, [%o1]
                   5589: 1:
                   5590:        retl
                   5591:        nop
                   5592:
                   5593:        /*
                   5594:         * Plenty to copy, try to be optimal.
                   5595:         * We only bother with word/halfword/byte copies here.
                   5596:         */
                   5597: Lback_fancy:
                   5598: !      btst    3, %o0          ! done already
                   5599:        bnz     1f              ! if ((src & 3) == 0 &&
                   5600:        btst    3, %o1          !     (dst & 3) == 0)
                   5601:        bz,a    Lback_words     !       goto words;
                   5602:        dec     4, %o2          ! (done early for word copy)
                   5603:
                   5604: 1:
                   5605:        /*
                   5606:         * See if the low bits match.
                   5607:         */
                   5608:        xor     %o0, %o1, %o3   ! t = src ^ dst;
                   5609:        btst    1, %o3
                   5610:        bz,a    3f              ! if (t & 1) == 0, can do better
                   5611:        btst    1, %o0
                   5612:
                   5613:        /*
                   5614:         * Nope; gotta do byte copy.
                   5615:         */
                   5616: 2:
                   5617:        dec     %o0             ! do {
                   5618:        ldsb    [%o0], %o4      !       *--dst = *--src;
                   5619:        dec     %o1
                   5620:        deccc   %o2             ! } while (--len != 0);
                   5621:        bnz     2b
                   5622:        stb     %o4, [%o1]
                   5623:        retl
                   5624:        nop
                   5625:
                   5626: 3:
                   5627:        /*
                   5628:         * Can do halfword or word copy, but might have to copy 1 byte first.
                   5629:         */
                   5630: !      btst    1, %o0          ! done earlier
                   5631:        bz,a    4f              ! if (src & 1) {        /* copy 1 byte */
                   5632:        btst    2, %o3          ! (done early)
                   5633:        dec     %o0             !       *--dst = *--src;
                   5634:        ldsb    [%o0], %o4
                   5635:        dec     %o1
                   5636:        stb     %o4, [%o1]
                   5637:        dec     %o2             !       len--;
                   5638:        btst    2, %o3          ! }
                   5639:
                   5640: 4:
                   5641:        /*
                   5642:         * See if we can do a word copy ((t&2) == 0).
                   5643:         */
                   5644: !      btst    2, %o3          ! done earlier
                   5645:        bz,a    6f              ! if (t & 2) == 0, can do word copy
                   5646:        btst    2, %o0          ! (src&2, done early)
                   5647:
                   5648:        /*
                   5649:         * Gotta do halfword copy.
                   5650:         */
                   5651:        dec     2, %o2          ! len -= 2;
                   5652: 5:
                   5653:        dec     2, %o0          ! do {
                   5654:        ldsh    [%o0], %o4      !       src -= 2;
                   5655:        dec     2, %o1          !       dst -= 2;
                   5656:        deccc   2, %o0          !       *(short *)dst = *(short *)src;
                   5657:        bge     5b              ! } while ((len -= 2) >= 0);
                   5658:        sth     %o4, [%o1]
                   5659:        b       Lback_mopb      ! goto mop_up_byte;
                   5660:        btst    1, %o2          ! (len&1, done early)
                   5661:
                   5662: 6:
                   5663:        /*
                   5664:         * We can do word copies, but we might have to copy
                   5665:         * one halfword first.
                   5666:         */
                   5667: !      btst    2, %o0          ! done already
                   5668:        bz      7f              ! if (src & 2) {
                   5669:        dec     4, %o2          ! (len -= 4, done early)
                   5670:        dec     2, %o0          !       src -= 2, dst -= 2;
                   5671:        ldsh    [%o0], %o4      !       *(short *)dst = *(short *)src;
                   5672:        dec     2, %o1
                   5673:        sth     %o4, [%o1]
                   5674:        dec     2, %o2          !       len -= 2;
                   5675:                                ! }
                   5676:
                   5677: 7:
                   5678: Lback_words:
                   5679:        /*
                   5680:         * Do word copies (backwards), then mop up trailing halfword
                   5681:         * and byte if any.
                   5682:         */
                   5683: !      dec     4, %o2          ! len -= 4, done already
                   5684: 0:                             ! do {
                   5685:        dec     4, %o0          !       src -= 4;
                   5686:        dec     4, %o1          !       src -= 4;
                   5687:        ld      [%o0], %o4      !       *(int *)dst = *(int *)src;
                   5688:        deccc   4, %o2          ! } while ((len -= 4) >= 0);
                   5689:        bge     0b
                   5690:        st      %o4, [%o1]
                   5691:
                   5692:        /*
                   5693:         * Check for trailing shortword.
                   5694:         */
                   5695:        btst    2, %o2          ! if (len & 2) {
                   5696:        bz,a    1f
                   5697:        btst    1, %o2          ! (len&1, done early)
                   5698:        dec     2, %o0          !       src -= 2, dst -= 2;
                   5699:        ldsh    [%o0], %o4      !       *(short *)dst = *(short *)src;
                   5700:        dec     2, %o1
                   5701:        sth     %o4, [%o1]      ! }
                   5702:        btst    1, %o2
                   5703:
                   5704:        /*
                   5705:         * Check for trailing byte.
                   5706:         */
                   5707: 1:
                   5708: Lback_mopb:
                   5709: !      btst    1, %o2          ! (done already)
                   5710:        bnz,a   1f              ! if (len & 1) {
                   5711:        ldsb    [%o0 - 1], %o4  !       b = src[-1];
                   5712:        retl
                   5713:        nop
                   5714: 1:
                   5715:        retl                    !       dst[-1] = b;
                   5716:        stb     %o4, [%o1 - 1]  ! }
                   5717:
1.79      mrg      5718: /*
                   5719:  * kcopy() is exactly like bcopy except that it set pcb_onfault such that
                   5720:  * when a fault occurs, it is able to return -1 to indicate this to the
                   5721:  * caller.
                   5722:  */
                   5723: ENTRY(kcopy)
1.111     pk       5724:        sethi   %hi(cpcb), %o5          ! cpcb->pcb_onfault = Lkcerr;
                   5725:        ld      [%o5 + %lo(cpcb)], %o5
1.79      mrg      5726:        set     Lkcerr, %o3
1.107     mycroft  5727:        ld      [%o5 + PCB_ONFAULT], %g1! save current onfault handler
1.79      mrg      5728:        st      %o3, [%o5 + PCB_ONFAULT]
                   5729:
                   5730:        cmp     %o2, BCOPY_SMALL
                   5731: Lkcopy_start:
                   5732:        bge,a   Lkcopy_fancy    ! if >= this many, go be fancy.
1.106     pk       5733:         btst   7, %o0          ! (part of being fancy)
1.79      mrg      5734:
                   5735:        /*
                   5736:         * Not much to copy, just do it a byte at a time.
                   5737:         */
                   5738:        deccc   %o2             ! while (--len >= 0)
1.108     mycroft  5739:        bl      1f
                   5740:         EMPTY
1.79      mrg      5741: 0:
1.107     mycroft  5742:        ldsb    [%o0], %o4      !       *dst++ = *src++;
1.79      mrg      5743:        inc     %o0
                   5744:        stb     %o4, [%o1]
                   5745:        deccc   %o2
                   5746:        bge     0b
1.106     pk       5747:         inc    %o1
1.79      mrg      5748: 1:
1.106     pk       5749:        st      %g1, [%o5 + PCB_ONFAULT]        ! restore onfault
1.79      mrg      5750:        retl
1.106     pk       5751:         mov    0, %o0          ! delay slot: return success
1.79      mrg      5752:        /* NOTREACHED */
                   5753:
                   5754:        /*
                   5755:         * Plenty of data to copy, so try to do it optimally.
                   5756:         */
                   5757: Lkcopy_fancy:
                   5758:        ! check for common case first: everything lines up.
                   5759: !      btst    7, %o0          ! done already
                   5760:        bne     1f
1.108     mycroft  5761:         EMPTY
1.79      mrg      5762:        btst    7, %o1
                   5763:        be,a    Lkcopy_doubles
1.106     pk       5764:         dec    8, %o2          ! if all lined up, len -= 8, goto bcopy_doubes
1.79      mrg      5765:
                   5766:        ! If the low bits match, we can make these line up.
                   5767: 1:
                   5768:        xor     %o0, %o1, %o3   ! t = src ^ dst;
                   5769:        btst    1, %o3          ! if (t & 1) {
                   5770:        be,a    1f
1.106     pk       5771:         btst   1, %o0          ! [delay slot: if (src & 1)]
1.79      mrg      5772:
                   5773:        ! low bits do not match, must copy by bytes.
                   5774: 0:
                   5775:        ldsb    [%o0], %o4      !       do {
1.107     mycroft  5776:        inc     %o0             !               *dst++ = *src++;
                   5777:        stb     %o4, [%o1]
1.79      mrg      5778:        deccc   %o2
                   5779:        bnz     0b              !       } while (--len != 0);
1.107     mycroft  5780:         inc    %o1
1.106     pk       5781:        st      %g1, [%o5 + PCB_ONFAULT]        ! restore onfault
1.79      mrg      5782:        retl
1.106     pk       5783:         mov    0, %o0          ! delay slot: return success
1.79      mrg      5784:        /* NOTREACHED */
                   5785:
                   5786:        ! lowest bit matches, so we can copy by words, if nothing else
                   5787: 1:
                   5788:        be,a    1f              ! if (src & 1) {
1.106     pk       5789:         btst   2, %o3          ! [delay slot: if (t & 2)]
1.79      mrg      5790:
                   5791:        ! although low bits match, both are 1: must copy 1 byte to align
                   5792:        ldsb    [%o0], %o4      !       *dst++ = *src++;
1.107     mycroft  5793:        inc     %o0
1.79      mrg      5794:        stb     %o4, [%o1]
1.107     mycroft  5795:        dec     %o2             !       len--;
1.79      mrg      5796:        inc     %o1
                   5797:        btst    2, %o3          ! } [if (t & 2)]
                   5798: 1:
                   5799:        be,a    1f              ! if (t & 2) {
1.106     pk       5800:         btst   2, %o0          ! [delay slot: if (src & 2)]
1.79      mrg      5801:        dec     2, %o2          !       len -= 2;
                   5802: 0:
                   5803:        ldsh    [%o0], %o4      !       do {
1.107     mycroft  5804:        inc     2, %o0          !               dst += 2, src += 2;
1.79      mrg      5805:        sth     %o4, [%o1]      !               *(short *)dst = *(short *)src;
                   5806:        deccc   2, %o2          !       } while ((len -= 2) >= 0);
                   5807:        bge     0b
1.106     pk       5808:         inc    2, %o1
1.79      mrg      5809:        b       Lkcopy_mopb     !       goto mop_up_byte;
1.106     pk       5810:         btst   1, %o2          ! } [delay slot: if (len & 1)]
1.79      mrg      5811:        /* NOTREACHED */
                   5812:
                   5813:        ! low two bits match, so we can copy by longwords
                   5814: 1:
                   5815:        be,a    1f              ! if (src & 2) {
1.106     pk       5816:         btst   4, %o3          ! [delay slot: if (t & 4)]
1.79      mrg      5817:
                   5818:        ! although low 2 bits match, they are 10: must copy one short to align
                   5819:        ldsh    [%o0], %o4      !       (*short *)dst = *(short *)src;
1.107     mycroft  5820:        inc     2, %o0          !       dst += 2;
1.79      mrg      5821:        sth     %o4, [%o1]
1.107     mycroft  5822:        dec     2, %o2          !       len -= 2;
1.79      mrg      5823:        inc     2, %o1          !       src += 2;
                   5824:        btst    4, %o3          ! } [if (t & 4)]
                   5825: 1:
                   5826:        be,a    1f              ! if (t & 4) {
1.106     pk       5827:         btst   4, %o0          ! [delay slot: if (src & 4)]
1.79      mrg      5828:        dec     4, %o2          !       len -= 4;
                   5829: 0:
                   5830:        ld      [%o0], %o4      !       do {
1.107     mycroft  5831:        inc     4, %o0          !               dst += 4, src += 4;
1.79      mrg      5832:        st      %o4, [%o1]      !               *(int *)dst = *(int *)src;
                   5833:        deccc   4, %o2          !       } while ((len -= 4) >= 0);
                   5834:        bge     0b
1.106     pk       5835:         inc    4, %o1
1.79      mrg      5836:        b       Lkcopy_mopw     !       goto mop_up_word_and_byte;
1.106     pk       5837:         btst   2, %o2          ! } [delay slot: if (len & 2)]
1.79      mrg      5838:        /* NOTREACHED */
                   5839:
                   5840:        ! low three bits match, so we can copy by doublewords
                   5841: 1:
                   5842:        be      1f              ! if (src & 4) {
1.106     pk       5843:         dec    8, %o2          ! [delay slot: len -= 8]
1.79      mrg      5844:        ld      [%o0], %o4      !       *(int *)dst = *(int *)src;
1.107     mycroft  5845:        inc     4, %o0          !       dst += 4, src += 4, len -= 4;
1.79      mrg      5846:        st      %o4, [%o1]
1.107     mycroft  5847:        dec     4, %o2          ! }
1.79      mrg      5848:        inc     4, %o1
                   5849: 1:
                   5850: Lkcopy_doubles:
                   5851:        ! swap %o4 with %o2 during doubles copy, since %o5 is verboten
                   5852:        mov     %o2, %o4
                   5853: Lkcopy_doubles2:
                   5854:        ldd     [%o0], %o2      ! do {
1.107     mycroft  5855:        inc     8, %o0          !       dst += 8, src += 8;
1.79      mrg      5856:        std     %o2, [%o1]      !       *(double *)dst = *(double *)src;
                   5857:        deccc   8, %o4          ! } while ((len -= 8) >= 0);
                   5858:        bge     Lkcopy_doubles2
                   5859:         inc    8, %o1
                   5860:        mov     %o4, %o2        ! restore len
                   5861:
                   5862:        ! check for a usual case again (save work)
                   5863:        btst    7, %o2          ! if ((len & 7) == 0)
                   5864:        be      Lkcopy_done     !       goto bcopy_done;
                   5865:
1.106     pk       5866:         btst   4, %o2          ! if ((len & 4)) == 0)
1.79      mrg      5867:        be,a    Lkcopy_mopw     !       goto mop_up_word_and_byte;
1.106     pk       5868:         btst   2, %o2          ! [delay slot: if (len & 2)]
1.79      mrg      5869:        ld      [%o0], %o4      !       *(int *)dst = *(int *)src;
1.107     mycroft  5870:        inc     4, %o0          !       dst += 4;
1.79      mrg      5871:        st      %o4, [%o1]
                   5872:        inc     4, %o1          !       src += 4;
                   5873:        btst    2, %o2          ! } [if (len & 2)]
                   5874:
                   5875: 1:
                   5876:        ! mop up trailing word (if present) and byte (if present).
                   5877: Lkcopy_mopw:
                   5878:        be      Lkcopy_mopb     ! no word, go mop up byte
1.106     pk       5879:         btst   1, %o2          ! [delay slot: if (len & 1)]
1.79      mrg      5880:        ldsh    [%o0], %o4      ! *(short *)dst = *(short *)src;
                   5881:        be      Lkcopy_done     ! if ((len & 1) == 0) goto done;
1.106     pk       5882:         sth    %o4, [%o1]
1.79      mrg      5883:        ldsb    [%o0 + 2], %o4  ! dst[2] = src[2];
                   5884:        stb     %o4, [%o1 + 2]
1.106     pk       5885:        st      %g1, [%o5 + PCB_ONFAULT]! restore onfault
1.79      mrg      5886:        retl
1.106     pk       5887:         mov    0, %o0          ! delay slot: return success
1.79      mrg      5888:        /* NOTREACHED */
                   5889:
                   5890:        ! mop up trailing byte (if present).
                   5891: Lkcopy_mopb:
                   5892:        bne,a   1f
1.106     pk       5893:         ldsb   [%o0], %o4
1.79      mrg      5894:
                   5895: Lkcopy_done:
1.106     pk       5896:        st      %g1, [%o5 + PCB_ONFAULT]        ! restore onfault
1.79      mrg      5897:        retl
1.106     pk       5898:         mov    0, %o0          ! delay slot: return success
1.108     mycroft  5899:        /* NOTREACHED */
1.79      mrg      5900:
                   5901: 1:
1.107     mycroft  5902:        stb     %o4, [%o1]
                   5903:        st      %g1, [%o5 + PCB_ONFAULT]        ! restore onfault
1.79      mrg      5904:        retl
1.107     mycroft  5905:         mov    0, %o0          ! delay slot: return success
1.108     mycroft  5906:        /* NOTREACHED */
1.107     mycroft  5907:
1.79      mrg      5908: Lkcerr:
1.107     mycroft  5909:        retl
1.138     chs      5910:         st     %g1, [%o5 + PCB_ONFAULT]        ! restore onfault
1.108     mycroft  5911:        /* NOTREACHED */
1.1       deraadt  5912:
                   5913: /*
                   5914:  * savefpstate(f) struct fpstate *f;
                   5915:  *
                   5916:  * Store the current FPU state.  The first `st %fsr' may cause a trap;
                   5917:  * our trap handler knows how to recover (by `returning' to savefpcont).
                   5918:  */
                   5919: ENTRY(savefpstate)
                   5920:        rd      %psr, %o1               ! enable FP before we begin
                   5921:        set     PSR_EF, %o2
                   5922:        or      %o1, %o2, %o1
                   5923:        wr      %o1, 0, %psr
                   5924:        /* do some setup work while we wait for PSR_EF to turn on */
                   5925:        set     FSR_QNE, %o5            ! QNE = 0x2000, too big for immediate
                   5926:        clr     %o3                     ! qsize = 0;
                   5927:        nop                             ! (still waiting for PSR_EF)
                   5928: special_fp_store:
                   5929:        st      %fsr, [%o0 + FS_FSR]    ! f->fs_fsr = getfsr();
                   5930:        /*
                   5931:         * Even if the preceding instruction did not trap, the queue
                   5932:         * is not necessarily empty: this state save might be happening
                   5933:         * because user code tried to store %fsr and took the FPU
                   5934:         * from `exception pending' mode to `exception' mode.
                   5935:         * So we still have to check the blasted QNE bit.
                   5936:         * With any luck it will usually not be set.
                   5937:         */
                   5938:        ld      [%o0 + FS_FSR], %o4     ! if (f->fs_fsr & QNE)
                   5939:        btst    %o5, %o4
                   5940:        bnz     Lfp_storeq              !       goto storeq;
                   5941:         std    %f0, [%o0 + FS_REGS + (4*0)]    ! f->fs_f0 = etc;
                   5942: Lfp_finish:
                   5943:        st      %o3, [%o0 + FS_QSIZE]   ! f->fs_qsize = qsize;
                   5944:        std     %f2, [%o0 + FS_REGS + (4*2)]
                   5945:        std     %f4, [%o0 + FS_REGS + (4*4)]
                   5946:        std     %f6, [%o0 + FS_REGS + (4*6)]
                   5947:        std     %f8, [%o0 + FS_REGS + (4*8)]
                   5948:        std     %f10, [%o0 + FS_REGS + (4*10)]
                   5949:        std     %f12, [%o0 + FS_REGS + (4*12)]
                   5950:        std     %f14, [%o0 + FS_REGS + (4*14)]
                   5951:        std     %f16, [%o0 + FS_REGS + (4*16)]
                   5952:        std     %f18, [%o0 + FS_REGS + (4*18)]
                   5953:        std     %f20, [%o0 + FS_REGS + (4*20)]
                   5954:        std     %f22, [%o0 + FS_REGS + (4*22)]
                   5955:        std     %f24, [%o0 + FS_REGS + (4*24)]
                   5956:        std     %f26, [%o0 + FS_REGS + (4*26)]
                   5957:        std     %f28, [%o0 + FS_REGS + (4*28)]
                   5958:        retl
                   5959:         std    %f30, [%o0 + FS_REGS + (4*30)]
                   5960:
                   5961: /*
                   5962:  * Store the (now known nonempty) FP queue.
                   5963:  * We have to reread the fsr each time in order to get the new QNE bit.
                   5964:  */
                   5965: Lfp_storeq:
                   5966:        add     %o0, FS_QUEUE, %o1      ! q = &f->fs_queue[0];
                   5967: 1:
                   5968:        std     %fq, [%o1 + %o3]        ! q[qsize++] = fsr_qfront();
                   5969:        st      %fsr, [%o0 + FS_FSR]    ! reread fsr
                   5970:        ld      [%o0 + FS_FSR], %o4     ! if fsr & QNE, loop
                   5971:        btst    %o5, %o4
                   5972:        bnz     1b
                   5973:         inc    8, %o3
                   5974:        b       Lfp_finish              ! set qsize and finish storing fregs
                   5975:         srl    %o3, 3, %o3             ! (but first fix qsize)
                   5976:
                   5977: /*
                   5978:  * The fsr store trapped.  Do it again; this time it will not trap.
                   5979:  * We could just have the trap handler return to the `st %fsr', but
                   5980:  * if for some reason it *does* trap, that would lock us into a tight
                   5981:  * loop.  This way we panic instead.  Whoopee.
                   5982:  */
                   5983: savefpcont:
                   5984:        b       special_fp_store + 4    ! continue
                   5985:         st     %fsr, [%o0 + FS_FSR]    ! but first finish the %fsr store
                   5986:
                   5987: /*
                   5988:  * Load FPU state.
                   5989:  */
                   5990: ENTRY(loadfpstate)
                   5991:        rd      %psr, %o1               ! enable FP before we begin
                   5992:        set     PSR_EF, %o2
                   5993:        or      %o1, %o2, %o1
                   5994:        wr      %o1, 0, %psr
                   5995:        nop; nop; nop                   ! paranoia
                   5996:        ldd     [%o0 + FS_REGS + (4*0)], %f0
                   5997:        ldd     [%o0 + FS_REGS + (4*2)], %f2
                   5998:        ldd     [%o0 + FS_REGS + (4*4)], %f4
                   5999:        ldd     [%o0 + FS_REGS + (4*6)], %f6
                   6000:        ldd     [%o0 + FS_REGS + (4*8)], %f8
                   6001:        ldd     [%o0 + FS_REGS + (4*10)], %f10
                   6002:        ldd     [%o0 + FS_REGS + (4*12)], %f12
                   6003:        ldd     [%o0 + FS_REGS + (4*14)], %f14
                   6004:        ldd     [%o0 + FS_REGS + (4*16)], %f16
                   6005:        ldd     [%o0 + FS_REGS + (4*18)], %f18
                   6006:        ldd     [%o0 + FS_REGS + (4*20)], %f20
                   6007:        ldd     [%o0 + FS_REGS + (4*22)], %f22
                   6008:        ldd     [%o0 + FS_REGS + (4*24)], %f24
                   6009:        ldd     [%o0 + FS_REGS + (4*26)], %f26
                   6010:        ldd     [%o0 + FS_REGS + (4*28)], %f28
                   6011:        ldd     [%o0 + FS_REGS + (4*30)], %f30
                   6012:        retl
                   6013:         ld     [%o0 + FS_FSR], %fsr    ! setfsr(f->fs_fsr);
                   6014:
                   6015: /*
                   6016:  * ienab_bis(bis) int bis;
                   6017:  * ienab_bic(bic) int bic;
                   6018:  *
1.167     pk       6019:  * Set and clear bits in the sun4/sun4c interrupt register.
1.52      pk       6020:  */
                   6021:
                   6022: #if defined(SUN4) || defined(SUN4C)
                   6023: /*
1.1       deraadt  6024:  * Since there are no read-modify-write instructions for this,
                   6025:  * and one of the interrupts is nonmaskable, we must disable traps.
                   6026:  */
                   6027: ENTRY(ienab_bis)
                   6028:        ! %o0 = bits to set
                   6029:        rd      %psr, %o2
                   6030:        wr      %o2, PSR_ET, %psr       ! disable traps
                   6031:        nop; nop                        ! 3-instr delay until ET turns off
1.62      pk       6032:        sethi   %hi(INTRREG_VA), %o3
                   6033:        ldub    [%o3 + %lo(INTRREG_VA)], %o4
                   6034:        or      %o4, %o0, %o4           ! *INTRREG_VA |= bis;
                   6035:        stb     %o4, [%o3 + %lo(INTRREG_VA)]
1.1       deraadt  6036:        wr      %o2, 0, %psr            ! reenable traps
                   6037:        nop
                   6038:        retl
                   6039:         nop
                   6040:
                   6041: ENTRY(ienab_bic)
                   6042:        ! %o0 = bits to clear
                   6043:        rd      %psr, %o2
                   6044:        wr      %o2, PSR_ET, %psr       ! disable traps
                   6045:        nop; nop
1.62      pk       6046:        sethi   %hi(INTRREG_VA), %o3
                   6047:        ldub    [%o3 + %lo(INTRREG_VA)], %o4
                   6048:        andn    %o4, %o0, %o4           ! *INTRREG_VA &=~ bic;
                   6049:        stb     %o4, [%o3 + %lo(INTRREG_VA)]
1.1       deraadt  6050:        wr      %o2, 0, %psr            ! reenable traps
                   6051:        nop
                   6052:        retl
                   6053:         nop
1.167     pk       6054: #endif /* SUN4 || SUN4C */
1.52      pk       6055:
                   6056: #if defined(SUN4M)
                   6057: /*
                   6058:  * raise(cpu, level)
                   6059:  */
                   6060: ENTRY(raise)
1.149     uwe      6061: #if !defined(MSIIEP) /* normal suns */
1.52      pk       6062:        ! *(ICR_PI_SET + cpu*_MAXNBPG) = PINTR_SINTRLEV(level)
                   6063:        sethi   %hi(1 << 16), %o2
                   6064:        sll     %o2, %o1, %o2
                   6065:        set     ICR_PI_SET, %o1
                   6066:        set     _MAXNBPG, %o3
                   6067: 1:
                   6068:        subcc   %o0, 1, %o0
                   6069:        bpos,a  1b
                   6070:         add    %o1, %o3, %o1
                   6071:        retl
                   6072:         st     %o2, [%o1]
1.197     wiz      6073: #else /* MSIIEP - ignore %o0, only one CPU ever */
1.149     uwe      6074:        mov     1, %o2
                   6075:        sethi   %hi(MSIIEP_PCIC_VA), %o0
                   6076:        sll     %o2, %o1, %o2
                   6077:        retl
                   6078:         sth    %o2, [%o0 + PCIC_SOFT_INTR_SET_REG]
                   6079: #endif
1.62      pk       6080:
                   6081: /*
1.94      pk       6082:  * Read Synchronous Fault Status registers.
                   6083:  * On entry: %l1 == PC, %l3 == fault type, %l4 == storage, %l7 == return address
                   6084:  * Only use %l5 and %l6.
                   6085:  * Note: not C callable.
                   6086:  */
1.111     pk       6087: _ENTRY(_C_LABEL(srmmu_get_syncflt))
                   6088: _ENTRY(_C_LABEL(hypersparc_get_syncflt))
1.94      pk       6089:        set     SRMMU_SFAR, %l5
                   6090:        lda     [%l5] ASI_SRMMU, %l5    ! sync virt addr; must be read first
                   6091:        st      %l5, [%l4 + 4]          ! => dump.sfva
                   6092:        set     SRMMU_SFSR, %l5
                   6093:        lda     [%l5] ASI_SRMMU, %l5    ! get sync fault status register
                   6094:        jmp     %l7 + 8                 ! return to caller
                   6095:         st     %l5, [%l4]              ! => dump.sfsr
                   6096:
1.111     pk       6097: _ENTRY(_C_LABEL(viking_get_syncflt))
                   6098: _ENTRY(_C_LABEL(ms1_get_syncflt))
                   6099: _ENTRY(_C_LABEL(swift_get_syncflt))
                   6100: _ENTRY(_C_LABEL(turbosparc_get_syncflt))
                   6101: _ENTRY(_C_LABEL(cypress_get_syncflt))
1.62      pk       6102:        cmp     %l3, T_TEXTFAULT
                   6103:        be,a    1f
1.94      pk       6104:         mov    %l1, %l5                ! use PC if type == T_TEXTFAULT
1.62      pk       6105:
1.94      pk       6106:        set     SRMMU_SFAR, %l5
                   6107:        lda     [%l5] ASI_SRMMU, %l5    ! sync virt addr; must be read first
1.62      pk       6108: 1:
1.94      pk       6109:        st      %l5, [%l4 + 4]          ! => dump.sfva
1.62      pk       6110:
1.94      pk       6111:        set     SRMMU_SFSR, %l5
                   6112:        lda     [%l5] ASI_SRMMU, %l5    ! get sync fault status register
                   6113:        jmp     %l7 + 8                 ! return to caller
                   6114:         st     %l5, [%l4]              ! => dump.sfsr
1.62      pk       6115:
1.162     uwe      6116: #if defined(MULTIPROCESSOR) && 0 /* notyet */
1.142     mrg      6117: /*
                   6118:  * Read Synchronous Fault Status registers.
                   6119:  * On entry: %o0 == &sfsr, %o1 == &sfar
                   6120:  */
                   6121: _ENTRY(_C_LABEL(smp_get_syncflt))
                   6122:        save    %sp, -CCFSZ, %sp
                   6123:
                   6124:        sethi   %hi(CPUINFO_VA), %o4
                   6125:        ld      [%l4 + %lo(CPUINFO_VA+CPUINFO_GETSYNCFLT)], %o5
                   6126:        clr     %l1
                   6127:        clr     %l3
                   6128:        jmpl    %o5, %l7
                   6129:         or     %o4, %lo(CPUINFO_SYNCFLTDUMP), %l4
                   6130:
                   6131:        ! load values out of the dump
                   6132:        ld      [%o4 + %lo(CPUINFO_VA+CPUINFO_SYNCFLTDUMP)], %o5
                   6133:        st      %o5, [%i0]
                   6134:        ld      [%o4 + %lo(CPUINFO_VA+CPUINFO_SYNCFLTDUMP+4)], %o5
                   6135:        st      %o5, [%i1]
                   6136:        ret
                   6137:         restore
                   6138: #endif /* MULTIPROCESSOR */
1.62      pk       6139:
1.94      pk       6140: /*
                   6141:  * Read Asynchronous Fault Status registers.
                   6142:  * On entry: %o0 == &afsr, %o1 == &afar
                   6143:  * Return 0 if async register are present.
                   6144:  */
1.111     pk       6145: _ENTRY(_C_LABEL(srmmu_get_asyncflt))
1.94      pk       6146:        set     SRMMU_AFAR, %o4
                   6147:        lda     [%o4] ASI_SRMMU, %o4    ! get async fault address
                   6148:        set     SRMMU_AFSR, %o3 !
                   6149:        st      %o4, [%o1]
                   6150:        lda     [%o3] ASI_SRMMU, %o3    ! get async fault status
                   6151:        st      %o3, [%o0]
                   6152:        retl
                   6153:         clr    %o0                     ! return value
1.62      pk       6154:
1.111     pk       6155: _ENTRY(_C_LABEL(cypress_get_asyncflt))
                   6156: _ENTRY(_C_LABEL(hypersparc_get_asyncflt))
1.94      pk       6157:        set     SRMMU_AFSR, %o3         ! must read status before fault on HS
                   6158:        lda     [%o3] ASI_SRMMU, %o3    ! get async fault status
                   6159:        st      %o3, [%o0]
                   6160:        btst    AFSR_AFO, %o3           ! and only read fault address
                   6161:        bz      1f                      ! if valid.
                   6162:        set     SRMMU_AFAR, %o4
                   6163:        lda     [%o4] ASI_SRMMU, %o4    ! get async fault address
                   6164:        clr     %o0                     ! return value
1.62      pk       6165:        retl
1.94      pk       6166:         st     %o4, [%o1]
1.62      pk       6167: 1:
                   6168:        retl
1.94      pk       6169:         clr    %o0                     ! return value
1.62      pk       6170:
1.111     pk       6171: _ENTRY(_C_LABEL(no_asyncflt_regs))
1.62      pk       6172:        retl
1.94      pk       6173:         mov    1, %o0                  ! return value
1.86      pk       6174:
1.111     pk       6175: _ENTRY(_C_LABEL(hypersparc_pure_vcache_flush))
1.86      pk       6176:        /*
                   6177:         * Flush entire on-chip instruction cache, which is
                   6178:         * a pure vitually-indexed/virtually-tagged cache.
                   6179:         */
                   6180:        retl
                   6181:         sta    %g0, [%g0] ASI_HICACHECLR
1.62      pk       6182:
1.52      pk       6183: #endif /* SUN4M */
1.1       deraadt  6184:
1.149     uwe      6185: #if !defined(MSIIEP)   /* normal suns */
1.1       deraadt  6186: /*
1.29      deraadt  6187:  * void lo_microtime(struct timeval *tv)
1.1       deraadt  6188:  *
                   6189:  * LBL's sparc bsd 'microtime': We don't need to spl (so this routine
                   6190:  * can be a leaf routine) and we don't keep a 'last' timeval (there
                   6191:  * can't be two calls to this routine in a microsecond).  This seems to
                   6192:  * be about 20 times faster than the Sun code on an SS-2. - vj
                   6193:  *
                   6194:  * Read time values from slowest-changing to fastest-changing,
                   6195:  * then re-read out to slowest.  If the values read before
                   6196:  * the innermost match those read after, the innermost value
                   6197:  * is consistent with the outer values.  If not, it may not
                   6198:  * be and we must retry.  Typically this loop runs only once;
                   6199:  * occasionally it runs twice, and only rarely does it run longer.
                   6200:  */
1.30      deraadt  6201: #if defined(SUN4)
1.29      deraadt  6202: ENTRY(lo_microtime)
1.30      deraadt  6203: #else
                   6204: ENTRY(microtime)
                   6205: #endif
1.111     pk       6206:        sethi   %hi(_C_LABEL(time)), %g2
1.68      mycroft  6207:
                   6208: #if defined(SUN4M) && !(defined(SUN4C) || defined(SUN4))
                   6209:        sethi   %hi(TIMERREG_VA+4), %g3
                   6210:        or      %g3, %lo(TIMERREG_VA+4), %g3
                   6211: #elif (defined(SUN4C) || defined(SUN4)) && !defined(SUN4M)
                   6212:        sethi   %hi(TIMERREG_VA), %g3
                   6213:        or      %g3, %lo(TIMERREG_VA), %g3
                   6214: #else
1.1       deraadt  6215:        sethi   %hi(TIMERREG_VA), %g3
1.62      pk       6216:        or      %g3, %lo(TIMERREG_VA), %g3
1.68      mycroft  6217: NOP_ON_4_4C_1:
1.62      pk       6218:         add    %g3, 4, %g3
1.68      mycroft  6219: #endif
1.62      pk       6220:
1.69      mycroft  6221: 2:
1.111     pk       6222:        ldd     [%g2+%lo(_C_LABEL(time))], %o2  ! time.tv_sec & time.tv_usec
1.62      pk       6223:        ld      [%g3], %o4                      ! usec counter
1.111     pk       6224:        ldd     [%g2+%lo(_C_LABEL(time))], %g4  ! see if time values changed
1.1       deraadt  6225:        cmp     %g4, %o2
1.52      pk       6226:        bne     2b                              ! if time.tv_sec changed
1.1       deraadt  6227:         cmp    %g5, %o3
1.52      pk       6228:        bne     2b                              ! if time.tv_usec changed
1.1       deraadt  6229:         tst    %o4
                   6230:
1.52      pk       6231:        bpos    3f                              ! reached limit?
1.1       deraadt  6232:         srl    %o4, TMR_SHIFT, %o4             ! convert counter to usec
1.111     pk       6233:        sethi   %hi(_C_LABEL(tick)), %g4        ! bump usec by 1 tick
                   6234:        ld      [%g4+%lo(_C_LABEL(tick))], %o1
1.1       deraadt  6235:        set     TMR_MASK, %g5
                   6236:        add     %o1, %o3, %o3
                   6237:        and     %o4, %g5, %o4
1.52      pk       6238: 3:
1.1       deraadt  6239:        add     %o4, %o3, %o3
                   6240:        set     1000000, %g5                    ! normalize usec value
                   6241:        cmp     %o3, %g5
1.52      pk       6242:        bl,a    4f
1.155     uwe      6243:         st     %o2, [%o0]
1.1       deraadt  6244:        add     %o2, 1, %o2                     ! overflow
                   6245:        sub     %o3, %g5, %o3
1.155     uwe      6246:        st      %o2, [%o0]
1.52      pk       6247: 4:
1.1       deraadt  6248:        retl
                   6249:         st     %o3, [%o0+4]
1.149     uwe      6250:
                   6251: #else /* MSIIEP */
                   6252: /* XXX: uwe: can be merged with 4c/4m version above */
                   6253: /*
                   6254:  * ms-IIep version of
                   6255:  * void microtime(struct timeval *tv)
                   6256:  *
                   6257:  * This is similar to 4c/4m microtime.   The difference is that
1.197     wiz      6258:  * counter uses 31 bits and ticks every 4 CPU cycles (CPU is @100MHz)
1.149     uwe      6259:  * the magic to divide by 25 is stolen from gcc
                   6260:  */
                   6261: ENTRY(microtime)
                   6262:        sethi   %hi(_C_LABEL(time)), %g2
                   6263:
                   6264:        sethi   %hi(MSIIEP_PCIC_VA), %g3
                   6265:        or      %g3, PCIC_SCCR_REG, %g3
                   6266:
                   6267: 2:
                   6268:        ldd     [%g2+%lo(_C_LABEL(time))], %o2  ! time.tv_sec & time.tv_usec
                   6269:        ld      [%g3], %o4                      ! system (timer) counter
                   6270:        ldd     [%g2+%lo(_C_LABEL(time))], %g4  ! see if time values changed
                   6271:        cmp     %g4, %o2
                   6272:        bne     2b                              ! if time.tv_sec changed
                   6273:         cmp    %g5, %o3
                   6274:        bne     2b                              ! if time.tv_usec changed
                   6275:         tst    %o4
                   6276:        !! %o2 - time.tv_sec;  %o3 - time.tv_usec;  %o4 - timer counter
                   6277:
                   6278: !!! BEGIN ms-IIep specific code
                   6279:        bpos    3f                              ! if limit not reached yet
                   6280:         clr    %g4                             !  then use timer as is
                   6281:
1.155     uwe      6282:        set     0x80000000, %g5
1.149     uwe      6283:        sethi   %hi(_C_LABEL(tick)), %g4
1.155     uwe      6284:        bclr    %g5, %o4                        ! cleat limit reached flag
1.149     uwe      6285:        ld      [%g4+%lo(_C_LABEL(tick))], %g4
                   6286:
                   6287:        !! %g4 - either 0 or tick (if timer has hit the limit)
                   6288: 3:
                   6289:        inc     -1, %o4                         ! timer is 1-based, adjust
1.155     uwe      6290:        !! divide by 25 magic stolen from a gcc output
                   6291:        set     1374389535, %g5
1.149     uwe      6292:        umul    %o4, %g5, %g0
                   6293:        rd      %y, %o4
                   6294:        srl     %o4, 3, %o4
                   6295:        add     %o4, %g4, %o4                   ! may be bump usec by tick
                   6296: !!! END ms-IIep specific code
                   6297:
                   6298:        add     %o3, %o4, %o3                   ! add timer to time.tv_usec
                   6299:        set     1000000, %g5                    ! normalize usec value
                   6300:        cmp     %o3, %g5
1.156     uwe      6301:        bl,a    4f
                   6302:         st     %o2, [%o0]
1.149     uwe      6303:        inc     %o2                             ! overflow into tv_sec
                   6304:        sub     %o3, %g5, %o3
1.155     uwe      6305:        st      %o2, [%o0]
1.156     uwe      6306: 4:     retl
1.155     uwe      6307:         st     %o3, [%o0 + 4]
1.149     uwe      6308: #endif /* MSIIEP */
1.1       deraadt  6309:
1.54      pk       6310: /*
                   6311:  * delay function
                   6312:  *
                   6313:  * void delay(N)  -- delay N microseconds
                   6314:  *
                   6315:  * Register usage: %o0 = "N" number of usecs to go (counts down to zero)
                   6316:  *                %o1 = "timerblurb" (stays constant)
                   6317:  *                %o2 = counter for 1 usec (counts down from %o1 to zero)
                   6318:  *
                   6319:  */
                   6320:
                   6321: ENTRY(delay)                   ! %o0 = n
1.57      pk       6322:        subcc   %o0, %g0, %g0
                   6323:        be      2f
                   6324:
1.111     pk       6325:        sethi   %hi(_C_LABEL(timerblurb)), %o1
                   6326:        ld      [%o1 + %lo(_C_LABEL(timerblurb))], %o1  ! %o1 = timerblurb
1.53      pk       6327:
1.57      pk       6328:         addcc  %o1, %g0, %o2           ! %o2 = cntr (start @ %o1), clear CCs
1.54      pk       6329:                                        ! first time through only
                   6330:
                   6331:                                        ! delay 1 usec
                   6332: 1:     bne     1b                      ! come back here if not done
                   6333:         subcc  %o2, 1, %o2             ! %o2 = %o2 - 1 [delay slot]
1.53      pk       6334:
1.54      pk       6335:        subcc   %o0, 1, %o0             ! %o0 = %o0 - 1
                   6336:        bne     1b                      ! done yet?
                   6337:         addcc  %o1, %g0, %o2           ! reinit %o2 and CCs  [delay slot]
                   6338:                                        ! harmless if not branching
1.57      pk       6339: 2:
1.54      pk       6340:        retl                            ! return
                   6341:         nop                            ! [delay slot]
1.53      pk       6342:
1.60      pk       6343: #if defined(KGDB) || defined(DDB) || defined(DIAGNOSTIC)
1.1       deraadt  6344: /*
                   6345:  * Write all windows (user or otherwise), except the current one.
                   6346:  *
                   6347:  * THIS COULD BE DONE IN USER CODE
                   6348:  */
                   6349: ENTRY(write_all_windows)
                   6350:        /*
                   6351:         * g2 = g1 = nwindows - 1;
                   6352:         * while (--g1 > 0) save();
                   6353:         * while (--g2 > 0) restore();
                   6354:         */
1.111     pk       6355:        sethi   %hi(_C_LABEL(nwindows)), %g1
                   6356:        ld      [%g1 + %lo(_C_LABEL(nwindows))], %g1
1.1       deraadt  6357:        dec     %g1
                   6358:        mov     %g1, %g2
                   6359:
                   6360: 1:     deccc   %g1
                   6361:        bg,a    1b
                   6362:         save   %sp, -64, %sp
                   6363:
                   6364: 2:     deccc   %g2
                   6365:        bg,a    2b
                   6366:         restore
                   6367:
                   6368:        retl
                   6369:        nop
                   6370: #endif /* KGDB */
                   6371:
1.8       pk       6372: ENTRY(setjmp)
                   6373:        std     %sp, [%o0+0]    ! stack pointer & return pc
                   6374:        st      %fp, [%o0+8]    ! frame pointer
                   6375:        retl
                   6376:         clr    %o0
                   6377:
                   6378: Lpanic_ljmp:
                   6379:        .asciz  "longjmp botch"
1.52      pk       6380:        _ALIGN
1.8       pk       6381:
                   6382: ENTRY(longjmp)
                   6383:        addcc   %o1, %g0, %g6   ! compute v ? v : 1 in a global register
                   6384:        be,a    0f
                   6385:         mov    1, %g6
                   6386: 0:
                   6387:        mov     %o0, %g1        ! save a in another global register
                   6388:        ld      [%g1+8], %g7    /* get caller's frame */
                   6389: 1:
                   6390:        cmp     %fp, %g7        ! compare against desired frame
                   6391:        bl,a    1b              ! if below,
                   6392:         restore                !    pop frame and loop
                   6393:        be,a    2f              ! if there,
                   6394:         ldd    [%g1+0], %o2    !    fetch return %sp and pc, and get out
                   6395:
                   6396: Llongjmpbotch:
                   6397:                                ! otherwise, went too far; bomb out
                   6398:        save    %sp, -CCFSZ, %sp        /* preserve current window */
                   6399:        sethi   %hi(Lpanic_ljmp), %o0
1.111     pk       6400:        call    _C_LABEL(panic)
1.8       pk       6401:        or %o0, %lo(Lpanic_ljmp), %o0;
                   6402:        unimp   0
                   6403:
                   6404: 2:
                   6405:        cmp     %o2, %sp        ! %sp must not decrease
                   6406:        bge,a   3f
                   6407:         mov    %o2, %sp        ! it is OK, put it in place
                   6408:        b,a     Llongjmpbotch
1.52      pk       6409: 3:
1.8       pk       6410:        jmp     %o3 + 8         ! success, return %g6
                   6411:         mov    %g6, %o0
                   6412:
1.1       deraadt  6413:        .data
1.153     pk       6414:        .globl  _C_LABEL(kernel_top)
                   6415: _C_LABEL(kernel_top):
1.117     christos 6416:        .word   0
                   6417:        .globl  _C_LABEL(bootinfo)
                   6418: _C_LABEL(bootinfo):
1.8       pk       6419:        .word   0
1.1       deraadt  6420:
1.111     pk       6421:        .globl  _C_LABEL(proc0paddr)
                   6422: _C_LABEL(proc0paddr):
                   6423:        .word   _C_LABEL(u0)    ! KVA of proc0 uarea
1.1       deraadt  6424:
                   6425: /* interrupt counters  XXX THESE BELONG ELSEWHERE (if anywhere) */
1.111     pk       6426:        .globl  _C_LABEL(intrcnt), _C_LABEL(eintrcnt)
                   6427:        .globl  _C_LABEL(intrnames), _C_LABEL(eintrnames)
                   6428: _C_LABEL(intrnames):
1.1       deraadt  6429:        .asciz  "spur"
                   6430:        .asciz  "lev1"
                   6431:        .asciz  "lev2"
                   6432:        .asciz  "lev3"
                   6433:        .asciz  "lev4"
                   6434:        .asciz  "lev5"
                   6435:        .asciz  "lev6"
                   6436:        .asciz  "lev7"
                   6437:        .asciz  "lev8"
                   6438:        .asciz  "lev9"
                   6439:        .asciz  "clock"
                   6440:        .asciz  "lev11"
                   6441:        .asciz  "lev12"
                   6442:        .asciz  "lev13"
                   6443:        .asciz  "prof"
1.111     pk       6444: _C_LABEL(eintrnames):
1.52      pk       6445:        _ALIGN
1.111     pk       6446: _C_LABEL(intrcnt):
1.1       deraadt  6447:        .skip   4*15
1.111     pk       6448: _C_LABEL(eintrcnt):
1.1       deraadt  6449:
1.111     pk       6450:        .comm   _C_LABEL(nwindows), 4
                   6451:        .comm   _C_LABEL(romp), 4

CVSweb <webmaster@jp.NetBSD.org>