.title	setexit set up an exit handler
	.sbttl	documentation
;
;	Sets up an exit handler for handling a last minute
;	cleanup for a program, also forces an exit on CTRL/Y.
;	Calling format from FORTRAN is:
;
;		EXTERNAL routine name
;		CALL SETEXIT(routine name)
;
;	This routine is called ONLY ONCE by a program!
;	The calling format to SYS$CLI may change. If it does, the
;	LIB$DISABLE_CTRL or LIB$ENABLE_CTRL can be used
;
;	Author:	Eric F. Richards
;	Date:	03-Jun-84
;	System:	VAX/VMS V3.6
;
	.ident	/V1.07/
	$libclidef			; set up control masks
	$cliservdef			; set up service numbers
	$clidef				; set up cli offsets
	$iodef				; set up I/O masks
	.enable suppression
	.disable traceback, debug
	.global	sys$cli
	.sbttl	setexit code
	.psect	$code, nowrt, exe, long, pic, shr
	.entry	setexit, ^m<r2,r3,r4,r5>; entry point

	subl2	#cli$c_srvdesc, sp	; set SP to top of workspace
	movc5	#0, (sp), #0, -		; clear workspace
		#cli$c_srvdesc, (sp)	; on stack
	movb	#cli$k_cliserv, (sp)	; set up working parameters to
	movw	#cli$k_disaoob, -	; disable control chars
		cli$w_servcod(sp)	; in workspace ares
	movl	#lib$m_cli_ctrly, -	; disable CTRL/Y
		cli$l_new_mask(sp)	; mask put in workspace
	pushl	sp			; put top of wkspace on stack
	calls	#1, g^sys$cli		; call CLI handler

	$assign_s chan=chan, -		; assign an I/O channel to
		  devnam=tt		; to the terminal
	blbc	r0, skipit		; error check

	$qio_s	chan=chan, -		; set up CTRL/Y AST
		func=#<io$_setmode!io$m_ctrlyast>, -
		p1 = kill		; to excecute this routine

skipit:	tstl	(ap)			; was a user-exit routine provided?
	beql	10$			; no, don't bother sett up for
	moval	@4(ap), exadr		; get jump address for handler
10$:	$dclexh_s exblok		; declare it
	ret				; and return

kill:	.word	0			; this is the routine to run on CTRL/Y
	$exit_s				; activate exit handlers
	ret				; and return (?)

setctl:	.word	^m<r2,r3,r4,r5>		; enable CTRL/Y, run user routine

	subl2	#cli$c_srvdesc, sp	; set SP to top of workspace
	movc5	#0, (sp), #0, -		; clear workspace
		#cli$c_srvdesc, (sp)	; on stack
	movb	#cli$k_cliserv, (sp)	; set up working parameters to
	movw	#cli$k_enaboob, -	; enable control chars
		cli$w_servcod(sp)	; in workspace ares
	movl	#lib$m_cli_ctrly, -	; enable CTRL/Y
		cli$l_new_mask(sp)	; mask put in workspace
	pushl	sp			; put top of wkspace on stack
	calls	#1, g^sys$cli		; call CLI handler

	tstl	exadr			; do we have an exit routine?
	beql	20$			; no, just return
	calls	#0, @exadr		; else run exit routine
20$:	movl	#1, r0			; set sucess
	ret				; and return

	.sbttl	data buffers
	.psect	$local, long, noexe, wrt, pic
exblok:	.long	0			; forward link used by system
	.address setctl			; routine to establish CTRL/Y
	.long	1			; number of args to this thing
	.address exits			; additional arguments
exits: 	.long	0			; exit status

exadr:	.long	0			; address of user routine to run

chan:	.blkl	1			; I/O channel buffer
tt:	.ascid /tt:/			; terminal descriptor
	.end