/ 
/ COPYRIGHT:  1979, by Ford Aerospace and Communications Corp.
/ ADDRESS:    Ford Aerospace and Communications Corp.
/             Western Development Laboratories
/             3939 Fabian Way
/             Palo Alto, California 94303
/             Attention: Software Technology Dept.
/             Mail Stop: V02 
/ 
/ CPCI:  NKSR
/ 
/ CPC:  include
/ 
/ TAG:  NKSRnuc.s
/ 
/ MODULE NAME:  NKSR nucleus
/ 
/ REFERENCES-
/   A Specs:  
/   B5 Specs:  
/ 
/ HISTORY:
/   AUTHOR:   L. C. Dion,  J. Holden
/   VERSION:  1.15 of 9/28/80
/   MODULE TYPE: 
/ PRIVILEGES:  
/ 
/ SPECIAL NOTES:  
/   This version of the NKSR nucleus is intended for use with
/   the KSOS process bootstrapper (PBB).
/   It can be used with either separate or non-separate I/D
/   images as it contains space for interrupt vectors in both
/   the data and text segments.
/ 
/ 
/ Define :-
/
	.globl	subs, case, stop, nucl
	.globl	dcal, dexi, dsen, dwai, doio
	.globl	pcal, pexi, osen, owai, lset, mexi
	.globl	b
/
/ Use :-
/
	.globl	gdyn, init
/
/ Assembly parameters
/
	safgap	= 40
	pivadr	= 40
	naplen	= -1
	stkinc	= 512.
/
/ Instructions not defined in Unix assembler
/
	ksos	= 104000^sys
	mfpi	= 006500^tst
	call	= 004700^jmp
	ret	= 000207
	rti	= 000002
/
/ KSOS kernel calls
/
	releas	= 23		/ K_release_process
	intret	= 12		/ K_interrupt_return
	set_pil	= 42		/ K_set_pil
	receiv	= 22		/ K_receive
	getss	= 10		/ K_get_segment_status
	remap	= 25		/ K_remap
	post	= 20		/ K_post
/
/ Pseudo interrupt vector offsets
/
	i.ipc	= 0
	i.ips	= 2
	i.ipl	= 4
	i.mes	= 6
	i.eve	= 12
	i.npc	= 26
	i.nps	= 30
	i.size	= 32
/
/ Interrupt levels
/
	base	= 0
	ipc	= 1
	timer	= 2
	sig	= 3
	io	= 4
	hard	= 5
/
	ipcvec	= [ipc*i.size]+pivadr
/
/ Other KSOS constants
/
	supdom	= 2		/ Supervisor domain
	rmpsiz	= 4		/ K_remap selector
	maxseg	= 15		/ Highest segment descriptor
	prcnsp	= 4		/ process_nsp
	ET_acp	= 15		/ ???????????????????????
/
/ Process descriptor format
/
	p.sp	= 0		/ Save area for sp
	p.st	= 2		/ Process state
	p.sc	= 4		/ Signal chain
	p.ch	= 6		/ Process descriptor chain
	p.il	= 10		/ Pseudo interrupt level
	p.size	= 12
	pp	= r5
/
	.data
	.=.+400			/ Interrupt vectors
gpd:	0; 0; 0; gpd; 0
dpd:	dpd0; dpd1; dpd2; dpd3; dpd4; dpd5; 0
dph:	dph0; dph1; dph2; dph3; dph4; dph5; 0
dpd0:	0; 0; 0; 0; 0
dpd1:	0; 0; 0; 0; 0
dpd2:	0; 0; 0; 0; 0
dpd3:	0; 0; 0; 0; 0
dpd4:	0; 0; 0; 0; 0
dpd5:	0; 0; 0; 0; 0
b:	000001; 000002; 000004; 000010
	000020; 000040; 000100; 000200
	000400; 001000; 002000; 004000
	010000; 020000; 040000; 100000
nlseid:	0; 0			/ Null seid
newdpd:	0
stklim:	0
ready:	0			/ Head
eready:	0			/ ... and tail of ready queue
/
/ Parameter area for K_get_segment_status
/
segsta:
ss.css:	0; 0			/ inseid:    seid
ss.csd:	0			/ inseg:     segdes
ss.lok:	.byte	0		/ mem_lock:  boolean;
ss.mad:	.byte	0		/ mem_advise:boolean;
ss.stk:	.byte	0		/ swap_lock: boolean;
ss.shr:	.byte	0		/ sharable:  boolean;
ss.dwn:	.byte	0		/ growth:    boolean;
	.even
ss.siz:	0			/ statsize:  integer;
ss.vss:	0; 0			/ statseid:  seid;
ss.vsd:	0			/ statdes:   segdes;
ss.map:	.byte	0		/ mapped:    boolean;
	.even
ss.acc:	0			/ statacc:   acc_mode;
ss.loc:	0; 0			/ statloc:   virt_loc;
/
/ Parameter area for K_remap
/
remapb:
rm.isd:	0			/ inseg:     segdes;
rm.loc:	0; 0			/ inloc:     virt_loc;
rm.acc:	0			/ inacc:     acc_mode;
rm.osd:	0			/ outseg:    segdes;
rm.siz:	0			/ outsize:   integer;
rm.sel:	rmpsiz			/ choice:    selector;
/
/ Parameter area for K_post (Audit capture)
/
acb:
ac.psd:	.byte	prcnsp, 1; 1	/ SEID(process_nsp, 1C, 1)
ac.int:	.byte	0		/ interrupt = false
	.even
ac.typ:	.byte	ET_acp, 255	/ Audit message type
ac.msg:	0; 0; 0; 0; 0
/
_S_nuc:	<@(#)NKSRnuc.s	1.15\0>
/
/ Start of text segment - entry vector for program
/
	.text
	jmp	nucl
	.=.+374			/ More interrupt vectors
/
/
/ Call ordinary process:
/	r0 = code address,
/	r1 = stack size
/	r2 = param area size
/	jsr	pc,pcal
/
/ The stack space and a process descriptor for the new process
/ are allocated, and the parameters to the process are then
/ copied onto the new stack. The new process is then entered.
/
pcal:	call	alloc			/ Allocate stack etc.
	mov	r1,r0			/ Save new pp
	mov	$hard,r1
	call	setpil
	mov	r1,p.il(pp)		/ Save callers state
	mov	sp,p.sp(pp)
	mov	p.ch(pp),p.ch(r0)	/ Link new pd into chain
	mov	r0,p.ch(pp)
	clr	p.il(r0)		/ Initialise pd
	clr	p.st(r0)
	clr	p.sc(r0)
	mov	r2,p.sp(r0)
	mov	r0,r1
	jbr	run
/
/ Wait (ordinary process)
/	r0 = queue
/	r1 = priority
/
/ The process is added to the signal queue in priority order,
/ and the nucleus switches to the next ready process.
/
owai:	mov	r1,p.st(pp)		/ Save rank
	mov	$hard,r1		/ Inhibit interrupts
	call	setpil
	mov	r1,p.il(pp)		/ Save process state
	mov	sp,p.sp(pp)
1:	mov	(r0),r1			/ Scan signal queue
	beq	1f
	cmp	p.st(pp),p.st(r1)
	blo	1f
	mov	r1,r0
	add	$p.sc,r0
	br	1b
1:	mov	(r0),p.sc(pp)		/ Link process into queue
	mov	pp,(r0)
	jbr	find			/ Find another process to run
/
/ Send (by normal process)
/	r0 = queue
/
/ The first process on the signal queue (if any) is unlinked
/ and becomes the current process. If it is a device process
/ this involves setting things up so that it looks as though
/ the sender has just been interrupted by the device process
/
osen:	mov	$hard,r1		/ Inhibit interrupts
	call	setpil
	mov	r1,p.il(pp)
	mov	sp,p.sp(pp)
	mov	(r0),r1			/ Queue empty?
	beq	run1
	mov	p.sc(r1),(r0)		/ unlink head of chain
	tst	p.st(r1)		/ Is it a device process?
	bpl	run			/ No, switch to it
	mov	p.il(r1),r3		/ Yes, fake an interrupt
	mul	$i.size,r3
	mov	p.il(pp),pivadr+i.ipl(r3)
	mov	(sp),pivadr+i.ipc(r3)
	clr	pivadr+i.ips(r3)
	tst	-(sp)
	mov	sp,p.ch(r1)		/ Switch to device process
	mov	p.sp(r1),sp
	mov	p.il(r1),r1
	call	setpil
	rts	pc
/
/ Exit process
/
pexi:	com	p.st(pp)		/ Mark as nonrunnable
/
/ Find process to run
/   The ready queue is examined to see if it is nonempty. If this
/   is so, the first process on the queue is unlinked and runs.
/   If not, all normal processes are inactive so a K_receive is
/   performed to cause the program to wait until either the receive
/   call is satisfied or some pseudo interrupt occurs. The receive
/   is performed directly into the ipc vector, and if it succeeds
/   an ipc interrupt is simulated. If the receive fails, either
/   because it was broken by an interrupt or because it timed out,
/   the ready queue is rescanned.
/
find0:	mov	$hard,r1		/ Lock out interrupts
	call	setpil
find:	mov	ready,r1		/ Anything to run?
	beq	1f
	mov	p.sc(r1),ready		/ Yes, unlink it
	bne	run0
	clr	eready			/ (unlinking last ready process)
	br	run0
1:	mov	$naplen,ipcvec+i.ips	/ Nothing to run yet,
	mov	$ipc,ipcvec+i.ipl	/ So wait for an ipc.
	mov	$ipcvec+i.ips,-(sp)	/ K_receive(naplen, ipc_vec)
	clr	-(sp)
	ksos	receiv			/ Sleep a while
	cmp	(sp)+,(sp)+
	tst	r0			/ Exceptions of K_receive?
	bne	find0
	mov	$hard,ipcvec+i.ipl	/ Fake interrupt
	mov	$find,ipcvec+i.ipc
	clr	ipcvec+i.ips
	jmp	*ipcvec+i.npc
/
/ Run a normal process
/   The current process (specified by pp) is linked onto the back
/   of the ready queue, and the chosen process (specified by r1)
/   is entered and run.
/
run:	mov	eready,r0		/ Link current process onto
	beq	1f			/ back of ready queue
	mov	pp,p.sc(r0)
	br	2f
1:	mov	pp,ready
2:	mov	pp,eready
	clr	p.sc(pp)
run0:	mov	r1,pp			/ Switch to new process
run1:	mov	p.sp(pp),sp		/ Restore state
	mov	p.il(pp),r1
	call	setpil
run2:	rts	pc
/
/ Error stops
/
stop:	tst	r0			/ Modula halt
	beq	die			/ Don't audit halt(0)
	mov	$177773,r1
	br	audit
stopnr:	mov	$177774,r1		/ Out of space
	br	audit
stopss:	mov	$177766,r1		/ Get segment status failed
	br	audit
subs:	mov	$177770,r1		/ Subscript error
	br	audit
case:	mov	$177767,r1		/ Case error
	br	audit
stopnd:	mov	$177772,r1		/ Out of vectors
	br	audit
unsol:	mov	$177771,r1
audit:	mov	$ac.msg,r2		/ Fill in audit capture message
	mov	r1,(r2)+		/ word 0 = stop code
	mov	r0,(r2)+		/ word 1 = r0 (line no.)
	mov	r5,(r2)+		/ word 2 = pp
	mov	sp,(r2)+		/ word 3 = sp
	mov	(sp)+,(r2)+		/ word 4 = pc
	mov	$acb,-(sp)
	clr	-(sp)
	ksos	post			/ Send audit message
	cmp	(sp)+,(sp)+
die:	mov	$nlseid,-(sp)		/ Null seid
	clr	-(sp)
	ksos	releas			/ K_release_process
/
/ Allocate stack for new process.
/   The stack and process descriptor are allocated, and the parameters
/   for the new process are moved from the callers stack to the new
/   stack.
/
alloc:	mov	stklim,r3		/ allocate stack space
	sub	r1,stklim		/ plus a safety gap
	sub	$p.size+safgap,stklim	/ and room for process descriptor
	call	expand			/ Grow stack segment if necessary
	sub	$p.size,r3		/ Allocate process descriptor
	mov	r3,r1			/ r1 = new pp
	sub	r2,r3			/ Allocate param area
	mov	r3,r2			/ r2 = new sp
	mov	r0,-(r2)		/ Save start address
	mov	(sp)+,r0		/ save link
	mov	(sp)+,(r1)		/ save calling process pc
1:	cmp	r3,r1			/ Copy parameters into new stack
	bhis	2f
	mov	(sp)+,(r3)+
	br	1b
2:	mov	(r1),-(sp)
	jmp	(r0)
/
/ Exit device module procedure
/	jmp	mexi
/
/ Called to return from a procedure of a device module, the
/ pseudo interrupt level of the caller was saved on the stack
/ above the link. It is removed and the link is moved so that
/ after falling through lset, the return will take us back to
/ the original calling point of the procedure.
/
mexi:	mov	2(sp),r1		/ Get previous interrupt level
	mov	(sp),2(sp)		/ Put link in correct place
	tst	(sp)+			/ and fix stack for rts
/
/ Set pseudo interrupt level
/	r1 = new level << 5
/ Called on entry to a device process or procedure. All levels
/ passed in by the compiler have been multiplied by 32 (c.f. the
/ PDP11 hardware PS) so this must be compensated for.
/ A rather strange kludge here involves the testing of the flag
/ newdpd, which is set iff this is an entry of a device process.
/ (see dcal) If so, the device process entry code, including the
/ simulation of an interrupt of the process initiating the device
/ process, is performed. This is done here because we do not know
/ which vector to use when dcal is done.
/
lset:	ash	$-5,r1			/ Fix up level
	tst	newdpd			/ Is this a device process entry?
	beq	setpil
	mov	newdpd,r3
	mov	p.sp(pp),r2		/ Yes, fake an interrupt
	mov	r2,p.ch(r3)
	mov	r1,r3
	mul	$i.size,r3
	mov	p.il(pp),pivadr+i.ipl(r3)
	mov	2(r2),pivadr+i.ipc(r3)
	clr	pivadr+i.ips(r3)
	clr	newdpd
/
/ Set pseudo interrupt level
/	r1 = new level
/	on return r1 = previous level
/
setpil:	mov	r0,-(sp)		/ Save r0 (clobbered by ksos)
	tst	-(sp)			/ Allocate space for result
	mov	r1,-(sp)
	mov	sp,r1
	mov	r1,-(sp)
	clr	-(sp)
	ksos	set_pil
	add	$6,sp
	mov	(sp)+,r1		/ r1 contains previous level
	mov	(sp)+,r0
	rts	pc
/
/ Call device process
/	r0 = code address
/	r1 = stack size
/	r2 = param area size
/
/ The stack for the new process and a process descriptor are
/ allocated. The address of the process descriptor is saved
/ in the variable newdpd, so that when the device process is
/ entered and calls lset, the rest of the device process entry
/ code will be performed.
/
dcal:	call	alloc			/ Allocate stack
	mov	$hard,r1		/ Inhibit interrupts
	call	setpil
	mov	r1,p.il(pp)		/ Save state of pp
	tst	-(sp)
	mov	sp,p.sp(pp)
	clr	r0			/ Find a device process descriptor
1:	mov	dpd(r0),r1
	beq	stopnd			/ Out of descriptors? Crash.
	tst	p.st(r1)		/ Is it in use?
	beq	2f
	tst	(r0)+			/ Yes, try next one
	br	1b
2:	mov	dph(r0),r0		/ Get associated handler
	com	p.st(r1)		/ Mark descriptor as in use
	mov	r2,sp			/ Switch to new stack
	mov	r1,-(sp)
	mov	r1,newdpd		/ Remember it: this fudge will
	jmp	*2(sp)			/ cause lset to complete the set-up
/
/ Send (by device process)
/	r0 = queue
/
/ The head of the signal queue, if any, is unlinked and added
/ to the ready queue.
/
dsen:	tst	(r0)			/ Quick test for null queue
	beq	2f
	mov	$hard,r1
	call	setpil
	mov	r1,-(sp)		/ Save current interrupt level
	mov	(r0),r1
	beq	1f			/ Retest to avoid races
	mov	p.sc(r1),(r0)		/ OK, unlink head of chain
	mov	ready,p.sc(r1)		/ Link receiver onto ready queue
	bne	0f
	mov	r1,eready
0:	mov	r1,ready
1:	mov	(sp)+,r1		/ Restore interrupt level
	call	setpil
2:	rts	pc
/
/ Wait (by device process)
/	r0 = queue
/	r1 = address of pd
/
/ The device process is added at the head of the signal queue,
/ and the process interrupted by the device process is resumed.
/
dwai:	mov	(r1),r1
	mov	(r0),p.sc(r1)
	mov	r1,(r0)
	br	drti
/
/ doio
/	r1 = address of address of pd
/
/ The context of the device process is saved, and that of the
/ interrupted process is restored. The interrupted process is
/ run.
/
doio:	mov	(r1),r0
drti:	mov	sp,p.sp(r0)		/ Save context
	mov	p.ch(r0),sp		/ Resume interrupted process
	mov	(sp)+,r1
	mov	(sp)+,r0
	ksos	intret
/
/ Exit device process
/
dexi:	mov	(r1),r1			/ Allow reuse of process descriptor
	clr	p.st(r1)
	br	drti
/
/ expand.
/   Expand stack segment so that stklim lies within the
/   segment. Expansion is done in minimum increments of
/   'stkinc'.
/
expand:	cmp	stklim,ss.loc+2		/ Is expansion needed?
	bhis	1f			/ If not, just return
	mov	r0,-(sp)		/ Get work registers
	mov	ss.loc+2,r0		/ Calculate amount needed
	sub	stklim,r0
	add	$stkinc,r0		/ Round up to a multiple
	bic	$-stkinc,r0		/ of stkinc
	add	r0,ss.siz		/ Update size of stack segment
	sub	r0,ss.loc+2		/ Update bottom address of segment
	mov	ss.csd,rm.isd		/ Set up K_remap block
	mov	ss.csd,rm.osd		/ inseg = outseg = stack
	mov	ss.siz,rm.siz
	mov	$remapb,-(sp)
	clr	-(sp)
	ksos	remap			/ Do the remap
	cmp	(sp)+,(sp)+
	tst	r0
	jne	stopnr			/ If it fails, die.
	mov	(sp)+,r0		/ Restore registers
1:	rts	pc
/
/ Handlers
/   There is a handler allocated to each device process when
/   it is initiated. The handler is plugged into the interrupt
/   vector, and when an interrupt is received it saves the 
/   context of the running process and switches to the associated
/   device process where it appears as a return from a call to
/   doio.
/
dph0:	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	sp,dpd0+p.ch
	mov	dpd0+p.sp,sp
	rts	pc

dph1:	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	sp,dpd1+p.ch
	mov	dpd1+p.sp,sp
	rts	pc

dph2:	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	sp,dpd2+p.ch
	mov	dpd2+p.sp,sp
	rts	pc

dph3:	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	sp,dpd3+p.ch
	mov	dpd3+p.sp,sp
	rts	pc

dph4:	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	sp,dpd4+p.ch
	mov	dpd4+p.sp,sp
	rts	pc

dph5:	mov	r0,-(sp)
	mov	r1,-(sp)
	mov	sp,dpd5+p.ch
	mov	dpd5+p.sp,sp
	rts	pc

/
/ Nucleus start up code
/
/ Firstly set up pp and sp. The stack will be set up in
/ the 8K segment growing down from the top of memory.
/ This segment initially contains the process arguments.
/ The status of the stack segment is gotten, this will be
/ used if we need to expand the stack.
/
nucl:	mov	$gpd,pp			/ Initial pd
	mov	$177776,sp		/ Set up sp to top of core
	sub	*$177776,sp		/ and move down over arguments
	mov	$hard,r1
	call	setpil			/ Probably superfluous
	clr	ss.csd			/ Start with segdes 0
1:	mov	$segsta,-(sp)		/ K_get_segment_status(
	clr	-(sp)			/    null_seid, segdes, stat
	ksos	getss			/ )
	cmp	(sp)+,(sp)+		/
	tst	r0			/ Did call fail?
	bne	2f			/ If so this isn't it!
	tstb	ss.dwn			/ Downward expanding?
	beq	2f			/ If so, it must be stack seg.
	cmpb	ss.loc,$supdom		/ But make sure correct domain
	beq	3f			/ If it's supervisor, it's OK.
2:	inc	ss.csd			/ Not found yet,
	cmp	ss.csd,$maxseg		/ Have we tried all segments?
	blos	1b			/ If not, do it again.
	jbr	stopss			/ Tried them all, so die.
3:	mov	sp,stklim		/ Initial stack limit
	sub	ss.siz,ss.loc+2		/ find bottom of segment
	inc	ss.loc+2		/ exactly!
	sub	$gdyn+safgap,stklim	/ Allocate global stack
	call	expand			/ Extend stack segment if required
	mov	$376,r0
1:	clr	-(r0)			/ Launder interrupt vectors
	tst	r0
	bne	1b
	mov	$pivadr+i.npc,r0
	mov	$hard+1,r1
1:	mov	$unsol,(r0)		/ set up unsolicited interrupt handler
	add	$i.size,r0
	sob	r1,1b
	mov	$base,r1		/ Set interrupt level down
	call	setpil
	jmp	init			/ Enter user program
