.title	ddb_priv privileged code to debug detached process
;
; Copyright (C) 1994 Neill Clift (neill@macro.demon.co.uk).
;
; This program comes without any warranty. The author does not accept any
; responsibility for any damage caused by the use of this program. This
; program is not in the public domain but may be copied freely so long as this
; copyright notice remains.
;
; Please send any modifications to the author.
;
; The aim of this code is to run up the debugger in a detached process with
; dbg$input etc pointing to a pseudo-terminal created especialy for the debug
; purpose.
;
	.disable global
	.link	/sys$system:sys.stb//selective_search
	.library /sys$library:lib.mlb/
;
; Error messages
;
	.external ddb__astact, -	; AST thread active
		ddb__astdis		; ASTs are disabled
;
; External data cells
;

	.external ctl$gl_pcb, -		; Process control block address
		ctl$gl_phd		; P1 window to Process Header
;
; External routines
;
	.external sch$clrefr, -		; Clear event flag rsb return
		sch$iolockw, -		; lock IO database for write access
		sch$iounlock, -		; unlock IO database
		sch$postef, -		; Set event flag
		sch$qast		; Queue an AST to another process
;
	.external exe$allocbuf, -	; Allocate nonpaged pool
		exe$alop1imag, -	; allocate image temporary memory
		exe$deanonpaged, -	; Deallocate nonpaged pool
		exe$epid_to_ipid, -	; Convert external to internal PID
		exe$srchandler, -	; Search for condition handler
		exe$ipid_to_pcb		; Convert internal PID to PCB
;
	.external ioc$clone_ucb, -	; Make copy of device UCB
		ioc$cvt_devnam, -	; Convert UCB to device name
		ioc$searchdev		; search for device in IO database
;
	.external ini$brk		; Bring up xdelta
;
	.external exe$c_sysefn		; System event flag number
;
; Include structure definitions
;
	$acbdef		; AST Control block offsets
	$dcdef		; Device Class and type definitions
	$devdef		; Device flags definitions
	$dyndef		; Dynamic memory structure types
	$ipldef		; Interupt priority levels
	$lckdef		; Lock manager flags
	$lnmdef		; Logical name services definitions
	$orbdef		; Object Rights Block offsets
	$pcbdef		; Process control block offsets
	$phddef		; process header offsets
	$prdef		; Internal processor registers
	$pridef		; Priority increment classes
	$psldef		; Process status longword
	$sfdef		; Stack frame definitions
	$ssdef		; System service completion codes
	$statedef	; Scheduling state definitions
	$ttyucbdef	; Terminal extension to UCB offsets
	$ucbdef		; Unit Control Block offsets
;
; Define ACB + extension to carry our data and code to another process.
;
	$defini	acb
. = acb$k_length
	$def	acb_l_iosb	.blkq	1		; User IOSB address
	$def	acb_l_efn	.blkl	1		; User event flag no.
	$def	acb_l_acmode	.blkl	1		; Callers access mode
	$def	acb_l_epid	.blkl	1		; External dest PID
	$def	acb_l_rpid	.blkl	1		; PID to return to
	$def	acb_l_status	.blkl	1		; Return status
	$def	acb_l_imgcnt	.blkl	1		; Image count
	$def	acb_l_acb	.blkl	1		; another ACB chained
	$equ	acb_k_devlen	10			; Length of device
	$def	acb_t_terminal	.blkb	acb_k_devlen+1	; Input/Output terminal
	$equ	acb_r_code	.			; Code to execute
	$equ	acb_k_length	.			; length of ACB
	$defend	acb
;
; Define Paged Image Block to carry paged kernel and user code + data in the
; remote image. This block is not deallocated but left for the life of the
; image.
;
;
	$defini	pib
	$equ	pib_k_lockname	4			; prefix size
	$def	pib_l_length	.blkl	1		; length of block
	$def	pib_t_terminal	.blkb	acb_k_devlen+1	; Input/Output buffer
	$def	pib_q_lksb	.blkq	1		; lock status block
	$def	pib_t_lockname	.blkb	pib_k_lockname	; Place to put lockname
	$def	pib_l_epid	.blkl	1		; external PID of target
	$equ	pib_r_code	.			; code starts here
	$equ	pib_k_length	.			; set length of block
	$defend	pid
;
	.psect	ddb_rdata nowrt rd noexe shr
vta0:	.ascid	/_VTA0:/				; Virtual terminal name
;!!!!	.psect	ddb_code nowrt rd exe pic shr
	.psect	zddb_code wrt rd exe pic shr
	.entry	ddb_priv ^m<>
efn      = 4						; Event flag to set
pidadr   = efn+4					; PID of process
iosb     = pidadr+4					; I/O status block
terminal = iosb+4					; Terminal to debug on
nargs    = 4						; Total arguments
	$cmkrnl_s -
		routin = b^ddb_priv_k, -
		arglst = (ap)
99$:	ret
	.entry	ddb_privw ^m<>
	$cmkrnl_s -
		routin = b^ddb_priv_k, -
		arglst = (ap)
	blbc	r0, 99$
	$synch_s -
		efn  = efn(ap), -
		iosb = iosb(ap)
99$:	ret
;
	.entry	ddb_priv_k ^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
;
; At this point R4 contains address
;
;	jsb	g^ini$brk
	bsbw	alloc_buf_r5			; allocate ACB
	blbc	r0, 99$				; failed to allocate
	bsbw	copy_args_r4			; copy arguments into ACB
	blbc	r0, 99$				; quit on error
	bsbb	copy_code_r4			; copy code into pool
	bsbb	qast_r5				; queue the ast
99$:	bsbw	tidy_r2				; tidy up
	ret					; return status
;
; Copies the code into pool and sets addresses of code to execute.
; Inputs:
;    R5: ACB address
; Outputs:
; Trashes:
;    R0,R1,R2,R3,R4
;
copy_code_r4:
	pushl	r5				; Save ACB
	movab	acb_r_code(r5), acb$l_kast(r5)	; set code to execute at IPL 2
	movc3	#code_length, w^code_start, -
		acb_r_code(r5)			; Copy the code into pool
	movl	#ss$_normal, r0			; all is ok
	popl	r5				; restore ACB
	rsb
;
; Tests the status of the target process and queues the AST to it if all is ok
;
; Inputs:
;    R5: ACB address
; Outputs:
;    R0: Status
;    R5: Cleared if AST queued ok.
; Trashes:
;    R1,R3,R4
qast_r5:
	setipl	ipl     = w^sched, -		; up to sched for database
		environ = UNIPROCESSOR		; just want to raise IPL
	lock	lockname  = sched, -		; lock the database
		condition = NOSETIPL, -		; poor mans lockdown
		preserve  = NO			; dont save R0
	movl	acb$l_pid(r5), r0		; get PID back
	jsb	g^exe$ipid_to_pcb		; convert to PCB
	beql	100$				; process has gone now
	bbs	#pcb$v_delpen, pcb$l_sts(r0), -
		100$				; dont queue to delpen proc
	bbs	#pcb$v_suspen, pcb$l_sts(r0), -
		110$				; dont queue to suspened
	bbs	#pcb$v_softsusp, pcb$l_sts(r0), -
		110$				; dont queue to soft susp
	cmpw	#sch$c_suspo, pcb$w_state(r0)	; dont queue to suspended
	beql	110$
	cmpw	#sch$c_susp, pcb$w_state(r0)	;  ..
	beql	110$
	cmpw	#sch$c_mwait, pcb$w_state(r0)	;  or resource wait processes
	beql	110$
	tstb	pcb$b_astact(r0)		; Any ASTs active?
	bneq	120$
	cmpb	#^B1111, pcb$b_asten(r0)	; All ASTs enabled?
	bneq	130$
	movl	#pri$_ticom, r2			; set large priority inc
	jsb	g^sch$qast			; queue the AST	
	blbc	r0, 100$			; quit with error
	clrl	r5				; dont deallocate ACB
99$:	unlock	lockname = sched, -		; unlock database
		newipl   = #ipl$_astdel, -	; can't affort to loose memory
		preserve = YES			; save status
	rsb
100$:	movzwl	#ss$_nonexpr, r0		; Say no process there
	brb	99$				; get back in line
110$:	movzwl	#ss$_suspended, r0		; say suspended
	brb	99$
120$:	movl	#ddb__astact, r0		; say thread active
	brb	99$
130$:	movl	#ddb__astdis, r0		; say ASTs disabled
	brb	99$
sched:	.long	ipl$_sched			; must be in next or same page
	assume	<.-qast_r5> le 512
;
; Probes, copies (to ACB) and validates arguments.
;
; Inputs:
;    R5: Pointer to ACB
;    AP: Argument list pointer
; Outputs:
;    R0: Status
; Trashes:
;    R1,R2,R3,R4
;
copy_args_r4:
	movl	g^ctl$gl_pcb, r4		; get address of PCB
	movl	pcb$l_pid(r4), acb_l_rpid(r5)	; save our PID for return
	movl	g^ctl$gl_phd, r0		; get process header
	movl	phd$l_imgcnt(r0), -
		acb_l_imgcnt(r5)		; Save image count for later
	movpsl	r0				; get our psl
	extzv	#psl$v_prvmod, #psl$s_prvmod, -
		r0, acb_l_acmode(r5)		; get previous mode
	movb	#psl$c_kernel!acb$m_kast!acb$m_nodelete, -
		acb$b_rmod(r5)			; set AST mode to kernel
	prober	#0, #nargs*4+4, (ap)		; can we read the arg list
	beql	accvio				; can't read it
	movzwl	#ss$_insfarg, r0		; assume too few arguments
	cmpb	(ap), #nargs			; enough arguments?
	blssu	99$				; not enough
	movl	iosb(ap), r1			; get iosb address
	probew	#0, #8, (r1)			; can we write it?
	beql	accvio				; nope!
	clrq	(r1)				; zero it for starters
	movl	r1, acb_l_iosb(r5)		; save away iosb address
	movl	efn(ap), r3			; get event flag number
	jsb	g^sch$clrefr			; clear the event flag
	blbc	r0, 99$				; quit on error
	movl	r3, acb_l_efn(r5)		; save event flag number
	bsbb	get_terminal_r4			; get the terminal name
	blbc	r0, 99$				; quit if error
	movl	pidadr(ap), r1			; get address of PID
	prober	#0, #4, (r1)			; can we read the longword?
	beql	accvio				; failed to read it
	movl	(r1), r0			; get pid
	movl	r0, acb_l_epid(r5)		; save external PID
	jsb	g^exe$epid_to_ipid		; convert to internal format
	beql	noprc				; zero means not converted
	movl	r0, acb$l_pid(r5)		; save the remote pid
	movl	#ss$_normal, r0			; all is ok
99$:	rsb
accvio:	movzwl	#ss$_accvio, r0			; say access violation
	rsb
noprc:	movzwl	#ss$_nonexpr, r0		; say process not found
	rsb
;
; Creates a logical UCB (Virtual terminal) for the physical terminal.
; Inputs:
;    R4: PCB address
;    R5: ACB address
; Outputs:
; Trashes:
;
get_terminal_r4:
	movq	r4, -(sp)			; save ACB/PCB address
	jsb	g^sch$iolockw			; Lock IO database fow write
	movaq	vta0, r1			; get vta0: address
	jsb	g^ioc$searchdev			; search for device
	clrl	r5				; Assume no cloned UCB
	blbc	r0, 1$				; skip logical UCB bit
	bsbb	clone_ucb_r5			; Clone the UCB
1$:	movl	#ss$_accvio, r0			; assume access violation
	movl	terminal(ap), r1		; get device name
	prober	#0, #8, (r1)			; read descriptor?
	beql	99$				; exit with error
	jsb	g^ioc$searchdev			; search for device
	blbc	r0, 99$				; quit with error
	cmpb	#dc$_term, ucb$b_devclass(r1)	; this a terminal?
	bneq	110$				; say its not right!
;
; R1 Contains original terminal UCB
; R5 Contains cloned UCB address (VTAnnn:) or zero
;
	tstl	r5				; cloned device there?
	beql	97$				; just copy device name
	bsbb	setup_plucb_r3			; setup UCBs
	brb	98$				; use LUCB
97$:	movl	r1, r5				; use PUCB for name
98$:	movl	4(sp), r2			; get ACB address back
	movl	#acb_k_devlen, r0		; set length of output
	movab	acb_t_terminal+1(r2), r1	; set buffer address
	mnegl	#1, r4				; we want a full device name
	jsb	g^ioc$cvt_devnam		; convert UCB to device name
	movb	r1, acb_t_terminal(r2)		; set length of terminal
99$:	movq	(sp)+, r4			; get ACB/PCB address back
	pushl	r0				; save status
	jsb	g^sch$iounlock			; unlock and return
	popl	r0				; restore status
	rsb					; return status
110$:	movzwl	#ss$_ivdevnam, r0		; say bad device name
	brb	99$				; release mutex
;
; Clones the UCB pointed to by R1
;
; Inputs:
;    R1: UCB to clone
; Outputs:
;    R0: Status
;    R5: Cloned UCB address or zero if failed
;
clone_ucb_r5:
	movl	r1, r5				; get UCB into input reg
	jsb	g^ioc$clone_ucb			; clone the device
	movl	r2, r5				; get UCB into correct reg
	blbc	r0, 1$				; do the rest
	clrw	ucb$w_refc(r5)			; say no accessors
	assume	ucb$v_deleteucb gt 15		; Can we shrink instruction?
	bisw	#ucb$m_deleteucb@-16, -
		ucb$l_sts+2(r5)			; say to delete on deaccess
	rsb
1$:	clrl	r5				; say no ucb there
	rsb
;
; Set up information in the Logical UCB and cross link this with the PUCB.
; Inputs:
;    R1: PUCB
;    R5: LUCB
; Outputs:
;    R1: PUCB
;    R5: LUCB
; Trashes:
;    R2,R3
;
setup_plucb_r3:
;	bisw	#ucb$m_job, ucb$w_devsts(r1)	; Say we have told job control
;	assume	dev$v_avl gt 15			; Can we shrink instruction?
;	bicw	#dev$m_avl@-16, -
;		ucb$l_devchar+2(r1)		; say unavailable
;	assume	dev$v_red gt 7			; Can we shrink instruction?
;	assume	dev$v_red lt 16			; in a byte?
;	bisb	#dev$m_red@-8, -
;		ucb$l_devchar2+1(r1)		; say redirected UCB
	movb	ucb$b_devtype(r1), -
		ucb$b_devtype(r5)		; copy device type	
	movb	ucb$b_flck(r1), -
		ucb$b_flck(r5)			; copy fork lock index
	assume	<ucb$b_dipl+1> eq ucb$b_amod	; copy both fields?
	movw	ucb$b_dipl(r1), -
		ucb$b_dipl(r5)			; copy ipl and access mode
	movl	ucb$l_dlck(r1), -
		ucb$l_dlck(r5)			; copy device lock
	movl	ucb$l_affinity(r1), -
		ucb$l_affinity(r5)		; copy device affinity
	movw	ucb$w_devbufsiz(r1), -
		ucb$w_devbufsiz(r5)		; copy device size
	assume	<ucb$l_devdepend+4> eq ucb$l_devdepnd2
	movq	ucb$l_devdepend(r1), -
		ucb$l_devdepend(r5)		; copy device dependent flags
;	movl	r1, ucb$l_tl_phyucb(r5)		; link LUCB to PUCB
;	movl	r5, ucb$l_tt_logucb(r1)		; link PUCB to LUCB
	movl	ucb$l_orb(r1), r2		; get PUCB object rights block
	movl	ucb$l_orb(r5), r3		; get LUCB object rights block
	movw	orb$w_prot(r2), orb$w_prot(r3)	; copy protection
	movl	orb$l_owner(r2), orb$l_owner(r3); copy owner
99$:	rsb
;
; Tidy up any memory allocated and drop IPL etc.
;
; Inputs:
;    R5: ACB address
; Outputs:
;    R0: Status
; Trashes:
;    R1,R2
;
tidy_r2:
	tstl	r5				; copy ACB address
	beql	2$				; ACB non allocated?
	pushl	r0				; save status
	movl	acb_l_acb(r5), r0		; get chained ACB
	beql	1$				; skip chain drop
	jsb	g^exe$deanonpaged		; deallocate it
1$:	movl	r5, r0				; get the main ones address
	jsb	g^exe$deanonpaged		; deallocate it
	popl	r0				; retore status
2$:	setipl	#0				; set IPL back to zero
	rsb
;
; Allocates an AST Control Block (ACB) from nonpaged pool.
;
; Inputs:
; Outputs:
;    R0: Status
;    R5: Address of ACB
; Trashes:
;    R2,R3,R4
;
alloc_buf_r5:
	movzwl	#acb_k_length+code_length, r1	; set size of ACB and extension
	jsb	g^exe$allocbuf			; Allocate the buffer
	blbc	r0, insfmem			; No memory?
	movl	r2, r5				; copy address of ACB
	clrl	acb_l_acb(r5)			; say no chained ACB
	movb	#dyn$c_acb, acb$b_type(r5)	; set type to ACB
	movzbl	#acb$k_length, r1		; set size of ACB
	jsb	g^exe$allocbuf			; Allocate the buffer
	blbc	r0, insfmem1			; No memory?
	movb	#dyn$c_acb, acb$b_type(r2)	; set type to ACB
	movl	r2, acb_l_acb(r5)		; copy address of ACB
	rsb
insfmem:
	clrl	r5				; mark buffer as missing
insfmem1:
	movzwl	#ss$_insfmem, r0		; say no memory available
	rsb
;
; The block of code between code_start and code_end is copied into nonpaged
; pool to be executed by the remote process. Since to execute the AST the
; target process must execute an REI we dont have to do one ourselves.
;
;
; Well here we are in remote process context. Special kernal ASTs must only use
; R0-R5. R5 must be preserved.
;
; Inputs:
;    R4: PCB address
;    R5: ACB address
; Outputs:
;    R5: ACB address
; Trashes:
;
;
code_start:
;	jsb	g^ini$brk
	bsbb	allocate_p1image_r4		; allocate paged image block
	blbc	r0, 1$				; quit with error
;
; At this point
;    R1: Size of memory allocated
;    R2: Address of allocated memory
;
	pushl	r5				; save ACB
	movl	acb_l_acb(r5), r1		; get chained ACB
	clrl	acb_l_acb(r5)			; say its no longer chained
	movl	acb$l_pid(r5), acb$l_pid(r1)	; set our pid
	movl	r1, r5				; copy to proper register
	movab	pib_r_code(r2), acb$l_ast(r5)	; set address of code
	movl	r2, acb$l_astprm(r5)		; set param as block address
	assume	psl$c_kernel eq 0		; Can we use clear for speed
	clrb	acb$b_rmod(r5)			; set mode to kernel
	movl	#pri$_ticom, r2			; set large priority inc
	jsb	g^sch$qast			; queue the AST to us
	popl	r5				; get back ACB addres
1$:	movl	r0, acb_l_status(r5)		; save final status
	movl	acb_l_acb(r5), r0		; get chained ACB
	beql	2$				; nothing to drop
	jsb	g^exe$deanonpaged		; drop chained ACB
2$:	movb	#psl$c_kernel!acb$m_kast, -
		acb$b_rmod(r5)			; set AST mode to kernel
	movl	acb_l_rpid(r5), acb$l_pid(r5)	; set return PID
	movab	w^post_results, acb$l_kast(r5)	; Set address of routine
	movl	#pri$_ticom, r2			; set large priority inc
	jmp	g^sch$qast			; queue the AST	
;
; Allocates a chunk of memory in the remote processes P1 space.
;
allocate_p1image_r4:
	movzwl	#pib_k_length+pcode_length, r1	; Set size of paged code
	jsb	g^exe$alop1imag			; allocate the memory
	blbc	r0, 99$
;
; At this point
;    R1: Size of memory allocated
;    R2: Address of allocated memory
;
	pushr	#^m<r2,r5>			; save ACB and paged mem
	movl	acb_l_epid(r5), pib_l_epid(r2)	; save external pid
	movc3	#acb_k_devlen+1, acb_t_terminal(r5), -
		pib_t_terminal(r2)		; move terminal buffer
	movl	(sp), r2			; get back address
	movc3	#pcode_length, w^pcode_start, -
		pib_r_code(r2)			; copy code to paged buffer
	popr	#^m<r2,r5>			; restore ACB and paged buffer
	movl	#ss$_normal, r0			
99$:	rsb

;
; Here we are back in the context of the original process. We have to write the
; status in the iosb and set the event flag.
;
post_results:
;	jsb	g^ini$brk
	movl	g^ctl$gl_phd, r0		; get address of process header
	cmpl	phd$l_imgcnt(r0), -
		acb_l_imgcnt(r5)		; compare image count
	bneq	2$				; Image has terminated!
	movl	acb_l_acmode(r5), r0		; get original mode
	movl	acb_l_iosb(r5), r1		; get address of iosb
	probew	r0, #8, (r1)			; write the iosb?
	beql	1$				; nope
	movl	acb_l_status(r5), (r1)		; set iosb status
1$:	movl	acb_l_efn(r5), r3		; get event flag
	movl	acb_l_rpid(r5), r1		; set our pid
	jsb	g^sch$postef			; set the event flag
2$:	movl	r5, r0				; copy ACB address
	jmp	g^exe$deanonpaged		; deallocate memory
;
	.entry	pcode_start ^m<r2,r3,r4,r5>
;
; We are called here in kernel mode. the AST parameter is the address of the
; paged block.
;
pibadr = 4
;	jsb	g^ini$brk
	movl	4(ap), r5			; get address of block
	bsbw	create_logicals_r4		; create all logical names
	blbc	r0, 99$
	$dclast_s -
		astadr = w^user_routine, -	; Declare user mode AST
		astprm = r5, -			;  to signal ss$_debug
		acmode = #psl$c_user		;  in user mode
	blbc	r0, 99$
	assume	pib_k_lockname eq 4		; can we use movl for prefix
	movl	b^lock, pib_t_lockname(r5)	; set lock prefix
	assume	<pib_t_lockname+pib_k_lockname> eq -
		pib_l_epid			; Can we not move the pid?
	pushab	pib_t_lockname(r5)		; push address
	pushl	#lock_length+4			; save length
	movl	sp, r2				; get address of descriptor
	$enq_s	efn    = s^#exe$c_sysefn, - 
		lkmode = #lck$k_exmode, -	; Take out resignal lock
		lksb   = pib_q_lksb(r5), -	; LKSB in pib
		flags  = #<lck$m_system!lck$m_noquota!lck$m_syncsts>, -
		resnam = (r2), -		; Use this resource name
		astprm = r5, -			; Pass pib as parameter
		blkast = w^resignal, -		; call resignal when blocked
		acmode = psl$c_user		; allow user mode queues
99$:	ret
;
tab:	.ascii	/LNM$JOB/
tab_len = .-tab
;
dbgin:	.ascii	/DBG$INPUT/
dbgin_len = .-dbgin
;
dbgout:	.ascii	/DBG$OUTPUT/
dbgout_len = .-dbgout
;
;dbgproc:.ascii	/DBG$PROCESS/
;dbgproc_len = .-dbgproc
;
;dbgnone:.ascii	/NONE/
;dbgnone_len = .-dbgnone
;
systab:	.ascii	/LNM$SYSTEM/
systab_len = .-systab
;
log:	.ascii	/DDB_/
log_length = .-log
	assume	log_length eq 4			; move easily?
lock:	.ascii	/DDB_/				; Prefix for lock name
lock_length = .-lock
	assume	lock_length eq pib_k_lockname	; Is code above correct
;
uacmode:.byte	psl$c_user
;
; Creates the logical names: DBG$INPUT, DBG$OUTPUT, DDB_<PID>, DBG$PROCESS.
; Inputs:
;    R5: Address of pib
; Outputs:
;    R0: Status
; Trashes:
;    R1,R2,R3,R4
;
create_logicals_r4:
	pushab	tab				; push string address
	pushl	#tab_len			; set length
	movl	sp, r2				; address of table name
	pushab	dbgin				; push string address
	pushl	#dbgin_len
	movl	sp, r3				; save descriptor address
	clrq	-(sp)				; no retlen and end of list
	pushab	pib_t_terminal+1(r5)		; set buffer address
	movw	#lnm$_string, -(sp)		; we are setting this value
	movzbw	pib_t_terminal(r5), -(sp)	; set size of input
	movl	sp, r4				; point to item list
	$crelnm_s -
		tabnam = (r2), -		; Create DBG$INPUT
		lognam = (r3), -
		acmode = uacmode, -		; In user mode
		itmlst = (r4)
	blbc	r0, 99$
	movzbl	#dbgout_len, (r3)		; Patch up item list
	movab	dbgout, 4(r3)
	$crelnm_s -
		tabnam = (r2), -		; Create DBG$OUTPUT
		lognam = (r3), -
		acmode = uacmode, -		; In user mode
		itmlst = (r4)
	blbc	r0, 99$
;	movzbl	#dbgproc_len, (r3)		; Patch up item list
;	movab	dbgproc, 4(r3)
;	movzbw	#dbgnone_len, (r4)		; Set size of none string
;	movab	dbgnone, 4(r4)			; Set address of string
;	$crelnm_s -
;		tabnam = (r2), -		; Create DBG$PROCESS
;		lognam = (r3), -
;		acmode = uacmode, -		; In user mode
;		itmlst = (r4)
;	blbc	r0, 99$				; Quit if error
	movzbl	#systab_len, (r2)		; set up table name size
	movab	systab, 4(r2)			; set up address of table
	assume	pib_k_lockname eq 4		; can we use movl for prefix
	movl	log, pib_t_lockname(r5)		; set logical prefix
	assume	<pib_t_lockname+pib_k_lockname> eq -
		pib_l_epid			; Can we not move the pid?
	movzbl	#log_length+4, (r3)		; save length
	movab	pib_t_lockname(r5), 4(r3)	; move address of string
	$crelnm_s -
		tabnam = (r2), -		; Create DBG$OUTPUT
		lognam = (r3), -
		acmode = uacmode, -		; In user mode
		itmlst = (r4)
99$:	movab	8(r2), sp			; drop reserved stack space
	rsb
;
	.entry	resignal ^m<r5>
pibadr = 4
;	jsb	g^ini$brk
	movl	pibadr(ap), r5			; Get pib address
	$enqw_s	efn    = s^#exe$c_sysefn, -
		lkmode = #lck$k_nlmode, -	; Convert to null mode
		lksb   = pib_q_lksb(r5), -	; LKSB in pib
		flags  = #<lck$m_syncsts!lck$m_convert>
	blbc	r0, 99$				; quit on error
	movzwl	pib_q_lksb(r5), r0		; get other status
	blbc	r0, 99$				; quit on error
	$enq_s	efn    = s^#exe$c_sysefn, - 	; use system efn
		lkmode = #lck$k_exmode, -	; Convert back to ex mode
		lksb   = pib_q_lksb(r5), -	; LKSB in pib
		flags  = #<lck$m_syncsts!lck$m_convert>, -
		astprm = r5, -			; Pass pib as parameter
		blkast = b^resignal		; call resignal when blocked
	blbc	r0, 99$				; quit on error
	$dclast_s -
		astadr = b^user_routine, -	; Declare user mode AST
		astprm = r5, -			;  to signal ss$_debug
		acmode = #psl$c_user		; change to user mode
99$:	ret
;
	.entry	user_routine ^m<>
;
pibadr = 4
savr0  = pibadr + 4
savr1  = savr0  + 4
savpc  = savr1  + 4
savpsl = savpc  + 4
;
;	jsb	g^ini$brk
	movab	b^astret, sf$l_save_pc(fp)	; Set new return for ast
	ret
astret:
	chmk	#0				; Allow ASTs again
	addl2	#8, sp				; Drop ASTPRM and arg count
	movq	(sp)+, r0			; Get back r0 and r1
	pushl	#ss$_debug			; signal debug
	pushl	#3				; set number of arguments
	pushl	#1				; Say this is from lib$signal
	movq	r0, -(sp)			; save r0,r1
	mnegl	#3, -(sp)			; say start at primary frame
	pushl	fp				; save initial FP
	pushl	#4				; set mechargs count
	pushl	sp				; point to mechanism args
	pushal	28(sp)				; poit to signal args
	pushl	#2				; two arguments
	jmp	g^exe$srchandler		; search for a handler
pcode_end:
pcode_length = pcode_end - pcode_start
;
code_end:
code_length = code_end - code_start
;
;	
	.end