/* --- Copyright University of Sussex 1996. All rights reserved. ----------
 * File:            C.alpha/src/asignals.s
 * Purpose:
 * Author:          John Gibson, Oct 14 1994 (see revisions)
 */

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

#_<

#_INCLUDE 'asm.ph'

section $-Sys;

constant
	procedure (Error_signal)
	;

vars
	_syserror, _rmserror
	;

endsection;

>_#

ASM_START_FILE


ASM_CODE_PSECT


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

#_IF DEF VMS

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

svbadr:	.WORD	C_LAB(_special_var_block)
erradr:	.WORD	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 _invocation_fp)

__pop_errsig::
	br	rt0, 1$			;;; address of 1f
1$:	ldW	rsvb, svbadr-1$(rt0)	;;; reset _special_var_block reg
	ldW	rfalse, _svb_FALSE	;;; set rfalse to false

	ldW	rt1, _svb_SAVED_SP	;;; get _saved_sp
	beq	rt1, 2$			;;; br if not in external calls
	mov	rt1, rsp		;;; else remove stuff on system stack
	stW	rzero, _svb_SAVED_SP	;;; and clear _saved_sp
	INIT_POP_REGISTERS		;;; set pop lvar registers to false
	ldW	rusp, _SVB_OFFS(_userhi)(rsvb)	;;; reset user stack

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

#_ELSE

ASM_NWRIT_PSECT
.globl __pop_errsig_adrtab
__pop_errsig_adrtab:
	.WORD	C_LAB(_special_var_block)
	.WORD	C_LAB(Sys$-Error_signal)


ASM_CODE_PSECT

	;;; Error signals set return to this.
	;;; Passed __pop_errsig_adrtab in rt0
ASM_ALIGN_QUAD
.globl __pop_errsig
__pop_errsig:
	ldW	rsvb, _WOFFS*0(rt0)	;;; reset _special_var_block reg
	ldW	rfalse, _svb_FALSE	;;; set rfalse to false

	ldW	rt1, _svb_SAVED_SP	;;; get _saved_sp
	beq	rt1, !$2f		;;; br if not in external calls
	mov	rt1, rsp		;;; else remove stuff on system stack
	stW	rzero, _svb_SAVED_SP	;;; and clear _saved_sp
	INIT_POP_REGISTERS		;;; set pop lvar registers to false
	ldW	rusp, _SVB_OFFS(_userhi)(rsvb)	;;; reset user stack

!$2:	ldW	rpb, _WOFFS*1(rt0)	;;; get Sys$-Error_signal
	ldW	rt0, _PD_EXECUTE(rpb)
	jmp	rzero, (rt0)			;;; call it

#_ENDIF


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

ASM_CODE_PSECT

	;;; _call_sys(______arg1, ..., ______argN, ___N, _________routine)
	;;; Call an external 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)

ASM_ALIGN_QUAD
DEF_C_LAB (_call_sys)
	;;; save pop caller's stack frame ptr for exception conditions
	stW	rsp, _svb_SAVED_SP
	bic	rsp, 15, rsp		;;; then octaword-align sp
	lda	rsp, -_WOFFS*16(rsp)	;;; enough for octa-aligned tmp frame

	stW	rsvb,  _WOFFS*0(rsp)	;;; save special var block
	stW	rret,  _WOFFS*1(rsp)	;;; save return
	stW	rnpl0, _WOFFS*3(rsp)	;;; save 'unoffical' local
	stW	rnpl1, _WOFFS*4(rsp)	;;;  "        "        "
#_IF DEF OSF1 or DEF LINUX
	stW	rnpl2, _WOFFS*5(rsp)	;;; save 'unoffical' local
	stW	rnpl3, _WOFFS*6(rsp)	;;;  "        "        "
	stW	rnpl4, _WOFFS*7(rsp)	;;;  "        "        "
	stW	rpl0,  _WOFFS*8(rsp)	;;;  "        "        "
	stW	rpl1,  _WOFFS*9(rsp)	;;;  "        "        "
	stW	rpl2,  _WOFFS*10(rsp)	;;;  "        "        "
	stW	rpl3,  _WOFFS*11(rsp)	;;;  "        "        "
	stW	rpl4,  _WOFFS*12(rsp)	;;;  "        "        "
#_ENDIF

	ldW	rchain, _WOFFS(rusp)	;;; arg count ___N in rchain (VMS AI reg)
	lda	rusp, _WOFFS(rusp)
	ldW	rpb, -_WOFFS(rusp)	;;; _________routine to call in r27
	sWaddq	rchain, rusp, rusp	;;; address of last arg on stack
	subq	rchain, 6, rt0	;;; ___N - 6 in rt0
	stW	rusp, _svb_SAVED_USP	;;; save usp for after call
#_IF DEF VMS
	ldq	rt1, 8(rpb)		;;; _________routine entry point in rt1
#_ENDIF

	;;; load argument registers (doesn't matter if there are less than 6)
	ldW	ra5, -_WOFFS*5(rusp)
	ldW	ra4, -_WOFFS*4(rusp)
	ldW	ra3, -_WOFFS*3(rusp)
	ldW	ra2, -_WOFFS*2(rusp)
	ldW	ra1, -_WOFFS*1(rusp)
	ldW	ra0, -_WOFFS*0(rusp)
	bgt	rt0, !$3f		;;; br if more than 6 args

#_IF DEF VMS
	jsr	rret, 0(rt1)		;;; call _________routine
#_ELSE
	jsr	rret, (rpb)		;;; call _________routine
#_ENDIF

!$1:	ldW	rsvb,  _WOFFS*0(rsp)	;;; restore special var block
	ldW	rret,  _WOFFS*1(rsp)	;;; restore return
	ldW	rnpl0, _WOFFS*3(rsp)	;;; restore 'unoffical' local
	ldW	rnpl1, _WOFFS*4(rsp)	;;;  "        "        "
#_IF DEF OSF1 or DEF LINUX
	ldW	rnpl2, _WOFFS*5(rsp)	;;; restore 'unoffical' local
	ldW	rnpl3, _WOFFS*6(rsp)	;;;  "        "        "
	ldW	rnpl4, _WOFFS*7(rsp)	;;;  "        "        "
	ldW	rpl0,  _WOFFS*8(rsp)	;;;  "        "        "
	ldW	rpl1,  _WOFFS*9(rsp)	;;;  "        "        "
	ldW	rpl2,  _WOFFS*10(rsp)	;;;  "        "        "
	ldW	rpl3,  _WOFFS*11(rsp)	;;;  "        "        "
	ldW	rpl4,  _WOFFS*12(rsp)	;;;  "        "        "
#_ENDIF
	ldW	rusp, _svb_SAVED_USP	;;; restore usp (args -1 removed)
	ldW	rfalse, _svb_FALSE	;;; restore rfalse

#_IF DEF VMS
	blbs	rt0, !$2f		;;; br if result OK
	stW	rt0, _SVB_OFFS(Sys$- _syserror)(rsvb)	;;; else save possible err code
	stW	rzero, _SVB_OFFS(Sys$- _rmserror)(rsvb) ;;; and zero this
!$2:
#_ENDIF
	stW	rt0, 0(rusp)		;;; return result
	ldW	rsp, _svb_SAVED_SP	;;; restore sp
	stW	rzero, _svb_SAVED_SP	;;; and zero _saved_sp
	ldW	rpb, _SF_OWNER(rsp)	;;; restore caller's pb
	ret	rzero, (rret)


	;;; more than 6 args
!$3:	stW	rpl10, _WOFFS*2(rsp)	;;; save local rpl10 (is an O/S local)
	mov	rsp, rpl10		;;; use rpl10 to save sp before args
	addq	rt0, 1, rt0		;;; round up remainder to even with
	bic	rt0, 1, rt0		;;; dummy at end (so sp octa-aligned)
	sll	rt0, 3, rt0		;;; make quad offset
	subq	rsp, rt0, rsp		;;; make space for args on stack
	mov	rsp, rt0
	lda	rusp, -_WOFFS*6(rusp)	;;; addr of 7th arg
	;;; copy remaining args to stack
!$4:	ldW	rfalse, 0(rusp)
	lda	rusp, -_WOFFS(rusp)
	stq	rfalse, 0(rt0)
	lda	rt0, 8(rt0)
	cmpult	rt0, rpl10, rfalse
	blbs	rfalse, !$4b

#_IF DEF VMS
	jsr	rret, (rt1)		;;; call _________routine
#_ELSE
	jsr	rret, (rpb)		;;; call _________routine
#_ENDIF

	mov	rpl10, rsp		;;; remove stack args
	ldW	rpl10, _WOFFS*2(rsp)	;;; restore local rpl10
	br	!$1b


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

#_IF DEF VMS

	.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)

#_ENDIF



ASM_END_FILE

/* --- Revision History ---------------------------------------------------
--- John Gibson, Oct 25 1996
	Fixed references to VMS _syserror/_rmserror to be in section Sys.
--- John Gibson, Oct 11 1996
	Changed __pop_errsig to clear the pop registers and the userstack
	only when in external calls, i.e. when _svb_SAVED_SP nonzero.
	(The large number of pop regs means that some of them may not be
	localised to any procedure in the call chain which will get unwound
	by the error, and hence clearing them to false will corrupt a
	value used by a procedure like ved_lmr which doesn't get unwound.)
--- John Gibson, Apr 12 1996
	_rmserror set zero when _syserror set.
--- Integral Solutions Ltd, Aug 31 1995 (Julian Clinton)
	Modified VMS labels when used with operators in __pop_errsig
 */
