.TITLE  CDASGN
	.IDENT	/V002/
;
;  AUTHORS:
;	VICKY WHITE, MARK PYATETSKY
;	FERMI NATIONAL ACCELERATOR LABORATORY
;	BATAVIA, IL 60510
;
;  UPDATE HISTORY:
;  V01  - JUN0282 - VW - ORIGINAL VERSION
;  V02  - JULY1982- MP - RT-11 ADDED
;
; ++
;
;  FUNCTION:
;  ROUTINE TO ASSIGN A LOGICAL UNIT OR CHANNEL TO A COMMUNICATIONS
;  DEVICE PHYSICAL UNIT
;  DIFFERENT VERSIONS ARE NEEDED FOR RSX AND RT11 OPERATING SYSTEMS
;
;  FOR RSX: THE LOGICAL UNIT NUMBER TO BE USED IS PASSED AS AN ARGUMENT
; 
;  FOR RT11: THE CHANNEL NUMBER WILL BE RETURNED IN THE FIRST ARGUMENT
;  -------
;
;  CALLING SEQUENCE:
;  ----------------
;
;  CALL CDASGN(CHAN,DEV,UNIT,STAT)
;
;  MACROS:
;  ------
        .MCALL CHT$DF,PUSH,POP,ERR$DF,CALL,RETURN,RT$RSX
	RT$RSX			;DEFINE VERSION: RT-11 OR RSX-11M
	CHT$DF			;DEFINE CHANNEL TABLE OFFSETS
	ERR$DF			;DEFINE ERROR RETURNS
;
;  GLOBALS:
;  -------
	.GLOBL	CDASGN		;ROUTINE ENTRY POINT
	.GLOBL	$ADDCH		;ROUTINE CALLED TO ADD CHANNEL TABLE ENTRY
	.PAGE
;
;  INPUTS TO ROUTINE 
;  -----------------
;	R5 IS THE ADDRESS OF A FORTRAN ARGUMENT LIST
;
;  OUTPUTS
;  -------
;	STATUS IS RETURNED IN STATUS ARGUMENT 
;       IF THE NUMBER OF ARGUMENTS IS INCORRECT AN ERROR STATUS
;       IS RETURNED IN THE COMMON /CDERR/
;  **NOTE** THIS ROUTINE MAY ONLY BE CALLED BEFORE ANY OTHER
;  DATA TRANSFER CALLS TO CDPACK ARE MADE. THIS IS TO ENSURE
;  THAT THE PACKAGE MAY BE CALLED FROM AST/COMPLETION LEVEL
;  CODE SECURELY, WHICH COULD NOT BE DONE IF THERE WAS A DANGER
;  OF AST/COMPLETION LEVEL CODE INTERRUPTING A CDASGN CALL.
;  THIS IS BECAUSE THE CHANNEL TABLE IS IN THE SAME COMMON AS
;  THE TABLE OF MESSAGE BLOCKS AND SO SHARING THE SAME SPACE.
;
;
;
;
;  COMMON AREA CDCM82
;  ------------------
	$CM82			;DEFINE PSECT CDCM82
;
;  COMMON FOR ERROR IN NO. OF ARGUMENTS
;
	.PSECT	CDERR,RW,GBL,D,OVR,REL
CDERR:  .BLKW
	.PSECT
CDASGN::
	.IF	NDF	RT11
;
	.MCALL	ALUN$S
;
	.IFF
;
	.MCALL	.LOOKUP,.QSET,CDI$DF
	.GLOBL	IRAD50,IGETC,IFETCH
	CDI$DF
	.IFTF
;
	PUSH	<R1,R2,R3,R4,R5>	;SAVE REGISTERS
        CMPB    (R5),#4                 ;CORRECT NUMBER OF ARGS
	BGE	10$			;BRANCH IF ENOUGH
	JMP	XARGS			;ELSE EXIT
;
10$:
        TST     (R5)+                   ;POINT TO PARAMETERS ADDRESSES
	MOV	@(R5)+,R1		;LUN NUMBER
	MOV	@(R5)+,R2		;DEVICE NAME TO ASSIGN TO
	MOV	@(R5)+,R3		;UNIT NUMBER OF DEVICE TO ASSIGN TO
	MOV	(R5),R4			;ADDRESS FOR RETURN STATUS
	TST	CD.NUM			;ANY MESSAGE BLOCK USED?
	BEQ	11$			;OK IF NO CD CALL MADE YET
	JMP	XINI			;ELSE DONT ALLOW CDASGN
11$:
;
	.IFF
;
	TST	-(R5)			;GET
	TST	-(R5)			;   POINTER TO
	TST	-(R5)			;	CHAN.
	PUSH	<R2,R3,R4,R5>		;SAVE UNIT, STATUS CHAN. POINTERS
;
;  CONVERT DEV-NAME FROM ASCII INTO RAD50
;
;		N = IRAD50(ICNT,INPUT,OUTPUT)
;
	MOV	#3,AREA			;NO OF ARGUMENTS
	MOV	#<AREA+10>,AREA+2	;ADDR OF NO OF CHAR - ASCII
	MOV	#<AREA+12>,AREA+4	;ADDR OF START OF ASCII STRING
	MOV	#<AREA+14>,AREA+6	;ADDR OF START OF RAD50 STRING
	MOV	#2,AREA+10		;NO OF INPUT ASCII CHAR (ICNT)
	MOV	R2,AREA+12		;INPUT ASCII STRING
	MOV	#AREA,R5		;ADDR OF ARG LIST
	CALL	IRAD50			;CALL CONVERSION ROUTINE
;
;  GET CHANNEL NUMBER
;
	CALL	IGETC			;GET FREE CHANNEL
	POP	<R5,R4,R3,R2>
	TST	R0			;IS FREE CHANNEL AVAILABLE?
	BLT	XCHAN			;IF LT 0  NO CHAN. AVAIL.
	MOV	R0,@(R5)		;RETURN CHAN. NO. IN ARGUMENT
	MOV	R0,R1			;       AND IN R1
	MOV	R0,<AREA+6>		;SAVE CHANNEL NO.
;
	.IFTF
;
	CALL	$ADDCH			;ADD CHANNEL TABLE ENTRY
	TST	R5			;GOT A CHANNEL TABLE ENTRY?
	BEQ	XSPAC			;BRANCH IF NO SPACE FOR ONE
;
;  CHANNEL TABLE ENTRY EITHER ADDED OR ALREADY EXISTED
;
	BCS	XDUP			;IF ALREADY ASSIGNED 
;
	.IFT
;
	ALUN$S	R1,R2,R3		;ASSIGN CHANNEL TO DEVICE
	BCC	20$			;BRANCH IF NO ERROR
	ADD	#CH.SIZ,CD.CHN		;ELSE REMOVE ADDED CH.TAB ENTRY
20$:	MOV	$DSW,(R4)		;SET ERROR STATUS RETURN
	BR	XIT
;
	.IFF
;
;
;  BUILD DEV. BLOCK (DBLK) FOR .FETCH AND .LOOKUP
;
	BIC	#^C<7>,R3		;UNIT NO MUST BE LESS THAN 8
	ADD	R3,AREA+14		;FORM THE START OF
	ADD	#36,AREA+14		;  'DBLK' IN RAD50
	CLR	AREA+16			;CONTINUE
	CLR	AREA+20			;	BUILDING
	CLR	AREA+22			;	      'DBLK'
;
;  FETCH THE DRIVER AND GET ADDITIONAL QUEUE ELEMENTS
;
	TST	CD.QFG
	BNE	1000$			;IF NE  .QSET HAS BEEN CALLED
	MOV	#1,AREA			;NO OF ARGUMENTS
	MOV	#<AREA+14>,AREA+2	;ADDR OF 'DBLK'
	MOV	#AREA,R5		;ADDR OF ARG LIST
	CALL	IFETCH			;FETCH THE DRIVER
	TST	R0			;IS FETCH OK?
	BNE	16$			;IF NE  NO
	.QSET	#CD.QUE,#CD.QEN		;ALLOCATE ADDITIONAL QUEUE ELEMENTS
	MOV	#1,CD.QFG		;SET FLAG TO 1
1000$:
;
;  OPEN CHANNEL
;
	MOV	<AREA+6>,R1		;RESTORE CHANNEL NO.
	MOV	#<AREA+14>,R5		;GET ADDR OF 'DBLK'
	.LOOKUP	#AREA,R1,R5
	BCC	20$			;BRANCH IF NO ERROR
16$:
	ADD	#CH.SIZ,CD.CHN		;ELSE REMOVE ADDED CH.TAB ENTRY
	MOV	#E.LKUP,(R4)		;SET ERROR: NO CHAN. AVAILABLE
	BR	XIT
20$:	BR	XDUP			;SET SUCCESS AND EXIT
;
AREA:	.BLKW	15			;AREA FOR ARGUMENT LISTS
XCHAN:
	MOV	R0,(R4)			;'IGETC' DOESN'T GIVE FREE CHAN.
	BR	XIT
;
	.IFTF
;
;  TRANSFER CALLS TO CDPACK ROUTINES ALREADY MADE
;
XINI:	MOV	#ER.INI,(R4)		;SET INITIALISATION ERROR
	BR	XIT
;
;  NO SPACE TO ADD NEW CHANNEL TABLE ENTRY
;
XSPAC:	MOV	#ER.SPC,(R4)		;SET ERROR RETURN STATUS
	BR	XIT
;
;  CHANNEL TABLE ENTRY ALREADY EXISTS - NO NEW ASSIGN DONE
;
XDUP:	MOV	#ER.SUC,(R4)		;SET SUCCESS
	BR	XIT
;
;  INCORRECT NUMBER OF ARGUMENTS
;
XARGS:	MOV	#ER.ARG,CDERR		;SET IN ERROR COMMON
;
XIT:
	POP	<R5,R4,R3,R2,R1>
	RETURN
.ENDC
	.END