.Title	VRECVE -- Variable recve data
	.Ident		-V1.0d-
;
;	********   ********    *******   **     **  **     **
;	*********  *********  *********  **     **  **     **
;	**     **  **     **  **     **  **     **  ***    **
;	**     **  **     **  **     **  **     **  ****   **
;	********   *********  **     **  **     **  ** **  **
;	********   ********   **     **  **  *  **  **  ** **
;	**     **  **  **     **     **  ** *** **  **   ****
;	**     **  **   **    **     **  **** ****  **    ***
;	*********  **    **   *********  ***   ***  **     **
;	********   **     **   *******   **     **  **     **
;	
;	
;	********    *******   **     **  *********  ********   **
;	*********  *********  **     **  *********  *********  **
;	**     **  **     **  **     **  **         **     **  **
;	**     **  **     **  **     **  **         **     **  **
;	********   **     **  **     **  *****      *********  **
;	********   **     **  **     **  *****      ********   **
;	**     **  **     **  **     **  **         **  **     **
;	**     **  **     **   **   **   **         **   **    **
;	*********  *********    *****    *********  **    **   **
;	********    *******      ***     *********  **     **  **
;	
;	
;	      *   *   **    **   ***    **     *   * 
;	      ** **  *  *  *  *  *  *  *  *   **  ** 
;	      * * *  ****  *     ***   *  *    *   * 
;	      *   *  *  *  *  *  *  *  *  *    *   * 
;	      *   *  *  *   **   *  *   **    *** ***
;
;
;       -------------------------------------------------
;           B B C   B R O W N   B O V E R I     B. V.
;       -------------------------------------------------
;
;	Copyright (c)		BBC Brown Boveri B.V.
;                               Alle rechten voorbehouden
;
;       Afdeling		Industrial Division group VGA
;       Tel.                    010 - 4078911    (centrale)
;
;       Adres                   Marten Meesweg 5
;                               3068 AV  ROTTERDAM
;       Postadres               Postbus 301
;                               3000 AH  ROTTERDAM
;       . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
;
;       Filenaam                VRECVE.MAC
;       Taal                    MACRO-11
;
;       Datum originele versie  13-Jul-87
;       Originele versie door   Hans Hamakers
;       Tel. intern             631
;
;
;       Korte beschrijving:
;
;           Subroutine to receive different packets
;
;	Assembleren:
;
;           MAC VRECVE,VRECVE=VRECVE
;
;       ---------------------
;       W I J Z I G I N G E N
;       ---------------------
;       datum           inhoud                                  A.trail versie
;       -----           ------                                  ------  ------
;	3-jul-87	Test statusbits after CRAW		JHA01	01c
;	1-Sep-87	Time-out support			JHA02	01d

	.Sbttl	DEF    -- Definitions and Data
;
	.Enabl	Mcl
;
	.Psect	BBNL$D,RW,D
;
;	Definitions:
;
; The receivebuffers and GTSK$ buffer overlay eachother
;
; ++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
OurTsk:	.BLKW	2	; Our taskname ( RAD50 )
;
$Sentsk::		; Sender taskname
;
Buffer:	; 15 word receive buffer of RREF$ with:
	;   task name ( 2  words )
	;   data      ( 8  words )
	;   space     ( 5  words )
;
	; 15 word receive buffer of RCDA$ with:
	;   task name ( 2  words )
	;   data      ( 13 words )
P.Data	=  4		; Start of data in buffer
P.TSK1	=  0		; Task
P.TSK2	=  2		;    name
;
	.Blkw	2.
;
Region: .Blkw	8.
;
	.Blkw	5.
;
; ++++++++++++++++++++++++++++++++++++++
;
Window:	WDBBK$	,128.,,,,,Buffer
;
$Vrapr:: 7			; APR to use
$RRef::  1			; RRef flag
Iniflg:	0			; Init flag
Refflg:	0			; REF Packet
Tmoflg:	0			; Time-out flag
Bufadr:	0			; Buffer address
Buflen:	0			; Buffer length
Parms:	0			; Parameters
	VR.Stp	== 1		; Stop if no data
	VR.Ext	== 2		; Exit if no data
	VR.Ret  == 4		; Return if no data
	VR.Nor  == 10		; Normal data
	VR.Ref  == 20		; Ref. data
	VR.All  == 30		; All data
;
Tmo:	0			; Time-out count			;JHA02

	.SBTTL	VRECVE -- Fortran interface
;
	.Psect	BBNL$I,RO,I
;
	.List	Bex
;
;
;   CALL   VRECVE(BUFFER,BUFLEN,[PARM],[ITMO],[DATLEN],[TSKNAM],IDSW)
;
VRECVE::
;
	CALL	$Saval		; Save all registers
;
	CMP	(R5)+,#7	; 7 arguments ?				;JHA02
	BNE	FTNEXT		;  No  : => Exit
;
	CMP	(R5),#-1	; Argument specified ?
	BEQ	FTNEXT		;  No : => Exit
	MOV	(R5)+,BUFADR	; Address of buffer
;
	CMP	(R5),#-1	; Argument specified ?
	BEQ	FTNEXT		;  No : => Exit
	MOV	@(R5)+,BUFLEN	; Buffersize
;
	CMP	(R5),#-1	; Argument specified ?
	BEQ	10$		;  No : => 10$
	MOV	@(R5),PARMS	; Parameters
	BR	20$		; => 20$
10$:
	CLR	PARMS		; Take default
20$:
	TST	(R5)+		; Point to timo field
	CMP	(R5),#-1	; Argument specified ?			;JHA02
	BEQ	30$		;  No : => 30$				;JHA02
	MOV	@(R5),TMO	; Timo					;JHA02
	BR	40$		; => 40$				;JHA02
30$:									;JHA02
	CLR	TMO		; Take default				;JHA02
40$:									;JHA02
;
	TST	(R5)+		; Point to length field
	CMP	4(R5),#-1	; DSW Argument specified ?
	BEQ	FTNEXT		;  No : => Exit
;
	CALL	START		; Process
;
	CLC			; Clear carry
	CMP	(R5),#-1	; Length Argument specified ?
	BEQ	50$		;  No : => 50$
	MOV	R2,@(R5)	; Copy Length
50$:
	TST	(R5)+		; Point to DSW
;
	CMP	(R5),#-1	; Task Argument specified ?
	BEQ	60$		;  No : => 60$
	MOV	(R5),R0		; Take address	
	MOV	BUFFER+P.TSK1,(R0)+	; Copy 
	MOV	BUFFER+P.TSK2,(R0)	;   taskname
60$:
	TST	(R5)+		; Point to DSW
;
	MOV	R4,@(R5)	; Copy error code
	BPL	FTNEXT		; Positive => 
	SEC			; Set carry
FTNEXT:
;
	RETURN			; Exit

	.SBTTL	$VRECV -- Macro interface
;
$VRECV::
;
;
;    R1  = Address of Buffer
;    R2  = Length of Buffer
;    R3  = Parameters
;    R4  = Time-out count
;
;	CALL	$VRECV
;
;  output:
;
;    R2         = Length of transfered data
;    $DSW       = Errorcode
;    Carry bit  = Error indicator
;
;
	CALL	$SAVAL		;
	MOV	R1,BUFADR	; Buffer address
	MOV	R2,BUFLEN	; Bufferlength
	MOV	R3,PARMS	; Parameters
	MOV	R4,TMO		; Time-out				;JHA02
	CALL	START		;
;
	MOV	R2,6(SP)	; Transfer R2 (current length)
	CLC			; Clear carry
	MOV	R4,$DSW		; Copy error code
	BPL	MACEXT		; Positive => 
	SEC			; Set carry
MACEXT:
	RETURN			;
;

	.Sbttl	START  -- Initialize part
;
START:
;
	BIT	#VR.ALL,PARMS	; Anything specified ?
	BNE	10$		;  Yes : => 10$
	BIS	#VR.ALL,PARMS	; Take default All
10$:
	TST	$RREF		; RREF packets wanted ?
	BNE	20$		;  Yes : => 20$
	BIC	#VR.REF,PARMS	; Clear ref bit
20$:
	BIT	#VR.ALL,PARMS	; Any bit left ?
	BNE	30$		;  Yes : => 30$
	MOV	#IE.ITS,$DSW	; Prepare error
	JMP	DSWERR		; => DSWERR
30$:
	BIT	#VR.STP!VR.EXT!VR.RET,PARMS
				; Anything specified ?
	BNE	40$		;  Yes : => 40$
	BIS	#VR.STP,PARMS	; Take default Stop
40$:
	TST	INIFLG		; Do we have to initialize ?
	BNE	80$		;  No : => 80$
;
; Get taskname .....
;
	GTSK$S	#OURTSK		; Get our taskname
;
	TST	$RREF		; Process RRef ?
	BEQ	70$		;  No : => 70$
;
; Insert apr .....
;
	MOVB	$VRAPR,WINDOW+W.NAPR
;
; Create window .....
;
	CRAW$S	#WINDOW		;					;JHA01
	BCC	50$		;					;JHA01
	CALLR	DSWERR		;					;JHA01
50$:									;JHA01
	BIT	#WS.UNM!WS.ELW,WINDOW+W.NSTS				;JHA01
				; Window unmapped or eliminated ?	;JHA01
	BEQ	60$		;  No : => 60$				;JHA01
	MOV	#IE.WOV,$DSW	; Force window overflow error		;JHA01
	CALLR	DSWERR		; =>					;JHA01
60$:									;JHA01
;
; Map with RREF$S .....
;
	BIS	#WS.MAP,WINDOW+W.NSTS
70$:
;
; Say we have initialized .....
;
	INC	INIFLG		;
80$:
;

	.SBTTL	GETREF -- Receive by reference
GETREF:
;
; GET RREF packet
;
	BIT	#VR.REF,PARMS	; Ref packets ?
	BEQ	GETNOR		;  No : => GETNOR
;
	RREF$S	#WINDOW		; Receive and map to region
;
; See if we have one
;
	BCC	10$		;  Yes : => 10$
	CMPB	#IE.ITS,$DSW	; No packet queued ?
	BEQ	GETNOR		;  Yes : => getnor
	CALLR	DSWERR		; Error  => DSWERR
10$:
;
; We have a REF packet, first process it
;
; A REF packet contains information of a dynamic region which contains
; user data 
;
; With the RREF$S directive the region is automaticly mapped.
;
	MOV	#1,REFFLG	;
;
	MOV	BUFFER+P.DATA,R2
				; Byte count
	MOV	WINDOW+W.NBAS,R0
				; R0 => Region
;
	CALL	PROCES		; Process data
;
; Destroy region after detach .....
;
	BIS	#RS.MDL,REGION+R.GSTS
;
; Copy the right RID .....
;
	MOV	WINDOW+W.NRID,REGION+R.GID
;
; Detach region .....
;
	DTRG$S	#REGION		;					;JHA01
	BCC	20$		;					;JHA01
	CALLR	DSWERR		;					;JHA01
20$:									;JHA01
;
; Back to user .....
;
	CALLR	EXIT
;

	.SBTTL	GETNOR -- Receive normal
;
GETNOR:
;
	BIT	#VR.NOR,PARMS	; Normal packets ?
	BEQ	NODAT		;  No: => NODAT
;
	RCVD$S	,#BUFFER	; Receive data
;
; See if we have one .....
;
	BCC	10$		;  Yes : => 10$
	CMPB	#IE.ITS,$DSW	; No packet queued ?
	BEQ	NODAT		;  Yes : => NODAT
	CALLR	DSWERR		; Error  => DSWERR
;
10$:
;
; We have a NORMAL packet, first process it .....
;
	CLR	REFFLG		;
;
	MOV	#26.,R2		; R2 =  Bytecount
	MOV	#BUFFER+P.DATA,R0
				; R0 => Data
;
	CALL	PROCES		; Process data
;
; Back to user .....
;
	CALLR	EXIT
;

	.SBTTL	EXIT   -- Exit
;
EXIT:
;
	CALLR	UNSPEC		; Unspecify AST's
;
;
	.SBTTL	UNSPEC -- Unspecify AST's
;
UNSPEC:
;
	BIT	#VR.REF,PARMS	; Ref ?
	BEQ	10$		;  No : => 10$
	SRRA$S			; RREF AST
10$:
	BIT	#VR.NOR,PARMS	; Nor ?
	BEQ	20$		;  No : => 20$
	SRDA$S			; RECV AST
20$:
	RETURN			;

	.SBTTL	DSWERR -- DSW Error
;
DSWERR:
	MOV	$DSW,R4		; Copy dsw error
	CLR	R3		; No data
	CALLR	UNSPEC		; Unspecify AST's
;
	.SBTTL	NODAT  -- No data queued
;
NODAT:
	BIT	#VR.RET,PARMS	; Return ?
	BEQ	10$		;  No : => 10$
	MOV	$DSW,R4		; Copy dsw error
	CLR	R3		; No data
	RETURN			; Error => RETURN
10$:
	BIT	#VR.EXT,PARMS	; Exit ?
	BEQ	20$		;  No : => 20$
	EXIT$S			; Exit task	
20$:
	TST	TMO		; Time-out count ?			;JHA02
	BEQ	30$		;  No : => 30$				;JHA02
	CLR	TMOFLG		; Clear flag				;JHA02
	MRKT$S	,TMO,#2,#MKTAST	;					;JHA02
30$:									;JHA02
;
; Specify AST's
;
	BIT	#VR.REF,PARMS	; Ref ?
	BEQ	110$		;  No : => 110$
	SRRA$S	#RCVAST,DSWERR	; RREF AST
110$:
	BIT	#VR.NOR,PARMS	; Nor ?
	BEQ	120$		;  No : => 120$
	SRDA$S	#RCVAST,DSWERR	; RECV AST
120$:
;
	STOP$S			; Stop for AST
;
	CMKT$S	,#MKTAST	; Cancel marktime			;JHA02
;
	TST	TMOFLG		; Time-out ?				;JHA02
	BNE	40$		;  Yes : => 40$				;JHA02
	JMP	GETREF		; Get data
40$:									;JHA02
	MOV	#IE.ITS,R4	; No data				;JHA02
	RETURN			;					;JHA02
;

	.Sbttl	RCVAST -- Reveive AST
;
RCVAST:	
	USTP$S	#OURTSK		;; Unstop ourself
	ASTX$S			;; AST exit
;
	.Sbttl	MKTAST -- Marktime AST
;
MKTAST:	
	INC	TMOFLG		;; Set flag				;JHA02
	TST	(SP)+		;; Flush flag word			;JHA02
	USTP$S	#OURTSK		;; Unstop ourself			;JHA02
	ASTX$S			;; AST exit				;JHA02
;
;
PROCES:
;
; In:	R0 => data
;	R2 =  Length
;
; Out:  R2 =  Length
;       R4 =  errorcode
;
	MOV	#IS.SUC,R4	; Assume successful
	MOV	R2,R3		; Copy bytecount
	CMP	R3,BUFLEN	; Does it fit ?
	BLOS	10$		;  Yes : => 10$
	MOV	#IE.RBS,R4	; Receive buffer too small
	MOV	BUFLEN,R3	; Take max. length
	MOV	R3,R2		; Copy actual bytecount
10$:
	TST	R3		; Any bytes to move ?
	BEQ	30$		;  No : => 30$
	MOV	BUFADR,R1	; R1 => Userbuffer
20$:
	MOVB	(R0)+,(R1)+	; Copy
	SOB	R3,20$		;  data
30$:
	RETURN			;
;
	.END