.TITLE	CWD/PWD COMMANDS
	.IDENT	/V01/

;+
;
;    MODULE:	CWD
;    VERSION:	V01
;    BY:	LARRY BAKER
;		GARY MAXWELL
;		NATIONAL STRONG MOTION DATA CENTER
;		OFFICE OF EARTHQUAKE STUDIES
;		U.S. GEOLOGICAL SURVEY
;		345 MIDDLEFIELD ROAD
;	        MAIL STOP 77
;		MENLO PARK, CALIFORNIA 94025
;    DATE:	23-OCT-79
;
; CWD -- CHANGE WORKING DIRECTORY
; PWD -- PRINT  WORKING DIRECTORY
;
; SYNTAX:
;
;	>CWD
;	>CWD [DDNN:] [[G,M]]
;	>CWD [.:] [ [.] [,.] ]
;	>PWD
;
; ALL ARGUMENTS TO CWD ARE OPTIONAL (DEVICE-UNIT, GROUP-CODE, AND MEMBER-
; CODE) AND IF NOT SPECIFIED RESULT IN NO CHANGE FOR THE MISSING ARGUMENT.
; THE BRACKETS AROUND THE UIC ARE OPTIONAL.
;
; CWD WITH NO ARGUMENTS RESETS DEFAULT UIC AND SY0: ASSIGNMENT TO
; THE LOGIN ASSIGNMENTS.
;
; CWD WITH ONE OR MORE '.' SPECIFIERS IS USED TO RESET SY0: AND
; UIC ASSIGNMENTS TO LOGON SETTINGS. A '.' SPECIFIER IN ANY POSITION
; TELLS CWD NOT TO ALTER THAT PARTICULAR SETTING; E.G. 
;
;	>CWD .:,.
;
; WILL RESET THE GROUP CODE TO THE LOGON SETTING, LEAVING SY0:
; AND MEMBER ASSIGNMENTS UNALTERED. NO ALPHA-NUMERICS ARE ALLOWED
; IF A '.' SPECIFIER IS PRESENT ANYWHERE IN THE COMMAND.
;
; PWD PRINTS THE CURRENT WORKING DIRECTORY AND SPACE INFORMATION
; ON SY0:
;
; CWD PERFORMS AN ASN DDNN:=SY: AND/OR A SET /UIC=[G,M] ON BEHALF
; OF THE ISSUING TERMINAL. NOTE, HOWEVER, THAT CWD WILL NOT CHANGE
; THE LOGIN UIC FOR PRIVILEGED TERMINALS. THIS ALLOWS PRIVILEGED
; TERMINALS TO ISSUE CWD WITH NO ARGUMENTS TO REGAIN LOGIN SETTINGS.
; EXPERIENCE SEEMS TO INDICATE THAT THE SYSTEM IS NOT ADVERSELY 
; AFFECTED BY THIS FEATURE.
;
; IN ADDITION, IF DDNN: IS PROVIDED TO CWD, FREE SPACE INFORMATION
; IS PRINTED FOR SY:.
;
; VOLUME SPACE INFORMATION FOR CWD AND PWD INVOLVES CHECKING THAT
; SY0: IS MOUNTED (AND NOT MARKED FOR DISMOUNT) AND PUBLIC, ALONG
; WITH THE PERCENTAGE OF SPACE CURRENTLY ALLOCATED ON THE DEVICE
; AND THE TOTAL COUNT OF FREE BLOCKS (THIS INFORMATION COMES DIRECTLY
; FROM THE DEVICE UCB AND VCB, INVOLVING NO I/O)
;
; FOR ALL FORMS OF THE COMMAND, AND AFTER CHECKING VOLUME INFORMATION,
; SEARCH FOR THE ASSIGNED WORKING DIRECTORY IS MADE TO SEE IF THE
; UFD ACTUALLY EXISTS. IF IT DOES NOT EXIST, A WARNING MESSAGE IS
; PRINTED.
;
;-
	.PAGE
;+
; ASSEMBLY AND BUILD INFORMATION
;
; CWD USES TERMINAL UTILITY MACROS LOCATED IN LB:[1,1]USERMAC.MLB.
;
; TO ASSEMBLE ALL MODULES:
;
;	MAC>CWD,CWD=LB:[1,1]EXEMC/ML,USERMAC/ML,[200,200]RSXMC/PA:1,-
;	MAC>SY:[GGG,MMM]CWD
;
; THE MACRO COMMAND LINE FOR VLFREE AND CWDCSI MODULES IS EXACTLY
; THE SAME, WITH THE EXCEPTION OF THE MODULE NAMES.
;
; BUILD INSTRUCTIONS:
;
;	TKB>CWD/PR/-FP,MP:CWD/-SP=SY:CWD,VLFREE,CWDCSI
;	TKB>LB:[1,24]MCR/LB,[1,1]EXELIB/LB
;	TKB>LB:[1,54]RSX11M.STB/SS
;	TKB>/
;	ENTER OPTIONS:
;	TKB>STACK=64
;	TKB>UNITS=2
;	TKB>ASG=TI:1,SY:2
;	TKB>TASK=...CWD
;	TKB>PRI=150
;	TKB>//
;
; NOTE THAT CWD MUST BE INSTALLED TWICE:
;
;	INS CWD			! CWD TASK
;	INS CWD/TASK=...PWD	! PWD TASK
;-
	.PAGE
	.SBTTL	MACROS, DATA AREAS 

;+
; MACRO TO WAITFOR OR STOPFOR AN EVENT FLAG BASED ON THE
; DEFINITION OF P.STP
;-
	.MACRO	WAITFR	EFLAG
.IF	DF P.STP
	.MCALL	STSE$S
	STSE$S	EFLAG
.IFF
	.MCALL	WTSE$S
	WTSE$S	EFLAG
.ENDC
	.ENDM	WAITFR
 
; LOCAL SYMBOLS:
 
TILUN	==	1			; TI: UNIT NUMBER FOR MESSAGES
FRSEFN	==	1			; EVENT FLAG FOR TI: OUTPUT
NUMEFN	==	3			; NUMBER OF EVENT FLAGS TO USE
P.STP   ==	0			; ENABLE STOP FORS (V3.2)
TMPLUN	==	2			; TEMPORARY WORK LUN
SPACE	=	<' >			; BLANK CHAR
 
; FLAGS WORD BIT DEFINITIONS:
 
CW.ASN	== 100000			; ASN DDNN:=SY:
CW.SET	==  40000			; SET /UIC
CW.FRE	==  20000			; PIP SY:/FREE
CW.UFD	==  10000			; DIR SY:GGGNNN EXIST?
CW.PWD	==   4000			; PWD COMMAND GIVEN
CW.RSE	==   2000			; DO ASN =SY0:
 
 
	.MCALL	GMCR$,DIR$,EXIT$S,WTSE$S,SETF$S
	.MCALL	TCBDF$,UCBDF$,DCBDF$
	.MCALL	PMSGDF,PRINT,ERROR,PMSG
	.MCALL	FINIT$,FDBDF$,FSRSZ$,FDOP$A

	TCBDF$			; DEFINE TASK CONTROL BLK. OFFSETS
	UCBDF$			; DEFINE UCB OFFSETS
	DCBDF$			; DEFINE DCB OFFSETS

	.PSECT
 
	PMSGDF	,TILUN,FRSEFN,NUMEFN ; DEFINE TI: OUTPUT MACROS
	FSRSZ$	0		; REQUIRED FOR UFD SEARCH

DIRFDB::FDBDF$			; FDB FOR UFD SEARCH
	FDOP$A	TMPLUN
 
GETMCR::GMCR$			; MCR COMMAND LINE BUFFER
 
$FLAG::	.WORD	0		; CWD FLAGS
TIUCB::	.WORD	0		; SAVE AREA FOR TI: UCB ADDRESS
VLDCB::	.WORD	0		; VOLUME DCB FOR SY0:
VLUCB::	.WORD	0		; VOLUME UCB FOR SY0:

$UUIC::
$UMEM::	.BYTE	0		; DEFAULT MEMBER SAVE AREA
$UGRP::	.BYTE	0		; DEFAULT GROUP SAVE AREA

$LUIC::
$LMEM::	.BYTE	0		; LOGIN MEMBER SAVE AREA
$LGRP::	.BYTE	0		; LOGIN GROUP SAVE AREA

$DNAM::	.WORD	0		; CWDCSI PUTS DEVICE NAME HERE
$DNUM::	.WORD	0		; CWDCSI PUTS DEVICE NUMBER HERE

DTDSC::	.WORD	0		; LENGTH OF DEVICE NAME (FILLED IN)
	.WORD	PWDBLK		; ADDRESS OF PHYSICAL DEVICE NAME
	.WORD	DUICLN		; LENGTH OF DIRECTORY UIC
	.WORD	DIRUIC		; ADDRESS OF DIRECTORY UIC
	.WORD	DFILEN		; LENGTH OF FILE SPEC
	.WORD	DIRFIL		; ADDRESS OF DIRECTORY FILE

WKBUF:	.BLKB	8.		; FIRST WORK BUFFER
WKBUF1:	.BLKW	5.		; SECOND WORK BUFFER

	.ENABL	LC
	.NLIST	BEX
 
DIRUIC::.ASCII	/[0,0]/		; SPECS FOR UFD SEARCH
DUICLN = .-DIRUIC
DIRFIL::.ASCII	/000000.DIR;1/
DFILEN = .-DIRFIL

	.EVEN
PWDMSG::.ASCII	/Working directory:  / ; START OF MESSAGE (DO NOT OVERWRITE)
PWDBLK::.BLKW	8.		; AREA TO BUILD WORKING DIRECTORY STRING
NDMSG::	.ASCII	<7>/** Warning: /
NDSTF::	.BLKB	14.
NDADD::	.ASCIZ	/ does not exist! **/
	.LIST	BEX
	.PAGE
	.SBTTL	MAIN LINE CODE

;+
; THE MAIN LINE CODE OF CWD CALLS THE FOLLOWING EXTERNAL ROUTINES:
;
;	CWDCSI - CWD/PWD COMMAND LINE PARSER
;	VLFREE - ROUTINE TO CALCULATE FREE SPACE ON SY:
;	$LOCKL
;	$UNLKL - SYSTEM LIST ROUTINES (FROM MCR.OLB)
;	$FDLOG - UCB SEARCH ROUTINE (FROM MCR.OLB)
;	$SWSTK
;
; IN ADDITION, ROUTINES FROM THE SYSTEM LIBRARY AND FILE CONTROL
; SERVICES ARE USED.
;-

	.ENABL	LSB
 
	.PSECT	CWD,RO
 
CWD::
	DIR$	#GETMCR		; GET COMMAND LINE
	BCC	10$
	ERROR	< CWD -- Get command line failure>,,CWD

10$:	MOV	$TKTCB,R0	; POINT TO OUR TCB
	MOV	T.UCB(R0),R0	; POINT TO TI: UCB
	MOV	R0,TIUCB	; SAVE IT FOR LATER
	MOV	U.UIC(R0),$UUIC	; SAVE CURRENT DEFAULT UIC
	MOV	U.LUIC(R0),$LUIC ; SAVE LOGON UIC
	MOV	#GETMCR+G.MCRB,R4 ; POINT TO COMMAND LINE
	MOV	$DSW,R3		; GET BYTE COUNT
	CALL	CWDCSI		; PARSE COMMAND (NO RETURN ON ERROR)

	CALL	$LOCKL		; LOCK SYSTEM LISTS
	BIT	#CW.RSE,$FLAG	; DO WE REMOVE SY0: ASN?
	BEQ	20$		; NO, SKIP IT
	CALL	DEASSN		; ELSE DO 'ASN =SY0:'

20$:	MOV	#WKBUF,R0	; POINT TO WORK BUFFER
	MOV	R0,R4		; COPY ADDRESS
	MOV	$DNAM,(R0)+	; STUFF DEVICE NAME FROM COMMAND
	MOV	$DNUM,R1	; GET DEVICE NUMBER
	CLR	R2		; NO LEADING ZEROES
	CALL	$CBTMG		; CONVERT IT
	MOVB	#<':>,(R0)	; STUFF TRAILING COLON
	MOV	R4,R0		; COPY SAVED POINTER
	MOV	#WKBUF1,R3	; POINT TO PARAMETER AREA
	CALL	$FDLOG		; SEARCH DEVICE TABLES
	BCC	30$		; FOUND IT - SKIP AHEAD
	ERROR	<$CWD -- Device is not in system>,ERREX,CWD,0
	.PAGE
30$:	MOV	D.NAM(R2),(R3)	; STORE PHYSICAL DEVICE NAME
	MOVB	U.UNIT(R1),2(R3) ; STORE UNIT NUMBER
	CMP	U.RED(R1),R1	; IS THIS DEVICE REDIRECTED?
	BEQ	300$		; NO, SKIP AHEAD
	MOV	U.RED(R1),R1	; ELSE POINT TO REDIRECTED UCB
	MOV	U.DCB(R1),R2	; POINT TO UNIT'S DCB
	BR	30$		; CHECK FOR FURTHER REDIRECTS

300$:	MOV	R1,VLUCB	; SAVE DEVICE UCB POINTER
	MOV	R2,VLDCB	; SAVE DEVICE DCB POINTER
	MOV	#PWDBLK,R0	; POINT TO MESSAGE STUFF AREA
	MOV	(R3)+,(R0)+	; MOVE PHYSICAL DEVICE NAME
	MOV	(R3),R1		; GET PHYSICAL DEVICE NUMBER
	CLR	R2		; NO LEADING ZEROES
	CALL	$CBTMG		; CONVERT TO ASCII
	MOVB	#<':>,(R0)+	; STUFF TRAILING COLON
	MOV	R0,R1		; COPY ADDRESS
	SUB	#PWDBLK,R1	; GET LENGTH OF DEVICE FRAGMENT
	MOV	R1,DTDSC	; SAVE IN DATASET DESCRIPTOR
	MOV	R0,R2		; COPY CURRENT POINTER
	MOV	$UUIC,R3	; GET BINARY DEFAULT UIC
	CLR	R4		; SUPPRESS ZEROES FOR UIC
	CALL	.PPASC		; CONVERT TO [GGG,MMM]
	CLRB	(R2)		; MARK END OF STRING
	BIT	#<CW.PWD!CW.RSE>,$FLAG ; PRINT WORKING DIRECTORY?
	BEQ	40$		; NO, SKIP IT
	MOV	R2,R1		; ELSE COPY END ADDRESS
	MOV	#PWDMSG,R0	; POINT TO START OF MESSAGE
	SUB	R0,R1		; CALCULATE LENGTH
	PMSG	,,#SPACE,0	; AND PRINT IT (NO WAIT)

40$:	BIT	#CW.SET,$FLAG	; DO WE DO A 'SET /UIC'?
	BEQ	50$		; NO, SKIP AHEAD
	MOV	TIUCB,R0	; ELSE GRAB TI: UCB POINTER
	CALL	$SWSTK,50$	; GO TO SYSTEM STATE
	MOV	$UUIC,U.UIC(R0)	;; RESET DEFAULT UIC
	RETURN			;; RETURN TO USER STATE

50$:	BIT	#CW.ASN,$FLAG	; DO WE DO A 'ASN DDN:=SY0:'?
	BEQ	60$		; NO, SKIP AHEAD
	CALL	ASSIGN		; ELSE DO IT NOW

60$:	CALL	VLFREE		; CHECK VOLUME - OPTIONALLY SHOW
				;  FREE SPACE (NO RETURN ON ERROR)

120$:	BIT	#CW.UFD,$FLAG	; LOOK FOR UFD ON SY0:?
	BEQ	CWDEX		; NO, GO EXIT
	CALL	$UNLKL		; UNLOCK LISTS BEFORE STARTING
	CALL	DRLOOK		; GO DO THE SEARCH

CWDEX::
ERREX::
	CALL	$UNLKL		; UNLOCK LISTS (EXTRA CALL OK)
	TST	P.CEFN		; ANY I/O DONE?
	BEQ	130$		; NO, JUST EXIT
	WAITFR	P.CEFN		; WAIT FOR I/O COMPLETION
130$:	EXIT$S			; AND EXIT TO MCR

	.DSABL	LSB
	.PAGE
	.SBTTL	LOOK FOR UFD ON SY0:
	.ENABL	LSB

;+
; SUBROUTINE DRLOOK - LOOK FOR UFD ON (NEW) SY0: DEVICE
;
; PRINTS WARNING MESSAGE IF DIRECTORY CANNOT BE FOUND
;-

DRLOOK::
	FINIT$			; INITIALIZE FILE SYSTEM
	MOV	#DTDSC,R3	; POINT TO DATASET DESCRIPTOR
	MOV	12(R3),R0	; GET POINTER TO UFD FILENAME
	MOVB	$UGRP,R1	; GET GROUP CODE
	MOV	R0,R2		; WANT LEADING ZEROES
	CALL	$CBTMG		; CONVERT INTO FILESPEC
	MOVB	$UMEM,R1	; GET MEMBER CODE
	MOV	R0,R2		; WANT LEADING ZEROES AGAIN
	CALL	$CBTMG		; AND CONVERT

	MOV	#DIRFDB,R0	; POINT TO FDB
	MOV	R0,R1		; COPY ADDRESS
	ADD	#F.FNB,R1	; POINT TO FILENAME BLOCK
	MOV	R3,R2		; COPY DATASET DESCRIPTOR PTR
	CLR	R3		; NO DEFAULT FILENAME BLOCK
	CALL	.PARSE		; PARSE FILENAME
	BCS	PSERR		; PARSING ERROR
	CALL	.FIND		; LOOK FOR DIRECTORY
	BCC	DRLRET		; IF OK, JUST RETURN

	MOV	#NDSTF,R1	; POINT TO STUFF AREA
	MOV	#PWDBLK,R0	; POINT TO PWD 'DDN:[GGG,MMM]'
10$:	MOVB	(R0)+,(R1)+	; COPY BYTE OF STRING
	BNE	10$		; DO UNTIL DONE
	DEC	R1		; POINT BACK TO NULL BYTE
	MOV	#NDADD,R0	; POINT TO REST OF MESSAGE
20$:	MOVB	(R0)+,(R1)+	; COPY A BYTE
	BNE	20$		; DO UNTIL DONE
	DEC	R1		; POINT BACK TO NULL BYTE
	MOV	#NDMSG,R0	; POINT TO START OF MESSAGE
	SUB	R0,R1		; CALCULATE LENGTH
	PMSG	,,#SPACE,0	; AND PRINT IT

DRLRET:	RETURN			; RETURN TO CALLER
PSERR:	ERROR	< CWD -- .PARSE error on directory>,ERREX,CWD,0

	.DSABL	LSB
	.PAGE
	.SBTTL	ASSIGN/DEASSIGN SY: DEVICE
	.ENABL	LSB

;+
; ASSIGN - ASSIGN DEVICE SY0: TO DEVICE WHOSE UCB ADDRESS
; IS CURRENTLY STORED IN VLUCB.
;
; INPUTS: NONE.
; OUTPUTS: NONE.
;
; A DIAGNOSTIC IS PRINTED IF INSUFFICIENT POOL SPACE PREVENTED
; ALLOCATION OF A LOGICAL CONTROL BLOCK.
;-

ASSIGN::
	MOV	#<"SY>,R2	; LOOK FOR SY0: ENTRY
	CLR	R3		; UNIT #0
	MOV	VLUCB,R4	; GET UCB OF NEW DEVICE
	CALL	LUNSRC		; SEARCH FOR IT
	BCS	20$		; NOT FOUND - GO ALLOCATE NEW ONE

;+
; JUST CHANGE ASSIGNMENT FROM CURRENT PHYSICAL DEVICE TO
; NEW DEVICE BY CHANGING THE L.ASG ENTRY IN THE LCB BLOCK
;-

	CALL	$SWSTK,ASSRET	; GO TO SYSTEM STATE
	MOV	R4,L.ASG(R0)	;; RESET UCB POINTER
	RETURN			;; RETURN TO USER STATE
				;;  AND RETURN FROM ASSIGN

20$:	CALL	ALLCB		; TRY ALLOCATING NEW LCB
	BCC	ASSRET		; SUCCESSFUL - GO RETURN
	PRINT	< CWD -- Insufficient pool to assign SY0:>,CWD,0

ASSRET:	RETURN			; RETURN TO CALLER

;+
; DEASSN - DEASSIGN LOGICAL ASSIGNMENT SY0:
;
; INPUTS: NONE.
; OUTPUTS: NONE.
;
; DEASSN LOOKS FOR A LCB WITH THE LOGICAL NAME SY0:. IF FOUND,
; IT IS REMOVED AND DEALLOCATED FROM POOL; OTHERWISE, NO ACTION
; IS TAKEN.
;-

DEASSN::
	MOV	#<"SY>,R2	; LOOK FOR SY0:
	CLR	R3		; UNIT #0
	CALL	LUNSRC		; SEARCH FOR IT
	BCS	50$		; NOT FOUND - JUST RETURN
	CALL	DEALUN		; ELSE DEALLOCATE IT
50$:	RETURN
	.DSABL	LSB
	.PAGE
	.SBTTL	ASSIGN/DEASSIGN SUPPORT ROUTINES

;+
; SUBROUTINE LUNSRC - LOOK FOR A LCB ENTRY FOR A GIVEN
; LOGICAL DEVICE NAME AND UNIT NO.
;
; INPUTS:
;	R2: ASCII NAME OF LOGICAL UNIT NO.
;	R3: LOGICAL UNIT NUMBER (BINARY)
;       TIUCB: MUST BE PREINITIALIZED WITH UCB ADDRESS OF
;	       UNIT TI: 
; OUTPUTS:
;	CARRY SET: ENTRY NOT FOUND
;	CARRY CLEAR: ENTRY FOUND -
;		R0: POINTS TO LCB ENTRY THAT MATCHES
;		R1: POINTS TO LCB ENTRY PRECEDING MATCHED ENTRY
;
; NOTES:
;   	LUNSRC ONLY SEARCHES THE LOCAL LCB ENTRIES FOR THE
;	REQUESTED TERMINAL.
;
;	LUNSRC DOES NOT REQUEST A LOCK ON THE SYSTEM LISTS,
;	AND PERFORMS NO WRITES INTO SYSTEM TABLES.
;
; REGISTERS R2 AND R3 ARE PRESERVED.
; REGISTERS R4 AND R5 ARE UNALTERED.
;-
LUNSRC::
	MOV	#$LOGHD,R0	; ADDRESS OF LCB LIST POINTER
10$:	MOV	R0,R1		; POINT TO PREVIOUS LCB
	MOV	L.LNK(R1),R0	; POINT TO NEXT LCB
	BEQ	LUNNF		; END OF LIST - NOT FOUND
	TSTB	L.TYPE(R0)	; STILL LOOKING AT LOCALS?
	BLE	LUNNF		; NO, SEARCH FAILS
	CMP	L.NAM(R0),R2	; DO NAMES MATCH?
	BNE	10$		; NO, GO TO NEXT ENTRY
	CMPB	L.UNIT(R0),R3	; YES - SAME UNIT NO.?
	BNE	10$		; NO, TRY NEXT ENTRY
	CMP	L.UCB(R0),TIUCB ; SAME TERMINAL?
	BNE	10$		; NO, TRY NEXT ENTRY
	CLC			; ELSE WE FOUND IT!
	BR	LUNRET		; RETURN
LUNNF:	SEC			; SET FAILURE
LUNRET:	RETURN			; RETURN

;+
; SUBROUTINE DEALUN - REMOVE LCB ENTRY FROM LIST
;
; DEALUN DETACHES AND DEALLOCATES THE LOGICAL UNIT ENTRY
; SPECIFIED UPON INPUT. NO CHECKS ARE MADE ON THE VALIDITY
; OR THE ENTRY OR THE INPUTS GIVEN!
;
; INPUTS:
;	R0: POINTS TO THE LCB ENTRY TO BE DEALLOCATED
;	R1: POINTS TO LCB PRECEDING THE LCB TO BE DEALLOCATED
;	    IN THE LCB LIST. IF THE LCB TO BE DEALLOCATED
;	    IS THE FIRST IN THE LIST, R1 MUST THEN POINT
;	    TO $LOGHD.
; OUTPUTS: NONE.
;
; ROUTINES CALLED: $SWSTK, $DEACB
;
; REGISTERS R0 AND R1 ARE DESTROYED.
;-

DEALUN::
	CALL	$SWSTK,10$	; GO TO SYSTEM STATE
	MOV	L.LNK(R0),L.LNK(R1) ;; RESET LINKAGES
	MOV	#L.LGTH,R1	;; GET LENGTH OF LCB BLOCK
	CALLR	$DEACB		;; DEALLOCATE THE SPACE
10$:				; REFERENCE LABEL
	RETURN			; RETURN TO CALLER

;+
; ALLCB - ALLOCATE LOCAL LCB ENTRY
;
; CREATE AN LCB BLOCK AND ENTER IT AT THE TOP OF THE LCB
; LIST (ALWAYS A LOCAL ASSIGNMENT).
;
; INPUTS:
;	R2 - ASCII NAME OF LOGICAL DEVICE
;	R3 - LOGICAL DEVICE NUMBER
;	R4 - UCB ADDRESS OF PHYSICAL UNIT BEING ASSIGNED TO
;	TIUCB - UCB ADDRESS OF DEVICE TI:
; OUTPUTS: 
;	CARRY SET - CORE ALLOCATION FAILURE
;	CARRY CLEAR - SUCCESSFUL RETURN
;
; NOTE: NO CHECKS ARE PERFORMED ON VALIDITY OF EITHER UCB
;	ADDRESSES FOR TI: OR THE PHYSICAL ASSIGNMENT UNIT.
;
; ROUTINES CALLED: $SWSTK, $ALOCB
;
; ALL REGISTERS PRESERVED.
;-

ALLCB::
	MOV	R0,-(SP)	; SAVE TWO REGISTERS
	MOV	R1,-(SP)
	CALL	$SWSTK,30$	; SWITCH TO SYSTEM STATE
	MOV	#L.LGTH,R1	;; GET LENGTH TO ALLOCATE
	MOV	R2,-(SP)	;; SAVE R2 (MASHED BY $ALOCB)
	CALL	$ALOCB		;; TRY TO GET CORE BLOCK
	MOV	(SP)+,R2	;; RECOVER AFTER CALL
	BCS	29$		;; BAIL OUT IF NO POOL
	MOV	$LOGHD,L.LNK(R0) ;; LINK TO NEXT LCB
	MOV	R2,L.NAM(R0)	;; SET LOGICAL NAME
	MOVB	R3,L.UNIT(R0)	;; SET LOGICAL UNIT NO.
	MOVB	#1,L.TYPE(R0)	;; SET AS LOCAL ASSIGNMENT
	MOV	TIUCB,L.UCB(R0)	;; SET TI: UCB ENTRY
	MOV	R4,L.ASG(R0)	;; SET PHYSICAL DEVICE UCB
	MOV	R0,$LOGHD	;; MAKE OUR ENTRY THE FIRST
	BR	290$		;; AND GET BACK TO USER STATE

29$:	CLR	R0		;; INDICATE FAILURE
290$:	RETURN			;; RETURN TO USER STATE

30$:				; REFERENCE LABEL
	TST	R0		; WAS ALLOCATION SUCCESSFUL?
	BNE	ALRET		; YES, GO RETURN (CARRY CLEAR)
	SEC			; ELSE INDICATE FAILURE

ALRET:	MOV	(SP)+,R1	; RECOVER REGISTERS
	MOV	(SP)+,R0
	RETURN			; AND RETURN
 
	.END	CWD