/* --- Copyright University of Sussex 1999. All rights reserved. ----------
 * File:	C.hppa/src/aextern.s
 * Purpose:	External function calls for HP PA-RISC 1.1
 * Author:	Julian Clinton, January 1993 (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,

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

);

>_#

#_INCLUDE 'asm_macros.h'


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

	.code
	.word		Lcode_end-Lcode_start, C_LAB(Sys$-objmod_pad_key)
Lcode_start
	.data
	.word		Ldata_end-Ldata_start, C_LAB(Sys$-objmod_pad_key)
Ldata_start

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

	.code

;;; _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:
;;;	%t1		_______routine (plabel)
;;;	%t2    	 	_____nargs
;;;	%arg0		_________fltsingle
;;;	%arg1		argument source pointer
;;;	%arg2		argument destination pointer
;;;	%pop0		saved stack pointer
;;;	%arg0-3		arguments to the called routine
;;;	%ret0-1		results from the called routine
;;;	%t3-4		work

;;; 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
;;;	save_curbrk	(on systems without mprotect) saves the current break
;;;			in case the external routine allocates extra store
;;;	result_struct	space for both single- and double-length results.

DEF_C_LAB (_call_external)

	ldwm		4(%usp), %arg0	;;; _________fltsingle
	ldwm		4(%usp), %t1  	;;; _______routine
	ldwm		4(%usp), %t2  	;;; _____nargs

	;;; Save pointer to caller's stack frame in case of callback or
	;;; interrupt
	stw		%sp, _SAVED_SP(%svb)

	;;; Save return address
	stwm		%r31, 4(%sp)

	;;; Save volatile Poplog registers for callback
	stwm		%pop0, 4(%sp)
	stwm		%pop1, 4(%sp)
	stwm		%pop2, 4(%sp)
	stwm		%pop3, 4(%sp)
	stwm		%pop4, 4(%sp)
	stwm		%pop5, 4(%sp)

	;;; Re-use %pop0 to save the stack pointer
	copy		%sp, %pop0

	;;; Allocate a stack frame for the called procedure:
	;;; include a conservative estimate of the space needed for the
	;;; arguments (8 bytes each) plus 48 bytes for the fixed area
	;;; with the whole thing 64-byte aligned
	sh3add		%t2, %sp, %sp
	addi		48+63, %sp, %sp
	dep		0, 31, 6, %sp

#_IF not(DEF BSD_MPROTECT)
	;;; Save the current break
	LDV32		EXTERN_NAME(_curbrk), %t3
	STV32		%t3, save_curbrk
#_ENDIF

	;;; If there are no arguments, go straight to the call
	comb,=,n	%t2, 0, do_call

	;;; Adjust %usp to clear arguments
	sh2add		%t2, %usp, %usp

	;;; Set pointers for copying: argument save area starts at (%sp-36)
	copy		%usp, %arg1		;;; argument source
	ldo		-32(%sp), %arg2		;;; argument destination

	;;; Copy and convert arguments:
	;;; %arg0 (_________fltsingle) is shifted for each arg processed;
	;;; convert_arg will side-effect %arg1/%arg2

L$1	bl		convert_arg, %rp
	nop
	addib,<>	-1, %t2, L$1
	extrs		%arg0, 30, 31, %arg0

	;;; Copy first four argument words to general registers
	ldw		-36(%sp), %arg0
	ldw		-40(%sp), %arg1
	ldw		-44(%sp), %arg2
	ldw		-48(%sp), %arg3

do_call
	;;; Save USP and SP for callback
	stw		%usp, _SAVED_USP(%svb)
	STV32		%sp, EXTERN_NAME(__pop_in_user_extern)

	;;; Make the call:
	;;; the target is a PLABEL called with $$dyncall. That expects its
	;;; argument in %t1 and its return address in %r31; we also copy
	;;; the return address to %rp for the routine itself.
	bl		$$dyncall, %r31
	copy		%r31, %rp

	;;; Disable async callback and restore USP
	STV32		0, EXTERN_NAME(__pop_in_user_extern)
	ldw		_SAVED_USP(%svb), %usp

	;;; Copy possible results into result_struct: double result
	;;; from (%ret0,%ret1) first, then word result from %ret0

	LDA32		C_LAB(Sys$-Extern$-result_struct), %t3
	stw		%ret0, 0(%t3)
	stw		%ret1, 4(%t3)
	stw		%ret0, 8(%t3)

	;;; Indicate external call over
	stw		0, _SAVED_SP(%svb)

	;;; Restore the stack pointer, pop registers, return address etc.
	copy		%pop0, %sp

	ldwm		-4(%sp), %pop5
	ldwm		-4(%sp), %pop4
	ldwm		-4(%sp), %pop3
	ldwm		-4(%sp), %pop2
	ldwm		-4(%sp), %pop1
	ldwm		-4(%sp), %pop0
	ldwm		-4(%sp), %r31

#_IF not(DEF BSD_MPROTECT)
	;;; Check for a change in the break
	LDV32		save_curbrk, %t3
	LDV32		EXTERN_NAME(_curbrk), %t4
	comb,=,n	%t4, %t3, L$2
	CHAINSYS	XC_LAB(Sys$-Mem_break_changed)
	nop
L$2
#_ENDIF

	RETE
	nop


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

;;; Registers used from _call_external:
;;;	%arg0		_________fltsingle bit mask
;;;	%arg1		argument source pointer
;;;	%arg2		argument destination pointer

;;; Results:
;;;	none, but modifies %arg1 and %arg2

;;; Other registers used:
;;;	%ret0		argument value
;;;	%ret1		extern type from key
;;;	%fr4		floating-point conversions
;;;	%t3		temporary for biginteger conversions

convert_arg

	;;; Get next argument from user stack
	ldwm		-4(%arg1), %ret0

	;;; Simple?
	bb,>=,n		%ret0, 31, L$12

	;;; Integer?
	bb,>=,n		%ret0, 30, L$11

	;;; Integer: convert to machine integer
	extrs		%ret0, 29, 30, %ret0
	bv		(%rp)
	stwm		%ret0, -4(%arg2)

L$11	;;; Single decimal: convert according to _________fltsingle mask
	bb,>=		%arg0, 31, L$111
	dep		0, 31, 1, %ret0		;;; clear decimal bit
	bv		(%rp)
L$111	stwm		%ret0, -4(%arg2)	;;; store as single
	fldws,ma	4(%arg2), %fr4L		;;; load back as single
	dep		0, 31, 3, %arg2		;;; align destination
	fcnvff,sgl,dbl	%fr4L, %fr4		;;; convert to double
	bv		(%rp)
	fstds,mb	%fr4, -8(%arg2)		;;; store as double

L$12	;;; Pop structure: get extern type from key into %ret1
	ldw		_KEY(%ret0), %ret1
	ldb		_K_EXTERN_TYPE(%ret1), %ret1

	;;; Byte-addressable structure?
	comib,<>,n	_:EXTERN_TYPE_NORMAL, %ret1, L$13

	;;; Pass the pointer unchanged
	bv		(%rp)
	stwm		%ret0, -4(%arg2)

L$13	;;; Deref type?
	comib,<>,n	_:EXTERN_TYPE_DEREF, %ret1, L$14

	;;; Dereference word field at pointer
	ldw		(%ret0), %ret0
	bv		(%rp)
	stwm		%ret0, -4(%arg2)

L$14	;;; Double decimal?
	comib,<>,n	_:EXTERN_TYPE_DDEC, %ret1, L$15

	;;; Assemble a double float from the two halves into %fr4
	;;; and convert according to _________fltsingle mask
	fldws		_DD_1(%ret0), %fr4L
	bb,>=		%arg0, 31, L$141
	fldws		_DD_2(%ret0), %fr4R
	fcnvff,dbl,sgl	%fr4, %fr4L		;;; convert to single
	bv		(%rp)
	fstws,mb	%fr4L, -4(%arg2)	;;; store as single
L$141	dep		0, 31, 3, %arg2		;;; align destination
	bv		(%rp)
	fstds,mb	%fr4, -8(%arg2)		;;; store as double

L$15	;;; Must be a biginteger (EXTERN_TYPE_BIGINT):
	;;; get first slice in %ret1
	ldw		_BGI_SLICES(%ret0), %ret1

	;;; If there's more than one slice, pull in the bottom bit of the
	;;; second
	ldw		_BGI_LENGTH(%ret0), %t3
	comib,=,n	1, %t3, L$16
	ldw		_BGI_SLICES+4(%ret0), %t3
	dep		%t3, 0, 1, %ret1

L$16	bv		(%rp)
	stwm		%ret1, -4(%arg2)


;;; _EXFUNC_CLOS_ACTION:
;;;	called from the code in an exfunc_closure (see asmout.p),
;;;	with the return address %r31 pointing at (exfunc_clos address)+16
;;;	and the closure return address saved in %t2

DEF_C_LAB(Sys$- _exfunc_clos_action)
	;;; Load address of external closure record to %t1 and restore
	;;; return address
	ldo		-19(%r31), %t1
	copy		%t2, %r31

	;;; Store frozen argument to destination
	ldw		_EFC_ARG_DEST(%t1), %t2
	ldw		_EFC_ARG(%t1), %t3
	stw		%t3, (%t2)

	;;; Get function address via external ptr
	ldw		_EFC_FUNC(%t1), %t3
	ldw		(%t3), %t1

	;;; Chain to function whose address is in %t1
	b		$$dyncall
	nop


;;; _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-


	.export		_pop_external_callback, entry
_pop_external_callback

	.proc
	.callinfo	calls, save_rp, entry_gr=18
	.enter

	;;; Disable async callback (after saving value of __pop_in_user_extern
	;;; in a callee-saves register which isn't otherwise used in this
	;;; routine)
	LDV32		EXTERN_NAME(__pop_in_user_extern), %npop0
	STV32		0, EXTERN_NAME(__pop_in_user_extern)

	;;; Restore Poplog fixed registers (cf. reset_pop_reg_environ in
	;;; "amisc.s")
	LDA32		C_LAB(false), %false
	LDA32		C_LAB(_special_var_block), %svb
	ldi		3, %pzero

	;;; Restore volatile registers saved by _call_external
	ldw		_SAVED_SP(%svb), %t1
	ldw		_SAVED_USP(%svb), %usp
	ldo		4(%t1), %t1	;;; ignore saved %r31
	ldwm		4(%t1), %pop0
	ldwm		4(%t1), %pop1
	ldwm		4(%t1), %pop2
	ldwm		4(%t1), %pop3
	ldwm		4(%t1), %pop4
	ldwm		4(%t1), %pop5

	;;; Push ARGP
	stwm		%arg0, -4(%usp)

#_IF not(DEF BSD_MPROTECT)

	;;; Push any change in the break
	LDV32		save_curbrk, %t1
	LDV32		EXTERN_NAME(_curbrk), %t2
	sub		%t1, %t2, %t1
	stwm		%t1, -4(%usp)

#_ELSE

	;;; No need to worry about the break: push a dummy argument
	stwm		0, -4(%usp)

#_ENDIF

	;;; Call back to Poplog; the 4-word stack frame is for dummy
	;;; SF_OWNER, SF_NEXT_SEG_SP and SF_NEXT_SEG_HI plus an etxra
	;;; word to keep things 8-byte aligned
	CALLSYS		XC_LAB(Sys$-Extern$-Callback)
	ldo		16(%sp), %sp
	ldo		-16(%sp), %sp

#_IF not(DEF BSD_MPROTECT)

	;;; Resave the current break
	LDV32		EXTERN_NAME(_curbrk), %t1
	STV32		%t1, save_curbrk

#_ENDIF

	;;; Return status code
	ldwm		4(%usp), %ret0

	;;; Resave USP and pop registers (which may have been relocated
	;;; by a garbage collection)
	ldw		_SAVED_SP(%svb), %t1
	stw		%usp, _SAVED_USP(%svb)
	ldo		4(%t1), %t1	;;; ignore saved %r31
	stwm		%pop0, 4(%t1)
	stwm		%pop1, 4(%t1)
	stwm		%pop2, 4(%t1)
	stwm		%pop3, 4(%t1)
	stwm		%pop4, 4(%t1)
	stwm		%pop5, 4(%t1)

	;;; Re-enable async callback
	STV32		%npop0, EXTERN_NAME(__pop_in_user_extern)

	.leave
	.procend

	;;; for indirect weak reference
DEF_C_LAB(Sys$- _external_callback_func)
	.word		P'_pop_external_callback


;;; -- Data ---------------------------------------------------------------

	.data

#_IF not(DEF BSD_MPROTECT)

;;; SAVE_CURBRK:
;;;	Saves the break value across an external call

save_curbrk
	.word		0

#_ENDIF

	.code

	.import		C_LAB(false), data
	.import		C_LAB(_special_var_block), data
	.import		C_LAB(Sys$-objmod_pad_key), data
	.import		C_LAB(Sys$-Extern$-result_struct), data
	.import		XC_LAB(Sys$-Mem_break_changed), data
	.import		XC_LAB(Sys$-Extern$-Callback), data
	.import		EXTERN_NAME(_curbrk), data
	.import		EXTERN_NAME(__pop_in_user_extern), data
	.import		$$dyncall, millicode


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

	.code
	.align		8
Lcode_end
	.data
	.align		8
Ldata_end

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


/* --- Revision History ---------------------------------------------------
--- Robert Duncan, Feb 17 1999
	Set Sys$- _external_callback_func to denote the ______plabel for
	_pop_external_callback
--- Robert John Duncan, Oct 13 1995
	Changed stack frame size in _pop_external_callback to be a multiple
	of 8 bytes to maintain double-word alignment
--- Integral Solutions Ltd, Aug 31 1995 (Julian Clinton)
	Added .import for C_LAB(Sys$-Extern$-result_struct)
--- John Gibson, Feb 17 1995
	Moved definition of Extern$- _r*esult_struct to extern_ptr.p as
	Extern$-result_struct
--- Integral Solutions Ltd (Julian Clinton), Feb  1 1994
	Fixed bug (stack empty after malloc not detected) caused by
	using half the Bobcat method. Snake now uses _curbrk directly.
--- Integral Solutions Ltd (Julian Clinton), Nov 16 1993
	Made _pop_external_callback set __pop_in_user_extern back to the same
	value it had on entry.
--- Robert John Duncan, May 24 1993
	Various 14.2+ changes:
	   o	Changed _call_external to take _________fltsingle arg whose Nth
		bit specifies the treatment of (d)decimals for Nth arg
	   o	Template part of exfunc closures now generated by POPC,
		which jumps to the _exfunc_clos_action code in this file
	   o	pop_ex*func_arg now defined in "c_core.c"
 */
