	.title	sends - PL/I callable send request
	.ident	-010000-
;
; Copyright 1981. Duke University.
;
;+
; Abstract:	SENDS
;
;	This module will send a string to a receiving process
;	under VAX/VMS.  It is intended to mimic the IAS send
;	directives.
;
; Calling sequence:
;
;	= sends (tsknam, ti, data, [pri], [efn]);
;
; Returns:	Fixed binary (15,0)
;
;	Directive status from send.
;
; Arguments:
;
; tsknam character (6) [varying]
;	The name of the task to send the data to.  Under
;	VAX/VMS, this is interpreted as a process name.
;
; ti fixed binary (15,0)
;	The TI identifier for the target process.  Under
;	VAX/VMS, this is ignored.
;
; data character (*) [varying]
;	The data to be sent.
;
; pri fixed binary (15,0)
;	The priority of the request.  Under VAX/VMS, this is
;	ignored.
;
; efn fixed binary (15,0)
;	The event flag to set on receipt of the data block.
;	Under VAX/VMS, this is ignored.
;
; Subroutines:
;
;	ilnar$	- Report illegal number of arguments.
;	savrg$	- Save registers
;
; Nonstandard features:
;
;	1.  Written in Macro-11
;	2.  Uses the undocumented VMS "elephant" directive.
;
; Written: 07-Apr-1981, -1.0.0-, Bruce C. Wright
; Modified:
; Verified:
;-

;
; Macro calls
;
	.mcall	dir$
;
	.psect	$sends,rw,d
;

; Static Read/write section
;
exfc:	.byte	145.,8.		; Directive code for elephant directive
	.word	4		; Subfunction code - call native image
	.word	secnam		; Section name to call
	.word	seclen		; Length of section name
;
; Arguments to send.
;
func:	.word	0		; Function code
buffer:	.word	0		; Address of buffer
buflen:	.word	0		; Length of buffer
mbxbuf:	.word	0		; Address of mailbox name
mbxlen:	.word	0		; Length of mailbox name
iost:	.word	0,0,0,0		; VMS I/O status block
;
; Global section name
;
	.psect	$merli,ro,d,ovr
secnam:	.ascii	/_DBA0:[PLIUTL]NATVMODE.EXE/
seclen	=	.-secnam
;
; Parameter definitions
;
nargs	=	16		; Number of arguments
tsknam	=	nargs+2		; Task name (input)
ti	=	tsknam+2	; TI address (ignored)
data	=	ti+2		; Send data (input)
pri	=	data+2		; Priority (ignored)
efn	=	pri+2		; Event flag (ignored)
rtn	=	efn+2		; Return code (output)

;
; Executable code
;
	.psect	merlin,rw,i
sends::	jsr	r0,savrg$	; Save registers 0 - 3
	mov	#3,r3		; Show ordinary send.
;
; Send data code
;
	cmp	nargs(sp),#6	; Right number of arguments?
	bhi	5$		; J if too many.
	cmp	nargs(sp),#4	; Too few?
	bhis	10$		; J if ok.
5$:	jsr	r5,ilnar$	; Report illegal number of arguments.
10$:	mov	data(sp),r0	; Pick up string dope vector.
	mov	4(r0),r1	; Pick up address of string.
	mov	(r0),r2		; Pick up length of string.
	bpl	20$		; J if fixed-length string.
	mov	(r1)+,r2	; Pick up actual string length.
20$:	bic	#140000,r2	; Remove garbage bits from length.
	mov	r3,func		; Set send function code.
	mov	r2,buflen	; Set buffer length.
	mov	r1,buffer	; Point to buffer from directive.
	mov	tsknam(sp),r0	; Get task name descriptor.
	mov	4(r0),r1	; Pick up address of string.
	mov	(r0),r2		; Get length of name.
	bpl	30$		; J if fixed-length string.
	mov	(r1)+,r2	; Pick up length from string.
30$:	bic	#140000,r2	; Clean garbage bits from r2.
	mov	r1,mbxbuf	; Set mailbox buffer descriptor.
	mov	r2,mbxlen	; ...
	dir$	#exfc		; Execute extended function.
	mov	nargs(sp),r0	; Pick up number of arguments.
	asl	r0		; Get word offset.
	add	sp,r0		; Absolutise ...
	mov	iost,@nargs(r0)	; ... And return the return code.
	rts	pc		; And return to the caller.
	.end
