xref: /netbsd/sys/arch/cesfic/cesfic/locore.s (revision bf9ec67e)
1/*	$NetBSD: locore.s,v 1.5 2002/05/19 21:34:16 jdolecek Exp $	*/
2
3/*
4 * Copyright (c) 1994, 1995 Gordon W. Ross
5 * Copyright (c) 1988 University of Utah.
6 * Copyright (c) 1980, 1990, 1993
7 *	The Regents of the University of California.  All rights reserved.
8 *
9 * This code is derived from software contributed to Berkeley by
10 * the Systems Programming Group of the University of Utah Computer
11 * Science Department.
12 *
13 * Redistribution and use in source and binary forms, with or without
14 * modification, are permitted provided that the following conditions
15 * are met:
16 * 1. Redistributions of source code must retain the above copyright
17 *    notice, this list of conditions and the following disclaimer.
18 * 2. Redistributions in binary form must reproduce the above copyright
19 *    notice, this list of conditions and the following disclaimer in the
20 *    documentation and/or other materials provided with the distribution.
21 * 3. All advertising materials mentioning features or use of this software
22 *    must display the following acknowledgement:
23 *	This product includes software developed by the University of
24 *	California, Berkeley and its contributors.
25 * 4. Neither the name of the University nor the names of its contributors
26 *    may be used to endorse or promote products derived from this software
27 *    without specific prior written permission.
28 *
29 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
30 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
31 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
32 * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
33 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
34 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
35 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
36 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
37 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
38 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
39 * SUCH DAMAGE.
40 *
41 * from: Utah $Hdr: locore.s 1.66 92/12/22$
42 *
43 *	@(#)locore.s	8.6 (Berkeley) 5/27/94
44 */
45
46#include "opt_compat_netbsd.h"
47#include "opt_compat_svr4.h"
48#include "opt_compat_sunos.h"
49#include "opt_ddb.h"
50#include "opt_fpsp.h"
51
52#include "assym.h"
53#include <machine/asm.h>
54#include <machine/trap.h>
55
56/*
57 * This is for kvm_mkdb, and should be the address of the beginning
58 * of the kernel text segment (not necessarily the same as kernbase).
59 */
60	.text
61GLOBAL(kernel_text)
62
63/*
64 * Temporary stack for a variety of purposes.
65 * Try and make this the first thing is the data segment so it
66 * is page aligned.  Note that if we overflow here, we run into
67 * our text segment.
68 */
69	.data
70	.space	NBPG
71ASLOCAL(tmpstk)
72
73#include <cesfic/cesfic/vectors.s>
74
75	.text
76
77/*
78 * Macro to relocate a symbol, used before MMU is enabled.
79 */
80#define	_RELOC(var, ar)		\
81	lea	var-KERNBASE,ar;		\
82	addl	%a5,ar
83
84#define	RELOC(var, ar)		_RELOC(_C_LABEL(var), ar)
85#define	ASRELOC(var, ar)	_RELOC(_ASM_LABEL(var), ar)
86
87/*
88 * Initialization
89 *
90 * A4 contains the address of the end of the symtab
91 * A5 contains physical load point from boot
92 * VBR contains zero from ROM.  Exceptions will continue to vector
93 * through ROM until MMU is turned on at which time they will vector
94 * through our table (vectors.s).
95 */
96
97BSS(lowram,4)
98BSS(esym,4)
99
100	.text
101ASENTRY_NOPROFILE(start)
102	movw	#PSL_HIGHIPL, %sr	| no interrupts
103	movl	#CACHE_OFF, %d0
104	movc	%d0, %cacr		| clear and disable on-chip cache(s)
105
106	/* XXX fixed load address */
107	movl	#0x20100000, %a5
108
109	movl	#0x20000000, %a0
110	RELOC(edata, %a1)
1111:
112	movl	%a5@+, %a0@+
113	cmpl	%a5, %a1
114	bne	1b
115
116	movl	#0x20000000, %a5
117
118	ASRELOC(tmpstk, %a0)
119	movl	%a0, %sp		| give ourselves a temporary stack
120
121	RELOC(edata, %a0)
122	RELOC(end, %a1)
1232:
124	clrb	%a0@+
125	cmpl	%a0, %a1
126	bne	2b
127
128	RELOC(esym, %a0)
129#if 0
130	movl	%a4, %a0@		| store end of symbol table
131#else
132	clrl	%a0@			| no symbol table, yet
133#endif
134
135	RELOC(lowram, %a0)
136	movl	%a5, %a0@		| store start of physical memory
137
138#if 0
139	RELOC(boothowto, %a0)		| save reboot flags
140	movl	%d7, %a0@
141	RELOC(bootdev, %a0)		|   and boot device
142	movl	%d6, %a0@
143#endif
144
145	/*
146	 * All data registers are now free.  All address registers
147	 * except a5 are free.  a5 is used by the RELOC() macro,
148	 * and cannot be used until after the MMU is enabled.
149	 */
150
151/* determine our CPU/MMU combo - check for all regardless of kernel config */
152	movl	#0x200,%d0		| data freeze bit
153	movc	%d0,%cacr		|   only exists on 68030
154	movc	%cacr,%d0		| read it back
155	tstl	%d0			| zero?
156	jeq	Lnot68030		| yes, we have 68020/68040
157	RELOC(mmutype, %a0)		| no, we have 68030
158	movl	#MMU_68030,%a0@		| set to reflect 68030 PMMU
159	RELOC(cputype, %a0)
160	movl	#CPU_68030,%a0@		| and 68030 CPU
161	jra	Lstart1
162Lnot68030:
163	bset	#31,%d0			| data cache enable bit
164	movc	%d0,%cacr		|   only exists on 68040
165	movc	%cacr,%d0		| read it back
166	tstl	%d0			| zero?
167	beq	Lis68020		| yes, we have 68020
168	moveq	#0,%d0			| now turn it back off
169	movec	%d0,%cacr		|   before we access any data
170	RELOC(mmutype, %a0)
171	movl	#MMU_68040,%a0@		| with a 68040 MMU
172	RELOC(cputype, %a0)
173	movl	#CPU_68040,%a0@		| and a 68040 CPU
174	RELOC(fputype, %a0)
175	movl	#FPU_68040,%a0@		| ...and FPU
176	jra	Lstart1
177Lis68020:
178	/* impossible */
179
180Lstart1:
181
182/* initialize source/destination control registers for movs */
183	moveq	#FC_USERD,%d0		| user space
184	movc	%d0,%sfc		|   as source
185	movc	%d0,%dfc		|   and destination of transfers
186
187/* initialize memory size (for pmap_bootstrap) */
188	movl	0x5c00ac00, %d0
189	andb	#0x60, %d0
190	jne	Lnot8M
191	movl	#0x20800000, %d1	| memory end, 8M
192	jra	Lmemok
193Lnot8M:
194	cmpb	#0x20, %d0
195	jne	Lunkmem
196	movl	#0x22000000, %d1	| memory end, 32M
197	jra	Lmemok
198Lunkmem:
199	/* ??? */
200	movl	#0x20400000, %d1	| memory end, assume at least 4M
201
202Lmemok:
203	moveq	#PGSHIFT,%d2
204	lsrl	%d2,%d1			| convert to page (click) number
205	movl	%a5,%d0			| lowram value from ROM via boot
206	lsrl	%d2,%d0			| convert to page number
207	subl	%d0,%d1			| compute amount of RAM present
208	RELOC(physmem, %a0)
209	movl	%d1,%a0@		| and physmem
210/* configure kernel and proc0 VA space so we can get going */
211	.globl	_Sysseg, _pmap_bootstrap, _avail_start
212#ifdef DDB
213	RELOC(esym,%a0)			| end of static kernel test/data/syms
214	movl	%a0@,%d5
215	jne	Lstart2
216#endif
217	movl	#_C_LABEL(end),%d5	| end of static kernel text/data
218Lstart2:
219	addl	#NBPG-1,%d5
220	andl	#PG_FRAME,%d5		| round to a page
221	movl	%d5,%a4
222	addl	%a5,%a4			| convert to PA
223	subl	#KERNBASE, %a4
224	pea	%a5@			| firstpa
225	pea	%a4@			| nextpa
226	RELOC(pmap_bootstrap,%a0)
227	jbsr	%a0@			| pmap_bootstrap(firstpa, nextpa)
228	addql	#8,%sp
229
230/*
231 * Prepare to enable MMU.
232 */
233	RELOC(Sysseg, %a0)		| system segment table addr
234	movl	%a0@,%d1		| read value (a KVA)
235	addl	%a5,%d1			| convert to PA
236	subl	#KERNBASE, %d1
237
238	RELOC(mmutype, %a0)
239	cmpl	#MMU_68040,%a0@		| 68040?
240	jne	Lmotommu1		| no, skip
241	.long	0x4e7b1807		| movc d1,srp
242	jra	Lstploaddone
243Lmotommu1:
244	RELOC(protorp, %a0)
245	movl	#0x80000202,%a0@	| nolimit + share global + 4 byte PTEs
246	movl	%d1,%a0@(4)		| + segtable address
247	pmove	%a0@,%srp		| load the supervisor root pointer
248	movl	#0x80000002,%a0@	| reinit upper half for CRP loads
249Lstploaddone:
250
251	RELOC(mmutype, %a0)
252	cmpl	#MMU_68040,%a0@		| 68040?
253	jne	Lmotommu2		| no, skip
254
255	movel #0x2000c000, %d0		| double map RAM
256	.long	0x4e7b0004		| movc d0,itt0
257	.long	0x4e7b0006		| movc d0,dtt0
258	moveq	#0, %d0			| ensure TT regs are disabled
259	.long	0x4e7b0005		| movc d0,itt1
260	.long	0x4e7b0007		| movc d0,dtt1
261
262	.word	0xf4d8			| cinva bc
263	.word	0xf518			| pflusha
264
265	movl	#0x8000, %d0
266	.long	0x4e7b0003		| movc d0,tc
267	movl	#0x80008000, %d0
268	movc	%d0, %cacr		| turn on both caches
269
270	jmp	Lenab1:l		| avoid pc-relative
271Lmotommu2:
272	/* XXX do TT here */
273	RELOC(prototc, %a2)
274	movl	#0x82c0aa00,%a2@	| value to load TC with
275	pmove	%a2@,%tc		| load it
276	jmp	Lenab1
277
278/*
279 * Should be running mapped from this point on
280 */
281Lenab1:
282	.word	0xf4d8			| cinva bc
283	.word	0xf518			| pflusha
284	nop
285	nop
286	nop
287	nop
288	nop
289	movl	#_C_LABEL(vectab),%d0	| set Vector Base Register
290	movc	%d0,%vbr
291	moveq	#0,%d0			| ensure TT regs are disabled
292	.long	0x4e7b0004		| movc d0,itt0
293	.long	0x4e7b0005		| movc d0,itt1
294	.long	0x4e7b0006		| movc d0,dtt0
295	.long	0x4e7b0007		| movc d0,dtt1
296
297/* select the software page size now */
298	lea	_ASM_LABEL(tmpstk),%sp	| temporary stack
299	jbsr	_C_LABEL(uvm_setpagesize)  | select software page size
300/* set kernel stack, user SP, and initial pcb */
301	movl	_C_LABEL(proc0paddr),%a1   | get proc0 pcb addr
302	lea	%a1@(USPACE-4),%sp	| set kernel stack to end of area
303	lea	_C_LABEL(proc0),%a2	| initialize proc0.p_addr so that
304	movl	%a1,%a2@(P_ADDR)	|   we don't deref NULL in trap()
305	movl	#USRSTACK-4,%a2
306	movl	%a2,%usp		| init user SP
307	movl	%a1,_C_LABEL(curpcb)	| proc0 is running
308
309	tstl	_C_LABEL(fputype)	| Have an FPU?
310	jeq	Lenab2			| No, skip.
311	clrl	%a1@(PCB_FPCTX)		| ensure null FP context
312	movl	%a1,%sp@-
313	jbsr	_C_LABEL(m68881_restore)   | restore it (does not kill a1)
314	addql	#4,%sp
315Lenab2:
316
317/* flush TLB and turn on caches */
318	jbsr	_C_LABEL(TBIA)		| invalidate TLB
319	cmpl	#MMU_68040,_C_LABEL(mmutype)	| 68040?
320	jeq	Lnocache0		| yes, cache already on
321	movl	#CACHE_ON,%d0
322	movc	%d0,%cacr		| clear cache(s)
323Lnocache0:
324
325/* Final setup for call to main(). */
326	jbsr	_C_LABEL(fic_init)
327
328/*
329 * Create a fake exception frame so that cpu_fork() can copy it.
330 * main() nevers returns; we exit to user mode from a forked process
331 * later on.
332 */
333	clrw	%sp@-			| vector offset/frame type
334	clrl	%sp@-			| PC - filled in by "execve"
335	movw	#PSL_USER,%sp@-		| in user mode
336	clrl	%sp@-			| stack adjust count and padding
337	lea	%sp@(-64),%sp		| construct space for D0-D7/A0-A7
338	lea	_C_LABEL(proc0),%a0	| save pointer to frame
339	movl	%sp,%a0@(P_MD_REGS)	|   in proc0.p_md.md_regs
340
341	jra	_C_LABEL(main)		| main()
342
343	pea	Lmainreturned		| Yow!  Main returned!
344	jbsr	_C_LABEL(panic)
345	/* NOTREACHED */
346Lmainreturned:
347	.asciz	"main() returned"
348	.even
349
350GLOBAL(proc_trampoline)
351	movl	%a3,%sp@-
352	jbsr	%a2@
353	addql	#4,%sp
354	movl	%sp@(FR_SP),%a0		| grab and load
355	movl	%a0,%usp		|   user SP
356	moveml	%sp@+,#0x7FFF		| restore most user regs
357	addql	#8,%sp			| toss SP and stack adjust
358	jra	_ASM_LABEL(rei)		| and return
359
360
361/*
362 * Trap/interrupt vector routines
363 */
364#include <m68k/m68k/trap_subr.s>
365
366	.data
367GLOBAL(m68k_fault_addr)
368	.long	0
369
370#if defined(M68040) || defined(M68060)
371ENTRY_NOPROFILE(addrerr4060)
372	clrl	%sp@-			| stack adjust count
373	moveml	#0xFFFF,%sp@-		| save user registers
374	movl	%usp,%a0			| save the user SP
375	movl	%a0,%sp@(FR_SP)		|   in the savearea
376	movl	%sp@(FR_HW+8),%sp@-
377	clrl	%sp@-			| dummy code
378	movl	#T_ADDRERR,%sp@-		| mark address error
379	jra	_ASM_LABEL(faultstkadj)	| and deal with it
380#endif
381
382#if defined(M68060)
383	clrl	%sp@-			| stack adjust count
384	moveml	#0xFFFF,%sp@-		| save user registers
385	movl	%usp,%a0			| save the user SP
386	movl	%a0,%sp@(FR_SP)		|   in the savearea
387	movel	%sp@(FR_HW+12),%d0	| FSLW
388	btst	#2,%d0			| branch prediction error?
389	jeq	Lnobpe
390	movc	%cacr,%d2
391	orl	#IC60_CABC,%d2		| clear all branch cache entries
392	movc	%d2,%cacr
393	movl	%d0,%d1
394	addql	#1,L60bpe
395	andl	#0x7ffd,%d1
396	jeq	_ASM_LABEL(faultstkadjnotrap2)
397Lnobpe:
398| we need to adjust for misaligned addresses
399	movl	%sp@(FR_HW+8),%d1		| grab VA
400	btst	#27,%d0			| check for mis-aligned access
401	jeq	Lberr3			| no, skip
402	addl	#28,%d1			| yes, get into next page
403					| operand case: 3,
404					| instruction case: 4+12+12
405	andl	#PG_FRAME,%d1            | and truncate
406Lberr3:
407	movl	%d1,%sp@-
408	movl	%d0,%sp@-			| code is FSLW now.
409	andw	#0x1f80,%d0
410	jeq	Lberr60			| it is a bus error
411	movl	#T_MMUFLT,%sp@-		| show that we are an MMU fault
412	jra	_ASM_LABEL(faultstkadj)	| and deal with it
413Lberr60:
414	tstl	_C_LABEL(nofault)	| catch bus error?
415	jeq	Lisberr			| no, handle as usual
416	movl	%sp@(FR_HW+8+8),_C_LABEL(m68k_fault_addr) | save fault addr
417	movl	_C_LABEL(nofault),%sp@-	| yes,
418	jbsr	_C_LABEL(longjmp)	|  longjmp(nofault)
419	/* NOTREACHED */
420#endif
421#if defined(M68040)
422ENTRY_NOPROFILE(buserr40)
423	clrl	%sp@-			| stack adjust count
424	moveml	#0xFFFF,%sp@-		| save user registers
425	movl	%usp,%a0			| save the user SP
426	movl	%a0,%sp@(FR_SP)		|   in the savearea
427	movl	%sp@(FR_HW+20),%d1	| get fault address
428	moveq	#0,%d0
429	movw	%sp@(FR_HW+12),%d0	| get SSW
430	btst	#11,%d0			| check for mis-aligned
431	jeq	Lbe1stpg		| no skip
432	addl	#3,%d1			| get into next page
433	andl	#PG_FRAME,%d1		| and truncate
434Lbe1stpg:
435	movl	%d1,%sp@-			| pass fault address.
436	movl	%d0,%sp@-			| pass SSW as code
437	btst	#10,%d0			| test ATC
438	jeq	Lberr40			| it is a bus error
439	movl	#T_MMUFLT,%sp@-		| show that we are an MMU fault
440	jra	_ASM_LABEL(faultstkadj)	| and deal with it
441Lberr40:
442	tstl	_C_LABEL(nofault)	| catch bus error?
443	jeq	Lisberr			| no, handle as usual
444	movl	%sp@(FR_HW+8+20),_C_LABEL(m68k_fault_addr) | save fault addr
445	movl	_C_LABEL(nofault),%sp@-	| yes,
446	jbsr	_C_LABEL(longjmp)	|  longjmp(nofault)
447	/* NOTREACHED */
448#endif
449
450#if defined(M68020) || defined(M68030)
451ENTRY_NOPROFILE(busaddrerr2030)
452	clrl	%sp@-			| stack adjust count
453	moveml	#0xFFFF,%sp@-		| save user registers
454	movl	%usp,%a0			| save the user SP
455	movl	%a0,%sp@(FR_SP)		|   in the savearea
456	moveq	#0,%d0
457	movw	%sp@(FR_HW+10),%d0	| grab SSW for fault processing
458	btst	#12,%d0			| RB set?
459	jeq	LbeX0			| no, test RC
460	bset	#14,%d0			| yes, must set FB
461	movw	%d0,%sp@(FR_HW+10)	| for hardware too
462LbeX0:
463	btst	#13,%d0			| RC set?
464	jeq	LbeX1			| no, skip
465	bset	#15,%d0			| yes, must set FC
466	movw	%d0,%sp@(FR_HW+10)	| for hardware too
467LbeX1:
468	btst	#8,%d0			| data fault?
469	jeq	Lbe0			| no, check for hard cases
470	movl	%sp@(FR_HW+16),%d1	| fault address is as given in frame
471	jra	Lbe10			| thats it
472Lbe0:
473	btst	#4,%sp@(FR_HW+6)		| long (type B) stack frame?
474	jne	Lbe4			| yes, go handle
475	movl	%sp@(FR_HW+2),%d1		| no, can use save PC
476	btst	#14,%d0			| FB set?
477	jeq	Lbe3			| no, try FC
478	addql	#4,%d1			| yes, adjust address
479	jra	Lbe10			| done
480Lbe3:
481	btst	#15,%d0			| FC set?
482	jeq	Lbe10			| no, done
483	addql	#2,%d1			| yes, adjust address
484	jra	Lbe10			| done
485Lbe4:
486	movl	%sp@(FR_HW+36),%d1	| long format, use stage B address
487	btst	#15,%d0			| FC set?
488	jeq	Lbe10			| no, all done
489	subql	#2,%d1			| yes, adjust address
490Lbe10:
491	movl	%d1,%sp@-			| push fault VA
492	movl	%d0,%sp@-			| and padded SSW
493	movw	%sp@(FR_HW+8+6),%d0	| get frame format/vector offset
494	andw	#0x0FFF,%d0		| clear out frame format
495	cmpw	#12,%d0			| address error vector?
496	jeq	Lisaerr			| yes, go to it
497#if defined(M68K_MMU_MOTOROLA)
498#if defined(M68K_MMU_HP)
499	tstl	_C_LABEL(mmutype)	| HP MMU?
500	jeq	Lbehpmmu		| yes, different MMU fault handler
501#endif
502	movl	%d1,%a0			| fault address
503	movl	%sp@,%d0			| function code from ssw
504	btst	#8,%d0			| data fault?
505	jne	Lbe10a
506	movql	#1,%d0			| user program access FC
507					| (we dont separate data/program)
508	btst	#5,%sp@(FR_HW+8)		| supervisor mode?
509	jeq	Lbe10a			| if no, done
510	movql	#5,%d0			| else supervisor program access
511Lbe10a:
512	ptestr	%d0,%a0@,#7		| do a table search
513	pmove	%psr,%sp@			| save result
514	movb	%sp@,%d1
515	btst	#2,%d1			| invalid (incl. limit viol. and berr)?
516	jeq	Lmightnotbemerr		| no -> wp check
517	btst	#7,%d1			| is it MMU table berr?
518	jne	Lisberr1		| yes, needs not be fast.
519#endif /* M68K_MMU_MOTOROLA */
520Lismerr:
521	movl	#T_MMUFLT,%sp@-		| show that we are an MMU fault
522	jra	_ASM_LABEL(faultstkadj)	| and deal with it
523#if defined(M68K_MMU_MOTOROLA)
524Lmightnotbemerr:
525	btst	#3,%d1			| write protect bit set?
526	jeq	Lisberr1		| no: must be bus error
527	movl	%sp@,%d0			| ssw into low word of %d0
528	andw	#0xc0,%d0		| Write protect is set on page:
529	cmpw	#0x40,%d0		| was it read cycle?
530	jne	Lismerr			| no, was not WPE, must be MMU fault
531	jra	Lisberr1		| real bus err needs not be fast.
532#endif /* M68K_MMU_MOTOROLA */
533#if defined(M68K_MMU_HP)
534Lbehpmmu:
535	MMUADDR(%a0)
536	movl	%a0@(MMUSTAT),%d0		| read MMU status
537	btst	#3,%d0			| MMU fault?
538	jeq	Lisberr1		| no, just a non-MMU bus error
539	andl	#~MMU_FAULT,%a0@(MMUSTAT)| yes, clear fault bits
540	movw	%d0,%sp@			| pass MMU stat in upper half of code
541	jra	Lismerr			| and handle it
542#endif
543Lisaerr:
544	movl	#T_ADDRERR,%sp@-		| mark address error
545	jra	_ASM_LABEL(faultstkadj)	| and deal with it
546Lisberr1:
547	clrw	%sp@			| re-clear pad word
548	tstl	_C_LABEL(nofault)	| catch bus error?
549	jeq	Lisberr			| no, handle as usual
550	movl	%sp@(FR_HW+8+16),_C_LABEL(m68k_fault_addr) | save fault addr
551	movl	_C_LABEL(nofault),%sp@-	| yes,
552	jbsr	_C_LABEL(longjmp)	|  longjmp(nofault)
553	/* NOTREACHED */
554#endif /* M68020 || M68030 */
555
556Lisberr:				| also used by M68040/60
557	movl	#T_BUSERR,%sp@-		| mark bus error
558	jra	_ASM_LABEL(faultstkadj)	| and deal with it
559
560/*
561 * FP exceptions.
562 */
563ENTRY_NOPROFILE(fpfline)
564#if defined(M68040)
565	cmpl	#FPU_68040,_C_LABEL(fputype) | 68040 FPU?
566	jne	Lfp_unimp		| no, skip FPSP
567	cmpw	#0x202c,%sp@(6)		| format type 2?
568	jne	_C_LABEL(illinst)	| no, not an FP emulation
569Ldofp_unimp:
570#ifdef FPSP
571#if 0
572	addl	#1, _C_LABEL(evcnt_fpsp_unimp)+EVCNT_COUNT
573#endif
574	jmp	_ASM_LABEL(fpsp_unimp)	| yes, go handle it
575#endif
576Lfp_unimp:
577#endif /* M68040 */
578#ifdef FPU_EMULATE
579	clrl	%sp@-			| stack adjust count
580	moveml	#0xFFFF,%sp@-		| save registers
581	moveq	#T_FPEMULI,%d0		| denote as FP emulation trap
582	jra	_ASM_LABEL(fault)	| do it
583#else
584	jra	_C_LABEL(illinst)
585#endif
586
587ENTRY_NOPROFILE(fpunsupp)
588#if defined(M68040)
589	cmpl	#FPU_68040,_C_LABEL(fputype) | 68040 FPU?
590	jne	_C_LABEL(illinst)	| no, treat as illinst
591#ifdef FPSP
592#if 0
593	addl	#1, _C_LABEL(evcnt_fpsp_unsupp)+EVCNT_COUNT
594#endif
595	jmp	_ASM_LABEL(fpsp_unsupp)	| yes, go handle it
596#endif
597Lfp_unsupp:
598#endif /* M68040 */
599#ifdef FPU_EMULATE
600	clrl	%sp@-			| stack adjust count
601	moveml	#0xFFFF,%sp@-		| save registers
602	moveq	#T_FPEMULD,%d0		| denote as FP emulation trap
603	jra	_ASM_LABEL(fault)	| do it
604#else
605	jra	_C_LABEL(illinst)
606#endif
607
608/*
609 * Handles all other FP coprocessor exceptions.
610 * Note that since some FP exceptions generate mid-instruction frames
611 * and may cause signal delivery, we need to test for stack adjustment
612 * after the trap call.
613 */
614ENTRY_NOPROFILE(fpfault)
615	clrl	%sp@-		| stack adjust count
616	moveml	#0xFFFF,%sp@-	| save user registers
617	movl	%usp,%a0		| and save
618	movl	%a0,%sp@(FR_SP)	|   the user stack pointer
619	clrl	%sp@-		| no VA arg
620	movl	_C_LABEL(curpcb),%a0 | current pcb
621	lea	%a0@(PCB_FPCTX),%a0 | address of FP savearea
622	fsave	%a0@		| save state
623#if defined(M68040) || defined(M68060)
624	/* always null state frame on 68040, 68060 */
625	cmpl	#FPU_68040,_C_LABEL(fputype)
626	jle	Lfptnull
627#endif
628	tstb	%a0@		| null state frame?
629	jeq	Lfptnull	| yes, safe
630	clrw	%d0		| no, need to tweak BIU
631	movb	%a0@(1),%d0	| get frame size
632	bset	#3,%a0@(0,%d0:w)	| set exc_pend bit of BIU
633Lfptnull:
634	fmovem	%fpsr,%sp@-	| push %fpsr as code argument
635	frestore %a0@		| restore state
636	movl	#T_FPERR,%sp@-	| push type arg
637	jra	_ASM_LABEL(faultstkadj) | call trap and deal with stack cleanup
638
639
640ENTRY_NOPROFILE(badtrap)
641	moveml	#0xC0C0,%sp@-		| save scratch regs
642	movw	%sp@(22),%sp@-		| push exception vector info
643	clrw	%sp@-
644	movl	%sp@(22),%sp@-		| and PC
645	jbsr	_C_LABEL(straytrap)	| report
646	addql	#8,%sp			| pop args
647	moveml	%sp@+,#0x0303		| restore regs
648	jra	_ASM_LABEL(rei)		| all done
649
650ENTRY_NOPROFILE(trap0)
651	clrl	%sp@-			| stack adjust count
652	moveml	#0xFFFF,%sp@-		| save user registers
653	movl	%usp,%a0			| save the user SP
654	movl	%a0,%sp@(FR_SP)		|   in the savearea
655	movl	%d0,%sp@-			| push syscall number
656	jbsr	_C_LABEL(syscall)	| handle it
657	addql	#4,%sp			| pop syscall arg
658	tstl	_C_LABEL(astpending)
659	jne	Lrei2
660	tstb	_C_LABEL(ssir)
661	jeq	Ltrap1
662	movw	#SPL1,%sr
663	tstb	_C_LABEL(ssir)
664	jne	Lsir1
665Ltrap1:
666	movl	%sp@(FR_SP),%a0		| grab and restore
667	movl	%a0,%usp			|   user SP
668	moveml	%sp@+,#0x7FFF		| restore most registers
669	addql	#8,%sp			| pop SP and stack adjust
670	rte
671
672/*
673 * Trap 12 is the entry point for the cachectl "syscall" (both HPUX & BSD)
674 *	cachectl(command, addr, length)
675 * command in d0, addr in a1, length in d1
676 */
677ENTRY_NOPROFILE(trap12)
678	movl	_C_LABEL(curproc),%sp@-	| push current proc pointer
679	movl	%d1,%sp@-			| push length
680	movl	%a1,%sp@-			| push addr
681	movl	%d0,%sp@-			| push command
682	jbsr	_C_LABEL(cachectl1)	| do it
683	lea	%sp@(16),%sp		| pop args
684	jra	_ASM_LABEL(rei)		| all done
685
686/*
687 * Trace (single-step) trap.  Kernel-mode is special.
688 * User mode traps are simply passed on to trap().
689 */
690ENTRY_NOPROFILE(trace)
691	clrl	%sp@-			| stack adjust count
692	moveml	#0xFFFF,%sp@-
693	moveq	#T_TRACE,%d0
694
695	| Check PSW and see what happen.
696	|   T=0 S=0	(should not happen)
697	|   T=1 S=0	trace trap from user mode
698	|   T=0 S=1	trace trap on a trap instruction
699	|   T=1 S=1	trace trap from system mode (kernel breakpoint)
700
701	movw	%sp@(FR_HW),%d1		| get PSW
702	notw	%d1			| XXX no support for T0 on 680[234]0
703	andw	#PSL_TS,%d1		| from system mode (T=1, S=1)?
704	jeq	Lkbrkpt			| yes, kernel breakpoint
705	jra	_ASM_LABEL(fault)	| no, user-mode fault
706
707
708/*
709 * Trap 15 is used for:
710 *	- GDB breakpoints (in user programs)
711 *	- KGDB breakpoints (in the kernel)
712 *	- trace traps for SUN binaries (not fully supported yet)
713 * User mode traps are simply passed to trap().
714 */
715ENTRY_NOPROFILE(trap15)
716	clrl	%sp@-			| stack adjust count
717	moveml	#0xFFFF,%sp@-
718	moveq	#T_TRAP15,%d0
719	movw	%sp@(FR_HW),%d1		| get PSW
720	andw	#PSL_S,%d1		| from system mode?
721	jne	Lkbrkpt			| yes, kernel breakpoint
722	jra	_ASM_LABEL(fault)	| no, user-mode fault
723
724Lkbrkpt: | Kernel-mode breakpoint or trace trap. (%d0=trap_type)
725	| Save the system sp rather than the user sp.
726	movw	#PSL_HIGHIPL,%sr		| lock out interrupts
727	lea	%sp@(FR_SIZE),%a6		| Save stack pointer
728	movl	%a6,%sp@(FR_SP)		|  from before trap
729
730	| If were are not on tmpstk switch to it.
731	| (so debugger can change the stack pointer)
732	movl	%a6,%d1
733	cmpl	#_ASM_LABEL(tmpstk),%d1
734	jls	Lbrkpt2			| already on tmpstk
735	| Copy frame to the temporary stack
736	movl	%sp,%a0			| %a0=src
737	lea	_ASM_LABEL(tmpstk)-96,%a1 | a1=dst
738	movl	%a1,%sp			| %sp=new frame
739	moveq	#FR_SIZE,%d1
740Lbrkpt1:
741	movl	%a0@+,%a1@+
742	subql	#4,%d1
743	bgt	Lbrkpt1
744
745Lbrkpt2:
746	| Call the trap handler for the kernel debugger.
747	| Do not call trap() to do it, so that we can
748	| set breakpoints in trap() if we want.  We know
749	| the trap type is either T_TRACE or T_BREAKPOINT.
750	movl	%d0,%sp@-		| push trap type
751	jbsr	_C_LABEL(trap_kdebug)
752	addql	#4,%sp			| pop args
753
754	| The stack pointer may have been modified, or
755	| data below it modified (by kgdb push call),
756	| so push the hardware frame at the current sp
757	| before restoring registers and returning.
758
759	movl	%sp@(FR_SP),%a0		| modified %sp
760	lea	%sp@(FR_SIZE),%a1		| end of our frame
761	movl	%a1@-,%a0@-		| copy 2 longs with
762	movl	%a1@-,%a0@-		| ... predecrement
763	movl	%a0,%sp@(FR_SP)		| %sp = h/w frame
764	moveml	%sp@+,#0x7FFF		| restore all but %sp
765	movl	%sp@,%sp			| ... and %sp
766	rte				| all done
767
768/* Use common m68k sigreturn */
769#include <m68k/m68k/sigreturn.s>
770
771/*
772 * Interrupt handlers.
773 * All device interrupts are auto-vectored.  The CPU provides
774 * the vector 0x18+level.  Note we count spurious interrupts, but
775 * we don't do anything else with them.
776 */
777
778#define INTERRUPT_SAVEREG	moveml	#0xC0C0,%sp@-
779#define INTERRUPT_RESTOREREG	moveml	%sp@+,#0x0303
780
781ENTRY_NOPROFILE(spurintr)	/* level 0 */
782	addql	#1,_C_LABEL(intrcnt)+0
783	addql	#1,_C_LABEL(uvmexp)+UVMEXP_INTRS
784	jra	_ASM_LABEL(rei)
785
786ENTRY_NOPROFILE(intrhand)	/* levels 1 through 5 */
787	INTERRUPT_SAVEREG
788	movw	%sp@(22),%sp@-		| push exception vector info
789	clrw	%sp@-
790	jbsr	_C_LABEL(isrdispatch)	| call dispatch routine
791	addql	#4,%sp
792	INTERRUPT_RESTOREREG
793	jra	_ASM_LABEL(rei)		| all done
794
795ENTRY_NOPROFILE(lev6intr)	/* Level 6: clock */
796	INTERRUPT_SAVEREG
797	/* XXX */
798	movl _C_LABEL(clockbase), %a0
799	movl %a0@, %d0
800	movl %d0, %a0@
801	btst #2, %d0
802	jeq 1f
803	addql	#1,_C_LABEL(intrcnt)+24
804	lea	%sp@(16), %a1		| a1 = &clockframe
805	movl	%a1, %sp@-
806	jbsr	_C_LABEL(hardclock)	| hardclock(&frame)
807	addql	#4, %sp
808	jra 2f
8091:
810	movl	%d0, %sp@-
811	jbsr	_C_LABEL(otherclock)
812	addql	#4, %sp
8132:
814	INTERRUPT_RESTOREREG
815	jra	_ASM_LABEL(rei)		| all done
816
817ENTRY_NOPROFILE(lev7intr)	/* level 7: parity errors, reset key */
818	addql	#1,_C_LABEL(intrcnt)+28
819	clrl	%sp@-
820	moveml	#0xFFFF,%sp@-		| save registers
821	movl	%usp,%a0			| and save
822	movl	%a0,%sp@(FR_SP)		|   the user stack pointer
823	jbsr	_C_LABEL(nmihand)	| call handler
824	movl	%sp@(FR_SP),%a0		| restore
825	movl	%a0,%usp			|   user SP
826	moveml	%sp@+,#0x7FFF		| and remaining registers
827	addql	#8,%sp			| pop SP and stack adjust
828	jra	_ASM_LABEL(rei)		| all done
829
830/*
831 * Emulation of VAX REI instruction.
832 *
833 * This code deals with checking for and servicing ASTs
834 * (profiling, scheduling) and software interrupts (network, softclock).
835 * We check for ASTs first, just like the VAX.  To avoid excess overhead
836 * the T_ASTFLT handling code will also check for software interrupts so we
837 * do not have to do it here.  After identifing that we need an AST we
838 * drop the IPL to allow device interrupts.
839 *
840 * This code is complicated by the fact that sendsig may have been called
841 * necessitating a stack cleanup.
842 */
843BSS(ssir,1)
844
845ASENTRY_NOPROFILE(rei)
846	tstl	_C_LABEL(astpending)	| AST pending?
847	jeq	Lchksir			| no, go check for SIR
848Lrei1:
849	btst	#5,%sp@			| yes, are we returning to user mode?
850	jne	Lchksir			| no, go check for SIR
851	movw	#PSL_LOWIPL,%sr		| lower SPL
852	clrl	%sp@-			| stack adjust
853	moveml	#0xFFFF,%sp@-		| save all registers
854	movl	%usp,%a1			| including
855	movl	%a1,%sp@(FR_SP)		|    the users SP
856Lrei2:
857	clrl	%sp@-			| VA == none
858	clrl	%sp@-			| code == none
859	movl	#T_ASTFLT,%sp@-		| type == async system trap
860	jbsr	_C_LABEL(trap)		| go handle it
861	lea	%sp@(12),%sp		| pop value args
862	movl	%sp@(FR_SP),%a0		| restore user SP
863	movl	%a0,%usp			|   from save area
864	movw	%sp@(FR_ADJ),%d0		| need to adjust stack?
865	jne	Laststkadj		| yes, go to it
866	moveml	%sp@+,#0x7FFF		| no, restore most user regs
867	addql	#8,%sp			| toss SP and stack adjust
868	rte				| and do real RTE
869Laststkadj:
870	lea	%sp@(FR_HW),%a1		| pointer to HW frame
871	addql	#8,%a1			| source pointer
872	movl	%a1,%a0			| source
873	addw	%d0,%a0			|  + hole size = dest pointer
874	movl	%a1@-,%a0@-		| copy
875	movl	%a1@-,%a0@-		|  8 bytes
876	movl	%a0,%sp@(FR_SP)		| new SSP
877	moveml	%sp@+,#0x7FFF		| restore user registers
878	movl	%sp@,%sp			| and our SP
879	rte				| and do real RTE
880Lchksir:
881	tstb	_C_LABEL(ssir)		| SIR pending?
882	jeq	Ldorte			| no, all done
883	movl	%d0,%sp@-			| need a scratch register
884	movw	%sp@(4),%d0		| get SR
885	andw	#PSL_IPL7,%d0		| mask all but IPL
886	jne	Lnosir			| came from interrupt, no can do
887	movl	%sp@+,%d0			| restore scratch register
888Lgotsir:
889	movw	#SPL1,%sr		| prevent others from servicing int
890	tstb	_C_LABEL(ssir)		| too late?
891	jeq	Ldorte			| yes, oh well...
892	clrl	%sp@-			| stack adjust
893	moveml	#0xFFFF,%sp@-		| save all registers
894	movl	%usp,%a1			| including
895	movl	%a1,%sp@(FR_SP)		|    the users SP
896Lsir1:
897	clrl	%sp@-			| VA == none
898	clrl	%sp@-			| code == none
899	movl	#T_SSIR,%sp@-		| type == software interrupt
900	jbsr	_C_LABEL(trap)		| go handle it
901	lea	%sp@(12),%sp		| pop value args
902	movl	%sp@(FR_SP),%a0		| restore
903	movl	%a0,%usp			|   user SP
904	moveml	%sp@+,#0x7FFF		| and all remaining registers
905	addql	#8,%sp			| pop SP and stack adjust
906	rte
907Lnosir:
908	movl	%sp@+,%d0			| restore scratch register
909Ldorte:
910	rte				| real return
911
912/*
913 * Use common m68k sigcode.
914 */
915#include <m68k/m68k/sigcode.s>
916#ifdef COMPAT_SUNOS
917#include <m68k/m68k/sunos_sigcode.s>
918#endif
919#ifdef COMPAT_SVR4
920#include <m68k/m68k/svr4_sigcode.s>
921#endif
922
923/*
924 * Primitives
925 */
926
927/*
928 * Use common m68k support routines.
929 */
930#include <m68k/m68k/support.s>
931
932/*
933 * Use common m68k process manipulation routines.
934 */
935#include <m68k/m68k/proc_subr.s>
936
937	.data
938GLOBAL(curpcb)
939GLOBAL(masterpaddr)		| XXX compatibility (debuggers)
940	.long	0
941
942ASLOCAL(mdpflag)
943	.byte	0		| copy of proc md_flags low byte
944#ifdef __ELF__
945	.align	4
946#else
947	.align	2
948#endif
949
950ASBSS(nullpcb,SIZEOF_PCB)
951
952/*
953 * At exit of a process, do a switch for the last time.
954 * Switch to a safe stack and PCB, and deallocate the process's resources.
955 */
956ENTRY(switch_exit)
957	movl	%sp@(4),%a0
958	/* save state into garbage pcb */
959	movl	#_ASM_LABEL(nullpcb),_C_LABEL(curpcb)
960	lea	_ASM_LABEL(tmpstk),%sp	| goto a tmp stack
961
962	/* Schedule the vmspace and stack to be freed. */
963	movl	%a0,%sp@-			| exit2(p)
964	jbsr	_C_LABEL(exit2)
965	lea	%sp@(4),%sp		| pop args
966
967	jra	_C_LABEL(cpu_switch)
968
969/*
970 * When no processes are on the runq, Swtch branches to Idle
971 * to wait for something to come ready.
972 */
973ASENTRY_NOPROFILE(Idle)
974	stop	#PSL_LOWIPL
975	movw	#PSL_HIGHIPL,%sr
976	movl	_C_LABEL(sched_whichqs),%d0
977	jeq	_ASM_LABEL(Idle)
978	jra	Lsw1
979
980Lbadsw:
981	PANIC("switch")
982	/*NOTREACHED*/
983
984/*
985 * cpu_switch()
986 *
987 * NOTE: On the mc68851 (318/319/330) we attempt to avoid flushing the
988 * entire ATC.  The effort involved in selective flushing may not be
989 * worth it, maybe we should just flush the whole thing?
990 *
991 * NOTE 2: With the new VM layout we now no longer know if an inactive
992 * user's PTEs have been changed (formerly denoted by the SPTECHG p_flag
993 * bit).  For now, we just always flush the full ATC.
994 */
995ENTRY(cpu_switch)
996	movl	_C_LABEL(curpcb),%a0	| current pcb
997	movw	%sr,%a0@(PCB_PS)		| save %sr before changing ipl
998#ifdef notyet
999	movl	_C_LABEL(curproc),%sp@-	| remember last proc running
1000#endif
1001	clrl	_C_LABEL(curproc)
1002
1003	/*
1004	 * Find the highest-priority queue that isn't empty,
1005	 * then take the first proc from that queue.
1006	 */
1007	movw	#PSL_HIGHIPL,%sr		| lock out interrupts
1008	movl	_C_LABEL(sched_whichqs),%d0
1009	jeq	_ASM_LABEL(Idle)
1010Lsw1:
1011	movl	%d0,%d1
1012	negl	%d0
1013	andl	%d1,%d0
1014	bfffo	%d0{#0:#32},%d1
1015	eorib	#31,%d1
1016
1017	movl	%d1,%d0
1018	lslb	#3,%d1			| convert queue number to index
1019	addl	#_C_LABEL(sched_qs),%d1	| locate queue (q)
1020	movl	%d1,%a1
1021	movl	%a1@(P_FORW),%a0		| p = q->p_forw
1022	cmpal	%d1,%a0			| anyone on queue?
1023	jeq	Lbadsw			| no, panic
1024	movl	%a0@(P_FORW),%a1@(P_FORW)	| q->p_forw = p->p_forw
1025	movl	%a0@(P_FORW),%a1		| n = p->p_forw
1026	movl	%d1,%a1@(P_BACK)		| n->p_back = q
1027	cmpal	%d1,%a1			| anyone left on queue?
1028	jne	Lsw2			| yes, skip
1029	movl	_C_LABEL(sched_whichqs),%d1
1030	bclr	%d0,%d1			| no, clear bit
1031	movl	%d1,_C_LABEL(sched_whichqs)
1032Lsw2:
1033	/* p->p_cpu initialized in fork1() for single-processor */
1034	movb	#SONPROC,%a0@(P_STAT)	| p->p_stat = SONPROC
1035	movl	%a0,_C_LABEL(curproc)
1036	clrl	_C_LABEL(want_resched)
1037#ifdef notyet
1038	movl	%sp@+,%a1
1039	cmpl	%a0,%a1			| switching to same proc?
1040	jeq	Lswdone			| yes, skip save and restore
1041#endif
1042	/*
1043	 * Save state of previous process in its pcb.
1044	 */
1045	movl	_C_LABEL(curpcb),%a1
1046	moveml	#0xFCFC,%a1@(PCB_REGS)	| save non-scratch registers
1047	movl	%usp,%a2			| grab USP (%a2 has been saved)
1048	movl	%a2,%a1@(PCB_USP)		| and save it
1049
1050	tstl	_C_LABEL(fputype)	| Do we have an FPU?
1051	jeq	Lswnofpsave		| No  Then don't attempt save.
1052	lea	%a1@(PCB_FPCTX),%a2	| pointer to FP save area
1053	fsave	%a2@			| save FP state
1054	tstb	%a2@			| null state frame?
1055	jeq	Lswnofpsave		| yes, all done
1056	fmovem	%fp0-%fp7,%a2@(216)	| save FP general registers
1057	fmovem	%fpcr/%fpsr/%fpi,%a2@(312)	| save FP control registers
1058Lswnofpsave:
1059
1060	clrl	%a0@(P_BACK)		| clear back link
1061	movb	%a0@(P_MD_FLAGS+3),mdpflag | low byte of p_md.md_flags
1062	movl	%a0@(P_ADDR),%a1		| get p_addr
1063	movl	%a1,_C_LABEL(curpcb)
1064
1065	/*
1066	 * Activate process's address space.
1067	 * XXX Should remember the last USTP value loaded, and call this
1068	 * XXX only if it has changed.
1069	 */
1070	pea	%a0@			| push proc
1071	jbsr	_C_LABEL(pmap_activate)	| pmap_activate(p)
1072	addql	#4,%sp
1073	movl	_C_LABEL(curpcb),%a1	| restore p_addr
1074
1075	lea	_ASM_LABEL(tmpstk),%sp	| now goto a tmp stack for NMI
1076
1077	moveml	%a1@(PCB_REGS),#0xFCFC	| and registers
1078	movl	%a1@(PCB_USP),%a0
1079	movl	%a0,%usp			| and USP
1080
1081	tstl	_C_LABEL(fputype)	| If we don't have an FPU,
1082	jeq	Lnofprest		|  don't try to restore it.
1083	lea	%a1@(PCB_FPCTX),%a0	| pointer to FP save area
1084	tstb	%a0@			| null state frame?
1085	jeq	Lresfprest		| yes, easy
1086#if defined(M68040)
1087#if defined(M68020) || defined(M68030)
1088	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040?
1089	jne	Lresnot040		| no, skip
1090#endif
1091	clrl	%sp@-			| yes...
1092	frestore %sp@+			| ...magic!
1093Lresnot040:
1094#endif
1095	fmovem	%a0@(312),%fpcr/%fpsr/%fpi	| restore FP control registers
1096	fmovem	%a0@(216),%fp0-%fp7	| restore FP general registers
1097Lresfprest:
1098	frestore %a0@			| restore state
1099
1100Lnofprest:
1101	movw	%a1@(PCB_PS),%sr		| no, restore PS
1102	moveq	#1,%d0			| return 1 (for alternate returns)
1103	rts
1104
1105/*
1106 * savectx(pcb)
1107 * Update pcb, saving current processor state.
1108 */
1109ENTRY(savectx)
1110	movl	%sp@(4),%a1
1111	movw	%sr,%a1@(PCB_PS)
1112	movl	%usp,%a0			| grab USP
1113	movl	%a0,%a1@(PCB_USP)		| and save it
1114	moveml	#0xFCFC,%a1@(PCB_REGS)	| save non-scratch registers
1115
1116	tstl	_C_LABEL(fputype)	| Do we have FPU?
1117	jeq	Lsvnofpsave		| No?  Then don't save state.
1118	lea	%a1@(PCB_FPCTX),%a0	| pointer to FP save area
1119	fsave	%a0@			| save FP state
1120	tstb	%a0@			| null state frame?
1121	jeq	Lsvnofpsave		| yes, all done
1122	fmovem	%fp0-%fp7,%a0@(216)	| save FP general registers
1123	fmovem	%fpcr/%fpsr/%fpi,%a0@(312)	| save FP control registers
1124Lsvnofpsave:
1125	moveq	#0,%d0			| return 0
1126	rts
1127
1128#if defined(M68040)
1129ENTRY(suline)
1130	movl	%sp@(4),%a0		| address to write
1131	movl	_C_LABEL(curpcb),%a1	| current pcb
1132	movl	#Lslerr,%a1@(PCB_ONFAULT) | where to return to on a fault
1133	movl	%sp@(8),%a1		| address of line
1134	movl	%a1@+,%d0			| get lword
1135	movsl	%d0,%a0@+			| put lword
1136	nop				| sync
1137	movl	%a1@+,%d0			| get lword
1138	movsl	%d0,%a0@+			| put lword
1139	nop				| sync
1140	movl	%a1@+,%d0			| get lword
1141	movsl	%d0,%a0@+			| put lword
1142	nop				| sync
1143	movl	%a1@+,%d0			| get lword
1144	movsl	%d0,%a0@+			| put lword
1145	nop				| sync
1146	moveq	#0,%d0			| indicate no fault
1147	jra	Lsldone
1148Lslerr:
1149	moveq	#-1,%d0
1150Lsldone:
1151	movl	_C_LABEL(curpcb),%a1	| current pcb
1152	clrl	%a1@(PCB_ONFAULT) 	| clear fault address
1153	rts
1154#endif
1155
1156/*
1157 * Invalidate entire TLB.
1158 */
1159ENTRY(TBIA)
1160_C_LABEL(_TBIA):
1161#if defined(M68040)
1162	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040?
1163	jne	Lmotommu3		| no, skip
1164	.word	0xf518			| yes, pflusha
1165	rts
1166Lmotommu3:
1167#endif
1168#if defined(M68K_MMU_MOTOROLA)
1169	tstl	_C_LABEL(mmutype)	| HP MMU?
1170	jeq	Lhpmmu6			| yes, skip
1171	pflusha				| flush entire TLB
1172	jpl	Lmc68851a		| 68851 implies no d-cache
1173	movl	#DC_CLEAR,%d0
1174	movc	%d0,%cacr			| invalidate on-chip d-cache
1175Lmc68851a:
1176	rts
1177Lhpmmu6:
1178#endif
1179#if defined(M68K_MMU_HP)
1180	MMUADDR(%a0)
1181	movl	%a0@(MMUTBINVAL),%sp@-	| do not ask me, this
1182	addql	#4,%sp			|   is how hpux does it
1183#ifdef DEBUG
1184	tstl	_ASM_LABEL(fullcflush)
1185	jne	_C_LABEL(_DCIA)		| XXX: invalidate entire cache
1186#endif
1187#endif
1188	rts
1189
1190/*
1191 * Invalidate any TLB entry for given VA (TB Invalidate Single)
1192 */
1193ENTRY(TBIS)
1194#ifdef DEBUG
1195	tstl	_ASM_LABEL(fulltflush)	| being conservative?
1196	jne	_C_LABEL(_TBIA)		| yes, flush entire TLB
1197#endif
1198#if defined(M68040)
1199	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040?
1200	jne	Lmotommu4		| no, skip
1201	movl	%sp@(4),%a0
1202	movc	%dfc,%d1
1203	moveq	#1,%d0			| user space
1204	movc	%d0,%dfc
1205	.word	0xf508			| pflush %a0@
1206	moveq	#5,%d0			| super space
1207	movc	%d0,%dfc
1208	.word	0xf508			| pflush %a0@
1209	movc	%d1,%dfc
1210	rts
1211Lmotommu4:
1212#endif
1213#if defined(M68K_MMU_MOTOROLA)
1214	tstl	_C_LABEL(mmutype)	| HP MMU?
1215	jeq	Lhpmmu5			| yes, skip
1216	movl	%sp@(4),%a0		| get addr to flush
1217	jpl	Lmc68851b		| is 68851?
1218	pflush	#0,#0,%a0@		| flush address from both sides
1219	movl	#DC_CLEAR,%d0
1220	movc	%d0,%cacr			| invalidate on-chip data cache
1221	rts
1222Lmc68851b:
1223	pflushs	#0,#0,%a0@		| flush address from both sides
1224	rts
1225Lhpmmu5:
1226#endif
1227#if defined(M68K_MMU_HP)
1228	movl	%sp@(4),%d0		| VA to invalidate
1229	bclr	#0,%d0			| ensure even
1230	movl	%d0,%a0
1231	movw	%sr,%d1			| go critical
1232	movw	#PSL_HIGHIPL,%sr		|   while in purge space
1233	moveq	#FC_PURGE,%d0		| change address space
1234	movc	%d0,%dfc			|   for destination
1235	moveq	#0,%d0			| zero to invalidate?
1236	movsl	%d0,%a0@			| hit it
1237	moveq	#FC_USERD,%d0		| back to old
1238	movc	%d0,%dfc			|   address space
1239	movw	%d1,%sr			| restore IPL
1240#endif
1241	rts
1242
1243/*
1244 * Invalidate supervisor side of TLB
1245 */
1246ENTRY(TBIAS)
1247#ifdef DEBUG
1248	tstl	_ASM_LABEL(fulltflush)	| being conservative?
1249	jne	_C_LABEL(_TBIA)		| yes, flush everything
1250#endif
1251#if defined(M68040)
1252	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040?
1253	jne	Lmotommu5		| no, skip
1254	.word	0xf518			| yes, pflusha (for now) XXX
1255	rts
1256Lmotommu5:
1257#endif
1258#if defined(M68K_MMU_MOTOROLA)
1259	tstl	_C_LABEL(mmutype)	| HP MMU?
1260	jeq	Lhpmmu7			| yes, skip
1261	jpl	Lmc68851c		| 68851?
1262	pflush #4,#4			| flush supervisor TLB entries
1263	movl	#DC_CLEAR,%d0
1264	movc	%d0,%cacr			| invalidate on-chip d-cache
1265	rts
1266Lmc68851c:
1267	pflushs #4,#4			| flush supervisor TLB entries
1268	rts
1269Lhpmmu7:
1270#endif
1271#if defined(M68K_MMU_HP)
1272	MMUADDR(%a0)
1273	movl	#0x8000,%d0		| more
1274	movl	%d0,%a0@(MMUTBINVAL)	|   HP magic
1275#ifdef DEBUG
1276	tstl	_ASM_LABEL(fullcflush)
1277	jne	_C_LABEL(_DCIS)		| XXX: invalidate entire sup. cache
1278#endif
1279#endif
1280	rts
1281
1282/*
1283 * Invalidate user side of TLB
1284 */
1285ENTRY(TBIAU)
1286#ifdef DEBUG
1287	tstl	_ASM_LABEL(fulltflush)	| being conservative?
1288	jne	_C_LABEL(_TBIA)		| yes, flush everything
1289#endif
1290#if defined(M68040)
1291	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040?
1292	jne	Lmotommu6		| no, skip
1293	.word	0xf518			| yes, pflusha (for now) XXX
1294	rts
1295Lmotommu6:
1296#endif
1297#if defined(M68K_MMU_MOTOROLA)
1298	tstl	_C_LABEL(mmutype)	| HP MMU?
1299	jeq	Lhpmmu8			| yes, skip
1300	jpl	Lmc68851d		| 68851?
1301	pflush	#0,#4			| flush user TLB entries
1302	movl	#DC_CLEAR,%d0
1303	movc	%d0,%cacr			| invalidate on-chip d-cache
1304	rts
1305Lmc68851d:
1306	pflushs	#0,#4			| flush user TLB entries
1307	rts
1308Lhpmmu8:
1309#endif
1310#if defined(M68K_MMU_HP)
1311	MMUADDR(%a0)
1312	moveq	#0,%d0			| more
1313	movl	%d0,%a0@(MMUTBINVAL)	|   HP magic
1314#ifdef DEBUG
1315	tstl	_ASM_LABEL(fullcflush)
1316	jne	_C_LABEL(_DCIU)		| XXX: invalidate entire user cache
1317#endif
1318#endif
1319	rts
1320
1321/*
1322 * Invalidate instruction cache
1323 */
1324ENTRY(ICIA)
1325#if defined(M68040)
1326ENTRY(ICPA)
1327	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040
1328	jne	Lmotommu7		| no, skip
1329	.word	0xf498			| cinva ic
1330	rts
1331Lmotommu7:
1332#endif
1333	movl	#IC_CLEAR,%d0
1334	movc	%d0,%cacr			| invalidate i-cache
1335	rts
1336
1337/*
1338 * Invalidate data cache.
1339 * HP external cache allows for invalidation of user/supervisor portions.
1340 * NOTE: we do not flush 68030 on-chip cache as there are no aliasing
1341 * problems with DC_WA.  The only cases we have to worry about are context
1342 * switch and TLB changes, both of which are handled "in-line" in resume
1343 * and TBI*.
1344 */
1345ENTRY(DCIA)
1346__DCIA:
1347#if defined(M68040)
1348	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040
1349	jne	Lmotommu8		| no, skip
1350	/* XXX implement */
1351	rts
1352Lmotommu8:
1353#endif
1354#if defined(M68K_MMU_HP)
1355	tstl	_C_LABEL(ectype)	| got external VAC?
1356	jle	Lnocache2		| no, all done
1357	MMUADDR(%a0)
1358	andl	#~MMU_CEN,%a0@(MMUCMD)	| disable cache in MMU control reg
1359	orl	#MMU_CEN,%a0@(MMUCMD)	| reenable cache in MMU control reg
1360Lnocache2:
1361#endif
1362	rts
1363
1364ENTRY(DCIS)
1365_C_LABEL(_DCIS):
1366#if defined(M68040)
1367	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040
1368	jne	Lmotommu9		| no, skip
1369	/* XXX implement */
1370	rts
1371Lmotommu9:
1372#endif
1373#if defined(M68K_MMU_HP)
1374	tstl	_C_LABEL(ectype)	| got external VAC?
1375	jle	Lnocache3		| no, all done
1376	MMUADDR(%a0)
1377	movl	%a0@(MMUSSTP),%d0		| read the supervisor STP
1378	movl	%d0,%a0@(MMUSSTP)		| write it back
1379Lnocache3:
1380#endif
1381	rts
1382
1383ENTRY(DCIU)
1384_C_LABEL(_DCIU):
1385#if defined(M68040)
1386	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040
1387	jne	LmotommuA		| no, skip
1388	/* XXX implement */
1389	rts
1390LmotommuA:
1391#endif
1392#if defined(M68K_MMU_HP)
1393	tstl	_C_LABEL(ectype)	| got external VAC?
1394	jle	Lnocache4		| no, all done
1395	MMUADDR(%a0)
1396	movl	%a0@(MMUUSTP),%d0		| read the user STP
1397	movl	%d0,%a0@(MMUUSTP)		| write it back
1398Lnocache4:
1399#endif
1400	rts
1401
1402#if defined(M68040)
1403ENTRY(ICPL)
1404	movl	%sp@(4),%a0		| address
1405	.word	0xf488			| cinvl ic,%a0@
1406	rts
1407ENTRY(ICPP)
1408	movl	%sp@(4),%a0		| address
1409	.word	0xf490			| cinvp ic,%a0@
1410	rts
1411ENTRY(DCPL)
1412	movl	%sp@(4),%a0		| address
1413	.word	0xf448			| cinvl dc,%a0@
1414	rts
1415ENTRY(DCPP)
1416	movl	%sp@(4),%a0		| address
1417	.word	0xf450			| cinvp dc,%a0@
1418	rts
1419ENTRY(DCPA)
1420	.word	0xf458			| cinva dc
1421	rts
1422ENTRY(DCFL)
1423	movl	%sp@(4),%a0		| address
1424	.word	0xf468			| cpushl dc,%a0@
1425	rts
1426ENTRY(DCFP)
1427	movl	%sp@(4),%a0		| address
1428	.word	0xf470			| cpushp dc,%a0@
1429	rts
1430#endif
1431
1432ENTRY(PCIA)
1433#if defined(M68040)
1434ENTRY(DCFA)
1435	cmpl	#MMU_68040,_C_LABEL(mmutype)	| 68040
1436	jne	LmotommuB		| no, skip
1437	.word	0xf478			| cpusha dc
1438	rts
1439LmotommuB:
1440#endif
1441#if defined(M68K_MMU_MOTOROLA)
1442	movl	#DC_CLEAR,%d0
1443	movc	%d0,%cacr		| invalidate on-chip d-cache
1444#endif
1445	rts
1446
1447ENTRY_NOPROFILE(getsfc)
1448	movc	%sfc,%d0
1449	rts
1450
1451ENTRY_NOPROFILE(getdfc)
1452	movc	%dfc,%d0
1453	rts
1454
1455/*
1456 * Load a new user segment table pointer.
1457 */
1458ENTRY(loadustp)
1459#if defined(M68K_MMU_MOTOROLA)
1460	tstl	_C_LABEL(mmutype)	| HP MMU?
1461	jeq	Lhpmmu9			| yes, skip
1462	movl	%sp@(4),%d0		| new USTP
1463	moveq	#PGSHIFT,%d1
1464	lsll	%d1,%d0			| convert to addr
1465#if defined(M68040)
1466	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040?
1467	jne	LmotommuC		| no, skip
1468	.word	0xf518			| yes, pflusha
1469	.long	0x4e7b0806		| movc %d0,%urp
1470	rts
1471LmotommuC:
1472#endif
1473	pflusha				| flush entire TLB
1474	lea	_C_LABEL(protorp),%a0	| CRP prototype
1475	movl	%d0,%a0@(4)		| stash USTP
1476	pmove	%a0@,%crp			| load root pointer
1477	movl	#CACHE_CLR,%d0
1478	movc	%d0,%cacr			| invalidate cache(s)
1479	rts
1480Lhpmmu9:
1481#endif
1482#if defined(M68K_MMU_HP)
1483	movl	#CACHE_CLR,%d0
1484	movc	%d0,%cacr			| invalidate cache(s)
1485	MMUADDR(%a0)
1486	movl	%a0@(MMUTBINVAL),%d1	| invalidate TLB
1487	tstl	_C_LABEL(ectype)	| have external VAC?
1488	jle	1f			| no, skip
1489	andl	#~MMU_CEN,%a0@(MMUCMD)	| toggle cache enable
1490	orl	#MMU_CEN,%a0@(MMUCMD)	| to clear data cache
14911:
1492	movl	%sp@(4),%a0@(MMUUSTP)	| load a new USTP
1493#endif
1494	rts
1495
1496ENTRY(ploadw)
1497#if defined(M68K_MMU_MOTOROLA)
1498	movl	%sp@(4),%a0		| address to load
1499#if defined(M68K_MMU_HP)
1500	tstl	_C_LABEL(mmutype)	| HP MMU?
1501	jeq	Lploadwskp		| yes, skip
1502#endif
1503#if defined(M68040)
1504	cmpl	#MMU_68040,_C_LABEL(mmutype) | 68040?
1505	jeq	Lploadwskp		| yes, skip
1506#endif
1507	ploadw	#1,%a0@			| pre-load translation
1508Lploadwskp:
1509#endif
1510	rts
1511
1512/*
1513 * Set processor priority level calls.  Most are implemented with
1514 * inline asm expansions.  However, spl0 requires special handling
1515 * as we need to check for our emulated software interrupts.
1516 */
1517
1518ENTRY(spl0)
1519	moveq	#0,%d0
1520	movw	%sr,%d0			| get old SR for return
1521	movw	#PSL_LOWIPL,%sr		| restore new SR
1522	tstb	_C_LABEL(ssir)		| software interrupt pending?
1523	jeq	Lspldone		| no, all done
1524	subql	#4,%sp			| make room for RTE frame
1525	movl	%sp@(4),%sp@(2)		| position return address
1526	clrw	%sp@(6)			| set frame type 0
1527	movw	#PSL_LOWIPL,%sp@		| and new SR
1528	jra	Lgotsir			| go handle it
1529Lspldone:
1530	rts
1531
1532/*
1533 * _delay(u_int N)
1534 *
1535 * Delay for at least (N/256) microsecends.
1536 * This routine depends on the variable:  delay_divisor
1537 * which should be set based on the CPU clock rate.
1538 */
1539ENTRY_NOPROFILE(_delay)
1540	| d0 = arg = (usecs << 8)
1541	movl	%sp@(4),%d0
1542	| d1 = delay_divisor
1543	movl	_C_LABEL(delay_divisor),%d1
1544L_delay:
1545	subl	%d1,%d0
1546	jgt	L_delay
1547	rts
1548
1549/*
1550 * Save and restore 68881 state.
1551 * Pretty awful looking since our assembler does not
1552 * recognize FP mnemonics.
1553 */
1554ENTRY(m68881_save)
1555	movl	%sp@(4),%a0		| save area pointer
1556	fsave	%a0@			| save state
1557	tstb	%a0@			| null state frame?
1558	jeq	Lm68881sdone		| yes, all done
1559	fmovem	%fp0-%fp7,%a0@(216)	| save FP general registers
1560	fmovem	%fpcr/%fpsr/%fpi,%a0@(312)	| save FP control registers
1561Lm68881sdone:
1562	rts
1563
1564ENTRY(m68881_restore)
1565	movl	%sp@(4),%a0		| save area pointer
1566	tstb	%a0@			| null state frame?
1567	jeq	Lm68881rdone		| yes, easy
1568	fmovem	%a0@(312),%fpcr/%fpsr/%fpi	| restore FP control registers
1569	fmovem	%a0@(216),%fp0-%fp7	| restore FP general registers
1570Lm68881rdone:
1571	frestore %a0@			| restore state
1572	rts
1573
1574ENTRY_NOPROFILE(doboot)
1575	movl #0x5c00c060, %d0		| want phys addressing
1576	.long	0x4e7b0006		| movc d0,dtt0
1577	movl	#1, 0x5c00b800		| reset
1578	stop	#0x2700			| paranoia
1579
1580	.data
1581GLOBAL(mmutype)
1582	.long	MMU_HP		| default to HP MMU
1583GLOBAL(cputype)
1584	.long	CPU_68020	| default to 68020 CPU
1585GLOBAL(fputype)
1586	.long	FPU_68881	| default to 68881 FPU
1587GLOBAL(protorp)
1588	.long	0,0		| prototype root pointer
1589GLOBAL(prototc)
1590	.long	0		| prototype translation control
1591GLOBAL(want_resched)
1592	.long	0
1593
1594GLOBAL(proc0paddr)
1595	.long	0		| KVA of proc0 u-area
1596#ifdef DEBUG
1597	.globl	fulltflush, fullcflush
1598fulltflush:
1599	.long	0
1600fullcflush:
1601	.long	0
1602#endif
1603
1604/* interrupt counters */
1605GLOBAL(intrnames)
1606	.asciz	"spur"
1607	.asciz	"lev1"
1608	.asciz	"lev2"
1609	.asciz	"lev3"
1610	.asciz	"lev4"
1611	.asciz	"lev5"
1612	.asciz	"clock"
1613	.asciz	"nmi"
1614GLOBAL(eintrnames)
1615	.even
1616GLOBAL(intrcnt)
1617	.long	0,0,0,0,0,0,0,0
1618GLOBAL(eintrcnt)
1619