xref: /original-bsd/sys/vax/vax/locore.s (revision de655a82)
1/*	locore.s	4.50	81/05/18	*/
2
3#include "../h/mtpr.h"
4#include "../h/trap.h"
5#include "../h/psl.h"
6#include "../h/pte.h"
7#include "../h/cpu.h"
8#include "../h/nexus.h"
9#include "../h/ubareg.h"
10
11#include "dz.h"
12#include "mba.h"
13
14	.set	HIGH,0x1f	# mask for total disable
15	.set	MCKVEC,4	# offset into scb of machine check vector
16	.set	NBPG,512
17	.set	PGSHIFT,9
18
19	.set	NISP,3		# number of interrupt stack pages
20
21/*
22 * User structure is UPAGES at top of user space.
23 */
24	.globl	_u
25	.set	_u,0x80000000 - UPAGES*NBPG
26
27/*
28 * Restart parameter block
29 * This is filled in in machdep.c in startup().
30 * It MUST be page aligned.
31 * When auto-restart occurs, we run restart() in machdep.c, which
32 * takes a core-dump and then cold-starts.
33 */
34	.globl	_rpb
35_rpb:
36	.space	508
37erpb:
38	.space	4
39	.globl	_intstack
40_intstack:
41	.space	NISP*NBPG
42eintstack:
43
44/*
45 * Do a dump.
46 * Called by auto-restart.
47 * May be called manually.
48 */
49	.align	2
50	.globl	_doadump
51_doadump:
52	nop; nop				# .word 0x0101
53#define	_rpbmap	_Sysmap+8			# scb, UNIvec, rpb, istack*4
54	bicl2	$PG_PROT,_rpbmap
55	bisl2	$PG_KW,_rpbmap
56	tstl	_rpb+RP_FLAG			# dump only once!
57	bneq	1f
58	incl	_rpb+RP_FLAG
59	mtpr	$0,$TBIA
60	movl	sp,erpb
61	movab	erpb,sp
62	mfpr	$PCBB,-(sp)
63	mfpr	$MAPEN,-(sp)
64	mfpr	$IPL,-(sp)
65	mtpr	$0,$MAPEN
66	mtpr	$HIGH,$IPL
67	pushr	$0x3fff
68	calls	$0,_dumpsys
691:
70	halt
71
72/*
73 * Interrupt vector routines
74 */
75	.globl	_waittime
76
77#define	SCBVEC(name)	.align 2; .globl _X/**/name; _X/**/name
78#define	PANIC(msg)	clrl _waittime; pushab 1f; \
79			calls $1,_panic; 1: .asciz msg
80#define	PRINTF(n,msg)	pushab 1f; calls $n+1,_printf; MSG(msg)
81#define	MSG(msg)	.data; 1: .asciz msg; .text
82#define	PUSHR		pushr $0x3f
83#define	POPR		popr $0x3f
84
85SCBVEC(machcheck):
86	PUSHR; pushab 6*4(sp); calls $1,_machinecheck; POPR;
87	addl2 (sp)+,sp; rei
88SCBVEC(kspnotval):
89	PUSHR; PANIC("KSP not valid");
90SCBVEC(powfail):
91	halt
92SCBVEC(chme): SCBVEC(chms): SCBVEC(chmu):
93	PUSHR; PANIC("CHM? in kernel");
94SCBVEC(stray):
95	PUSHR; PRINTF(0, "stray scb interrupt\n"); POPR;
96	rei
97SCBVEC(nexzvec):
98	PUSHR; mfpr $IPL,-(sp); PRINTF(1, "nexus stray intr ipl%x\n"); POPR; rei
99SCBVEC(cmrd):
100	PUSHR; calls $0,_memerr; POPR; rei
101SCBVEC(wtime):
102	PUSHR; pushl 6*4(sp); PRINTF(1,"write timeout %x\n"); POPR;
103	PANIC("wtimo");
104
105#if NMBA > 0
106SCBVEC(mba3int):
107	PUSHR; pushl $3; brb 1f
108SCBVEC(mba2int):
109	PUSHR; pushl $2; brb 1f
110SCBVEC(mba1int):
111	PUSHR; pushl $1; brb 1f
112SCBVEC(mba0int):
113	PUSHR; pushl $0
1141:	calls $1,_mbintr
115	POPR
116	incl	_cnt+V_INTR
117	rei
118#endif
119
120#if VAX780
121/*
122 * Registers for the uba handling code
123 */
124#define	rUBANUM	r0
125#define	rUBAHD	r1
126#define	rUVEC	r3
127#define	rUBA	r4
128/* r2,r5 are scratch */
129
130SCBVEC(ua3int):
131	PUSHR; movl $3,rUBANUM; moval _uba_hd+(3*UH_SIZE),rUBAHD; brb 1f
132SCBVEC(ua2int):
133	PUSHR; movl $2,rUBANUM; moval _uba_hd+(2*UH_SIZE),rUBAHD; brb 1f
134SCBVEC(ua1int):
135	PUSHR; movl $1,rUBANUM; moval _uba_hd+(1*UH_SIZE),rUBAHD; brb 1f
136SCBVEC(ua0int):
137	PUSHR; movl $0,rUBANUM; moval _uba_hd+(0*UH_SIZE),rUBAHD;
1381:
139	incl	_cnt+V_INTR
140	mfpr	$IPL,r2				/* r2 = mfpr(IPL); */
141	movl	UH_UBA(rUBAHD),rUBA		/* uba = uhp->uh_uba; */
142	movl	UBA_BRRVR-0x14*4(rUBA)[r2],rUVEC
143					/* uvec = uba->uba_brrvr[r2-0x14] */
144ubanorm:
145	bleq	ubaerror
146	addl2	UH_VEC(rUBAHD),rUVEC		/* uvec += uh->uh_vec */
147	bicl3	$3,(rUVEC),r1
148	jmp	2(r1)				/* 2 skips ``pushr $0x3f'' */
149ubaerror:
150	PUSHR; calls $0,_ubaerror; POPR		/* ubaerror r/w's r0-r5 */
151	tstl rUVEC; jneq ubanorm		/* rUVEC contains result */
152	POPR
153	rei
154#endif
155SCBVEC(cnrint):
156	PUSHR; calls $0,_cnrint; POPR; incl _cnt+V_INTR; rei
157SCBVEC(cnxint):
158	PUSHR; calls $0,_cnxint; POPR; incl _cnt+V_INTR; rei
159SCBVEC(hardclock):
160	PUSHR
161	pushl 4+6*4(sp); pushl 4+6*4(sp);
162	calls $2,_hardclock			# hardclock(pc,psl)
163	POPR;
164	incl	_cnt+V_INTR		## temp so not to break vmstat -= HZ
165	rei
166SCBVEC(softclock):
167	PUSHR
168	pushl 4+6*4(sp); pushl 4+6*4(sp);
169	calls $2,_softclock			# softclock(pc,psl)
170	POPR;
171	rei
172SCBVEC(consdin):
173	halt
174SCBVEC(consdout):
175	halt
176
177#if NDZ > 0
178/*
179 * DZ pseudo dma routine:
180 *	r0 - controller number
181 */
182	.align	1
183	.globl	_dzdma
184_dzdma:
185	mull2	$8*20,r0
186	movab	_dzpdma(r0),r3		# pdma structure base
187					# for this controller
188dzploop:
189	movl	r3,r0
190	movl	(r0)+,r1		# device register address
191	movzbl	1(r1),r2		# get line number
192	bitb	$0x80,r2		# TRDY on?
193	beql	dzprei			# no
194	bicb2	$0xf8,r2		# clear garbage bits
195	mull2	$20,r2
196	addl2	r2,r0			# point at line's pdma structure
197	movl	(r0)+,r2		# p_mem
198	cmpl	r2,(r0)+		# p_mem < p_end ?
199	bgequ	dzpcall			# no, go call dzxint
200	movb	(r2)+,6(r1)		# dztbuf = *p_mem++
201	movl	r2,-8(r0)
202	brb 	dzploop			# check for another line
203dzprei:
204	POPR
205	incl	_cnt+V_PDMA
206	rei
207
208dzpcall:
209	pushl	r3
210	pushl	(r0)+			# push tty address
211	calls	$1,*(r0)		# call interrupt rtn
212	movl	(sp)+,r3
213	brb 	dzploop			# check for another line
214#endif
215
216/*
217 * Stray UNIBUS interrupt catch routines
218 */
219	.data
220	.align	2
221#define	PJ	PUSHR;jsb _Xustray
222	.globl	_catcher
223_catcher:
224	PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ
225	PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ
226	PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ
227	PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ
228	PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ
229	PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ
230	PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ
231	PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ;PJ
232
233	.globl	_cold
234_cold:	.long	1
235	.data
236
237	.text
238SCBVEC(ustray):
239	blbc	_cold,1f
240	mfpr	$IPL,r11
241	subl3	$_catcher+8,(sp)+,r10
242	ashl	$-1,r10,r10
243	POPR
244	rei
2451:
246	subl3	$_catcher+8,(sp)+,r0
247	ashl	$-1,r0,-(sp)
248	mfpr	$IPL,-(sp)
249	PRINTF(2, "uba?: stray intr ipl %x vec %o\n")
250	POPR
251	rei
252
253/*
254 * Trap and fault vector routines
255 */
256#define	TRAP(a)	pushl $a; brw alltraps
257
258/*
259 * Ast delivery (profiling and/or reschedule)
260 */
261SCBVEC(astflt):
262	pushl $0; TRAP(ASTFLT)
263SCBVEC(privinflt):
264	pushl $0; TRAP(PRIVINFLT)
265SCBVEC(xfcflt):
266	pushl $0; TRAP(XFCFLT)
267SCBVEC(resopflt):
268	pushl $0; TRAP(RESOPFLT)
269SCBVEC(resadflt):
270	pushl $0; TRAP(RESADFLT)
271SCBVEC(bptflt):
272	pushl $0; TRAP(BPTFLT)
273SCBVEC(compatflt):
274	TRAP(COMPATFLT);
275SCBVEC(tracep):
276	pushl $0; TRAP(TRCTRAP)
277SCBVEC(arithtrap):
278	TRAP(ARITHTRAP)
279SCBVEC(protflt):
280	blbs	(sp)+,segflt
281	TRAP(PROTFLT)
282segflt:
283	TRAP(SEGFLT)
284SCBVEC(transflt):
285	blbs	(sp)+,tableflt
286	TRAP(PAGEFLT)
287tableflt:
288	TRAP(TABLEFLT)
289
290alltraps:
291	mfpr	$USP,-(sp); calls $0,_trap; mtpr (sp)+,$USP
292	incl	_cnt+V_TRAP
293	addl2	$8,sp			# pop type, code
294	mtpr	$HIGH,$IPL		## dont go to a higher IPL (GROT)
295	rei
296
297SCBVEC(syscall):
298	pushl	$SYSCALL
299	mfpr	$USP,-(sp); calls $0,_syscall; mtpr (sp)+,$USP
300	incl	_cnt+V_SYSCALL
301	addl2	$8,sp			# pop type, code
302	mtpr	$HIGH,$IPL		## dont go to a higher IPL (GROT)
303	rei
304
305/*
306 * System page table
307 */
308#define	vaddr(x)	((((x)-_Sysmap)/4)*NBPG+0x80000000)
309#define	SYSMAP(mname, vname, npte)			\
310_/**/mname:	.globl	_/**/mname;		\
311	.space	npte*4;				\
312	.globl	_/**/vname;			\
313	.set	_/**/vname,vaddr(_/**/mname)
314
315	.data
316	.align	2
317	SYSMAP(Sysmap	,Sysbase	,SYSPTSIZE	)
318	SYSMAP(UMBAbeg	,umbabeg	,0		)
319	SYSMAP(Nexmap	,nexus		,16*MAXNNEXUS	)
320	SYSMAP(UMEMmap	,umem		,16*MAXNUBA	)
321	SYSMAP(UMBAend	,umbaend	,0		)
322	SYSMAP(Usrptmap	,usrpt		,USRPTSIZE	)
323	SYSMAP(Forkmap	,forkutl	,UPAGES		)
324	SYSMAP(Xswapmap	,xswaputl	,UPAGES		)
325	SYSMAP(Xswap2map,xswap2utl	,UPAGES		)
326	SYSMAP(Swapmap	,swaputl	,UPAGES		)
327	SYSMAP(Pushmap	,pushutl	,UPAGES		)
328	SYSMAP(Vfmap	,vfutl		,UPAGES		)
329	SYSMAP(CMAP1	,CADDR1		,1		)
330	SYSMAP(CMAP2	,CADDR2		,1		)
331	SYSMAP(mcrmap	,mcr		,1		)
332	SYSMAP(mmap	,vmmap		,1		)
333	SYSMAP(msgbufmap,msgbuf		,CLSIZE		)
334	SYSMAP(camap	,cabase		,16*CLSIZE	)
335	SYSMAP(ecamap	,calimit	,0		)
336#ifdef BBNNET
337	SYSMAP(Netmap	,netutl		,NNETPAGES*CLSIZE)
338#endif
339
340eSysmap:
341	.globl	_Syssize
342	.set	_Syssize,(eSysmap-_Sysmap)/4
343	.text
344
345/*
346 * Initialization
347 *
348 * ipl 0x1f; mapen 0; scbb, pcbb, sbr, slr, isp, ksp not set
349 */
350	.data
351	.globl	_cpu
352_cpu:	.long	0
353	.text
354	.globl	start
355start:
356	.word	0
357/* set system control block base and system page table params */
358	mtpr	$_scb-0x80000000,$SCBB
359	mtpr	$_Sysmap-0x80000000,$SBR
360	mtpr	$_Syssize,$SLR
361/* double map the kernel into the virtual user addresses of phys mem */
362	mtpr	$_Sysmap,$P0BR
363	mtpr	$_Syssize,$P0LR
364/* set ISP and get cpu type */
365	movl	$_intstack+NISP*NBPG,sp
366	mfpr	$SID,r0
367	movab	_cpu,r1
368	extzv	$24,$8,r0,(r1)
369/* init RPB */
370	movab	_rpb,r0
371	movl	r0,(r0)+			# rp_selfref
372	movab	_doadump,r1
373	movl	r1,(r0)+			# rp_dumprout
374	movl	$0x1f,r2
375	clrl	r3
3761:	addl2	(r1)+,r3; sobgtr r2,1b
377	movl	r3,(r0)+			# rp_chksum
378/* count up memory */
379	clrl	r7
3801:	pushl	$4; pushl r7; calls $2,_badaddr; tstl r0; bneq 9f
381	acbl	$8096*1024-1,$64*1024,r7,1b
3829:
383/* clear memory from kernel bss and pages for proc 0 u. and page table */
384	movab	_edata,r6
385	movab	_end,r5
386	bbcc	$31,r5,0f; 0:
387	addl2	$(UPAGES*NBPG)+NBPG+NBPG,r5
3881:	clrq	(r6); acbl r5,$8,r6,1b
389/* trap() and syscall() save r0-r11 in the entry mask (per ../h/reg.h) */
390	bisw2	$0x0fff,_trap
391	bisw2	$0x0fff,_syscall
392	calls	$0,_fixctlrmask
393/* initialize system page table: scb and int stack writeable */
394	clrl	r2
395	movab	eintstack,r1; bbcc $31,r1,0f; 0: ashl $-PGSHIFT,r1,r1
3961:	bisl3	$PG_V|PG_KW,r2,_Sysmap[r2]; aoblss r1,r2,1b
397/* make rpb read-only as red zone for interrupt stack */
398	bicl2	$PG_PROT,_rpbmap
399	bisl2	$PG_KR,_rpbmap
400/* make kernel text space read-only */
401	movab	_etext+NBPG-1,r1; bbcc $31,r1,0f; 0: ashl $-PGSHIFT,r1,r1
4021:	bisl3	$PG_V|PG_KR,r2,_Sysmap[r2]; aoblss r1,r2,1b
403/* make kernel data, bss, read-write */
404	movab	_end+NBPG-1,r1; bbcc $31,r1,0f; 0:; ashl $-PGSHIFT,r1,r1
4051:	bisl3	$PG_V|PG_KW,r2,_Sysmap[r2]; aoblss r1,r2,1b
406/* now go to mapped mode */
407	mtpr	$1,$TBIA; mtpr $1,$MAPEN; jmp *$0f; 0:
408/* init mem sizes */
409	ashl	$-PGSHIFT,r7,_maxmem
410	movl	_maxmem,_physmem
411	movl	_maxmem,_freemem
412/* setup context for proc[0] == Scheduler */
413	movab	_end+NBPG-1,r6
414	bicl2	$NBPG-1,r6		# make page boundary
415/* setup page table for proc[0] */
416	bbcc	$31,r6,0f; 0:
417	ashl	$-PGSHIFT,r6,r3			# r3 = btoc(r6)
418	bisl3	$PG_V|PG_KW,r3,_Usrptmap	# init first upt entry
419	incl	r3
420	movab	_usrpt,r0
421	mtpr	r0,$TBIS
422/* init p0br, p0lr */
423	mtpr	r0,$P0BR
424	mtpr	$0,$P0LR
425/* init p1br, p1lr */
426	movab	NBPG(r0),r0
427	movl	$0x200000-UPAGES,r1
428	mtpr	r1,$P1LR
429	mnegl	r1,r1
430	moval	-4*UPAGES(r0)[r1],r2
431	mtpr	r2,$P1BR
432/* setup mapping for UPAGES of _u */
433	movl	$UPAGES,r2; movab _u+NBPG*UPAGES,r1; addl2 $UPAGES,r3; jbr 2f
4341:	decl	r3
435	moval	-NBPG(r1),r1;
436	bisl3	$PG_V|PG_URKW,r3,-(r0)
437	mtpr	r1,$TBIS
4382:	sobgeq	r2,1b
439/* initialize (slightly) the pcb */
440	movab	UPAGES*NBPG(r1),PCB_KSP(r1)
441	mnegl	$1,PCB_ESP(r1)
442	mnegl	$1,PCB_SSP(r1)
443	movl	r1,PCB_USP(r1)
444	mfpr	$P0BR,PCB_P0BR(r1)
445	mfpr	$P0LR,PCB_P0LR(r1)
446	movb	$4,PCB_P0LR+3(r1)		# disable ast
447	mfpr	$P1BR,PCB_P1BR(r1)
448	mfpr	$P1LR,PCB_P1LR(r1)
449	movl	$CLSIZE,PCB_SZPT(r1)		# init u.u_pcb.pcb_szpt
450	movl	r11,PCB_R11(r1)
451	movab	1f,PCB_PC(r1)			# initial pc
452	clrl	PCB_PSL(r1)			# mode(k,k), ipl=0
453	ashl	$PGSHIFT,r3,r3
454	mtpr	r3,$PCBB			# first pcbb
455/* set regs, p0br, p0lr, p1br, p1lr, astlvl, ksp and change to kernel mode */
456	ldpctx
457	rei
458/* put signal trampoline code in u. area */
4591:	movab	_u,r0
460	movc3	$12,sigcode,PCB_SIGC(r0)
461/* save reboot flags in global _boothowto */
462	movl	r11,_boothowto
463/* calculate firstaddr, and call main() */
464	movab	_end+NBPG-1,r0; bbcc $31,r0,0f; 0:; ashl $-PGSHIFT,r0,-(sp)
465	addl2	$UPAGES+1,(sp); calls $1,_main
466/* proc[1] == /etc/init now running here; run icode */
467	pushl	$PSL_CURMOD|PSL_PRVMOD; pushl $0; rei
468
469/* signal trampoline code: it is known that this code takes exactly 12 bytes */
470/* in ../h/pcb.h and in the movc3 above */
471sigcode:
472	calls	$3,1(pc)
473	rei
474	.word	0x7f				# registers 0-6 (6==sp/compat)
475	callg	(ap),*12(ap)
476	ret
477
478/*
479 * Primitives
480 */
481
482/*
483 * badaddr(addr, len)
484 *	see if access addr with a len type instruction causes a machine check
485 *	len is length of access (1=byte, 2=short, 4=long)
486 */
487	.globl	_badaddr
488_badaddr:
489	.word	0
490	movl	$1,r0
491	mfpr	$IPL,r1
492	mtpr	$HIGH,$IPL
493	movl	_scb+MCKVEC,r2
494	movl	4(ap),r3
495	movl	8(ap),r4
496	movab	9f+INTSTK,_scb+MCKVEC
497	bbc	$0,r4,1f; tstb	(r3)
4981:	bbc	$1,r4,1f; tstw	(r3)
4991:	bbc	$2,r4,1f; tstl	(r3)
5001:	clrl	r0			# made it w/o machine checks
5012:	movl	r2,_scb+MCKVEC
502	mtpr	r1,$IPL
503	ret
504	.align	2
5059:
506	casel	_cpu,$1,$VAX_MAX
5070:
508	.word	8f-0b		# 1 is 780
509	.word	5f-0b		# 2 is 750
510	.word	5f-0b		# 3 is 7ZZ
5115:
512#if defined(VAX750) || defined(VAX7ZZ)
513	mtpr	$0xf,$MCESR
514#endif
515	brb	1f
5168:
517#if VAX780
518	mtpr	$0,$SBIFS
519#endif
5201:
521	addl2	(sp)+,sp		# discard mchchk trash
522	movab	2b,(sp)
523	rei
524
525_addupc:	.globl	_addupc
526	.word	0x0
527	movl	8(ap),r2		# &u.u_prof
528	subl3	8(r2),4(ap),r0		# corrected pc
529	blss	9f
530	extzv	$1,$31,r0,r0		# logical right shift
531	extzv	$1,$31,12(r2),r1	# ditto for scale
532	emul	r1,r0,$0,r0
533	ashq	$-14,r0,r0
534	tstl	r1
535	bneq	9f
536	incl	r0
537	bicl2	$1,r0
538	cmpl	r0,4(r2)		# length
539	bgequ	9f
540	addl2	(r2),r0			# base
541	probew	$3,$2,(r0)
542	beql	8f
543	addw2	12(ap),(r0)
5449:
545	ret
5468:
547	clrl	12(r2)
548	ret
549
550_Copyin:	.globl	_Copyin		# <<<massaged for jsb by asm.sed>>>
551	movl	12(sp),r0		# copy length
552	blss	ersb
553	movl	4(sp),r1		# copy user address
554	cmpl	$NBPG,r0		# probing one page or less ?
555	bgeq	cishort			# yes
556ciloop:
557	prober	$3,$NBPG,(r1)		# bytes accessible ?
558	beql	ersb			# no
559	addl2	$NBPG,r1		# incr user address ptr
560	acbl	$NBPG+1,$-NBPG,r0,ciloop	# reduce count and loop
561cishort:
562	prober	$3,r0,(r1)		# bytes accessible ?
563	beql	ersb			# no
564	movc3	12(sp),*4(sp),*8(sp)
565	clrl	r0
566	rsb
567
568ersb:
569	mnegl	$1,r0
570	rsb
571
572_Copyout: 	.globl	_Copyout	# <<<massaged for jsb by asm.sed >>>
573	movl	12(sp),r0		# get count
574	blss	ersb
575	movl	8(sp),r1		# get user address
576	cmpl	$NBPG,r0		# can do in one probew?
577	bgeq	coshort			# yes
578coloop:
579	probew	$3,$NBPG,(r1)		# bytes accessible?
580	beql	ersb			# no
581	addl2	$NBPG,r1		# increment user address
582	acbl	$NBPG+1,$-NBPG,r0,coloop	# reduce count and loop
583coshort:
584	probew	$3,r0,(r1)		# bytes accessible?
585	beql	ersb			# no
586	movc3	12(sp),*4(sp),*8(sp)
587	clrl	r0
588	rsb
589
590/*
591 * non-local goto's
592 */
593	.globl	_Setjmp
594_Setjmp:
595	movq	r6,(r0)+
596	movq	r8,(r0)+
597	movq	r10,(r0)+
598	movq	r12,(r0)+
599	addl3	$4,sp,(r0)+
600	movl	(sp),(r0)
601	clrl	r0
602	rsb
603
604	.globl	_Longjmp
605_Longjmp:
606	movq	(r0)+,r6
607	movq	(r0)+,r8
608	movq	(r0)+,r10
609	movq	(r0)+,r12
610	movl	(r0)+,r1
611	cmpl	r1,sp				# must be a pop
612	bgequ	lj2
613	pushab	lj1
614	calls	$1,_panic
615lj2:
616	movl	r1,sp
617	jmp	*(r0)				# ``rsb''
618
619lj1:	.asciz	"longjmp"
620
621	.globl	_whichqs
622	.globl	_qs
623	.globl	_cnt
624
625	.globl	_noproc
626	.comm	_noproc,4
627	.globl	_runrun
628	.comm	_runrun,4
629
630/*
631 * The following primitives use the fancy VAX instructions
632 * much like VMS does.  _whichqs tells which of the 32 queues _qs
633 * have processes in them.  Setrq puts processes into queues, Remrq
634 * removes them from queues.  The running process is on no queue,
635 * other processes are on a queue related to p->p_pri, divided by 4
636 * actually to shrink the 0-127 range of priorities into the 32 available
637 * queues.
638 */
639
640/*
641 * Setrq(p), using fancy VAX instructions.
642 *
643 * Call should be made at spl6(), and p->p_stat should be SRUN
644 */
645	.globl	_Setrq		# <<<massaged to jsb by "asm.sed">>>
646_Setrq:
647	tstl	P_RLINK(r0)		## firewall: p->p_rlink must be 0
648	beql	set1			##
649	pushab	set3			##
650	calls	$1,_panic		##
651set1:
652	movzbl	P_PRI(r0),r1		# put on queue which is p->p_pri / 4
653	ashl	$-2,r1,r1
654	movaq	_qs[r1],r2
655	insque	(r0),*4(r2)		# at end of queue
656	bbss	r1,_whichqs,set2	# mark queue non-empty
657set2:
658	rsb
659
660set3:	.asciz	"setrq"
661
662/*
663 * Remrq(p), using fancy VAX instructions
664 *
665 * Call should be made at spl6().
666 */
667	.globl	_Remrq		# <<<massaged to jsb by "asm.sed">>>
668_Remrq:
669	movzbl	P_PRI(r0),r1
670	ashl	$-2,r1,r1
671	bbsc	r1,_whichqs,rem1
672	pushab	rem3			# it wasn't recorded to be on its q
673	calls	$1,_panic
674rem1:
675	remque	(r0),r2
676	beql	rem2
677	bbss	r1,_whichqs,rem2
678rem2:
679	clrl	P_RLINK(r0)		## for firewall checking
680	rsb
681
682rem3:	.asciz	"remrq"
683
684/*
685 * Masterpaddr is the p->p_addr of the running process on the master
686 * processor.  When a multiprocessor system, the slave processors will have
687 * an array of slavepaddr's.
688 */
689	.globl	_masterpaddr
690	.data
691_masterpaddr:
692	.long	0
693
694	.text
695sw0:	.asciz	"swtch"
696/*
697 * Swtch(), using fancy VAX instructions
698 */
699	.globl	_Swtch
700_Swtch:				# <<<massaged to jsb by "asm.sed">>>
701	movl	$1,_noproc
702	clrl	_runrun
703sw1:	ffs	$0,$32,_whichqs,r0	# look for non-empty queue
704	bneq	sw1a
705	mtpr	$0,$IPL			# must allow interrupts here
706	brw	sw1			# this is an idle loop!
707sw1a:	mtpr	$0x18,$IPL		# lock out all so _whichqs==_qs
708	bbcc	r0,_whichqs,sw1		# proc moved via lbolt interrupt
709	movaq	_qs[r0],r1
710	remque	*(r1),r2		# r2 = p = highest pri process
711	bvc	sw2			# make sure something was there
712sw1b:	pushab	sw0
713	calls	$1,_panic
714sw2:	beql	sw3
715	insv	$1,r0,$1,_whichqs	# still more procs in this queue
716sw3:
717	clrl	_noproc
718	tstl	P_WCHAN(r2)		## firewalls
719	bneq	sw1b			##
720	movzbl	P_STAT(r2),r3		##
721	cmpl	$SRUN,r3		##
722	bneq	sw1b			##
723	clrl	P_RLINK(r2)		##
724	movl	*P_ADDR(r2),r0
725	movl	r0,_masterpaddr
726	ashl	$PGSHIFT,r0,r0		# r0 = pcbb(p)
727/*	mfpr	$PCBB,r1		# resume of current proc is easy
728 *	cmpl	r0,r1
729 */	beql	res0
730	incl	_cnt+V_SWTCH
731/* fall into... */
732
733/*
734 * Resume(pf)
735 */
736	.globl	_Resume		# <<<massaged to jsb by "asm.sed">>>
737_Resume:
738	mtpr	$0x18,$IPL			# no interrupts, please
739	movl	_CMAP2,_u+PCB_CMAP2	# yech
740	svpctx
741	mtpr	r0,$PCBB
742	ldpctx
743	movl	_u+PCB_CMAP2,_CMAP2	# yech
744res0:
745	tstl	_u+PCB_SSWAP
746	beql	res1
747	movl	_u+PCB_SSWAP,r0
748	clrl	_u+PCB_SSWAP
749	movab	_Longjmp,(sp)
750	movl	$PSL_PRVMOD,4(sp)		# ``cheating'' (jfr)
751res1:
752	rei
753
754/*
755 * {fu,su},{byte,word}, all massaged by asm.sed to jsb's
756 */
757	.globl	_Fuword
758_Fuword:
759	prober	$3,$4,(r0)
760	beql	fserr
761	movl	(r0),r0
762	rsb
763fserr:
764	mnegl	$1,r0
765	rsb
766
767	.globl	_Fubyte
768_Fubyte:
769	prober	$3,$1,(r0)
770	beql	fserr
771	movzbl	(r0),r0
772	rsb
773
774	.globl	_Suword
775_Suword:
776	probew	$3,$4,(r0)
777	beql	fserr
778	movl	r1,(r0)
779	clrl	r0
780	rsb
781
782	.globl	_Subyte
783_Subyte:
784	probew	$3,$1,(r0)
785	beql	fserr
786	movb	r1,(r0)
787	clrl	r0
788	rsb
789
790/*
791 * Copy 1 relocation unit (NBPG bytes)
792 * from user virtual address to physical address
793 */
794_copyseg: 	.globl	_copyseg
795	.word	0x0
796	bisl3	$PG_V|PG_KW,8(ap),_CMAP2
797	mtpr	$_CADDR2,$TBIS	# invalidate entry for copy
798	movc3	$NBPG,*4(ap),_CADDR2
799	ret
800
801/*
802 * zero out physical memory
803 * specified in relocation units (NBPG bytes)
804 */
805_clearseg: 	.globl	_clearseg
806	.word	0x0
807	bisl3	$PG_V|PG_KW,4(ap),_CMAP1
808	mtpr	$_CADDR1,$TBIS
809	movc5	$0,(sp),$0,$NBPG,_CADDR1
810	ret
811
812/*
813 * Check address.
814 * Given virtual address, byte count, and rw flag
815 * returns 0 on no access.
816 */
817_useracc:	.globl	_useracc
818	.word	0x0
819	movl	4(ap),r0		# get va
820	movl	8(ap),r1		# count
821	tstl	12(ap)			# test for read access ?
822	bneq	userar			# yes
823	cmpl	$NBPG,r1			# can we do it in one probe ?
824	bgeq	uaw2			# yes
825uaw1:
826	probew	$3,$NBPG,(r0)
827	beql	uaerr			# no access
828	addl2	$NBPG,r0
829	acbl	$NBPG+1,$-NBPG,r1,uaw1
830uaw2:
831	probew	$3,r1,(r0)
832	beql	uaerr
833	movl	$1,r0
834	ret
835
836userar:
837	cmpl	$NBPG,r1
838	bgeq	uar2
839uar1:
840	prober	$3,$NBPG,(r0)
841	beql	uaerr
842	addl2	$NBPG,r0
843	acbl	$NBPG+1,$-NBPG,r1,uar1
844uar2:
845	prober	$3,r1,(r0)
846	beql	uaerr
847	movl	$1,r0
848	ret
849uaerr:
850	clrl	r0
851	ret
852
853/*
854 * kernacc - check for kernel access privileges
855 *
856 * We can't use the probe instruction directly because
857 * it ors together current and previous mode.
858 */
859	.globl	_kernacc
860_kernacc:
861	.word	0x0
862	movl	4(ap),r0	# virtual address
863	bbcc	$31,r0,kacc1
864	bbs	$30,r0,kacerr
865	mfpr	$SBR,r2		# address and length of page table (system)
866	bbss	$31,r2,0f; 0:
867	mfpr	$SLR,r3
868	brb	kacc2
869kacc1:
870	bbsc	$30,r0,kacc3
871	mfpr	$P0BR,r2	# user P0
872	mfpr	$P0LR,r3
873	brb	kacc2
874kacc3:
875	mfpr	$P1BR,r2	# user P1 (stack)
876	mfpr	$P1LR,r3
877kacc2:
878	addl3	8(ap),r0,r1	# ending virtual address
879	addl2	$NBPG-1,r1
880	ashl	$-PGSHIFT,r0,r0
881	ashl	$-PGSHIFT,r1,r1
882	bbs	$31,4(ap),kacc6
883	bbc	$30,4(ap),kacc6
884	cmpl	r0,r3		# user stack
885	blss	kacerr		# address too low
886	brb	kacc4
887kacc6:
888	cmpl	r1,r3		# compare last page to P0LR or SLR
889	bgtr	kacerr		# address too high
890kacc4:
891	movl	(r2)[r0],r3
892	bbc	$31,4(ap),kacc4a
893	bbc	$31,r3,kacerr	# valid bit is off
894kacc4a:
895	cmpzv	$27,$4,r3,$1	# check protection code
896	bleq	kacerr		# no access allowed
897	tstb	12(ap)
898	bneq	kacc5		# only check read access
899	cmpzv	$27,$2,r3,$3	# check low 2 bits of prot code
900	beql	kacerr		# no write access
901kacc5:
902	aoblss	r1,r0,kacc4	# next page
903	movl	$1,r0		# no errors
904	ret
905kacerr:
906	clrl	r0		# error
907	ret
908