.TITLE	LABEL.MAC                                                       ;GWA001
	.IDENT	/051785/                                                        ;GWA001
	.NLIST	BEX
;+------------------------------------------------------
;
;	DISPLAYS AND CHANGES DISK LABELS, COMPATABLE WITH
;	THE INDIRECT COMMAND FILE PROCESSOR.
;
;	TO READ AN EXISTING LABEL:
;	>LAB DDU:
;		CREATES A ONE RECORD FILE NAMED LABEL.CMD;1
;		WITH THE FOLLOWING TEXT:
;		.ENABLE GLOBAL
;		.SETS $LABEL "------"
;	EXAMPLE:
;	LAB DB1:
;	@LABEL
;;;	STRING $LABEL NOW CONTAINS LABEL OF THE DISK ON DB1:
;
;	TO INSERT A NEW LABEL:
;	>LAB DDU:NEWLABEL
;		FILE LABEL.CMD;1 NOT ALTERED
;
;	BY NATIONAL DATA SYSTEMS - JACK HARVEY
;	- ADAPTED FROM DECUS PROGRAM PUBLISHED IN
;	  NOVEMBER, 1978 ISSUE OF MULTI-TASKER,
;	  BY KAARLE KAILA, NOKIA ELECTRONICS,
;		HELSINKI, FINLAND.
;
;-------------------------------------------------------
;
; 031783 KAR IP - MODIFIED TO EMIT STATUS
;
; 051785 GWA001	- Moved to RSX-11M+ and changed file name from LAB.TSK          ;GWA001
;		  to LABEL.TSK, installed as ...LAB.                            ;GWA001
;		- Fixed so that we now accept DD: as well as DDU:.              ;GWA001
;		  Note that DDUU: still doesn't work.                           ;GWA001
;                                                                               ;GWA001
; 010486 RLH001 - Deleted insertion of new label code.
;                                                                               ;GWA001
	.MCALL	DIR$ GMCR$ QIOW$S EXST$S ALUN$S WSIG$S QIOW$ CALL
	.MCALL	FDBDF$ FDOP$A NMBLK$ OPEN$W PUT$ CLOSE$
	.MCALL	FSRSZ$ FDAT$A

	.MACRO	MSG	A,B,?C,?D
	MOV	#BUF,R0
	MOV	#A,R1
	MOV	#ST,R2
	CALL	$EDMSG
	MOV	R1,B+Q.IOPL+2
C:	DIR$	#B
	BCC	D
	CMPB	#IE.UPN&377,$DSW
	BNE	D
	WSIG$S
	BR	C
D:
	.ENDM	MSG

	FSRSZ$	1
	.PSECT	LAB
FDB:	FDBDF$				;FILE FDB
	FDAT$A	R.VAR FD.CR
	FDOP$A	2,,DEFALT

DEFALT:	NMBLK$	LABEL CMD 1		;LABEL.CMD;1

GETMCR:	GMCR$				;MCR COMMAND LINE
ST:	.BLKW	2			;STATUS BLOCK
BUF:	.BLKB	512.			;HOME BLOCK BUFFER

DEVICE:	.BLKB	2
UNIT:	.WORD	0

ENGLOB:	.ASCII	/.ENABLE GLOBAL/
ENSIZ=	.-ENGLOB
TEXT:	.ASCII	/.SETS $LABEL "/
LABEL:	.BLKB	13.			;RECORD FOR LABEL.CMD;1

ERR:	.ASCII	/LAB -- Error in command line - no action/                     ;GWA001
ERL=	.-ERR                                                                   ;GWA001
DRERR:	.ASCIZ	/LAB -- Error while reading disk, IOSB = %P/                   ;GWA001
DWERR:	.ASCIZ	/LAB -- Error while writing disk, IOSB = %P/                   ;GWA001
	.EVEN
RER:	QIOW$	IO.WLB,5,5,,,,<BUF,,40>	;DISK READ ERROR
WER:	QIOW$	IO.WLB,5,5,,,,<BUF,,40>	;DISK WRITE ERROR

START:
	DIR$	#GETMCR			;GET THE MCR COMMAND LINE
	MOV	$DSW,R2			;SIZE
	BMI	30$			;BR IF NO MCR COMMAND LINE
	MOV	#GETMCR+G.MCRB,R1	;BUFFER START
10$:	CMPB	#' ,(R1)+		;SCAN FOR FIRST SPACE
	BEQ	15$
	SOB	R2,10$
	BR	30$			;NO TEXT
15$:	MOV	R1,R0			;SETUP TO SQUEEZE SPACES OUT
	DEC	R2			;CORRECT FOR SPACE FOUND
	MOV	R1,R3			;REMEMBER START OF TEXT
17$:	CMPB	#' ,(R1)+		;FOUND A SPACE?
	BEQ	18$			;BR ON SPACE
	MOVB	-1(R1),(R0)+		;PACK TEXT
18$:	SOB	R2,17$			;CONTINUE TO END OF DATA
	MOV	R0,R2			;CALCULATE SIZE
	SUB	R3,R2
	BEQ	30$			;BR IF NO DATA
	MOV	R3,R1			;RESET POINTER
20$:	MOVB	(R1)+,DEVICE		;MOVE DEVICE NAME
	MOVB	(R1)+,DEVICE+1
	CMPB	#':,(R1)		; NO UNIT #?                            ;GWA001
	BNE	21$			; NOT ':', MUST BE UNIT.                ;GWA001
	CLRB	UNIT			; ELSE FORCE UNIT 0                     ;GWA001
	INC	R1			; BUMP POINTER                          ;GWA001
	SUB	#3,R2			; CORRECT FOR DD:                       ;GWA001
	BR	22$			; AND PROCEED AS BEFORE.                ;GWA001
21$:	MOVB	(R1)+,UNIT		;GET UNIT NUMBER                        ;GWA001
	BICB	#'0,UNIT		;CONVERT TO BINARY
	CMPB	#':,(R1)+		;CHECK FOR SEMICOLON AND PASS IT
	BNE	30$
	SUB	#4,R2			;CORRECT FOR DDU:
22$:	CMP	R2,#12.			;LENGTH OF LABEL                        ;GWA001
	BHI	30$			;BR IF TOO LONG
	ALUN$S	#1,DEVICE,UNIT		;SET LUN 1 TO THE DEVICE
	TST	$DSW			;LUN OKAY?
	BPL	40$			;BR IF OKAY
30$:	QIOW$S	#IO.WLB,#5,#5,,,,<#ERR,#ERL,#40>
	MOV	#2,ST			; ERROR STATUS			031783
	BR	55$			;NG, EXIT
40$:	QIOW$S	#IO.RLB,#1,#1,,#ST,,<#BUF,#512.,,,#1>;READ LOGICAL BLOCK 1
	TSTB	ST			;DISK READ ERROR?
	BPL	50$			;BR IF NO ERROR
	MSG	DRERR,RER		; ISSUE ERROR MESSAGE WITH ST	031783
	MOV	#2,ST			; ERROR STATUS			031783
	BR	55$			;				031783
;IF DISK READ ERROR OCCURS, $LABEL WILL BE NULL IF WRITTEN
50$:					; SAVE OLD LABEL ** RLH01
52$:	CALL	OLDLAB			;WRITE OLD LABEL TO LABEL.CMD FILE
54$:	MOV	#1,ST			; EVERYTING'S FINE		031783
55$:	EXST$S	ST			;				031783
;
OLDLAB:                                                                         ;GWA001
	MOV	#BUF+16,R1		;LOCATION OF OLD LABEL
	MOV	#12.,R2
	MOV	#LABEL,R0
10$:	TSTB	(R1)			;LOOK FOR TRAILING SPACE
	BEQ	20$			;BR WHEN FOUND
	MOVB	(R1)+,(R0)+		;MOVE CHARACTER OF LABEL
	SOB	R2,10$
20$:	MOVB	#'",(R0)+		;FINAL - .SETS LABEL "----"
	MOV	R0,R1
	SUB	#TEXT,R1		;CALCULATE SIZE
	OPEN$W	#FDB			;OPEN LABEL.CMD;1 FILE
	PUT$	,#ENGLOB,#ENSIZ		;.ENABLE GLOBAL
	PUT$	,#TEXT,R1		;.SETS $LABEL "DISKLABEL"
	CLOSE$				;CLOSE THE FILE
	RETURN
	.END	START