.NLIST
;	.LIST	TTM	; LIST IN TELETYPE (80-COLUMN) MODE
;	.NLIST		; DON'T LIST ANYTHING
;	.NLIST	SYM	; DON'T LIST SYMBOL TABLE
;	.NLIST	COM	; DON'T LIST COMMENTS
;	.NLIST	SEQ	; DON'T LIST LINE NUMBERS
;	.NLIST	LOC	; DON'T LIST PC LOCATIONS
;	.NLIST	BIN	; DON'T LIST BINARY CODE
	.NLIST	CND	; DON'T LIST UNSATISIFED CONDITIONAL CODING
;	.LIST	MEB	; LIST MACRO EXPANSIONS
	.NLIST	BEX	; LIST ONLY 1ST LINE OF BINARY EXPANSIONS
	.ENABL	AMA	; LIST ABSOLUTE ADDRESSES
	.LIST
;
;************************************
	.TITLE	DSKFX
;************************************
;
	.IDENT	/PMC002/
;	P. M. CHAMBERLAIN
;	EASTMAN KODAK CO.
;	3131 MANOR WAY
;	DALLAS TX, 75235
;
;
; THIS TASK IS INTENDED TO SUPPLEMENT, NOT REPLACE, THE FUNCTIONS
; PROVIDED BY "PIP", "VFY", "ZAP", AND "DMP" -- BY PERMITTING
; EXAMINATION OF DISK BLOCKS (PARTICULARLY FILE HEADERS) IN A
; CLEARER FORMAT, ALTERATIONS TO FILE HEADERS, ETC.
;
; AS SUCH, IT IS BOTH POWERFUL AND DANGEROUS, AND MUST BE RUN
; WITH CARE!!
;
; ALTHOUGH IT'S PRIMARY PURPOSE IS TO HELP SALVAGE "BLOWN" DISK
; PACKS, IT HAS A GREAT DEAL OF USEFULNESS AS A GENERAL UTILITY
; TASK, SINCE FILES CAN BE MOVED FROM ONE DIRECTORY TO ANOTHER,
; HAVE THEIR OWNERSHIP CHANGED, ETC., WITHOUT NEEDING TO CREATE
; A COPY OF THE ORIGINAL FILE.  
;
; ON THOSE HOPEFULLY RARE OCCASIONS WHEN THE PROTECTION ON A FILE
; IS ALTERED SO THAT IT CANNOT BE ACCESSED BY ANY OF THE SYSTEM
; TASKS, "DSKFX" WILL STILL PERMIT THE FILE HEADER TO BE ACCESSED
; SO THAT THE PROTECTION CAN BE CORRECTED.
;
;
	.MCALL	HMBOF$, DEF$L, QIOW$S, EXIT$S, ALUN$S
	.MCALL	FHDOF$, FSRSZ$, FDBDF$, FDRC$A, FDBK$A
	.MCALL	FDOP$A, OFNB$, GCMLB$, CSI$, GCML$
	.MCALL	CSI$1, CLOSE$, FINIT$
;
; DEFINE SYMBOLS LOCALLY
	HMBOF$
	FHDOF$
	DEF$L
;
; LOCAL MACRO TO OUTPUT MESSAGES, FORMATS, ETC.
	.MACRO	MSG A
	MOV	#'A,R4
	MOV	#'A'L,R5
	CALL	MESSG
	.ENDM
;
; LOCAL MACRO TO CONVERT FILE OFFSETS FOR OUTPUT
	.MACRO	LIST	A
	MOV	#<'A'>,R1
	MOV	R3,R2
	CALL	$CBTA
	.ENDM
;
; LOCAL MACRO TO CONVERT HOME BLOCK VALUES FOR OUTPUT
	.MACRO	LSTHV A
	MOV	HOMBUF+'A',R1
	MOV	R4,R2
	CALL	$CBTA
	.ENDM
;
; LOCAL MACRO TO CONVERT FILE HEADER VALUES FOR OUTPUT
	.MACRO	LSTIV A
	MOV	IDXBUF+'A',R1
	MOV	R4,R2
	CALL	$CBTA
	.ENDM
;
LF=12
CR=15
YES='Y
;
; PSECT FOR FILE STORAGE
	FSRSZ$	1
;
	.PSECT	$DATA
SOURCE:	.BLKB	6		; SOURCE DRIVE FOR COPYING
DRIVE:	.BLKB	4		; DEFAULT DRIVE (A1)
PWD1:	.BLKB	6		; INPUT FOR PASSWORD
ADR:	.BLKW
CHARCT:	.BLKW
BKUP:	.BLKB	4
DATA:	.BLKB	10.
NEWUIC:	.BLKW	2
MODE:	.BLKW
BUFADR:	.BLKW
NEWVAL:	.BLKW
BLANK:	.BYTE	40
WRONG:	.BYTE	40,77
PROMPT:	.BYTE	LF,CR,137
WORK:	.BLKB	8.
LASTC:	.BLKB
	.EVEN
DRVSW:	.BLKW	1
UICSW:	.BLKW	1
SW:	.BLKW	1
BLKNUM:	.BLKW	2
BLKPOS:	.BLKW	1
TWO:	.WORD	2
FIRST:	.BLKW	2
COUNT:	.BLKW	1
STACK:	.BLKW	1
	.EVEN
;
; FDB FOR DISK FILES
SFIL:	FDBDF$
	FDRC$A	FD.RWM
	FDBK$A	,512.,,32.,IOST
	FDOP$A	2,CSIBLK+C.DSDS,,FO.RD!FA.SHR
;
GCLBUF:	.BLKW	41.
PROMP2:	.ASCII	<CR><LF>\  ENTER FILE NAME  \
PLEN=.-PROMP2
	.EVEN
GCLM:	GCMLB$	,FIL,GCLBUF
	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE
	.EVEN
;
; DISPATCH TABLE
FUNC1:	.WORD	LSTHOM	; LIST HOME BLOCK
FUNC2:	.WORD	LSTIDX	; LIST INDEX FILE HEADER
FUNC3:	.WORD	LSTNUM	; LIST ANY FILE HEADER BY FILE NUMBER
FUNC4:	.WORD	LSTNAM	; LIST ANY FILE HEADER BY FILE NAME
FUNC5:	.WORD	HUNT	; FIND FILE CONTAINING A SPECIFIC LOGICAL BLOCK
FUNC6:	.WORD	REWRIT	; RE-WRITE A LOGICAL BLOCK
FUNC7:	.WORD	DEFDR	; ASSIGN A NEW DEFAULT DRIVE
FUNC8:	.WORD	CPYBKP	; COPY ANY LOGICAL BLOCK FROM A BACKUP PACK
FUNC9:	.WORD	MOVUFD	; MOVE FILE ENTRY FROM ONE UFD TO ANOTHER
FUNC=.-FUNC1/2		; COUNT OF VALID FUNCTIONS
IOST:	.BLKW	2		; I/O STATUS BLOCK
FILNUM:	.BLKW	1
	FILSEQ:	.BLKW	1
LUN:	.WORD	2
SWIT:	.WORD	1
ANS:	.BLKB	1
	.NLIST
PWD2:	.ASCII	\POOBAH\
	.LIST
M10:	.ASCII	<CR><LF>\PASSWORD>\
M10L=.-M10
M11:	.ASCII	<CR><LF>\ - <CTRL Z> IN RESPONSE TO ANY INQUIRY \
	.ASCII	\CAUSES TASK TO EXIT.\
	.ASCII	<CR><LF>\ - <ESC> CAUSES RETURN TO MENU.\
	.ASCII	<CR><LF><LF>\  DO YOU NEED MORE INSTRUCTIONS? [Y/N]\
	.ASCII	\   \
M11L=.-M11
M12:	.ASCII	<CR><LF>\ - DISKS TO BE USED MUST BE MOUNTED [DCF].\
	.ASCII	<CR><LF>\ - THE DEFAULT DRIVE WILL BE USED FOR ALL \
	.ASCII	\OPERATIONS EXCEPT REQUESTING\<CR><LF>\   FILE HEADER INFO\
	.ASCII	\RMATION BY FILE NAME.  IN THAT CASE, IF A DRIVE\<CR><LF>
	.ASCII	\   IS SPECIFIED, IT WILL BE USED FOR THAT ONE OPERATION, \
	.ASCII	\AFTER WHICH THE\<CR><LF>\   TASK REVERTS TO THE DEFAULT \
	.ASCII	\DRIVE.\<CR><LF>\ - IF YOU WANT TO MAKE CHANGES IN \
	.ASCII	\A FILE HEADER, THE ADDRESSING, DISPLAY,\<CR><LF>\   AND\
	.ASCII	\ CHANGES WORK EXACTLY LIKE "ODT", EXCEPT THAT <CTRL Z> IS\
	.ASCII	\ USED TO\<CR><LF>\   EXIT FROM THE ROUTINE.\
	.ASCII	\   ONLY AN UNDERLINE PROMPT IS DISPLAYED, AND\<CR><LF> 
	.ASCII	\   ADDRESSES \
	.ASCII	\MUST BE ENTERED IN OCTAL.  A LINE FEED ADVANCES TO \
	.ASCII	\THE\<CR><LF>\   NEXT ADDRESS, AND ^ RETREATS TO THE \
	.ASCII	\PREVIOUS ADDRESS.  THE ADDRESSES\<CR><LF>\   ARE IN \
	.ASCII	\WORDS OR BYTES, DEPENDING ON THE ADDRESSING MODE, WHICH \
	.ASCII	<CR><LF>\   MAY BE /, \<134>\, ', ", OR %.  THE REVISED \
	.ASCII	\HEADER WILL BE RE-LISTED,\<CR><LF>\   WITH NEW \
	.ASCII	\CHECKSUMS ALREADY CALCULATED AND STORED.\<CR><LF>
	.ASCII	\ - SEARCHING FOR THE FILE THAT CONTAINS A SPECIFIC \
	.ASCII	\BLOCK NUMBER MAY TAKE\<CR><LF>\   SOME TIME, SINCE \
	.ASCII	\EVERY FILE HEADER MAY NEED TO BE EXAMINED.  IF THE \
	.ASCII	<CR><LF>
	.ASCII	\   BLOCK BEING SEARCHED FOR IS MULTIPLY ASSIGNED, ONLY \
	.ASCII	\THE FIRST ASSIGN-\<CR><LF>\   MENT WILL BE FOUND.\
	.ASCII	<CR><LF>\ - REMEMBER THAT CHANGES IN A FILE NAME, \
	.ASCII	\TYPE, OR VERSION WILL NOT\<CR><LF>\   CHANGE THE \
	.ASCII	\ENTRIES IN THE UFD.\
M13:	.ASCII	<CR><LF><LF>\<CR> WHEN READY TO CONTINUE.  \
M12L=.-M12
M13L=.-M13
M20:	.ASCII	<CR><LF>\   STOP DSKFX\
M20L=.-M20
M30:	.ASCII	<CR><LF>\  ENTER DEFAULT DRIVE, E.G. DP1: <CR>   \
M30L=.-M30
M31:	.ASCII	<CR><LF>\  ENTER FILE NUMBER <CR>   \
M31L=.-M31
M32:	.ASCII	<CR><LF>\  ENTER UIC (NO DRIVE) WHERE ENTRY IS TO BE MADE\
	.ASCII	\ <CR>   \
M32L=.-M32
M40:	.ASCII	<CR><LF>\ 1 - LIST HOME BLOCK\
	.ASCII	<CR><LF>\ 2 - LIST INDEX FILE HEADER\
	.ASCII	<CR><LF>\ 3 - FIND FILE HEADER BY FILE NUMBER\
	.ASCII	<CR><LF>\ 4 - FIND FILE HEADER BY FILE NAME\
	.ASCII	<CR><LF>\ 5 - FIND FILE CONTAINING A SPECIFIED LOGICAL\
	.ASCII	\ BLOCK\
	.ASCII	<CR><LF>\ 6 - REWRITE A FILE BLOCK TO ELIMINATE A \
	.ASCII	\PARITY ERROR\
	.ASCII	<CR><LF>\ 7 - CHANGE DEFAULT DRIVE\
	.ASCII	<CR><LF>\ 8 - COPY SELECTED LOGICAL BLOCKS FROM \
	.ASCII	\BACKUP DRIVE\
	.ASCII	<CR><LF>\ 9 - MOVE FILE ENTRY TO ANOTHER UFD\
	.ASCII	\ (ACTUAL FILE NOT MOVED)\
	.ASCII	<CR><LF><LF>\ ENTER SELECTION <CR>   \
M40L=.-M40
M50:	.ASCII	<CR><LF>\  FILE NOT FOUND\
M51:	.ASCII	<CR><LF>\  FCS \
M51A:	.BLKB	3
M50L=.-M50
M52:	.ASCII	<CR><LF>\  FILE NUMBER IS \
M52A:	.BLKB	14.
M52L=.-M52
	.ASCII	<CR><LF>
M51L=.-M51
M53:	.ASCII	<CR><LF>\  BLOCK IS NOT A FILE HEADER.\
M53L=.-M53
M54:	.ASCII	<CR><LF>\  DELETION NOT MADE\
M54L=.-M54
M55:	.ASCII	<CR><LF>\  NEW ENTRY NOT MADE\
M55L=.-M55
M60:	.ASCII	<CR><LF>\  ENTER BLOCK NUMBER TO BE FOUND <CR>   \
M60L=.-M60
M61:	.ASCII	<CR><LF>\  BLOCK IS BLOCK \
M61A:	.BLKB	7
	.ASCII	\ IN FILE NUMBER \
M61B:	.BLKB	7
M61L=.-M61
M62:	.ASCII	<CR><LF>\  BLOCK IS NOT LOCATED IN ANY FILE\
M62L=.-M62
M70:	.ASCII	<CR><LF>\  LIST VIRTUAL AND LOGICAL BLOCKS IN THE \
	.ASCII	\FILE? [Y/N]  \
M70L=.-M70
M75:	.ASCII	<CR><LF><LF>\   BLOCKS    VIRTUAL RANGE    LOGICAL RANGE\
M75L=.-M75
M76:	.ASCII	<CR><LF>
M76A:	.ASCII	\          \
M76B:	.BLKB	7
	.ASCII	\-\
M76C:	.ASCII	\          \
M76D:	.BLKB	7
	.ASCII	\-\
M76E:	.BLKB	7
M76L=.-M76
M80:	.ASCII	<CR>\  PARITY WILL BE CORRECTED.  BLOCK MAY STILL CONT\
	.ASCII	\AIN BAD DATA\<CR><LF>
M80L=.-M80
M81:	.ASCII	<CR><LF>\  NOT YET IMPLEMENTED\
M81L=.-M81
M91:	.ASCII	<CR><LF><LF>\  WARNING!!  IF A FILE HEADER IS MOVED,\
	.ASCII	\ "VFY" SHOULD BE RUN\<CR><LF>\  AS QUICKLY AS POSS\
	.ASCII	\IBLE IN ORDER TO CHECK FOR MULTIPLY ASSIGNED BLOCKS.\
M91L=.-M91
M92:	.ASCII	<CR><LF><LF>\  ENTER SOURCE DRIVE <CR>   \
M92L=.-M92
M93:	.ASCII	<CR><LF><LF>\  ENTER LOGICAL BLOCK NUMBER TO BE COPIED\
	.ASCII	\ <CR>   \
M93L=.-M93
M94:	.ASCII	<CR><LF><7>\  INVALID LOGICAL BLOCK NUMBER.\
M94L=.-M94
M95:	.ASCII	<CR><LF><7>\  READ ERROR ON SOURCE DRIVE.\
M95L=.-M95
M96:	.ASCII	<CR><LF><7>\  WRITE ERROR ON OBJECT DRIVE.\
M96L=.-M96
M97:	.ASCII	<CR><LF><LF>\  DO ANOTHER BLOCK? [Y/N]   \
M97L=.-M97
	.EVEN
ADR1:	.WORD	0
ADR2:	.WORD	1
FILBUF:	.BLKW	256.
IDXBUF:	.BLKW	256.
HOMBUF:	.BLKW	256.
CLRSCR:	.BYTE	32,33,'H,33,'J,15,12	; FOR BOTH LSI AND VT52
HOMBLK:	.BLKB	3
	.ASCII	\  H.IBSZ  \
H1V:	.BLKB	6
	.ASCII	\  -- INDEX FILE BIT MAP SIZE\<CR><LF>
H2:	.BLKB	3
	.ASCII	\  H.IBLB  \
H2V:	.BLKB	6
	.BYTE	CR,LF
H3:	.BLKB	3
	.ASCII	\          \
H3V:	.BLKB	6
	.ASCII	\  -- LOCATION OF INDEX FILE BIT MAP\<CR><LF>
H4:	.BLKB	3
	.ASCII	\  H.FMAX  \
H4V:	.BLKB	6
	.ASCII	\  -- MAXIMUM FILES ALLOWED\<CR><LF>
H5:	.BLKB	3
	.ASCII	\  H.SBCL  \
H5V:	.BLKB	6
	.ASCII	\  -- STORAGE BIT MAP CLUSTER FACTOR\<CR><LF>
H6:	.BLKB	3
	.ASCII	\  H.DVTY  \
H6V:	.BLKB	6
	.ASCII	\  -- DISK DEVICE TYPE\<CR><LF>
H7:	.BLKB	3
	.ASCII	\  H.VLEV  \
H7V:	.BLKB	6
	.ASCII	\  -- STRUCTURE LEVEL\<CR><LF>
H8:	.BLKB	3
	.ASCII	\  H.VNAM  \
H8V:	.BLKB	12.
	.ASCII	\  -- VOLUME NAME\<CR><LF>
H10:	.BLKB	3
	.ASCII	\  H.VCHA  \
H10V:	.BLKB	6
	.ASCII	\  -- VOLUME CHARACTERISTICS\<CR><LF>
H15:	.BLKB	3
	.ASCII	\  H.WISZ  \
H15V:	.BLKB	6
	.ASCII	\  -- DEFAULT RETRIEVAL POINTERS IN WINDOW\<CR><LF>
H16:	.BLKB	3
	.ASCII	\  H.FIEX  \
H16V:	.BLKB	6
	.ASCII	\  -- DEFAULT BLOCKS TO EXTEND FILES\<CR><LF>
H161:	.BLKB	3
	.ASCII	\  H.LRUC  \
H161V:	.BLKB	6
	.ASCII	\  -- NUMBER OF ENTRIES IN DIRECTORY LRU\<CR><LF>
H17:	.BLKB	3
	.ASCII	\  H.CHK1  \
H17V:	.BLKB	6
	.ASCII	\  -- CHECKSUM, WORDS 0-28\<CR><LF>
H18:	.BLKB	3
	.ASCII	\  H.VDAT  \
H18V:	.BLKB	14.
	.ASCII	\  -- CREATION DATE AND TIME\<CR><LF>
H19:	.BLKB	3
	.ASCII	\  H.CHK2  \
H19V:	.BLKB	6
	.ASCII	\  -- CHECKSUM OF HOME BLOCK\<CR><LF>
	.ASCII	<CR><LF><LF>\ ANY CHANGES? [Y/N]  \
HMBLKL=.-HOMBLK
FILNU:
	.ASCII	\   (HEADER NOT IN USE) \
FILHED:
	.ASCII	\  LOGICAL BLOCK NUMBER \
F1V:	.BLKB	8.
	.ASCII	<CR><LF>
F2:	.BLKB	3
	.ASCII	\  H.FNUM  \
F2V:	.BLKB	6
	.ASCII	\ -- FILE NUMBER\<CR><LF>
F3:	.BLKB	3
	.ASCII	\  H.FSEQ  \
F3V:	.BLKB	6
	.ASCII	\ -- FILE SEQUENCE NUMBER\<CR><LF>
F4:	.BLKB	3
	.ASCII	\  H.FLEV  \
F4V:	.BLKB	6
	.ASCII	\ -- STRUCTURE LEVEL AND SYSTEM NUMBER\<CR><LF>
F5:	.BLKB	3
	.ASCII	\  H.PROG(B)  \
F5V:	.BLKB	5
	.ASCII	\ -- MEMBER NUMBER\<CR><LF>
F6:	.BLKB	3
	.ASCII	\  H.PROJ(B)  \
F6V:	.BLKB	5
	.ASCII	\ -- GROUP NUMBER\<CR><LF>
F7:	.BLKB	3
	.ASCII	\  H.FPRO  \
F7V:	.BLKB	6
	.ASCII	\ -- FILE-PROTECTION CODE\<CR><LF>
F8:	.BLKB	3
	.ASCII	\  H.UCHA(B)  \
F8V:	.BLKB	5
	.ASCII	\ -- USER CONTROLLED CHARACTERISTICS\<CR><LF>
F9:	.BLKB	3
	.ASCII	\  H.SCHA(B)  \
F9V:	.BLKB	5
	.ASCII	\ -- SYSTEM CONTROLLED CHARACTERISTICS\<CR><LF>
F10:	.BLKB	3
	.ASCII	\  F.RTYP(B)  \
F10V:	.BLKB	5
	.ASCII	\ -- RECORD TYPE\<CR><LF>
F11:	.BLKB	3
	.ASCII	\  F.RATT(B)  \
F11V:	.BLKB	5
	.ASCII	\ -- RECORD ATTRIBUTES\<CR><LF>
F12:	.BLKB	3
	.ASCII	\  F.RSIZ  \
F12V:	.BLKB	6
	.ASCII	\ -- RECORD SIZE, OR LARGEST RECORD\<CR><LF>
F13:	.BLKB	3
	.ASCII	\  F.HIBK  \
F13V:	.BLKB	6
F14V:	.BLKB	6
	.ASCII	\ -- HIGHEST VIRTUAL BLOCK ALLOCATED\<CR><LF>
F15:	.BLKB	3
	.ASCII	\  F.EFBK  \
F15V:	.BLKB	6
F16V:	.BLKB	6
	.ASCII	\ -- END-OF-FILE BLOCK\<CR><LF>
F17:	.BLKB	3
	.ASCII	\  I.FNAM  \
F17V:	.BLKB	12.
	.ASCII	\ -- FILE NAME (RAD-50)\<CR><LF>
F18:	.BLKB	3
	.ASCII	\  I.FTYP     \
F18V:	.BLKB	3
	.ASCII	\ -- FILE TYPE (RAD-50)\<CR><LF>
F19:	.BLKB	3
	.ASCII	\  I.FVER  \
F19V:	.BLKB	6
	.ASCII	\ -- FILE VERSION NUMBER (BINARY)\<CR><LF>
F20:	.BLKB	3
	.ASCII	\  I.RVNO  \
F20V:	.BLKB	6
	.ASCII	\ -- REVISION NUMBER\<CR><LF>
F21:	.BLKB	3
	.ASCII	\  I.RVDT  \
F21V:	.BLKB	13.
	.ASCII	\ -- REVISION DATE AND TIME\<CR><LF>
F22:	.BLKB	3
	.ASCII	\  I.CRDT  \
F22V:	.BLKB	13.
	.ASCII	\ -- CREATION DATE AND TIME\<CR><LF>
F30:	.BLKB	3
	.ASCII	\  H.CKSM  \
F30V:	.BLKB	6
	.ASCII	\ -- CHECKSUM OF WORDS 0-254\<CR><LF>
	.ASCII	<LF>\ ANY CHANGES? [Y/N]  \
FILNUL=.-FILNU
FLHEDL=.-FILHED
;
;
	.PAGE
	.PSECT
START:
	FINIT$
	MOV	SP,STACK	; SAVE INITIAL VALUE OF SP
	CALL	HOME
; GET PASSWORD
	MSG	M10
	QIOW$S	#IO.RNE,#1,#1,,,,<#PWD1,#6>	; READ PASSWORD
	MOV	#PWD2,R0	; CHECK PASSWORD
	MOV	#PWD1,R1
	MOV	#6,R2
005$:
	CMPB	(R0)+,(R1)+
	BEQ	010$
	JMP	STOP
010$:
	SOB	R2,005$
;
; SEE IF INSTRUCTIONS ARE NEEDED
	MSG	M11
	CALL	GETANS
	BNE	015$
;
; PRINT INSTRUCTIONS
	CALL	HOME
	MSG	M12
	CALL	GETANS
;
; GET DEFAULT DRIVE
015$:
DEFDR:
	CALL	HOME
	MSG	M30
	MOV	#DRIVE,R4
	MOV	#5,R5
	CALL	INPUT
;
; ASSIGN DEFAULT DRIVE AS LUN #2
	CALL	ASGLUN
;
; READ HOME BLOCK AND LIST MENU
MENU:
	CALL	RDHMBK
	TST	$DSW
	BGT	025$
	MOVB	IOST,R0
	JMP	STOP
;
025$:
; CALCULATE LOCATION OF INDEX FILE HEADER
	MOV	HOMBUF+H.IBSZ,ADR2	; SIZE OF INDEX FILE BIT MAP
	ADD	HOMBUF+H.IBLB+2,ADR2	; LOCATION OF INDEX BIT MAP
	ADC	ADR1
	ADD	HOMBUF+H.IBLB,ADR1
; READ INDEX FILE HEADER
	QIOW$S  #IO.RLB,#2,#2,,#IOST,,<#IDXBUF,#512.,#0,ADR1,ADR2>
	TST	$DSW
	BGT	030$
	JMP	STOP
030$:
	CALL	HOME	; LIST THE MENU
	MSG	M40
	MOV	#ANS,R4
	MOV	#2,R5
	CALL	INPUT	; READ THE SELECTION
	MOVB	(R4),R4
	SUB	#60,R4
	CMP	#FUNC,R4	; CHECK FOR VALID SELECTION
	BGE	035$
	JMP	STOP
035$:
	DEC	R4	; GO DO WHAT HAS BEEN SELECTED
	ASL	R4
	ADD	#FUNC1,R4
	JMP	@(R4)
;
;**********************************************
;	INTERNAL SUBROUTINES
;**********************************************
;
; READ HOME BLOCK
RDHMBK:
	CLR	ADR1
	MOV	#1,ADR2
	QIOW$S #IO.RLB,#2,#2,,#IOST,,<#HOMBUF,#512.,#0,ADR1,ADR2>
	RETURN
;
;
;
; SUBROUTINE TO LIST THE HOME BLOCK
LSTHOM:
	CALL	HOME
	CALL	RDHMBK
	MOV	#HOMBLK,R0
	MOV	#15010,R3
	MOV	#33010,R4
	LIST	H.IBSZ
	MOV	#H1V,R0
	LSTHV	H.IBSZ
	MOV	#H2,R0
	LIST	H.IBLB
	MOV	#H2V,R0
	LSTHV	H.IBLB
	MOV	#H3,R0
	LIST	<H.IBLB+2>
	MOV	#H3V,R0
	LSTHV	<H.IBLB+2>
	MOV	#H4,R0
	LIST	H.FMAX
	MOV	#H4V,R0
	LSTHV	H.FMAX
	MOV	#H5,R0
	LIST	H.SBCL
	MOV	#H5V,R0
	LSTHV	H.SBCL
	MOV	#H6,R0
	LIST	H.DVTY
	MOV	#H6V,R0
	LSTHV	H.DVTY
	MOV	#H7,R0
	LIST	H.VLEV
	MOV	#H7V,R0
	LSTHV	H.VLEV
	MOV	#H8,R0
	LIST	H.VNAM
	MOV	#11.,R2
	MOV	#H8V,R0
	MOV	#<HOMBUF+H.VNAM>,R1
040$:
	MOVB	(R1)+,(R0)+
	SOB	R2,040$
	MOV	#H10,R0
	LIST	H.VCHA
	MOV	#H10V,R0
	LSTHV	H.VCHA
	MOV	#H15,R0
	LIST	H.WISZ
	MOV	#H15V,R0
	MOVB	HOMBUF+H.WISZ,R1
	BIC	#177400,R1
	MOV	R4,R2
	CALL	$CBTA
	MOV	#H16,R0
	LIST	H.FIEX
	MOV	#H16V,R0
	MOVB	HOMBUF+H.FIEX,R1
	BIC	#177400,R1
	MOV	R4,R2
	CALL	$CBTA
	MOV	#H161,R0
	LIST	H.LRUC
	MOV	#H161V,R0
	MOVB	HOMBUF+H.LRUC,R1
	BIC	#177400,R1
	MOV	R4,R2
	CALL	$CBTA
	MOV	#H17,R0
	LIST	H.CHK1
	MOV	#H17V,R0
	LSTHV	H.CHK1
	MOV	#H18,R0
	LIST	H.VDAT
	MOV	#14.,R2
	MOV	#<HOMBUF+H.VDAT>,R0
	MOV	#H18V,R1
050$:
	MOVB	(R0)+,(R1)+
	SOB	R2,050$
	MOV	#H19,R0
	LIST	H.CHK2
	MOV	#H19V,R0
	LSTHV	H.CHK2
;
	MOV	#HOMBLK,R4
	MOV	#HMBLKL,R5
	CALL	MESSG
	CALL	GETANS
	BNE	065$
	MOV	#HOMBUF,BUFADR
	CALL	CHANGE
;
; CALCULATE NEW CHECKSUMS
	MOV	#28.,R2
	CLR	HOMBUF+H.CHK1
	CLR	HOMBUF+H.CHK2
	MOV	#HOMBUF,R1
055$:
	ADD	(R1),HOMBUF+H.CHK1
	ADD	(R1)+,HOMBUF+H.CHK2
	SOB	R2,055$
	MOV	#227.,R2
060$:
	ADD	(R1)+,HOMBUF+H.CHK2
	SOB	R2,060$
;
; WRITE BACK HOME BLOCK
	CLR	ADR1
	MOV	#1,ADR2
	QIOW$S	#IO.WLB,#2,#2,,#IOST,,<#HOMBUF,#512.,#0,ADR1,ADR2>
	JMP	LSTHOM
065$:
	JMP	MENU
;
; SUBROUTINE TO LIST INDEX FILE HEADER
LSTIDX:
	CALL	LSTHED
	MOV	#1,FILNUM
	CALL	BLKREQ
	JMP	MENU
;
; SUBROUTINE TO PRINT ANY FILE HEADER
LSTHED:
	CALL	HOME
	MOV	#15010,R3
	MOV	#33010,R4
	MOV	#F1V,R0
	MOV	ADR1,R1
	MOV	#4010,R2
	CALL	$CBTA
	MOV	ADR2,R1
	MOV	R4,R2
	CALL	$CBTA
	MOV	#F2,R0
	LIST	H.FNUM
	MOV	#F2V,R0
	LSTIV	H.FNUM
	MOV	#F3,R0
	LIST	H.FSEQ
	MOV	#F3V,R0
	LSTIV	H.FSEQ
	MOV	#F4,R0
	LIST	H.FLEV
	MOV	#F4V,R0
	LSTIV	H.FLEV
	MOV	#F5,R0
	LIST	H.PROG
	MOV	#F5V,R0
	MOVB	IDXBUF+H.PROG,R1
	BIC	#177400,R1
	MOV	R3,R2
	CALL	$CBTA
	MOV	#F6,R0
	LIST	H.PROJ
	MOV	#F6V,R0
	MOVB	IDXBUF+H.PROJ,R1
	BIC	#177400,R1
	MOV	R3,R2
	CALL	$CBTA
	MOV	#F7,R0
	LIST	H.FPRO
	MOV	#F7V,R0
	LSTIV	H.FPRO
	MOV	#F8,R0
	LIST	H.UCHA
	MOV	#F8V,R0
	MOVB	IDXBUF+H.UCHA,R1
	BIC	#177400,R1
	MOV	R3,R2
	CALL	$CBTA
	MOV	#F9,R0
	LIST	H.SCHA
	MOV	#F9V,R0
	MOVB	IDXBUF+H.SCHA,R1
	BIC	#177400,R1
	MOV	R3,R2
	CALL	$CBTA
	MOV	#F10,R0
	LIST	<H.UFAT+F.RTYP>
	MOV	#F10V,R0
	MOV	IDXBUF+H.UFAT+F.RTYP,R1
	MOV	R3,R2
	CALL	$CBTA
	MOV	#F11,R0
	LIST	<H.UFAT+F.RATT>
	MOV	#F11V,R0
	MOVB	IDXBUF+H.UFAT+F.RATT,R1
	BIC	#177400,R1
	MOV	R3,R2
	CALL	$CBTA
	MOV	#F12,R0
	LIST	<H.UFAT+F.RSIZ>
	MOV	#F12V,R0
	LSTIV	<H.UFAT+F.RSIZ>
	MOV	#F13,R0
	LIST	<H.UFAT+F.HIBK>
	MOV	#F13V,R0
	LSTIV	<H.UFAT+F.HIBK>
	LSTIV	<H.UFAT+F.HIBK+2>
	MOV	#F15,R0
	LIST	<H.UFAT+F.EFBK>
	MOV	#F15V,R0
	LSTIV	<H.UFAT+F.EFBK>
	LSTIV	<H.UFAT+F.EFBK+2>
	MOV	#F17,R0
	MOVB	IDXBUF+H.IDOF,R5
	ASL	R5
	MOV	R5,R1
	MOV	R3,R2
	CALL	$CBTA
	MOV	#F17V,R0
	ADD	#IDXBUF,R5
	MOV	I.FNAM(R5),R1
	CALL	$C5TA
	MOV	I.FNAM+2(R5),R1
	CALL	$C5TA
	MOV	I.FNAM+4(R5),R1
	CALL	$C5TA
	MOV	#F18,R0
	LIST	<S.HDHD+I.FTYP>
	MOV	#F18V,R0
	MOV	I.FTYP(R5),R1
	CALL	$C5TA
	MOV	#F19,R0
	LIST	<S.HDHD+I.FVER>
	MOV	#F19V,R0
	MOV	I.FVER(R5),R1
	MOV	R4,R2
	CALL	$CBTA
	MOV	#F20,R0
	LIST	<S.HDHD+I.RVNO>
	MOV	#F20V,R0
	MOV	I.RVNO(R5),R1
	MOV	R4,R2
	CALL	$CBTA
	MOV	#F21,R0
	LIST	<S.HDHD+I.RVDT>
	MOV	#F21V,R0
	MOV	R5,R1
	ADD	#I.RVDT,R1
	MOV	#13.,R2
070$:
	MOVB	(R1)+,(R0)+
	BNE	072$
	MOVB	#40,-1(R0)
072$:
	SOB	R2,070$
	MOV	#F22,R0
	LIST	<S.HDHD+I.CRDT>
	MOV	#F22V,R0
	MOV	R5,R1
	ADD	#I.CRDT,R1
	MOV	#13.,R2
075$:
	MOVB	(R1)+,(R0)+
	BNE	077$
	MOVB	#40,-1(R0)
077$:
	SOB	R2,075$
	MOV	#F30,R0
	LIST	H.CKSM
	MOV	#F30V,R0
	LSTIV	H.CKSM
	MOV	#CLRSCR,R4
	MOV	#6,R5
	CALL	MESSG
	TST	IDXBUF+H.FNUM
	BNE	78$
	MOV	#FILNU,R4
	MOV	#FILNUL,R5
	BR	79$
78$:
	MOV	#FILHED,R4
	MOV	#FLHEDL,R5
79$:
	CALL	MESSG
	CALL	GETANS
	BNE	090$
	MOV	#IDXBUF,BUFADR
	CALL	CHANGE
	MOV	#S.IDHD,R0	; STORE OFFSETS
	ASH	#8.,R0
	MOV	#S.HDHD,R1
	ASR	R1
	BIS	R1,R0
	MOV	R0,IDXBUF+H.IDOF
	MOV	#255.,R2	; CALC NEW CHECKSUM
	MOV	#<IDXBUF+H.CKSM>,R0
	CLR	(R0)
	TST	IDXBUF+H.FNUM	; BUT NOT IF FILE IS NOT IN USE
	BEQ	087$
	MOV	#IDXBUF,R1
085$:
	ADD	(R1)+,(R0)
	SOB	R2,085$
; WRITE BACK THE FILE HEADER
087$:
	QIOW$S	#IO.WLB,#2,#2,,#IOST,,<#IDXBUF,#512.,#0,ADR1,ADR2>
	JMP	LSTHED
090$:
	RETURN
;
;
; ***************************************************************
; ENTRY POINT FOR ROUTINE TO FIND FILE HEADER BY FILE NUMBER
; ***************************************************************
;
LSTNUM:
	CALL	HOME
LSTNU2:
	MSG	M31
	MOV	#DATA,R4
	MOV	#8.,R5
	CALL	INPUT
	MOV	IOST+2,R0	; CONVERT A1 VALUE TO OCTAL
	ADD	#DATA,R0
	MOVB	#'A,(R0)
	MOV	#DATA,R0
	CALL	$COTB
	MOV	R1,FILNUM	; SAVE BINARY FILE NUMBER
	JMP	LST2
;
;
; ***************************************************************
; ENTRY POINT FOR ROUTINE TO FIND FILE HEADER BY FILE NAME
; ***************************************************************
;
LSTNAM:
	CALL	GETFIL
	BCS	LSTNAM
; TRY TO OPEN FILE BY FILE NAME BLOCK
150$:
	MOV	SFIL+F.FNB,FILNUM
	MOV	SFIL+F.FNB+2,FILSEQ
	OFNB$	#SFIL
	MOVB	F.ERR(R0),R1
	BGT	155$
; IF FILE EXISTS BUT CANNOT BE OPENED, SHOW THE FCS ERROR AND
; THE FILE NUMBER, SO IT CAN BE OPENED BY FILE NUMBER.
	MOV	#M51A,R0
	MOV	#14412,R2
	CALL	$CBTA
	MOV	#M52A,R0
	MOV	FILNUM,R1
	MOV	#33010,R2
	CALL	$CBTA
	MOVB	#':,(R0)+
	MOV	FILSEQ,R1
	MOV	#33010,R2
	CALL	$CBTA
	MSG	M51
	JMP	LSTNU2
155$:
	CLOSE$	#SFIL		; CLOSE THE FILE
;
; FIND THE LOGICAL BLOCK CONTAINING THE FILE HEADER
LST2:
	MOV	#SWIT,-(SP)
	MOV	#IOST,-(SP)
	MOV	#ADR1,-(SP)
	MOV	#FILNUM,-(SP)
	MOV	#IDXBUF,-(SP)
	MOV	#LUN,-(SP)
	MOV	#6,-(SP)
	MOV	SP,R5
	CALL	HEDBLK
	ADD	#14.,SP
; CHECK FOR VALID HEADER
	TSTB	IOST
	BGT	157$
	MSG	M53
	CALL	WAITFR
	JMP	MENU
; READ THE FILE HEADER
157$:
	QIOW$S  #IO.RLB,#2,#2,,#IOST,,<#IDXBUF,#512.,#0,ADR1,ADR2>
; LIST THE FILE HEADER
	CALL	LSTHED
	CALL	BLKREQ
160$:
	CALL	ASGLUN	; REASSIGN LUN 2 TO THE DEFAULT DRIVE
	JMP	MENU
;
;
BLKLST:
	MSG	M75
	MOV	#37010,R3
	CLR	BLKNUM
	CLR	BLKNUM+2
	MOV	#IDXBUF,-(SP)	; SET UP BUFFER WITH
	MOV	#TWO,-(SP)	; LOGICAL BLOCK FOR RETRIEVAL POINTERS
	MOV	#2,-(SP)
	MOV	SP,R5
	CALL	DBLKS
	ADD	#6,SP
165$:
;			GET DATA ON NEXT CONTIGUOUS BLOCK GROUP
	MOV	#COUNT,-(SP)
	MOV	#FIRST,-(SP)
	MOV	#TWO,-(SP)
	MOV	#3,-(SP)
	MOV	SP,R5
	CALL	DBLK
	CMP	#1,FILNUM	; SPECIAL FOR INDEX FILE
	BNE	166$
	TST	BLKNUM+2
	BNE	166$
	CALL	DBLK
	CALL	DBLK
	ADD	HOMBUF+H.IBSZ,FIRST+2
	SUB	HOMBUF+H.IBSZ,COUNT
166$:
	ADD	#8.,SP
	TST	BLKNUM+2
	BEQ	170$
	TST	FIRST
	BNE	170$
	TST	FIRST+2
	BEQ	175$
170$:
	MOV	#M76A,R0
	MOV	COUNT,R1
	MOV	R3,R2
	CALL	$CBTA
	MOV	BLKNUM+2,R1
	INC	R1
	MOV	#M76B,R0
	MOV	R3,R2
	CALL	$CBTA
	ADD	COUNT,BLKNUM+2
	ADC	BLKNUM
	MOV	BLKNUM+2,R1
	MOV	#M76C,R0
	MOV	R3,R2
	CALL	$CBTA
	MOV	FIRST+2,R1
	MOV	#M76D,R0
	MOV	R3,R2
	CALL	$CBTA
	MOV	FIRST+2,R1
	ADD	COUNT,R1
	DEC	R1
	MOV	#M76E,R0
	MOV	R3,R2
	CALL	$CBTA
	MSG	M76
	BR	165$
175$:
WAITFR:
	MSG	M13
	CALL	GETANS
	RETURN
;
; ***************************************************************
; ROUTINE TO FIND FILE CONTAINING A CERTAIN LOGICAL BLOCK
; ***************************************************************
;
HUNT:
	MOV	#M61A,R0	; CLEAR OUT MESSAGE OUTPUT AREA
	MOV	#M61B,R1
	MOV	#7,R2
180$:
	CLRB	(R0)+
	CLRB	(R1)+
	SOB	R2,180$
	CALL	HOME
	MOV	#1,SW
	MSG	M60
	CALL	GETBLK
	CLR	FILNUM
; START LOOP THRU ALL FILES, BEGINNING WITH FILE 1
185$:
	INC	FILNUM
	MOV	#1,BLKPOS
	MOV	#SW,-(SP)
	MOV	#IOST,-(SP)
	MOV	#ADR1,-(SP)
	MOV	#FILNUM,-(SP)
	MOV	#IDXBUF,-(SP)
	MOV	#TWO,-(SP)
	MOV	#6,-(SP)
	MOV	SP,R5
	CALL	HEDBLK	; GET LOCATION OF FILE HEADER
	ADD	#14.,SP
	TSTB	IOST	; END OF INDEX FILE?
	BLT	195$
; READ FILE HEADER
	QIOW$S	#IO.RLB,#2,#2,,#IOST,,<#FILBUF,#512.,#0,ADR1,ADR2>
	TST	FILBUF+H.FNUM	; IF FILE NUMBER IS 0, FILE IS
	BEQ	185$		; NOT IN USE
	MOV	#FILBUF,-(SP)
	MOV	#TWO,-(SP)
	MOV	#2,-(SP)
	MOV	SP,R5
	CALL	DBLKS	; SET UP TO DECODE RETRIEVAL POINTERS
	ADD	#6,SP
; LOOP THRU ALL POINTERS IN THIS FILE
190$:
	MOV	#COUNT,-(SP)
	MOV	#FIRST,-(SP)
	MOV	#TWO,-(SP)
	MOV	#3,-(SP)
	MOV	SP,R5
	CALL	DBLK		; GET NEXT RETRIEVAL POINTER
	ADD	#8.,SP
	MOV	FIRST+2,R4		
	TST	COUNT
	BEQ	185$
; SEE IF REQUESTED BLOCK IS IN CURRENT RANGE
	ADD	COUNT,BLKPOS
	CMP	BLKNUM+2,R4
	BLO	190$
	ADD	COUNT,R4
	DEC	R4
	CMP	BLKNUM+2,R4
	BHI	190$
	CMP	FIRST,BLKNUM
	BNE	190$
;
; IF IN THIS FILE, LIST FILE NUMBER AND LOCATION OF BLOCK IN FILE
	ADD	BLKNUM+2,BLKPOS
	SUB	FIRST+2,BLKPOS
	SUB	COUNT,BLKPOS
	MOV	#M61,R4
	MOV	#M61L,R5
	MOV	BLKPOS,R1
	MOV	#M61A,R0
	MOV	#34010,R2
	CALL	$CBTA
	MOV	FILNUM,R1
	MOV	#M61B,R0
	MOV	#34010,R2
	CALL	$CBTA
	CALL	MESSG
	BR	200$
195$:
	MSG	M62
200$:
	MSG	M13
	CALL	GETANS
	JMP	MENU
;
; ***************************************************************
; ROUTINE TO READ AND RE-WRITE A DISK BLOCK, PURELY FOR
; THE PURPOSE OF ELIMINATING A PARITY ERROR
; ***************************************************************
;
REWRIT:
	CALL	HOME
	MSG	M80
	MOV	#2,R0
	BR	FETCH
;
; ***************************************************************
; ROUTINE TO COPY SELECTED BLOCKS FROM BACKUP PACK
; ***************************************************************
;
CPYBKP:
	CALL	HOME
	MSG	M91
	MSG	M92
	MOV	#SOURCE,R4
	MOV	#6,R5
	CALL	INPUT
	MOV	SOURCE,R0
	MOVB	SOURCE+2,R1
	SUB	#60,R1
	ALUN$S	#3,R0,R1
	TST	$DSW
	BGT	2010$
	JMP	STOP
2010$:
	MOV	#3,R0
FETCH:
	MSG	M93
	MOV	#DATA,R4
	MOV	#10.,R5
	CALL	INPUT
	MOV	#BLKNUM,R3
	MOV	IOST+2,R4
	MOV	#DATA,R5
	CALL	.OD2CT
	BCC	2020$
	MSG	M94
	BR	2040$
2020$:
	QIOW$S	#IO.RLB,R0,R0,,#IOST,,<#FILBUF,#512.,#0,BLKNUM,BLKNUM+2>
	TSTB	IOST
	BGT	2030$
	MSG	M95
	BR	2040$
2030$:
	QIOW$S	#IO.WLB,#2,#2,,#IOST,,<#FILBUF,#512.,#0,BLKNUM,BLKNUM+2>
	TSTB	IOST
	BGT	2040$
	MSG	M96
2040$:
	CALL	GETANS
	BEQ	FETCH
	ALUN$S	#3
	JMP	MENU
; ***************************************************************
;  ROUTINE TO MOVE FILE ENTRY FROM ONE UFD TO ANOTHER
; ***************************************************************
;
MOVUFD:
	CALL	GETFIL
	BCC	3010$
	MSG	M13
	CALL	GETANS
	JMP	MENU
3010$:
	MOV	SFIL+F.FNB+N.FID,R1
	MOV	#M52A,R0
	MOV	#33010,R2
	CALL	$CBTA
	MOVB	#':,(R0)+
	MOV	SFIL+F.FNB+N.FID+2,R1
	MOV	#30010,R2
	CALL	$CBTA
	MSG	M52
	MOV	#SFIL,R0
	MOV	SFIL+F.FNB+N.FID,WORK	; SAVE FILE ID
	MOV	SFIL+F.FNB+N.FID+2,WORK+2
	MOV	SFIL+F.FNB+N.DID,WORK+4
	MOV	SFIL+F.FNB+N.DID+2,WORK+6
	MSG	M32
	MOV	#DATA,R4
	MOV	R4,NEWUIC+2
	MOV	#10.,R5
	CALL	INPUT
	MOV	IOST+2,NEWUIC
	MOV	#SFIL,R0
	MOV	#<SFIL+F.FNB>,R1
	MOV	#NEWUIC,R2
	CALL	.GTDIR
	BCS	3025$
	MOV	WORK,SFIL+F.FNB+N.FID
	MOV	WORK+2,SFIL+F.FNB+N.FID+2
	CALL	.ENTER
	BCC	3030$
3025$:
	MOVB	F.ERR(R0),R1
	MOV	#M51A,R0
	MOV	#14412,R2
	CALL	$CBTA
	MSG	M51
	MSG	M55
	CALL	WAITFR
	JMP	MENU
3030$:
	MOV	WORK+4,SFIL+F.FNB+N.DID
	MOV	WORK+6,SFIL+F.FNB+N.DID+2
	MOV	WORK,SFIL+F.FNB
	MOV	WORK+2,SFIL+F.FNB+2
	CALL	.REMOV
	BCC	3040$
	MSG	M54
	CALL	WAITFR
3040$:
	JMP	MENU
;
;
GETFIL:
	MOV	#PLEN,R0	 ; CLEAR COMMAND LINE
	MOV	#GCLBUF,R1
95$:
	CLR	(R1)+
	SOB	R0,95$
	GCML$	#GCLM,#PROMP2,#PLEN	 ; READ COMMAND LINE
	CMPB	GCLM+G.ERR,#GE.EOF
	BNE	100$
	JMP	STOP
100$:
	CSI$1	#CSIBLK,#GCLBUF,#41.
	MOVB	#1,CSIBLK
	CLR	R3
	MOV	#4,CSIBLK+C.DEVD	; ASSUME DEFAULT DRIVE
	MOV	#DRIVE,CSIBLK+C.DEVD+2
	MOV	#SFIL,R0	; ASSUME DEFAULT UIC
	MOV	#<SFIL+F.FNB>,R1
	CALL	.GTDID
; CHECK COMMAND LINE FOR DRIVE AND UIC ENTRIES
; THE DATASET DESCRIPTOR WILL BE SET UP WITHIN THE CSI BLOCK
	MOV	<CSIBLK+C.CMLD>,R1
	MOV	CSIBLK+C.CMLD+2,R2
	CLR	DRVSW
	CLR	UICSW
105$:
	CMPB	(R2),#':
	BNE	110$
	INC	DRVSW	; A DRIVE IS DESIGNATED
110$:
	CMPB	(R2)+,#'[
	BNE	115$
	INC	UICSW	; A UIC IS DESIGNATED
	BR	120$
115$:
	SOB	R1,105$
120$:
	MOV	CSIBLK+C.CMLD,R1
	MOV	CSIBLK+C.CMLD+2,R2
	TST	DRVSW
	BEQ	130$
125$:
	INC	R3		; IF A DRIVE IS PART OF FILE DESCRIPTION,
	CMPB	(R2)+,#':	; BUILD IT INTO THE DATASET DESCRIPTOR
	BNE	125$
	MOV	R3,CSIBLK+C.DEVD
	MOV	CSIBLK+C.CMLD+2,CSIBLK+C.DEVD+2
	SUB	R3,R1
	CLR	R3
	MOV	GCLM,R4
	MOVB	GCLM+2,R5
	SUB	#60,R5
	ALUN$S	#2		; CLOSE CURRENT LUN 2
	ALUN$S	#2,R4,R5	; ASSIGN SPECIFIED DEVICE AS LUN 2
130$:
	TST	UICSW
	BEQ	140$
	MOV	R2,CSIBLK+C.DIRD+2
135$:
	INC	R3
	CMPB	(R2)+,#']
	BNE	135$
	MOV	R3,CSIBLK+C.DIRD
	SUB	R3,R1
140$:
	MOV	R1,CSIBLK+C.FILD
	MOV	#DATA,R3
	MOV	R3,CSIBLK+C.FILD+2
145$:
	MOVB	(R2)+,(R3)+
	SOB	R1,145$
	CLR	R3
; PUT DATA INTO THE FILE NAME BLOCK OF THE FDB
	MOV	#SFIL,R0
	MOV	#<SFIL+F.FNB>,R1
	MOV	#<CSIBLK+C.DSDS>,R2
	CALL	.PARSE
; FIND THE FILE ENTRY IN ITS UFD
	MOV	#SFIL,R0
	MOV	#<SFIL+F.FNB>,R1
	CALL	.FIND
	BCC	147$
; IF FILE DOESN'T EXIST, RETURN A -26 ERROR
	MOV	#-26.,R1
	MOV	#M51A,R0
	MOV	#14412,R2
	CALL	$CBTA
	MSG	M50
	SEC
147$:
	RETURN
;
; ***************************************************************
; SUBROUTINE TO DISPLAY OR CHANGE DATA IN A BUFFER
; ***************************************************************
;
CHANGE:
202$:
	MOV	#PROMPT,R4
	MOV	#3,R5
205$:
	CALL	MESSG
210$:
	MOV	#-1,ADR	; INDICATES NO ADR IS STORED
215$:
	CLR	CHARCT
220$:
	MOV	#DATA,R1
	ADD	CHARCT,R1
	QIOW$S	#IO.RLB,#1,#1,,#IOST,,<R1,#1>	; READ 1 CHARACTER
	CMP	#-10.,IOST	; CHECK FOR CTRL Z
	BNE	225$
	RETURN
225$:
	CMP	IOST,#IS.CR	; CHECK FOR <CR>
	BNE	230$
	MOVB	#15,1(R1)	; IF FOUND, ENTER AT END OF ARRAY
	BR	235$
230$:
	CMPB	#'0,(R1)	; LOOK FOR NUMERIC ENTRY
	BGT	235$
	CMPB	#'7,(R1)
	BLT	235$
	INC	CHARCT
	JMP	220$
235$:
	TST	ADR	; IS AN ADR STORED?
	BGE	300$
	TST	CHARCT	; ARE THERE ANY CHARACTERS ENTERED?
	BNE	245$
240$:
	MOV	#WRONG,R4	; INVALID ENTRY
	MOV	#5,R5
	BR	205$
;
; CONVERT ENTRY TO OCTAL VALUE
245$:
	MOV	#BLANK,R4
	MOV	#1,R5
	CALL	MESSG
	MOV	#DATA,R0
	CALL	$COTB
	CMP	R1,#1000	; VALID ADR?
	BGE	240$
	MOVB	R2,MODE
	MOV	R1,ADR		; SAVE ADR
	MOV	R1,R3
250$:
	MOV	#DATA,R1
	ADD	BUFADR,R3
;
; CHECK FOR /
255$:
	CMP	#'/,R2
	BNE	260$
	BIT	#1,R3		; EVEN ADR?
	BNE	275$
	MOV	(R3),R1
	MOV	#31010,R2
	MOV	#6,R5
	JMP	280$
260$:
	CMP	#'",R2
	BNE	265$
	BIT	#1,ADR
	BNE	290$
	MOV	R3,R4
	MOV	#2,R5
	CALL	MESSG
	CALL	SPACE
	JMP	215$
265$:			; CHECK FOR RAD-50
	CMP	#'%,R2
	BNE	270$
	BIT	#1,R3		; EVEN ADR?
	BNE	240$
	MOV	(R3),R1
	MOV	#WORK,R0
	MOV	R0,R4
	CALL	$C5TA
	MOV	#3,R5
	CALL	MESSG
	CALL	SPACE
	JMP	215$
270$:			; CHECK FOR BYTE
	CMP	#'\,R2
	BNE	285$
275$:
	MOV	#'\,R2
	MOV	#3,R5
	MOV	#15010,R2
	MOVB	(R3),R1
	BIC	#177400,R1
280$:
	MOV	#WORK,R0
	MOV	R0,R4
	CALL	$CBTA
	CALL	MESSG
	CALL	SPACE
	JMP	215$
285$:
	CMP	#'',R2
	BNE	295$
290$:
	MOV	#'',R2
	MOV	R3,R4
	MOV	#1,R5
	CALL	MESSG
	CALL	SPACE
	JMP	215$
295$:			; CHECK FOR CR
	CMP	#15,R2
	BNE	240$
	JMP	202$
; AN ADR HAS ALREADY BEEN STORED
300$:
	MOVB	(R1),LASTC
	MOVB	(R1),R2
	CMP	#12,R2		; CHECK FOR <LF>
	BEQ	315$
	CMP	#136,R2		; CHECK FOR <^>
	BNE	305$
	BR	315$
305$:
	CMP	IOST,#IS.CR
	BEQ	310$
	JMP	375$
310$:
	MOVB	#15,R2
	MOVB	R2,(R1)
315$:
	TST	CHARCT
	BEQ	340$
	MOV	#DATA,R0
	MOV	ADR,R3
	ADD	BUFADR,R3
	CMPB	#'/,MODE
	BNE	320$
	CALL	$COTB
	MOV	R1,(R3)
	BR	340$
320$:
	CMPB	#'",MODE
	BNE	325$
	MOV	(R1),(R3)	; ACCEPT INPUT AS A2
	BR	340$
325$:
	CMPB	#'%,MODE
	BNE	330$
	MOV	#1,R1		; CONVERT INPUT TO R50
	CALL	$CAT5B
	MOV	R1,(R3)
	BR	340$
330$:
	CMPB	#'\,MODE
	BNE	335$
	CALL	$COTB
	MOVB	R1,(R3)
	BR	340$
335$:
	MOVB	(R0),(R3)	; ACCEPT INPUT AS A1
;
; SEE IF ENTRY ENDED WITH A LF OR CIRCUMFLEX
340$:
	CMP	IOST,#IS.CR
	BNE	345$
	JMP	202$
345$:
	CMPB	#12,LASTC
	BEQ	360$
	CMPB	#'^,LASTC
	BEQ	350$
	JMP	202$
350$:
	MOV	#PROMPT,R4
	MOV	#1,R5
	CALL	MESSG
	CMPB	#'',MODE
	BEQ	355$
	CMPB	#'\,MODE
	BEQ	355$
	BIT	#1,ADR
	BNE	355$
	DEC	ADR
355$:
	DEC	ADR
	TST	ADR
	BGE	370$
	JMP	240$
360$:
	CMPB	#'',MODE
	BEQ	365$
	CMPB	#'\,MODE
	BEQ	365$
	BIT	#1,ADR
	BNE	365$
	INC	ADR
365$:
	INC	ADR
	CMP	ADR,#1000
	BLT	370$
	JMP	240$
370$:
	MOV	#WORK,R0
	MOV	ADR,R1
	MOV	ADR,R3
	ADD	BUFADR,R3
	MOV	#15010,R2
	CALL	$CBTA
	MOVB	MODE,(R0)+
	MOVB	#40,(R0)+
	MOV	#<PROMPT+1>,R4
	MOV	#7.,R5
	CALL	MESSG
	CLR	CHARCT
	MOVB	MODE,R2
	MOV	ADR,R3
	JMP	250$
375$:
	CMPB	R2,#'/
	BEQ	385$
	CMPB	R2,#'\
	BEQ	385$
	CMPB	R2,#'"
	BEQ	385$
	CMPB	R2,#'%
	BEQ	385$
	CMPB	R2,#''
	BEQ	385$
	INC	CHARCT
	JMP	220$
385$:
	MOVB	R2,MODE
	JMP	255$
	RETURN
;
BLKREQ:
	MSG	M70
	CALL	GETANS
	BNE	386$
	CALL	BLKLST
386$:
	RETURN
;
GETBLK:
	MOV	#DATA,R4
	MOV	#10.,R5
	CALL	INPUT	; GET NUMBER OF LOGICAL BLOCK TO BE FOUND
	MOV	#BLKNUM,R3
	MOV	IOST+2,R4
	MOV	#DATA,R5
	CALL	.OD2CT	; CONVERT FROM A1 TO DOUBLE-WORD
	RETURN
;
; ASSIGN LOGICAL UNIT NUMBER
ASGLUN:
	ALUN$S	#2
	MOV	DRIVE,R0
	MOVB	DRIVE+2,R1
	SUB	#60,R1
	ALUN$S	#2,R0,R1
	TST	$DSW
	BGT	390$
	JMP	STOP
390$:
	RETURN
;
; HOME THE CURSOR AND CLEAR SCREEN (VT52)
HOME:
	MOV	#CLRSCR,R4
	MOV	#7,R5
	CALL	MESSG
	RETURN
;
MESSG:
	QIOW$S	#IO.WAL,#1,#1,,,,<R4,R5>
	RETURN
;
;
GETANS:
	MOV	#ANS,R4
	MOV	#1,R5
	CALL	INPUT
	BIC	#40,(R4)
	CMPB	#YES,(R4)
	RETURN
;
INPUT:
	QIOW$S	#IO.RLB,#1,#1,,#IOST,,<R4,R5>
	CMP	IOST,#IE.EOF
	BEQ	STOP
	CMP	IOST,#IS.ESC
	BNE	10$
	MOV	STACK,SP
	JMP	MENU
10$:
	RETURN
;
SPACE:
	MOV	#BLANK,R4
	MOV	#2,R5
	CALL	MESSG
	RETURN
;
STOP:
	MSG	M20
	EXIT$S
;
	.END	START