/* --- Copyright University of Sussex 1995. All rights reserved. ----------
 * File:        C.mips/src/aextern.s
 * Purpose:     External function calls for MIPS R2000/R3000
 * Author:      Robert Duncan and Simon Nichols, Feb 13 1990 (see revisions)
 */


#_<

#_INCLUDE 'declare.ph'
#_INCLUDE 'external.ph'
#_INCLUDE 'numbers.ph'

lconstant macro (

	_BGI_LENGTH	= @@BGI_LENGTH,
	_BGI_SLICES	= @@BGI_SLICES,
	_DD_1		= @@DD_1,	;;; MS half of ddecimal
	_DD_2		= @@DD_2,	;;; LS half of ddecimal
	_EFC_FUNC	= @@EFC_FUNC,
	_EFC_ARG	= @@EFC_ARG,
	_EFC_ARG_DEST	= @@EFC_ARG_DEST,
	_KEY		= @@KEY,
	_K_EXTERN_TYPE	= @@K_EXTERN_TYPE,
	_XP_PTR		= @@XP_PTR,

	_SAVED_SP	= [_SVB_OFFS(Sys$-Extern$- _saved_sp)(svb)],
	_SAVED_USP	= [_SVB_OFFS(Sys$-Extern$- _saved_usp)(svb)],

);

>_#

#_INCLUDE 'pop_regdef.h'


/************************* wrapping structures ************************/

	.data
	.word	Ldata_size
	.word	C_LAB(Sys$-objmod_pad_key)
Ldata_start:

/**********************************************************************/


	.text

;;; _call_external(_____nargs, _______routine, _________fltsingle)
;;;	User interface to external routines: moves _____nargs from the user
;;;	stack to the call stack (or registers) converting where necessary.
;;;	Bit N set in the _________fltsingle arg means pass the (N+1)'th arg as a
;;;	single float (if it's (d)decimal), otherwise decimals are passed
;;;	as doubles. Bit 31 of _________fltsingle covers all args from 32 onwards.
;;;	Results are returned in the three-word structure result_struct
;;;	double float result first, followed by a single word result.
;;;	Must be capable of dealing with callback.

;;; Register usage:
;;;	t0	argument count (_____nargs)
;;;	t1	_________fltsingle bit mask
;;;	t2	argument source pointer (into the user stack)
;;;	t3	argument destination pointer (into the call stack)
;;;	t5	work
;;;	t9	address of routine to call (_______routine)
;;;	v0	argument conversion
;;;	f0	argument conversion
;;;	a0-a3,f12,f14
;;;		arguments to the call
;;; 	p0	stack frame pointer

;;; Memory usage:
;;;	_SAVED_SP
;;;		pointer to the stack frame of the calling procedure;
;;;		used by the interrupt handler defined in "asignals.s"
;;;	_SAVED_USP
;;;		value of USP after clearing the external arguments;
;;;		used in callback
;;;	result_struct
;;;		space for both single- and double-length results.


DEF_C_LAB (_call_external)

	.ent	$call_external
$call_external:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	;;; Save caller's stack pointer in case of interrupt/callback

	sw	sp, _SAVED_SP

	;;; Create stack frame containing:
	;;; 	return address
	;;; 	context pointer
	;;; 	special var block (caller-save register)
	;;; 	pop reg 1
	;;; 	pop reg 0
	;;; 	current break (where needed)
	;;; Once p0's been saved, we can use it as a frame pointer,
	;;; since the stack pointer will be changed by some
	;;; indeterminate amount for the arguments to the call

	.frame	p0, 24, ra
	.mask	0x91030000, -4
	subu	sp, 24
	sw	ra, 20(sp)
	sw	gp, 16(sp)
	sw	svb, 12(sp)
	sw	p1, 8(sp)
	sw	p0, 4(sp)
	move	p0, sp

#_IF not(DEF BSD_MPROTECT)

	;;; Save the current break

	lw	t0, EXTERN_NAME(_curbrk)
	sw	t0, 0(sp)

#_ENDIF

	;;; Load fixed arguments:

	lw	t0, 8(usp)	;;; _____nargs
	lw	t9, 4(usp)	;;; _______routine
	lw	t1, (usp)	;;; _________fltsingle
	addu	usp, 12

	;;; Adjust stack pointer by a conservative estimate of the space
	;;; needed for all arguments (i.e. two words for each) and align
	;;; it on a double-word boundary (as expected by the MIPS compilers)

	sll	t5, t0, 3
	subu	sp, t5
	and	sp, ~7

	;;; If there are no arguments, go straight to the call

	beqz	t0, do_call

	;;; Adjust USP to clear arguments

	sll	t5, t0, 2
	addu	usp, t5

	;;; Set pointers for copying

	move	t2, usp		;;; argument source
	move	t3, sp		;;; argument destination

	;;; Copy and convert the arguments:
	;;; allocation of arguments to registers is complicated and not
	;;; quite as described in Kane (1st. ed.) so we adopt a conservative
	;;; strategy: all arguments are copied to the stack, and all the
	;;; argument registers (a0 - a3, f12 - f14) are set regardless of
	;;; the argument types

	;;; First argument:

	bal	convert_arg
	move	a0, v0
	mov.d	$f12, $f0
	beqz	t0, do_call

	;;; Second argument:

	bal	convert_arg
	move	a1, v0
	move	a2, v0		;;; in case arg 1 was a double float
	mov.d	$f14, $f0
	beqz	t0, do_call

	;;; Remaining arguments:

1:	bal	convert_arg
	bnez	t0, 1b

	lw	a2, 8(sp)
	lw	a3, 12(sp)

do_call:

	;;; Call the routine

	sw	usp, _SAVED_USP			;;; save USP for callback
	sw	sp, EXTERN_NAME(__pop_in_user_extern)
						;;; enable async callback
	jal	t9
	move	sp, p0				;;; restore stack pointer
	lw	svb, 12(sp)			;;; restore special var block
	lw	gp, 16(sp)			;;; restore context pointer
	sw	zero, EXTERN_NAME(__pop_in_user_extern)
						;;; disable async callback
	lw	usp, _SAVED_USP			;;; restore USP

	;;; Copy possible results into result_struct:
	;;; double result from $f0 first, then word result from v0

	la	t5, C_LAB(Sys$-Extern$-result_struct)
	s.d	$f0, (t5)		;;; double result
	sw	v0, 8(t5)		;;; word result

	;;; Restore remaining registers from the stack

	lw	p0, 4(sp)
	lw	p1, 8(sp)
	lw	ra, 20(sp)

#_IF not(DEF BSD_MPROTECT)

	;;; Check for a change in the break

	lw	t0, 0(sp)
	lw	t1, EXTERN_NAME(_curbrk)
	addu	sp, 24
	sw	zero, _SAVED_SP		;;; no longer in external call
	beq	t0, t1, 1f
	la	t9, XC_LAB(Sys$-Mem_break_changed)
	j	t9
1:	j	ra

#_ELSE

	addu	sp, 24
	sw	zero, _SAVED_SP		;;; no longer in external call
	j	ra

#_ENDIF

	.end	$call_external


;;; convert_arg:
;;;	convert one POP argument to external format
;;;	and push on the call stack

;;; Registers used from _call_external:
;;;	t0	argument count (decremented by 1)
;;;	t1	_________fltsingle bit mask (shifted left by 1)
;;;	t2	argument source pointer (advanced by 1 word)
;;;	t3	argument destination pointer (advanced according to size)

;;; Results:
;;;	v0	converted word-length argument
;;;	f0	converted float argument

;;; Other registers used:
;;;	t4	external type key field
;;;	t5	work
;;;	t7	bit 0 from _________fltsingle (controls conversion of this arg)

	.ent	convert_arg
convert_arg:

	;;; Get next argument from user stack

	subu	t2, 4
	lw	v0, (t2)
	subu	t0, 1

	;;; Copy bit 0 from _________fltsingle to t7 and shift

	and	t7, t1, 1
	sra	t1, 1

	;;; Simple?

	and	t5, v0, 1
	beqz	t5, 2f

	;;; Integer?

	and	t5, v0, 2
	beqz	t5, 1f

	;;; Convert to machine integer

	sra	v0, 2
	b	push_word

1:	;;; Single decimal: load to f0 and convert according to bit in
	;;; _________fltsingle

	subu	v0, 1		;;; clear decimal bit
	mtc1	v0, $f0
	bnez	t7, push_word	;;; t7 = 1 => leave as single
	cvt.d.s	$f0, $f0	;;; convert to double
	b	push_double

2:	;;; Pop structure: get extern type from key into t4

	lw	t4, _KEY(v0)
	lbu	t4, _K_EXTERN_TYPE(t4)

	;;; Byte-addressable structure? (EXTERN_TYPE_NORMAL = 0)

	beqz	t4, push_word	;;; leave unchanged

	;;; External deref?

	bne	t4, _:EXTERN_TYPE_DEREF, 3f

	;;; Dereference XP_PTR

	lw	v0, _XP_PTR(v0)
	b	push_word

3:	;;; Ddecimal?

	bne	t4, _:EXTERN_TYPE_DDEC, 4f

	;;; Assemble a double float from the two halves
	;;; and convert according to bit in _________fltsingle

	lwc1	$f1, _DD_1(v0)
	lwc1	$f0, _DD_2(v0)
	beqz	t7, push_double	;;; t7 = 0 => leave as double
	cvt.s.d	$f0, $f0	;;; convert to single
	mfc1	v0, $f0		;;; word-length result in v0
	b	push_word

4:	;;; Must be a biginteger (EXTERN_TYPE_BIGINT):
	;;; get first slice in t4

	lw	t4, _BGI_SLICES(v0)

	;;; If there's more than one slice, pull in the bottom bit of the
	;;; second

	lw	t5, _BGI_LENGTH(v0)
	beq	t5, 1, 5f
	lw	t5, _BGI_SLICES+4(v0)
	sll	t5, 31
	or	t4, t5

5:	move	v0, t4

push_word:

	sw	v0, (t3)
	addu	t3, 4
	j	ra

push_double:

	;;; Double argument must be on a double-word boundary

	addu	t3, 15
	and	t3, ~7
	s.d	$f0, -8(t3)
	j	ra

	.end	convert_arg


;;; _EXFUNC_CLOS_ACTION:
;;;     called from the code in an exfunc_closure (see asmout.p), with
;;;     the closure address in t9

DEF_C_LAB(Sys$- _exfunc_clos_action)

	.ent	$exfunc_clos_action
$exfunc_clos_action:

	;;; Store frozen argument to destination

	lw	t1, _EFC_ARG_DEST(t9)
	lw	t2, _EFC_ARG(t9)
	sw	t2, (t1)

	;;; Get function address via external ptr

	lw	t3, _EFC_FUNC(t9)
	lw	t9, (t3)

	;;; Chain to function

	j	t9

	.end	$exfunc_clos_action


;;; _POP_EXTERNAL_CALLBACK:
;;;	interface routine for external callback

;;; C synopsis:
;;;	int _pop_external_callback(unsigned argp[])

;;; Arguments:
;;;	argp[0]	is the function code for -Callback-

DEF_C_LAB(Sys$- _external_callback_func)
	;;; for indirect weak reference

	.globl	_pop_external_callback
	.ent	_pop_external_callback
_pop_external_callback:
	.set	noreorder
	CPLOAD	t9
	.set	reorder

	;;; Create stack frame containing the return address, the
	;;; context pointer and all user registers, plus an extra 3
	;;; words for SF_OWNER, SF_NEXT_SEG_SP and SF_NEXT_SEG_HI

	.frame	sp, 56, ra
	.mask	0xd0ff0000, -4
	subu	sp, 56
	sw	ra, 52(sp)
	sw	usp, 48(sp)
	sw	gp, 44(sp)
	sw	pb, 40(sp)
	sw	false, 36(sp)
	sw	np3, 32(sp)
	sw	np2, 28(sp)
	sw	np1, 24(sp)
	sw	np0, 20(sp)
	sw	p1, 16(sp)
	sw	p0, 12(sp)

	;;; Disable async callback (after saving value of
	;;; __pop_in_user_extern)

	lw	np0, EXTERN_NAME(__pop_in_user_extern)
	sw	zero, EXTERN_NAME(__pop_in_user_extern)

	;;; Restore Poplog fixed registers

	la	false, C_LAB(false)
	la	svb, C_LAB(_special_var_block)

	;;; Restore Poplog volatile registers saved by _call_external

	lw	np1, _SAVED_SP
	lw	usp, _SAVED_USP
	lw	pb, (np1)
	lw	p1, -16(np1)
	lw	p0, -20(np1)

	;;; Push ARGP:

	subu	usp, 8
	sw	a0, 4(usp)

#_IF not(DEF BSD_MPROTECT)

	;;; Push any change in the break (previous value saved by
	;;; _call_external)

	lw	t0, -24(np1)
	lw	t1, EXTERN_NAME(_curbrk)
	subu	t0, t1
	sw	t0, (usp)

#_ELSE

	;;; No need to worry about the break: push a dummy argument

	sw	zero, (usp)

#_ENDIF

	jal	XC_LAB(Sys$-Extern$-Callback)
	lw	gp, 44(sp)

#_IF not(DEF BSD_MPROTECT)

	;;; Resave the current break

	lw	t0, EXTERN_NAME(_curbrk)
	sw	t0, -24(np1)

#_ENDIF

	;;; Return status code

	lw	v0, (usp)
	addu	usp, 4

	;;; Resave USP and pop registers

	sw	usp, _SAVED_USP
	sw	p1, -16(np1)
	sw	p0, -20(np1)

	;;; Re-enable async callback (restoring saved __pop_in_user_extern)

	sw	np0, EXTERN_NAME(__pop_in_user_extern)

	;;; Unwind stack frame and return

	lw	ra, 52(sp)
	lw	usp, 48(sp)
	lw	pb, 40(sp)
	lw	false, 36(sp)
	lw	np3, 32(sp)
	lw	np2, 28(sp)
	lw	np1, 24(sp)
	lw	np0, 20(sp)
	lw	p1, 16(sp)
	lw	p0, 12(sp)
	addu	sp, 56

	j	ra

	.end	_pop_external_callback



/***************** end labels for wrapping structures *****************/

	.data
Ldata_end:
Ldata_size = 0 ##PATCH## Ldata_size Ldata_end Ldata_start

/**********************************************************************/


/* --- Revision History ---------------------------------------------------
--- John Gibson, Feb 17 1995
	Moved definition of Extern$- _r*esult_struct to extern_ptr.p as
	Extern$-result_struct
--- Robert John Duncan, Jun 14 1994
	Fix to stack frame layout in _call_external: pop Callback function
	needs to be able to access the return address at the usual offset
	(SF_RETURN_ADDR).
--- Robert John Duncan, Mar 22 1994
	Removed procedure assignments to a0 (again). Changed external
	jumps to go off t9.
--- Robert John Duncan, Mar 15 1994
	_exfunc_clos_action now gets the closure address in t9.
	Removed the wrapping structure from the text section.
--- Robert John Duncan, Mar 15 1994
	Pop calls must now set a0 to the procedure address
--- Robert John Duncan, Mar  9 1994
	Added directives for position-independent code. Made to use special
	var block register instead of depending on the global pointer, so
	no need for any extern declarations. Moved to more conventional
	stack frame layout.
--- Robert John Duncan, Mar  8 1994
	Added .ent/.end directives
--- Robert John Duncan, Mar  7 1994
	Changed to use register $t9 for function calls only.
--- Simon Nichols, Nov 10 1993
	Made _pop_external_callback set __pop_in_user_extern back to the same
	value it had on entry.
--- Robert John Duncan, Jun 16 1993
	Removed .extern declaration for __pop_in_user_extern because the
	defining file "c_core.c" is now liable to be compiled -G 0.
--- John Gibson, May 19 1993
	Template part of exfunc closures now generated by POPC, which
	jumps to the _exfunc_clos_action code in this file.
--- John Gibson, Dec 18 1992
	Moved pop_ex*func_arg to c_core.c (otherwise it's undefined if this
	file is not extracted)
--- Robert John Duncan, Aug 26 1992
	Completely revised strategy for allocating arguments to registers
	used by _call_external, given that the rules given in Kane don't
	work at all for single floats. The new strategy is to cover all
	combinations by putting all arguments on the stack and to initialise
	all argument registers (both word and float). Some of the work will
	be redundant, but it's simpler than the previous method and probably
	no less efficient.
--- Robert John Duncan, Aug 25 1992
	Changed _call_external to take -fltsingle- arg whose Nth bit
	specifies the treatment of (d)decimals for Nth arg
--- Robert John Duncan, Apr 17 1991
	Changed to use pop register names throughout, since "pop_regdef.h"
	no longer includes the system "regdef.h"
--- Robert John Duncan, Jan 29 1991
	Added setting and clearing of __pop_in_user_extern (tested nonzero
	by signal handler in c_core.c to determine whether asynchronous
	callback is allowed)
--- John Gibson, Nov 19 1990
	Added pop label for _pop_external_callback.
	Removed functions for getting interrupt/disable flag info
	(replaced by pointer constants in asignals.s)
--- Robert John Duncan, Nov 13 1990
	_call_external now doesn't return the result structure on the stack;
	the structure is exported instead as Sys$-Extern$- _r*esult_struct.
	_pop_external_callback now receives and passes on a status return
	from Callback.
--- Robert John Duncan, Oct  1 1990
	Fixed unwind from _call_external not to change SP until the saved
	register values have been restored (in case of interrupt)
--- Simon Nichols, Sep  6 1990
	Added exfunc closure stuff
--- Robert John Duncan, Jul  4 1990
	Added extern declarations for special vars
--- Roger Evans, Jul  3 1990
	Added pop_interrupt_disabled
--- Simon Nichols, May 31 1990
	Changed _pop_interrupt_pending to pop_interrupt_pending
 */
