/* --- Copyright University of Sussex 1994. All rights reserved. ----------
 * File:            S.axpvms/src/asignals.s
 * Purpose:
 * Author:          John Gibson, Oct 14 1994
 */

	.title  "asignals.o"	;;; must be the object file name

;;;------------------ POP CONDITION HANDLER ------------------------------

#_<

#_INCLUDE 'asm.ph'

vars
	_syserror
	;

constant
	procedure (Sys$-Error_signal)
	;

>_#



;;; --- ROUTINE TO CLEAN UP AND CALL A POP ERROR HANDLER -----------------

	.psect	pop$mix,noshr,nowrt,exe,mix,quad

svbadr:	.long	C_LAB(_special_var_block)
erradr:	.long	C_LAB(Sys$-Error_signal)

	;;; Conditions (i.e. error signals) set return to this through
	;;; sys$goto_unwind (which unwinds VMS procedures back to
	;;; fp value __pop_invocation_fp)

__pop_errsig::
	br	rt0, 1$			;;; address of 1$
1$:	ldl	rsvb, svbadr-1$(rt0)	;;; reset _special_var_block reg
	ldl	rfalse, _svb_FALSE	;;; set rfalse to false
	INIT_POP_REGISTERS		;;; set pop lvar registers to false
	ldl	rusp, _SVB_OFFS(_userhi)(rsvb)	;;; reset user stack

	ldl	rt1, _svb_SAVED_SP	;;; get _saved_sp
	beq	rt1, 2$			;;; br if not in external calls
	mov	rt1, sp			;;; else remove stuff on system stack
	stl	rzero, _svb_SAVED_SP	;;; and clear _saved_sp

2$:	ldl	rpb, erradr-1$(rt0)	;;; get Sys$-Error_signal
	ldl	rt0, _PD_EXECUTE(rpb)
	jmp	(rt0)			;;; call it


;;; --- SYSTEM CALLS --------------------------------------------------------

ASM_CODE_PSECT

	;;; _call_sys(______arg1, ..., ______argN, ___N, _________routine)
	;;; Call a VMS procedure, moving args from userstack to regs, etc.
	;;; No arg conversion and no callback -- for internal use only (calls
	;;; to this are generated by the _extern syntax form).
	;;; (User external calls are done in aextern.s)

	.align quad
DEF_C_LAB (_call_sys)
	;;; save pop caller's stack frame ptr for exception conditions
	stl	sp, _svb_SAVED_SP
	bic	sp, #15, sp		;;; then octaword-align sp
	lda	sp, -8*4(sp)		;;; enough for octa-aligned tmp frame

	stl	rsvb,  0*4(sp)		;;; save special var block
	stl	rret,  1*4(sp)		;;; save return
	stl	rnpl0, 2*4(sp)		;;; save 'unoffical' local (r20)
	stl	rnpl1, 3*4(sp)		;;;  "        "        "   (r21)

	ldl	r25, 4(rusp)		;;; arg count ___N in AI reg
	lda	rusp, 4(rusp)
	ldl	rpb, -4(rusp)		;;; _________routine to call in r27
	s4addl	r25, rusp, rusp		;;; address of last arg on stack
	subl	r25, #6, r0		;;; ___N - 6 in r0
	stl	rusp, _svb_SAVED_USP	;;; save usp for after call
	ldq	r1, 8(rpb)		;;; _________routine entry point in r1

	;;; load argument registers (doesn't matter if there are less than 6)
	ldl	r21, -5*4(rusp)
	ldl	r20, -4*4(rusp)
	ldl	r19, -3*4(rusp)
	ldl	r18, -2*4(rusp)
	ldl	r17, -1*4(rusp)
	ldl	r16, -0*4(rusp)
	bgt	r0, 3$			;;; br if more than 6 args

	jsr	rret, (r1)		;;; call _________routine

1$:	ldl	rsvb,  0*4(sp)		;;; restore special var block
	ldl	rret,  1*4(sp)		;;; restore return
	ldl	rnpl0, 2*4(sp)		;;; restore 'unoffical' local (r20)
	ldl	rnpl1, 3*4(sp)		;;;  "        "        "   (r21)
	ldl	rusp, _svb_SAVED_USP	;;; restore usp (args -1 removed)
	ldl	rfalse, _svb_FALSE	;;; restore rfalse

	blbs	r0, 2$			;;; br if result OK
	stl	r0, _SVB_OFFS(_syserror)(rsvb)	;;; else save possible err code
2$:	stl	r0, (rusp)		;;; return result
	ldl	sp, _svb_SAVED_SP	;;; restore sp
	stl	rzero, _svb_SAVED_SP	;;; and zero _saved_sp
	ldl	rpb, _SF_OWNER(sp)	;;; restore caller's pb
	ret	(rret)


	;;; more than 6 args
3$:	stl	r13, 4*4(sp)		;;; save local r13 (rnpl2)
	mov	sp, r13			;;; use r13 to save sp before args
	addl	r0, #1, r0		;;; round up remainder to even with
	bic	r0, #1, r0		;;; dummy at end (so sp octa-aligned)
	sll	r0, #3, r0		;;; make quad offset
	subl	sp, r0, sp		;;; make space for args on stack
	mov	sp, r0
	lda	rusp, -6*4(rusp)	;;; addr of 7th arg
	;;; copy remaining args to stack
4$:	ldl	rfalse, (rusp)
	lda	rusp, -4(rusp)
	stq	rfalse, (r0)
	lda	r0, 8(r0)
	cmpult	r0, r13, rfalse
	blbs	rfalse, 4$

	jsr	rret, (r1)		;;; call _________routine

	mov	r13, sp			;;; remove stack args
	ldl	r13, 4*4(sp)		;;; restore local r13
	br	1$


;;; -------------------------------------------------------------------------

	.psect pop$nosrdata,noshr,noexe,wrt,quad

	;;; process table
DEF_C_LAB (Sys$- _vmsproc_tab)
	.blkl	32*3      ;;; space for 32 PROC_ENTRY
DEF_C_LAB (Sys$- _vmsproc_tab_lim)

__pop_invocation_fp::
	.long	0





	.end