.TITLE	ACPFST - IQ.OPN PROCESSING (FAST VARIANT)
	.SBTTL	ACPFST - TITLE PAGE
	.IDENT	/V01.01/
;
; VERSION:	V01.01
;
; AUTHOR:	C.T. MICKELSON
;		GOODYEAR AEROSPACE CORPORATION
;		AKRON, OHIO 44315
;
; MODIFICATION HISTORY:
;
;	V01.00	CTM	11-JAN-83	ORIGINAL VERSION
;	V01.01	CTM	27-JUL-83	FIX PROBLEM INDEXING SUPPLEMENTARY
;					POOL BLOCK WHEN BASCNT = 0 AND VDIM # 0
;
; THIS ROUTINE PROCESSES THE IQ.OPN!SF.FST FUNCTION. A WINDOW BLOCK IS CREATED,
; A BLOCK OF POOL ALLOCATED FOR STORING HARDWARE CONTROL PARAMETERS,
; CONTROL PARAMETERS ARE LOADED FROM THE USER BUFFER, ADDITIONAL DATA STORED
; IN POOL, A FORTRAN CALLING SEQUENCE BUILT IN THE WINDOW,
; THE PROCESS IS COUNTED, AND THE FUNCTION RETURNED.
;
; INPUT:
;
;	R3 = IO PACKET ADDRESS
;	R5 = UCB ADDRESS
;
; OUTPUT:
;
;	SEE ABOVE EXPLANATION
;
; NOTES:
;
;	AN IQ.OPN!SF.FST FUNCTION HAS THE FOLLOWING USER IO PARAMETERS.
;
;	P1 - PDP-11 PARAMETER BUFFER VIRTUAL ADDRESS
;	P2 - BUFFER LENGTH IN BYTES
;	P3 - VIRTUAL CHANNEL NUMBER, NUMBER OF BUFFERS
;	P4 - 0
;	P5 - PDP-11 STAGER BUFFER STATUS BLOCK VIRTUAL ADDRESS
;	P6 - STAGER BUFFER STATUS BLOCK LENGTH IN BYTES
;
;	THE FORMAT OF THE IQ.OPN!SF.FST PARAMETERS WHEN THE PACKET IS DEQUEUED
;	BY THE ACP IS AS FOLLOWS (THE REFORMATTING IS DONE BY THE MPP
;	DEVICE DRIVER):
;
;	I.PRM(R3) - BUFFER RELOCATION BIAS
;	 +02	  - BUFFER KAPR6 VIRTUAL ADDRESS
;	 +04	  - BUFFER LENGTH IN BYTES
;	 +06	  - VIRTUAL CHANNEL NUMBER, NUMBER OF BUFFERS
;	 +10	  - 0
;	 +12	  - STAGER BUFFER STATUS BLOCK RELOCATION BIAS
;	 +14	  - STAGER BUFFER STATUS BLOCK KAPR 6 VIRTUAL ADDRESS
;	 +16	  - STAGER BUFFER STATUS BLOCK LENGTH IN BYTES
;
; REGISTERS:	USES R0-R5	SAVES R3,R5
;
; CALLS:	ACPDON,$ALOCB,$DEACB
;
	.PAGE
	.SBTTL	ACPFST - DECLARATIONS
	.DSABL	GBL
;
; MACRO LIBRARY CALLS:
;
;	SYMBOLS
;
	.MCALL	DRERR$,IOERR$,PKTDF$,UCBDF$
	DRERR$			;DEFINE DIRECTIVE ERROR CODE SYMBOLICS
	IOERR$			;DEFINE IO ERROR CODE SYMBOLICS
	PKTDF$			;DEFINE IO PACKET SYMBOLICS
	UCBDF$			;DEFINE UNIT CONTROL BLOCK SYMBOLICS
;
;	DIRECTIVES
;
;
;	OTHER MACROS
;
	.MCALL	CALL		;CALL SUBROUTINE
	.MCALL	CALLR		;CALL SUBROUTINE AND EXIT CALLER
;
; PSECT DEFINITIONS
;
	.PSECT	$CODE1,RO,I,REL,CON,LCL
	.PSECT	$PDATA,RO,D,REL,CON,LCL
	.PSECT	$VARS,RW,D,REL,CON,LCL
	.PSECT	SMMDAT,RW,D,REL,OVR,GBL
;
; GLOBAL DECLARATIONS
;
;	ACPFST MODULE ENTRY POINTS
;
	.GLOBL	ACPFST		;MODULE ENTRY POINT
;
; GLOBAL REFERENCES
;
;	SMMACP SUBROUTINES
;
	.GLOBL	ACPDON		;FINISH IO REQUEST ROUTINE
	.GLOBL	ALLOST		;ALLOCATE STAGING MEMORY BUFFER ROUTINE
	.GLOBL	BITMAP		;STAGING MEMORY ALLOCATION BITMAP ADDRESS
	.GLOBL	GETBLK		;GET DATA FROM USER BUFFER
	.GLOBL	RTNBLK		;RETURN DATA TO USER BUFFER
;
;	EXECUTIVE REFERENCES
;
	.GLOBL	$ALOCB
	.GLOBL	$DEACB
;
;	DEVICE DRIVER SYMBOL TABLE REFERENCES
;
;
;	OTHER REFERENCES
;
	.GLOBL	NBANKS		;NUMBER OF BANKS IN THE MAIN STAGER
	.GLOBL	NBNKS		;NUMBER OF BANKS IN MAIN STAGER
	.GLOBL	NWORDS		;NUMBER OF MAIN STAGER WORDS PER BANK
;
; LOCAL SYMBOLS
;
	.PAGE
;
; LOCAL (RO) DATA:
;
	.PSECT	$PDATA
BITLEN:	.WORD	BTLENG		;LENGTH OF MEMORY ALLOCATION BITMAP
BITGRN:	.WORD	BTGRAN		;GRANULARITY OF BITMAP
;
; LOCAL (RW) DATA:
;
	.PSECT	$VARS
; PARAMETER FILE HEADER RECORD BUFFER SPACE
NBKS:	.BLKW	1		;NUMBER OF BANKS FROM USER BUFFER
NWDS:	.BLKW	2		;NUMBER OF WORDS FROM USER BUFFER
VDIM:	.BLKW	1		;NUMBER OF VARIABLE DIMENSIONS FROM USER BUFFER
NMVS:	.BLKW	1		;NUMBER OF DATA MOVES FROM USER BUFFER
STWDS:	.BLKW	2		;WORDS PER STGR BUFFER FROM USER BUFFER
PFHDLN=.-NBKS			;PARAMETER FILE HEADER RECORD LENGTH
; PARAMETER FILE DATA MOVE HEADER BUFFER SPACE
MVN:	.BLKW	1		;DATA MOVE NUMBER
XFRWID:	.BLKW	1		;CHANNEL TRANSFER WIDTH
RCSIZE:	.BLKW	2		;RECORD SIZE FOR THIS DATA MOVE
BASEAD:	.BLKW	2		;BASE ADDRESS WITHIN BUFFER FOR THIS DATA MOVE
BASECT:	.BLKW	1		;NUMBER OF VARIABLE DIMENSIONS FOR THIS DATA MOVE
DMHDLN=.-MVN			;DATA MOVE HEADER LENGTH
ALOPAR:	.WORD	7		;ALLOST SUBROUTINE CALLING SEQUENCE
	.WORD	BITMAP
	.WORD	BITLEN
	.WORD	BITGRN
	.WORD	STSBSB		;STAGER ADDRESS ADDRESS
	.WORD	STSBSB+10	;BUFFER LENGTH ADDRESS
	.WORD	0		;NBUFF ADDRESS FILLED IN PRIOR TO CALL
	.WORD	STSBSB+4	;TOTAL ALLOCATION ADDRESS
STSBSB:	.WORD	0,0		;STAGER BUFFER ADDRESS
	.WORD	0,0		;TOTAL STAGER ALLOCATION
	.WORD	0,0		;BUFFER LENGTH
LNSBSB=.-STSBSB
; THE FOLLOWING SIX LINES MUST REMAIN CONTIGUOUS AND IN ORDER
ADRREC:	.WORD	0		;BASE ADDRESS OF RECSIZ IN POOL
ADRADR:	.WORD	0		;BASE ADDRESS OF BASADR IN POOL
ADRCNT:	.WORD	0		;BASE ADDRESS OF BASCNT IN POOL
ADROUT:	.WORD	0		;BASE ADDRESS OF HARDWARE PARAMETERS IN POOL
ADRWGT:	.WORD	0		;BASE ADDRESS OF BASWGT IN POOL
ADRLEN:	.WORD	0		;BASE ADDRESS OF BASLEN IN POOL
	.PAGE
	.SBTTL	ACPFST - SUBROUTINE BODY
	.PSECT	$CODE1
	.ENABL	LSB
ACPFST::
	MOV	#NBNK,NBANKS	;SET HARDWARE CONFIGURATION OF BANKS
	MOV	#NBNK,NBNKS
	MOV	#NWDSLO,NWORDS	;AND WORDS PER BANK
	MOV	#NWDSHI,NWORDS+2
	MOV	#PFHDLN,R0	;GET HEADER RECORD LENGTH
	MOV	#NBKS,R1	;SET ADDRESS OF RECEIVING DATA BUFFER
	MOV	R3,R2		;POINT TO USER BUFFER ADDRESS DOUBLEWORD
	ADD	#I.PRM,R2
	CALL	GETBLK		;GET PARAMETER HEADER FROM USER BUFFER
	ADD	R0,2(R2)	;ADDRESS NEXT RECORD IN USER BUFFER
	CMP	#NBNK,NBKS	;CHECK PARAMETERS BANKS COUNT
	BNE	2$		;IF NOT EQUAL, RETURN ERROR STATUS
	CMP	#NWDSLO,NWDS	;CHECK PARAMETERS WORDS/BANK COUNT
	BNE	2$		;IF NOT EQUAL, RETURN ERROR STATUS
	CMP	#NWDSHI,NWDS+2
	BEQ	4$
2$:
	JMP	585$
4$:
	CMP	#2,NMVS		;TEST FOR MINIMUM NUMBER OF MOVES
	BGT	6$		;ERROR IF NOT ENOUGH
	CMP	#NMVMAX,NMVS	;TEST FOR MAXIMUM NUMBER OF DIMENSIONS
	BGE	8$		;CONTINUE IF NOT TO MANY
6$:
	JMP	586$
8$:
;
; CREATE A WINDOW BLOCK
;
	MOV	#W$SIZE,R1	;GET SIZE OF WINDOW
	CLR	R0		;CLEAR WINDOW ADDRESS
	SYSTEM	20$		;;ENTER SYSTEM STATE
	CALL	$ALOCB		;;ALLOCATE CORE BLOCK
	BCS	10$		;;IF CS - NO POOL
	MOV	R0,S.R0(SP)	;;RETURN BLOCK ADDRESS
10$:
	RETURN			;;EXIT SYSTEM STATE
20$:
	MOV	R0,R4		;SAVE WINDOW ADDRESS, IF ALLOCATED
	BNE	21$		;IF NE - CONTINUE
	JMP	580$		;ELSE, RETURN IE.NDR
21$:
;
; CREATE HARDWARE CONTROL PARAMETER BLOCK
;
	MOV	NMVS,R1		;GET MOVES FROM HEADER DATA
	MUL	#CTLENG,R1	;MULTIPLY BY BYTES PER MOVE
	CLR	R0		;CLEAR BLOCK ADDRESS
	SYSTEM	40$		;;ENTER SYSTEM STATE
	CALL	$ALOCB		;;ALLOCATE CORE BLOCK
	BCS	30$		;;IF CS - NO POOL
	MOV	R0,S.R0(SP)	;;RETURN BLOCK ADDRESS
	MOV	R1,S.R1(SP)	;;RETURN BLOCK LENGTH
30$:
	RETURN			;;EXIT SYSTEM STATE
40$:
	MOV	R0,W$AOUT(R4)	;SAVE OUTPUT BLOCK ADDRESS
	BNE	41$		;IF ALLOCATED, CONTINUE
	JMP	570$		;ELSE, RELEASE WINDOW AND RETURN IE.NDR
41$:
	MOV	R0,ADROUT	;SAVE HARDWARE PARAMETERS ADDRESS
	MOV	R1,W$OUTP(R4)	;SAVE ALLOCATED BLOCK LENGTH
;
; CLEAR HARDWARE CONTROL BLOCK
;
	ASR	R1		;CONVERT BYTE COUNT TO WORD COUNT
45$:
	CLR	(R0)+		;CLEAR A WORD
	SOB	R1,45$		;COUNT AND DO NEXT
;
; FILL IN WINDOW BLOCK CALLING SEQUENCE ADDRESSES
;
	MOV	R4,R0		;POINT TO BOTTOM OF WINDOW BLOCK
	MOV	R4,R1		;POINT AT CALLING SEQUENCE BLOCK
	ADD	#W$NPAR,R1
	MOV	#NPAR,(R1)+	;SET NUMBER OF PARAMETERS IN SEQUENCE
	MOV	#4,R2		;SET UP FOR NEXT FOUR PARAMETERS
50$:
	TST	(R0)+		;BUMP TO NEXT WINDOW ADDRESS
	MOV	R0,(R1)+	;STORE NEXT ADDRESS IN WINDOW BLOCK
	SOB	R2,50$		;COUNT AND DO NEXT PARAMETER
	MOV	#2,R2		;SET UP FOR NEXT TWO PARAMETERS
60$:
	TST	(R0)+		;BUMP TO NEXT WINDOW ADDRESS
	MOV	R0,(R1)+	;STORE NEXT ADDRESS IN WINDOW BLOCK
	TST	(R0)+		;LEAVE ROOM FOR INTEGER*4
	SOB	R2,60$
	MOV	I.PRM+6(R3),R0	;GET VCN, BUFFER PARAMETER FROM QIO
	MOV	R0,-(SP)	;SAVE IT FOR NOW
	BIC	#^C<377>,R0	;MASK VCN IN LOW BYTE
	MOV	R0,W$VCN(R4)	;SAVE VCN IN WINDOW
	MOV	(SP)+,R0	;RESTORE PARAMETER FROM STACK
	SWAB	R0		;BUFFERS, MOVES TO LOW BYTE
	BIC	#^C<17>,R0	;SAVE NUMBER OF BUFFERS
	MOV	R0,W$NBUF(R4)	;IN WINDOW
	MOV	W$ANBF(R4),ALOPAR+14 ;FILL ADDRESS OF NBUFF INTO ALLOST CALL
;
; STORE NUMBER OF WORDS IN STAGER BUFFER IN WINDOW AND STATUS BLOCK
;
	MOV	STWDS,R0
	MOV	R0,W$STBL(R4)
	MOV	R0,STSBSB+10
	MOV	STWDS+2,R0
	MOV	R0,W$STBL+2(R4)
	MOV	R0,STSBSB+12
;
; ALLOCATE STAGER MEMORY BUFFER SPACE
;
	MOV	R3,-(SP)	;SAVE IO PACKET ADDRESS
	MOV	R4,-(SP)	;SAVE WINDOW BLOCK ADDRESS
	MOV	R5,-(SP)	;SAVE UCB ADDRESS
	MOV	#ALOPAR,R5	;SET UP CALL TO ALLOCATE MEMORY
	CALL	ALLOST		;ALLOCATE VIRTUAL CHANNEL BUFFER
	MOV	(SP)+,R5	;RESTORE REGISTERS
	MOV	(SP)+,R4
	MOV	(SP)+,R3
;
; RETURN STAGER BUFFER STATUS TO USER PROGRAM
;
	MOV	R0,-(SP)	;SAVE ALLOCATION FUNCTION RESULT
	MOV	#LNSBSB,R0	;SET BYTE LENGTH OF TRANSFER
	MOV	#STSBSB,R1	;POINT TO STAGER BUFFER STATUS BLOCK
	MOV	R3,R2		;POINT TO USER BUFFER ADDRESS DOUBLEWORD
	ADD	#I.PRM+12,R2
	CALL	RTNBLK		;RETURN STATUS TO USER
;
; CHECK IF BUFFER SPACE ALLOCATED SUCCESSFULLY
;
	MOV	(SP)+,R0	;RESTORE ALLOCATION FUNCTION RESULT
	BPL	68$		;CONTINUE IF SUCCESSFUL
	JMP	530$		;ELSE, DELETE VIRTUAL CHANNEL STRUCTURES
68$:
	MOV	STSBSB,W$STBA(R4) ;STORE STAGER BUFFER ADDRESS IN WINDOW
	MOV	STSBSB+2,W$STBA+2(R4)
	MOV	NMVS,W$NMOV(R4)	;SAVE NUMBER OF MOVES
	MOV	VDIM,R1		;GET NUMBER OF VARIABLE DIMENSIONS FROM HEADER
	MOV	R1,W$VDIM(R4)	;STORE VARIBLE DIMENSION COUNT IN WINDOW
;
; CALCULATE SIZE OF SUPPLEMENTARY POOL REQUIRED
;
	MUL	#8.,R1		;COMPUTE BYTES PER DIMENSION * VDIM
	ADD	#10.,R1		;ADD ADDITIONAL BYTES PER MOVE
	MUL	NMVS,R1		;MULTIPLY BY NUMBER OF MOVES
;
; ALLOCATE SUPPLEMENTARY POOL BLOCK
;
	CLR	R0		;CLEAR BLOCK ADDRESS
	SYSTEM	100$		;;ENTER SYSTEM STATE
	CALL	$ALOCB		;;ALLOCATE CORE BLOCK
	BCS	90$		;;IF CS - NO POOL
	MOV	R0,S.R0(SP)	;;RETURN BLOCK ADDRESS
	MOV	R1,S.R1(SP)	;;RETURN BLOCK LENGTH
90$:
	RETURN			;;EXIT SYSTEM STATE
100$:
	MOV	R0,W$AREC(R4)	;SAVE SUPPLEMENTARY BLOCK ADDRESS, IF ALLOCATED
	BNE	101$		;CONTINUE, ELSE, RELEASE BLOCK
	JMP	520$		;WINDOW, RETURN IE.NDR
101$:
	MOV	R0,ADRREC	;SAVE RECSIZ ADDRESS
	MOV	R1,W$SUPP(R4)	;SAVE BLOCK LENGTH IN WINDOW
;
; COMPUTE STARTING ADDRESSES OF DATA STRUCTURES IN SUPPLEMENTARY POOL BLOCK
;
	MOV	NMVS,R1		;GET NUMBER OF MOVES
	ASL	R1		;MULTIPLY BY FOUR
	ASL	R1
	ADD	R1,R0		;LEAVE SPACE FOR RECSIZ VECTOR
	MOV	R0,W$AADR(R4)	;SET ADDRESS OF BASADR VECTOR
	MOV	R0,ADRADR	;SAVE BASADR ADDRESS
	ADD	R1,R0		;LEAVE SPACE FOR BASADR VECTOR
	MOV	R0,W$ACNT(R4)	;SET ADDRESS OF BASCNT VECTOR
	MOV	R0,ADRCNT	;SAVE BASCNT ADDRESS
	ASR	R1		;MULTIPLY MOVES BY TWO
	ADD	R1,R0		;LEAVE SPACE FOR BASCNT VECTOR
;
; INITIALIZE BASWGT, BASLEN, AND BASCUR ADDRESS PARAMETERS IF VDIM = 0
;
	MOV	#-1,R1
	MOV	R1,W$AWGT(R4)	;ASSUME NO VARIABLE DIMENSIONS
	MOV	R1,W$ALEN(R4)
	MOV	R1,W$ACUR(R4)
	MOV	R1,W$APKT(R4)	;INIT IO PACKET ADDRESS AS WELL
	TST	W$VDIM(R4)	;TEST IF ANY VARIABLE DIMENSIONS
	BEQ	110$		;IF ZERO - NONE, SKIP; ELSE, CONTINUE
;
; SETUP ADDRESSES FOR VDIM DEPENDENT VARIABLES IF VDIM NON-ZERO
;
	MOV	R0,W$AWGT(R4)	;SET ADDRESS OF BASWGT MATRIX
	MOV	R0,ADRWGT	;SAVE BASWGT ADDRESS
	MOV	NMVS,R1		;GET NUMBER OF MOVES
	MUL	VDIM,R1		;MULTIPLY BY MAXIMUM NUMBER OF VARIABLE DIMENSIONS
	ASL	R1		;MULTIPLY BY FOUR
	ASL	R1
	ADD	R1,R0		;LEAVE SPACE FOR BASWGT MATRIX
	MOV	R0,W$ALEN(R4)	;SET ADDRESS OF BASLEN MATRIX
	MOV	R0,ADRLEN	;SAVE BASLEN ADDRESS
	ASR	R1		;MULTIPLY NUMBER OF MOVES BY TWO
	ADD	R1,R0		;LEAVE SPACE FOR BASLEN MATRIX
	MOV	R0,W$ACUR(R4)	;SET ADDRESS OF BASCUR MATRIX
110$:
;
; DONE BUILDING WINDOW BLOCK, CLEAR SUPPLEMENTARY POOL BLOCK
;
	MOV	W$AREC(R4),R0	;GET ADDRESS OF SUPPLEMENTARY POOL BLOCK
	MOV	W$SUPP(R4),R1	;GET LENGTH OF BLOCK
	ASR	R1		;CONVERT BYTE COUNT TO WORD COUNT
120$:
	CLR	(R0)+		;CLEAR A WORD
	SOB	R1,120$		;COUNT AND DO NEXT
;
; GET CHANNEL PARAMETERS FROM USER BUFFER
;
	MOV	R3,-(SP)	;SAVE R3 FOR USE BELOW
	CLR	-(SP)		;CLEAR MOVE COUNTER
	MOV	NMVS,-(SP)	;GET NUMBER OF MOVES TO STACK
	MOV	R3,R2		;POINT AT BUFFER DOUBLEWORD ADDRESS
	ADD	#I.PRM,R2	;IN IO PACKET
130$:
	MOV	#ADRREC,R3	;POINT AT LIST OF ADDRESSES
	MOV	#DMHDLN,R0	;GET DATA MOVE HEADER PARAMETERS
	MOV	#MVN,R1		;TO LOCAL STORAGE
	CALL	GETBLK		;GET DATA BLOCK FROM USER BUFFER
	ADD	R0,2(R2)	;ADJUST DATA BUFFER ADDRESS
	INC	2(SP)		;INCREMENT MOVE COUNTER
	CMP	2(SP),MVN	;COMPARE MOVE NUMBERS
	BNE	522$		;IF NOT EQUAL, OUT OF ORDER ERROR
	CMP	#WARU,XFRWID	;CHECK IF ARRAY PORT WIDTH
	BEQ	140$		;IF EQUAL, OK TO CONTINUE
	CMP	#WDR11,XFRWID	;ELSE, CHECK IF HOST PORT WIDTH
	BNE	524$		;IF NOT EQUAL, PORT WIDTH ERROR
140$:
	MOV	(R3),R0		;GET ADDRESS OF RECSIZ IN POOL
	MOV	RCSIZE,(R0)+	;SAVE RECSIZ FOR THIS MOVE
	MOV	RCSIZE+2,(R0)+
	MOV	R0,(R3)+	;SAVE ADDRESS FOR NEXT MOVE
	MOV	(R3),R0		;GET ADDRESS OF BASADR IN POOL
	MOV	BASEAD,(R0)+	;SAVE BASADR FOR THIS MOVE
	MOV	BASEAD+2,(R0)+
	MOV	R0,(R3)+	;SAVE ADDRESS FOR NEXT MOVE
	MOV	(R3),R0		;GET ADDRESS OF BASCNT IN POOL
	MOV	BASECT,(R0)+	;SAVE BASCNT FOR THIS MOVE
	MOV	R0,(R3)+	;SAVE ADDRESS FOR NEXT MOVE
	MOV	#CTLENG,R0	;GET HARDWARE CONTROL PARAMETERS
	MOV	(R3),R1		;INTO POOL BLOCK
	CALL	GETBLK		;GET DATA BLOCK FROM USER BUFFER
	ADD	R0,2(R2)	;ADJUST DATA BUFFER ADDRESS
	ADD	R0,(R3)+	;ADJUST POOL ADDRESS FOR NEXT MOVE
	MOV	BASECT,R0	;GET VARIABLE DIMENSIONS FOR DATA MOVE
	ASL	R0		;GET 4 BYTES PER VARIABLE DIMENSION
	ASL	R0
	BEQ	150$		;IF NONE, ONLY ADJUST POOL ADDRESS
	MOV	(R3),R1		;ELSE, GET ADDRESS OF BASWGT IN POOL AND
	CALL	GETBLK		;GET DATA BLOCK FROM USER BUFFER
	ADD	R0,2(R2)	;ADJUST DATA BUFFER ADDRESS
150$:
	MOV	VDIM,R1		;LEAVE ROOM FOR VDIM 4 BYTE PARAMETERS IN POOL
	ASL	R1
	MOV	R1,-(SP)
	ASL	R1
	ADD	R1,(R3)+	;ADJUST POOL BLOCK ADDRESS FOR NEXT MOVE
	ASR	R0		;GET TWO BYTES PER VARIABLE DIMENSION
	BEQ	160$		;IF NONE, ONLY ADJUST POOL ADDRESS
	MOV	(R3),R1		;ELSE, GET ADDRESS OF BASLEN IN POOL AND
	CALL	GETBLK		;GET DATA BLOCK FROM USER BUFFER
	ADD	R0,2(R2)	;ADJUST DATA BUFFER ADDRESS
160$:
	ADD	(SP)+,(R3)	;ADJUST POOL BLOCK ADDRESS FOR NEXT MOVE
	DEC	(SP)		;COUNT AND DO NEXT MOVE
	BNE	130$
	ADD	#4,SP		;CLEAR STACK
	MOV	(SP)+,R3	;AND RESTORE R3
;
; LINK NEW WINDOW INTO PROCESS CHAIN
;
	MOV	@I.LN2(R3),R0	;LINK NEW WINDOW TO LIST
	BIC	#1,R0		;CLEAR LOCK BIT
	MOV	R0,(R4)		;POINT NEW BLOCK TO OLD
	BIC	#^C<1>,@I.LN2(R3) ;CLEAR OLD WINDOW ADDRESS
	BIS	R4,@I.LN2(R3)	;SET NEW WINDOW ADDRESS, WITH SAME LOCK BIT
	INC	@U.VCB(R5)	;INCREMENT PROCESS COUNT
;
; SET STATUS AND RETURN IO FUNCTION
;
	MOV	#IS.SUC&377,R0	;SET SUCCESSFUL STATUS
	BR	590$		;GO CLEAN UP FUNCTION
520$:
	MOV	#IE.NDR&377,R0	;SET NO POOL ERROR
	BR	540$		;CONTINUE IN COMMON CODE
522$:
	MOV	#-43.,R0	;SET MOVES OUT OF ORDER ERROR
	BR	526$
524$:
	MOV	#-44.,R0	;SET ILLEGAL PORT WIDTH ERROR
526$:
	ADD	#4,SP		;CLEAR STACK
	MOV	(SP)+,R3	;RESTORE R3
	MOV	R0,-(SP)	;SAVE ERROR CODE
	MOV	W$AREC(R4),R0	;RELEASE SUPPLEMENTARY POOL
	MOV	W$SUPP(R4),R1	;GET BLOCK LENGTH
	SYSTEM	528$		;;ENTER SYSTEM STATE
	CALLR	$DEACB		;;DEALLOCATE CORE BLOCK
528$:
	MOV	(SP)+,R0	;RESTORE ERROR CODE
530$:
	SWAB	R0		;GET ALGORITHM ERROR TO UPPER BYTE
	BIC	#377,R0		;CLEAR LOW BYTE
	BIS	#IE.ABO&377,R0	;SET ABORT ERROR CODE
540$:
	MOV	R0,-(SP)	;SAVE FINAL IO STATUS
	MOV	W$AOUT(R4),R0	;RELEASE OUTPUT PARAMETER BLOCK
	MOV	W$OUTP(R4),R1	;GET BLOCK LENGTH
	SYSTEM	550$		;;ENTER SYSTEM STATE
	CALLR	$DEACB		;;DEALLOCATE CORE BLOCK
550$:
	MOV	R4,R0		;RELEASE WINDOW BLOCK
	MOV	#W$SIZE,R1	;SET BLOCK LENGTH
	SYSTEM	560$		;;ENTER SYSTEM STATE
	CALLR	$DEACB		;;DEALLOCATE CORE BLOCK
560$:
	MOV	(SP)+,R0	;GET FINAL IO STATUS
	BR	590$		;RETURN IO FUNCTION
570$:
	MOV	R4,R0		;RELEASE THE WINDOW BLOCK
	MOV	#W$SIZE,R1	;SET BLOCK LENGTH
	SYSTEM	580$		;;ENTER SYSTEM STATE
	CALLR	$DEACB		;;DEALLOCATE CORE BLOCK
580$:
	MOV	#IE.NDR&377,R0	;SET IE.NDR ERROR
	BR	590$
585$:
	MOV	#<256.*-41.>!<IE.ABO&377>,R0 ;SET STAGER CONFIGURATION ERROR
	BR	590$
586$:
	MOV	#<256.*-42.>!<IE.ABO&377>,R0 ;SET ILLEGAL NUMBER OF MOVES ERROR
590$:
	CALLR	ACPDON		;FINISH PACKET AND RETURN
	.DSABL	LSB
	.END