.TITLE  HEADER -- DUMP A FILE HEADER
	.IDENT	/1/
	.MCALL	IF,END,ELSE,IFB,ERR$P,WHILE,STRMACS
	.MCALL	ALUN$S,DIR$,QIO$,WTSE$,FHDOF$
	STRMACS
	FHDOF$	DEF$L
;
;	HEADER
;
;	ROUTINE TO DUMP THE HEADER OF A FILE. THE HEADER
;	IS INTERPRETED TO MAKE IT EASIER FOR PEOPLE TO
;	READ
;
;
;	LOCAL MACROS
;
	.MACRO	PUT
	CALL  PUT
	.IF  GT,.-HER-127.
	BCC  .+6
	JMP  HER
	.IFF
	BCS  HER
	.ENDC
	.ENDM
;
	.MACRO	SYMBOL ONE
	.WORD  ONE
        .ASCIZ  /ONE/
	.EVEN
	.ENDM
HEADER::
	IF  #SW.PH,SETON,OPTIONS	;NOT VALID UNLESS A FILE
	  ERR$P  #ERR,<%CAN ONLY DUMP THE HEADER OF A FILE : %>
HER:
	  SEC
EXIT:
	  RETURN
	END
	CALL  NEWPAG			;ADVANCE TO A NEW PAGE
	IF  ,CS 			;IF ERROR
	  BR  HER			;EXIT
	END
	MOVE  < 					FILE HEADER DUMP>
	PUT
	MOV  #IN+F.FNB+N.FID,IORATT+Q.IOPL ;INSERT ADDRESS OF FILE ID
	MOV  IN+F.DVNM,R1		;GET DEVICE NAME
	MOVB  IN+F.UNIT,R2		;AND UNIT
	ALUN$S	#LKLUN,R1,R2		;ASSIGN A LUN
	IF  ,CS 			;IF ERROR
	  MOV  $DSW,R1			;GET ERROR CODE
	  NEG  R1			;AND MESSAGE NUMBER
	  ERR$P  #ERR,<%ERROR ASSIGNING LUN TO DUMP HEADER : >,R1
	  ERR$P  ,<%%>
	  BR  HER			;GO EXIT
	END
DUMHD:
	DIR$  #IORATT			;READ HEADER
	IF  ,CC 			;IF OK
	  DIR$	#WAIT			;WAIT FOR I/O TO COMPLETE
	END
	IF  ,CS 			;IF DIRECTIVE REJECTED
	  MOV  $DSW,R1			;GET ERROR CODE
	  NEG  R1			;AND MESSAGE NUMBER
RER:
	  ERR$P  #ERR,<%CANNOT READ HEADER : >,R1
	  ERR$P  ,<%%>
	  BR  HER			;GO TAKE ERROR RETURN
	END
	IFB  IOST,LT			;IF ERROR FROM DRIVER
	  MOVB	IOST,R1 		;GET ERROR CODE
	  NEG  R1			;AND MESSAGE NUMBER
	  BR  RER			;GO PRINT OUT
	END
	MOV  #BUF1,R3			;POINT TO START OF HEADER
	MOV  OUT+F.NRBD+2,R0		;OUTPUT BUFFER ADDRESS
	MOVE  <0HEADER AREA>
	PUT
	MOVE  <	IDENTIFICATION AREA OFFSET (H.IDOF) : >
	MOVB  H.IDOF(R3),R1		;GET H.IDOF
	CLR  R2 			;SUPPRESS ZEROS
	CALL  $CBTMG			;CONVERT
	PUT
	MOVE  <	MAP AREA OFFSET (H.MPOF) : >
	MOVB  H.MPOF(R3),R1		;GET H.MPOF
	CLR  R2 			;SUPPRESS ZEROS
	CALL  $CBTMG			;CONVERT
	PUT
	MOVE  <	FILE NUMBER, FILE SEQUENCE NUMBER (H.FNUM,H.FSEQ) : (>
	MOV  H.FNUM(R3),R1		;GET H.FNUM
	CLR  R2 			;SUPPRESS ZEROS
	CALL  $CBOMG			;AND CONVERT
	MOVB  #',,(R0)+ 		;SEPARATING ','
	MOV  H.FSEQ(R3),R1		;GET H.FSEQ
	CLR  R2 			;SUPPRESS ZEROS
	CALL  $CBOMG			;CONVERT
	MOVB  #'),(R0)+ 		;CLOSING BRACKET
	PUT
	MOVE  <	STRUCTURE LEVEL AND SYSTEM NUMBER (H.FLEV) : >
	MOV  H.FLEV(R3),R1		;GET H.FLEV
	MOV  #1,R2			;DON'T SUPPRESS THE ZEROS
	CALL  $CBOMG			;AND CONVERT
	PUT				;DUMP
	MOVE  <	FILE OWNER UIC (H.FOWN) : >
	MOV  H.FOWN(R3),R1		;GET IT
	CLR  R2 			;SUPPRESS ZEROS
	CALL  UIC			;DUMP A UIC
	PUT
	MOVE  <	FILE PROTECTION CODE (H.FPRO) : >
	MOV  H.FPRO(R3),R1		;GET H.FPRO
	CALL  PROT			;CONVERT
	PUT
	MOVE  <	USER CONTROLLED FILE CHARACTERISTICS (H.UCHA) : >
	CLR  R1 			;GET H.UCHA
	BISB  H.UCHA(R3),R1		;AS A BYTE
	MOV  #UCHA,R2			;AND INTERPRET BIT PATTERN
	CALL  BITS			;AS A USER CHARACTERICS BYTE
	PUT
	MOVE  <	SYSTEM CONTROLLED FILE CHARACTERISTICS (H.SCHA) : >
	CLR  R1 			;GET H.SCHA
	BISB  H.SCHA(R3),R1		;AS A BYTE
	MOV  #SCHA,R2			;AND INTERPRET BIT PATTERN AS
	CALL  BITS			;AS A SYSTEM FILE CHARACTERISTICS BYTE
	PUT
	MOVE  <	USER FILE ATTRIBUTES (H.UFAT)>
	PUT
	MOVE  <		RECORD TYPE (F.RTYP) : >
	CLR  R1 			;GET F.RTYP
	BISB  H.UFAT+F.RTYP(R3),R1	;AS A BYTE
	MOV  #RTYP,R2			;INTERPRET BIT PATTERN AS
	CALL  BITS			;A RECORD TYPE BYTE
	PUT
	MOVE  <		RECORD ATTRIBUTE (F.RATT) : >
	CLR  R1 			;GET F.RATT
	BISB  H.UFAT+F.RATT(R3),R1	;AS A BYTE
	MOV  #RATT,R2			;INTERPRET BIT PATTERN AS
	CALL  BITS			;A RECORD ATTRIBUTE BYTE
	PUT
	MOVE  <		RECORD SIZE (F.RSIZ) : >
	MOV  H.UFAT+F.RSIZ(R3),R1	;GET F.RSIZ
	CALL  CBDMG			;AND CONVERT
	PUT
	MOVE  <		HIGH VIRTUAL BLOCK (F.HIBK) : >
	MOV  R3,R1			;CALCULATE ADDRESS OF F.HIBK
	ADD  #H.UFAT+F.HIBK,R1		;AND
	CALL  CDDMG			;CONVERT
	PUT
	MOVE  <		END OF FILE BLOCK (F.EFBK) : >
	MOV  R3,R1			;CALCULATE ADDRESS OF
	ADD  #H.UFAT+F.EFBK,R1		;F.EFBK AND
	CALL  CDDMG			;CONVERT
	PUT
	MOVE  <		FIRST FREE BYTE (F.FFBY) : >
	MOV  H.UFAT+F.FFBY(R3),R1	;GET F.FFBY
	CLR  R2 			;SUPPRESS LEADING ZEROS
	CALL  $CBOMG			;AND CONVERT
	PUT
	MOVE  <		REMAINING USER FILE ATTRIBUTES>
	PUT
	MOV  #H.UFAT+<7*2>,R3		;OFFSET INTO HEADER
	MOV  #BUF1+H.UFAT+<7*2>,R5	;ADDRESS OF FIRST BYTE
	MOV  #32.-<7*2>,R4		;BYTE COUNT
	CALL  FORMAT			;AND CONVERT TO PRINTABLES
	IF  ,CS 			;IF ERROR
	  JMP  HER			;GO EXIT
	END
	MOV  #BUF1,R3			;SET UP TO POINT TO START OF HEADER
					;AREA AGAIN
	CLR  R4 			;NOW FIND OUT IF THERE ARE ANY EXTRA
	BISB  H.IDOF(R3),R4		;BYTES IN 'HEADER AREA'
	ASL  R4 			;---BYTE OFFSET TO START OF
					;IDENTIFICATION AREA--
	SUB  #H.UFAT+32.,R4		;REMAINING BYTES
	IF  ,GT 			;IF THERE ARE ANY. DUMP THEM
	  MOVE	<	REMAINING HEADER AREA WORDS>
	  PUT
	  MOV  #H.UFAT+32.,R3		;OFFSET INTO HEADER
	  MOV  #BUF1+H.UFAT+32.,R5	;ADDRESS
	  CALL	FORMAT			;DUMP THEM OUT
	  IF  ,CS			;IF ERROR
	    JMP  HER			;EXIT
	  END
	END
	MOV  OUT+F.NRBD+2,R0		;OUTPUT ADDRESS
	MOVE  < IDENTIFICATION AREA>
	PUT
	CLR  R3 			;GET ADDRESS OF IDENTIFICATION AREA
	BISB  BUF1+H.IDOF,R3		;...
	ASL  R3
	ADD  #BUF1,R3			;INTO R3
	MOVE  <	FILE SPECIFIER (I.FNAM.I.FTYP;I.FVER) : >
	MOV  I.FNAM(R3),R1		;FILE NAME
	CALL  $C5TA
	MOV  I.FNAM+2(R3),R1
	CALL  $C5TA
	MOV  I.FNAM+4(R3),R1
	CALL  $C5TA
	MOVB  #'.,(R0)+ 		;SEPARATOR
	MOV  I.FTYP(R3),R1		;FILE TYPE
	CALL  $C5TA
	MOVB  #';,(R0)+ 		;SEPARATOR
	MOV  I.FVER(R3),R1		;FILE VERSION
	CLR  R2
	CALL  $CBOMG
	PUT
	MOVE  <	REVISION NUMBER (I.RVNO) : >
	MOV  I.RVNO(R3),R1		;GET I.RVNO
	CALL  CBDMG			;AND CONVERT
	PUT
	MOVE  <	REVISION DATE TIME (I.RVDT, I.RVTI) : >
	MOV  #I.RVDT,R1 		;ADDRESS OF I.RVDT
	ADD  R3,R1
	CALL  DATE			;CONVERT THE DATE
	MOVB  #' ,(R0)+ 		;SEPARATOR
	MOV  #I.RVTI,R1 		;ADDRESS OF I.RVTI
	ADD  R3,R1
	CALL  TIME
	PUT
	MOVE  <	CREATION DATE TIME (I.CRDT,I.CRTI) : >
	MOV  #I.CRDT,R1 		;ADDRESS OF I.CRDT
	ADD  R3,R1
	CALL  DATE			;CONVERT THE DATE
	MOVB  #' ,(R0)+ 		;SEPARATOR
	MOV  #I.CRTI,R1 		;ADDRESS OF I.CRTI
	ADD  R3,R1
	CALL  TIME			;CONVERT THE TIME
	PUT
	MOVE  <	EXPIRATION DATE (I.EXDT) : >
	MOV  #I.EXDT,R1 		;ADDRESS OF I.EXDT
	ADD  R3,R1
	CALL  DATE			;CONVERT
	PUT
	MOVE  <	FILLER : >
	MOVB  I.EXDT+7.,R1		;GET THE FILLER BYTE
	CLR  R2 			;SUPPRESS LEADING ZEROS
	CALL  $CBTMG			;AND CONVERT
	PUT
	CLR  R4 			;NOW FIND IF ANY UNUSED WORDS
	BISB  BUF1+H.MPOF,R4		;BETWEEN ID AND MAP AREAS
	ASL  R4 			;(OFFSET IN BYTES)
	ADD  #BUF1,R4			;---ADDRESS OF MAP AREA---
	MOV  R4,-(SP)			;SAVE FOR LATER
	MOV  R3,R5			;CALCULATE ADDRESS OF END
	ADD  #I.EXDT+8.,R5		;OF ID AREA
	SUB  R5,R4			;NUMBER OF WORDS LEFT OVER
	IF  ,GT 			;IF ANYTHING LEFT
	  MOVE	<	REMAINING IDENTIFICATION AREA WORDS>
	  CALL	PUT			;DUMP THE LINE
	  IF  ,CS			;IF ERROR
	    TST  (SP)+			;CLEAR THE STACK
	    JMP  HER			;AND HANDLE
	  END
	  MOV  #I.EXDT+8.,R3		;INITIAL OFFSET INTO ID AREA
	  CALL	FORMAT			;DUMP THE AREA
	  IF  ,CS			;IF ERROR
	    TST  (SP)+			;THROW AWAY EXTRA WORD
	    JMP  HER			;GO HANDLE
	  END
	END
	MOV  (SP)+,R3			;GET ADDRESS OF MAP AREA
	MOV  OUT+F.NRBD+2,R0		;GET OUTPUT BUFFER ADDRESS
	MOVE  < MAP AREA>
	PUT
	MOVE  <	EXTENSION SEGMENT NUMBER (M.ESQN) : >
	CLR  R1
	BISB  M.ESQN(R3),R1		;GET M.ESQN
	CALL  CBDMG			;CONVERT
	PUT
	MOVE  <	EXTENSION RELATIVE VOLUME NUMBER (M.ERVN) : >
	CLR  R1 			;GET
	BISB  M.ERVN(R3),R1		;M.ERVN
	CALL  CBDMG			;CONVERT
	PUT
	MOVE  <	EXTENSION FILE NUMBER, FILE SEQUENCE NUMBER (M.EFNU,M.EFSQ) : (>
	MOV  M.EFNU(R3),R1		;R1
	CLR  R2 			;SUPPRESS LEADING ZEROS
	CALL  $CBOMG			;CONVERT
	MOVB  #',,(R0)+ 		;SEPARATOR CHARACTER
	MOV  M.EFSQ(R3),R1		;M.EFSQ
	CLR  R2 			;SUPPRESS LEADING ZEROS
	CALL  $CBOMG			;CONVERT
	MOVB  #'),(R0)+ 		;CLOSING BRACKET
	PUT
	MOVE  <	BLOCK COUNT FIELD SIZE (M.CTSZ) : >
	MOVB  M.CTSZ(R3),R1		;M.CTSZ
	CALL  CBDMG
	PUT
	MOVE  <	BLOCK NUMBER FIELD SIZE (M.LBSZ) : >
	MOVB  M.LBSZ(R3),R1		;M.LBSZ
	CALL  CBDMG			;CONVERT
	PUT
	MOVE  <	WORDS OF RETRIEVAL POINTERS USED (M.USE) : >
	CLR  R1 			;M.USE
	BISB  M.USE(R3),R1
	CALL  CBDMG			;CONVERT
	PUT
	MOVE  <	MAXIMUM WORDS OF RETRIEVAL POINTERS AVAILABLE (M.MAX) : >
	CLR  R1 			;M.MAX
	BISB  M.MAX(R3),R1
	CALL  CBDMG			;CONVERT
	PUT
	MOVE  <	RETRIEVAL POINTERS (M.RTRV)>
	PUT
	MOVB  #TAB,(R0)+		;INDENT 2
	MOVB  #TAB,(R0)+		;LEVELS
	MOV  #4,R4			;REPEAT TITLE 4 TIMES
	WHILE  ,GT			;...
	  MOVE	<NUMBER SIZE LBN	  >
TSIZ=	  ..B.. 			;SIZE OF ABOVE TEXT
	  DEC  R4
	END
	CLR  -(SP)			;CURRENT RETRIEVAL POINTER NUMBER
	CLR  R1 			;FIND OUT HOW MANY TO DUMP
	BISB  M.USE(R3),R1
	ASL  R1 			;NUMBER OF BYTES IN USE
	MOVB  M.CTSZ(R3),R4		;NUMBER OF BYTES DIVIDED BY SIZE
	MOV  R4,-(SP)			;SAVE SIZE OF BLOCK COUNTER
	MOVB  M.LBSZ(R3),R5
	MOV  R5,-(SP)			;SAVE SIZE OF BLOCK ADDRESS
	ADD  R5,R4
	MOV  R0,R2			;SAVE OUTPUT BUFFER POINTER
	CLR  R0
	DIV  R4,R0
	MOV  R0,-(SP)			;SAVE COUNT
	MOV  R2,R0			;RESTORE OUTPUT BUFFER POINTER
	ADD  #M.RTRV,R3 		;ADDRESS OF FIRST RETRIEVAL POINTER
	CMP  -(SP),-(SP)		;LEAVE SOME ROOM ON THE STACK
	CLR  R4 			;START A NEW LINE IMMEDIATELY
	WHILE  4(SP),GT 		;WHILE STILL SOMETHING TO DUMP
	  IF  R4,EQ			;IF THIS LINE IS FULL
	    CALL  PUT			;DUMP THE LINE
	    IF	,CS			;IF ERROR
	      ADD  #14,SP		;CLEAR UP STACK
	      JMP  HER			;AND GO EXIT
	    END
	    MOV  #2+<TSIZ*4>,R1 	;CLEAR THE OUTPUT BUFFER
10$:
	    MOVB  #' ,(R0)+
	    SOB  R1,10$
	    MOV  OUT+F.NRBD+2,R5	;GET BUFFER ADDRESS
	    TSTB  (R5)+ 		;LEAVE THE CARRIAGE CONTROL ALONE
	    MOVB  #TAB,(R5)+		;BUT INDENT
	    MOVB  #TAB,(R5)+		;TWO LEVELS
	    MOV  #4,R4			;WE'L PLACE 4 RETRIEVAL POINTERS THIS
					;LINE
	  END
	  INC  12(SP)			;ADVANCE TO NEXT RETRIEVAL POINTER
	  MOV  12(SP),R1		;GET IT'S NUMBER
	  MOV  R5,R0			;POINT TO THIS RETRIEVAL POINTER'S SPOT
	  CALL	CBDMG			;CONVERT
	  CLR  R1			;GET BLOCK COUNT
	  BISB	1(R3),R1		;AS A BYTE
	  INC  R1			;UN ADJUST
	  MOV  R5,R0			;POINT TO RIGHT PLACE
	  ADD  #7.,R0			;IN OUTPUT BUFFER
	  CALL	CBDMG			;THEN CONVERT TO DECIMAL
	  CLR  (SP)			;CLEAR THE FIRST WORD
	  MOVB	1(R3),(SP)		;GET LOW PART OF HIGH LBN WORD
	  CMPB	(R3)+,(R3)+		;SKIP TO LOW PART OF LOW LBN WORD
	  MOVB	(R3)+,2(SP)		;AND GET IT
	  MOVB	(R3)+,3(SP)		;...
	  MOV  SP,R1			;ADDRESS OF THING
	  MOV  R5,R0			;FIND RIGHT SPOT IN OUTPUT BUFFER
	  ADD  #12.,R0			;...
	  CALL	CDDMG			;AND CONVERT
	  ADD  #TSIZ,R5 		;POINT TO OUTPUT BUFFER FOR NEXT
					;RETRIEVAL POINTER
	  DEC  R4			;AND COUNT DOWN
	  DEC  4(SP)			;COUNT DOWN
	END
	ADD  #14,SP			;CLEAR STACK
	PUT
	MOVE  <HEADER CHECKSUM WORD (H.CKSM) : >
	MOV  BUF1+H.CKSM,R1		;GET H.CKSM
	MOV  #1,R2			;DON'T SUPPRESS ZEROS
	CALL  $CBOMG			;CONVERT TO OCTAL
	PUT
	CLR  R3 			;NOW SEE IF THERE IS AN EXTENSION HEADER
	BISB  BUF1+H.MPOF,R3		;POINT AT
	ASL  R3 			;MAP
	ADD  #BUF1,R3			;AREA
	IF  M.EFNU(R3),NE		;AN EXTENSION FILE HEADER?
	  DEC  R0			;YES
	  MOVE	<0				EXTENSION HEADER>
	  PUT
	  ADD  #M.EFNU,R3		;ADDRESS OF FILE ID
	  MOV  R3,IORATT+Q.IOPL 	;INTO IO PARAMETER LIST
	  JMP  DUMHD			;GO DUMP THE HEADER
	END
	CLC				;SHOW EVERYTHING HUNKY-DORY
	JMP  EXIT			;AND EXIT
	.PAGE
;
;	UIC
;
;	CONVERT THE UIC IN R1 TO BINARY IN BUFFER AT (R0)
;
UIC:
	MOV  R3,-(SP)			;SAVE CRUCIAL REGISTER
	MOV  R0,R2			;GET OUTPUT BUFFER ADDRESS
	MOV  R1,R3			;AND UIC
	CLR  R4 			;WE WANT PRETTY FORMAT
	CALL  .PPASC			;CONVERT UIC
	MOV  R2,R0			;UPDATE BUFFER POINTER
	MOV  (SP)+,R3			;RESTORE REGISTER
	RETURN				;AND RETURN
;
;	BITS
;
;	ROUTINE TO TAKE A WORD IN R1, A BIT PATTERN TABLE IN R2
;	AND PRODUCE A FORMATTED PRINT OUT
;
;	THE BIT PATTERN ENTRIES ARE .WORD BIT
;				    .ASCIZ /BIT/
;				    .EVEN
;	FOLLOWED A WORD OF 0
;
BITS:
	MOV  R2,-(SP)			;SAVE INPUT
	MOV  R1,-(SP)
	CLR  R2 			;FIRST PRINT NUMBER OUT IN OCTAL
	CALL  $CBOMG			;...
	MOVB  #' ,(R0)+ 		;SEPARATORS
	MOVB  #'-,(R0)+
	MOVB  #' ,(R0)+
	MOV  (SP)+,R1			;REGAIN TABLE ADDRESS
	MOV  (SP)+,R2			;AND PATTERN
	WHILE  (R2),NE			;WHILE NOT AT END OF TABLE
	  IF  (R2),SETON,R1		;IF THIS BIT IN PATTERN
	    BIC  (R2),R1		;STRIP THE BIT
	    TST  (R2)+			;POINT TO SYMBOL
10$:
	    MOVB  (R2)+,(R0)+		;GET THE CHARACTER
	    BNE  10$			;WHILE NOT AT END, LOOP
	    TSTB  -(R0) 		;RE-GURGITATE A BYTE
	    IF	R1,NE			;IF MORE BITS COMMING
	      MOVB  #'!,(R0)+		;INSERT DELIMTER
	    END
	  ELSE
	    TST  (R2)+			;SKIP TO SYMBOL
20$:
	    TSTB  (R2)+ 		;SKIP OVER IT
	    BNE  20$			;NOT AT END, LOOP
	  END
	  TSTB	(R2)+			;TAKE CARE OF
	  BIC  #1,R2			;ALIGNMENT
	END
	RETURN
;
;	CDDMG
;
;	CONVERT A DO%BLE PRECISION DECIMAL NUMBER POINTED TO BY R1 TO
;	ZERO SUPPRESSED TEXT
;
CDDMG:
	CLR  R2 			;SUPPRESS ZEROS
	CALL  $CDDMG			;AND CONVERT NUMBER
	MOVB  #'.,(R0)+ 		;SHOW IT'S A DECIMAL NUMBER
	RETURN				;RETURN
;
;	CBDMG
;
;	CONVERT DECIMAL NUMBER IN R1 TO ZERO SUPPRESSED TEXT
;
CBDMG:
	CLR  R2 			;SUPPRESS LEADING ZEROS
	CALL  $CBDMG
	MOVB  #'.,(R0)+ 		;SHOW IT'S A DECIMAL NUMBER
	RETURN
;
;	TIME
;
;	FORMAT TIME POINTED TO BY R1
;
TIME:
	MOVB  (R1)+,(R0)+		;FORMAT FROM HHMMSS TO HH:MM:SS
	MOVB  (R1)+,(R0)+
	MOVB  #':,(R0)+
	MOVB  (R1)+,(R0)+
	MOVB  (R1)+,(R0)+
	MOVB  #':,(R0)+
	MOVB  (R1)+,(R0)+
	MOVB  (R1)+,(R0)+
	RETURN
;
;	DATE
;
;	FORMAT THE DATE POINTED TO BY R1
;
DATE:
	MOVB  (R1)+,(R0)+		;FORMAT FROM DDMMMYY TO DD-MMM-YY
	MOVB  (R1)+,(R0)+
	MOVB  #'-,(R0)+
	MOVB  (R1)+,(R0)+
	MOVB  (R1)+,(R0)+
	MOVB  (R1)+,(R0)+
	MOVB  #'-,(R0)+
	MOVB  (R1)+,(R0)+
	MOVB  (R1)+,(R0)+
	RETURN
;
;	PROT
;
;	OUTPUT A PROTECTION CODE
;
PROT:
	MOVB  #'[,(R0)+ 		;LEADING BRACKET
	MOV  #PTABL,R2			;ADDRESS OF LETTER TABLE
	MOV  #15.,R4			;COUNTER
	WHILE  ,GE			;LOOP
	  ROR  R1			;GET NEXT BIT
	  IF  ,CC			;IF ACCESS PERMITTED
	    MOVB  (R2),(R0)+		;MOVE IN CODE LETTER
	  END
	  IF  #3,SETOFF,R4		;IF AT END OF GROUP
	    MOVB  #',,(R0)+		;STICK IN A DELIMTITER
	  END
	  TSTB	(R2)+			;ADVANCE CODE LETTER POINTER
	  DEC  R4			;COUNT DOWN
	END
	MOVB  #'],-1(R0)		;PUT IN TRAILING BRACKET
	RETURN
	.PAGE
;
;	DATA AREAS
;
UCHA:
	SYMBOL	UC.CON
	SYMBOL	UC.DLK
	.WORD  0
SCHA:
	SYMBOL	SC.MDL
	SYMBOL	SC.BAD
	.WORD  0
RTYP:
	SYMBOL	R.FIX
	SYMBOL	R.VAR
	.WORD  0
RATT:
	SYMBOL	FD.FTN
	SYMBOL	FD.CR
	SYMBOL	FD.BLK
	.WORD  0
WAIT:
	WTSE$  1
;
;	QIO TO READ HEADER OF FILE POINT TO BY IN
;
IORATT:
	QIO$  IO.RAT,LKLUN,1,,IOST,,<IN+F.FNB+N.FID,RCTL>
;
;	ATTRIBUTE CONTROL LIST. READ 512. BYTES OF WHOLE HEADER
;	INTO BUF1
;
RCTL:	.BYTE  -10.,0.
	.WORD  BUF1
	.WORD  0
;
;	TABLE OF ACCESS TYPES
;
PTABL:  .ASCII  /RWEDRWEDRWEDRWED/
	.EVEN
	.END