/* --- Copyright University of Sussex 1996. All rights reserved. ----------
 * File:		S.pcwnt/src/aextern.s
 * Purpose:		External interface for Intel 80x86 (Microsoft assembler)
 * Author:		Robert John Duncan, Apr 15 1994 (see revisions)
 * Related Files:	S.pcunix/src/aextern.s
 */

/*************************************************************************
		THIS FILE WAS GENERATED AUTOMATICALLY FROM
		 /rsuna/pop/master/S.pcunix/src/aextern.s
		     ON Fri Apr 15 10:37:30 BST 1994
	  AND SUBSEQUENTLY EDITED ON Fri Apr 15 10:51:26 BST 1994
*************************************************************************/

#_<

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

lconstant macro (

	USP		= "ebx",	;;; User stack pointer
	PB		= "ebp",	;;; Procedure base register

	SAVED_SP	= [I_LAB(Sys$-Extern$- _saved_sp)],
	SAVED_USP	= [I_LAB(Sys$-Extern$- _saved_usp)],

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

);

>_#

	.erre	@Version ge 611
	option	casemap:none
	.386
	.model	flat


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

	.code
	dword	L$text_size, C_LAB(Sys$-objmod_pad_key)
L$text_start:
	.data
	assume	cs:nothing
	dword	L$data_size, C_LAB(Sys$-objmod_pad_key)
L$data_start:

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


	.code

;;; _call_external(_____nargs, _______routine, _________fltsingle)
;;;	User interface to external routines: moves _____nargs from the user
;;;	stack to the call stack, 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:
;;;	EAX	argument conversion; result from the external call
;;;	ECX	number of arguments (_____nargs);
;;;		address of result array
;;;	EDX	_________fltsingle bit mask
;;;	ESI	external type of compound arguments
;;;	EDI	address of the external routine (_______routine)

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

DEF_C_LAB(_call_external)

	;;; Save caller's stack pointer for interrupt/callback

	lea	eax, dword ptr [esp+4]
	mov	dword ptr SAVED_SP, eax

	;;; Load fixed arguments

	mov	edx, dword ptr [USP]	;;; _________fltsingle
	mov	edi, dword ptr [USP+4]	;;; _______routine
	mov	ecx, dword ptr [USP+8]	;;; _____nargs
	add	USP, 12

	test	ecx, ecx
	jz	do_call

	;;; Rotate _________fltsingle to get bit for last arg at the top

	cmp	ecx, 32
	jae	argloop
	ror	edx, cl

	;;; Transfer (and convert) any arguments

argloop:

	mov	eax, dword ptr [USP]
	add	USP, 4

	test	eax, 1	;;; issimple
	jz	L$2$1
	test	eax, 2	;;; isinteger
	jz	L$1$1

	;;; Pop integer: convert to m/c integer and push

	sar	eax, 2
	push	eax
	jmp	nextarg

L$1$1:	;;; Pop decimal: convert to m/c single float and push

	sub	eax, 1
	push	eax

	;;; If the sign bit of _________fltsingle is not set, convert to double

	test	edx, edx
	js	nextarg
	fld	dword ptr [esp]	;;; Load from stack as single
	sub	esp, 4
	fstp	qword ptr [esp]	;;; Store back as double
	jmp	nextarg

L$2$1:	;;; Pop structure: get extern type from key into ESI

	mov	esi, dword ptr [eax+_KEY]
	movzx	esi, byte ptr [esi+_K_EXTERN_TYPE]

	test	esi, esi
	jnz	L$3$1

	;;; EXTERN_TYPE_NORMAL (0): push unchanged

	push	eax
	jmp	nextarg

L$3$1:	cmp	esi, _:EXTERN_TYPE_DEREF
	jne	L$4$1

	;;; External pointer: push dereferenced

	push	dword ptr [eax+_XP_PTR]
	jmp	nextarg

L$4$1:	cmp	esi, _:EXTERN_TYPE_DDEC
	jne	L$5$1

	;;; Ddecimal: push the two halves

	push	dword ptr [eax+_DD_1]
	push	dword ptr [eax+_DD_2]

	;;; If the sign bit of _________fltsingle is set, convert to single float

	test	edx, edx
	jns	nextarg
	fld	qword ptr [esp]	;;; Load from stack as double
	add	esp, 4
	fstp	dword ptr [esp]	;;; Store back as single
	jmp	nextarg

L$5$1:	;;; Must be biginteger: load first slice to ESI

	mov	esi, dword ptr [eax+_BGI_SLICES]

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

	cmp	dword ptr [eax+_BGI_LENGTH], 1
	je	L$6$1
	mov	eax, dword ptr [eax+_BGI_SLICES+4]
	shl	esi, 1
	shrd	esi, eax, 1

L$6$1:	;;; Push the result

	push	esi

nextarg:

	sub	ecx, 1
	jz	do_call

	;;; Shift up _________fltsingle

	cmp	ecx, 32
	jae	argloop
	shl	edx, 1
	jmp	argloop

do_call:

	cld	;;; clear direction flag
	mov	dword ptr SAVED_USP, USP	;;; save USP for callback
	mov	dword ptr EXTERN_NAME(__pop_in_user_extern), esp
					;;; enable async callback
	call	edi
	mov	dword ptr EXTERN_NAME(__pop_in_user_extern), 0
					;;; disable async callback
	mov	USP, dword ptr SAVED_USP	;;; restore USP

	;;; Copy possible results into result_struct:
	;;; double result from ST(0) first, then word result from EAX

	lea	ecx, dword ptr C_LAB(Sys$-Extern$-result_struct)

	mov	dword ptr [ecx+8], eax	;;; word result

	;;; See if there's a double result (i.e something in ST(0)):
	;;; use FXAM, and copy the resulting status word to EAX.
	;;; Mask out everything except bits C0 and C3; if these are both
	;;; set, then the register was empty and there's no result

	fxam
	fstsw	ax
	and	ax, 04100h
	cmp	ax, 04100h
	je	L$7$1

	fstp	qword ptr [ecx]	;;; double result

L$7$1:	;;; Reset stack pointer

	mov	eax, dword ptr SAVED_SP
	lea	esp, dword ptr [eax-4]
	mov	dword ptr SAVED_SP, 0	;;; Indicates external call over

L$0$1:	ret

	align	4


;;; _EXFUNC_CLOS_ACTION:
;;;	called from the code in an exfunc_closure (see asmout.p), with
;;;	the top of stack pointing to (exfunc_clos address)+8

DEF_C_LAB(Sys$- _exfunc_clos_action)
	;;; Load address of external closure record to eax

	pop	eax
	lea	eax, dword ptr [eax-8]

	;;; Store frozen argument to destination

	mov	edx, dword ptr [eax+_EFC_ARG_DEST]
	mov	ecx, dword ptr [eax+_EFC_ARG]
	mov	dword ptr [edx], ecx

	;;; Chain function via external ptr

	mov	eax, dword ptr [eax+_EFC_FUNC]
	jmp	dword ptr [eax]

	align	4


;;; _EXTERNAL_CALLBACK_FUNC:
;;;	interface routine for external callback; called indirectly from
;;; 	_pop_external_callback in "external.c"

;;; C Synopsis:
;;;	int _external_callback_func(unsigned argp[])

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

DEF_C_LAB(Sys$- _external_callback_func)

	;;; Save user registers

	push	ebx
	push	ebp
	push	esi
	push	edi

	;;; Save __pop_in_user_extern

	push	dword ptr EXTERN_NAME(__pop_in_user_extern)

	;;; Create 3 word dummy stack frame for SF_NEXT_SEG_SP
	;;; and SF_NEXT_SEG_HI

	lea	esp, dword ptr [esp-(3*4)]

	;;; Disable async callback

	mov	dword ptr EXTERN_NAME(__pop_in_user_extern), 0

	;;; Restore procedure base register and saved USP

	mov	eax, dword ptr SAVED_SP
	mov	PB, dword ptr [eax]
	mov	USP, dword ptr SAVED_USP

	;;; Push argp

	sub	USP, 8
	mov	eax, dword ptr [esp+((1+5)+3)*4]
	mov	dword ptr [USP+4], eax

	;;; Dummy argument

	mov	dword ptr [USP], 0

	;;; Do the callback

	call	XC_LAB(Sys$-Extern$-Callback)

	;;; Return status code

	mov	eax, dword ptr [USP]
	add	USP, 4

	;;; Resave USP

	mov	dword ptr SAVED_USP, USP

	;;; Remove stack frame

	lea	esp, dword ptr [esp+3*4]

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

	pop	dword ptr EXTERN_NAME(__pop_in_user_extern)

	;;; Restore registers and return

	cld
	pop	edi
	pop	esi
	pop	ebp
	pop	ebx

	ret

	align	4


	.data
	assume	cs:nothing


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

	.code
L$text_end:
	L$text_size	equ	L$text_end-L$text_start
	.data
	assume	cs:nothing
L$data_end:
	L$data_size	equ	L$data_end-L$data_start

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

@CurSeg	ends
	extern	C_LAB(Sys$-objmod_pad_key):near
	extern	C_LAB(Sys$-Extern$-result_struct):near
	extern	EXTERN_NAME(__pop_in_user_extern):near
	extern	SAVED_SP:near
	extern	SAVED_USP:near
	extern	XC_LAB(Sys$-Extern$-Callback):near
	end


/* --- Revision History ---------------------------------------------------
--- Robert Duncan, Mar  1 1996
	Added missing CLD to return from callback: DF must be clear when
	executing external code
--- Robert John Duncan, Sep 13 1995
	Added missing extern declaration
--- John Gibson, Feb 17 1995
	Moved definition of Extern$- _r*esult_struct to extern_ptr.p as
	Extern$-result_struct
 */
