.TITLE  FIDDLE -- FIDDLE A BIT MAP
	.IDENT	/1/
	.MCALL	STRMACS,IF,END,ELSE,IFB
	.MCALL	FINIT$,GCML$,ERR$P,EXIT$S,CSI$1,CSI$2,OPNS$M,CLOSE$
	.MCALL	QIO$,FDBDF$,FDRC$A,FDOP$A,GCMLB$,CSI$,ERR$B,WTSE$
	.MCALL	CSI$SW,CSI$SV,CSI$ND,FSRSZ$,FDBK$A,DIR$
	STRMACS
	FSRSZ$	2
;
;	THIS ROUTINE CAN BE USED TO FIDDLE BITS IN ABITMAP OF A DISK
;	FILE. IN PARTICULAR, IT CAN BE USED TO SET OR RESET
;	BITS IN THE INDEX FILE BITMAP AS NEEDED TO REMOVE FILES WITH
;	BAD FILE HEADER (SEE NOV 76 DISPATCH)
;
;	COMMAND LINE:
;
;	FID FILE-SPEC [/SWITCHES]
;
;	WHERE /SWITCHES MAY BE ONE OF
;
;	/SET		SET THE BIT IN THE BIT FILE
;	/BLOCK:BLOCK	THE BIT MAP STARTS IN BLOCK "BLOCK". 1 ASSUMED.
;	/BYTE:BYTE	THE BIT MAP STARTS AD BYTE "BYTE" IN BLOCK "BLOCK"
;			0 IS ASSUMED
;	/ADJUST:VALUE	ADJUST BIT NUMBER BY ADDING "VALUE"
;
;	THE PROGRAM THEN PROMPTS FOR THE BIT
;	TO BE SET OR RESET.
;
;	ENTER CONTROL-Z TO EXIT
;
START:
	FINIT$
	MOV  #SUB,ERR+E.SUBL		;ADDRESS OF SUBSTITUTION LIST
	GCML$  #GCMBLK			;GET A COMMAND LINE
	IF  ,CS 			;IF ERROR
ERRCML:
	  IFB  #GE.EOF,NE,GCMBLK+G.ERR	;IF NOT END OF FILE
	    ERR$P  #ERR,<%CANNOT GET COMMAND LINE>
	  END
EXIT:
	  EXIT$S			;EXIT
	END
	CSI$1  #CSIBLK,GCMBLK+G.CMLD+2,GCMBLK+G.CMLD
	IF  ,CS 			;IF NOT OK
	  ERR$P  #ERR,<%INVALID SYNTAX : %>
	  BR  EXIT			;GO EXIT
	END
	CSI$2  #CSIBLK,OUTPUT,#SWITCH
	IF  ,CS 			;IF NOT OK
	  ERR$P  #ERR,<%INVALID FILE SPECIFIER : %>
	  BR  EXIT
	END
	OPNS$M	#IN			;OPEN FILE
	IF  ,CS 			;IF ERROR
	  MOVB	F.ERR(R0),R1		;ERROR CODE
	  NEG  R1			;AND MESSAGE NUMBER
	  ERR$P  #ERR,<%CANNOT OPEN FILE : >,R1
	  BR  EXIT
	END
LOOP:
	GCML$  #GCMBLK,#BIT,#LBIT	;GET A BIT NUMBER
	IF  ,CS 			;IF ERROR
	  CLOSE$  #IN			;CLOSE FILE
	  BR  ERRCML			;AND HANDLE ERROR
	END
	MOV  GCMBLK+G.CMLD+2,R0 	;GET ADDRESS OF INPUT
	MOV  R0,R1			;AND ADDRESS OF END OF STRING
	ADD  GCMBLK+G.CMLD,R1		;..
	CLRB  (R1)			;AND INSERT A TERMINATOR
	CALL  $COTB			;CONVERT TO BINARY
	IF  R2,NE			;IF WE DIDN'T HIT OUR STOPPER, THERE
					;WAS INVALID INPUT
	  ERR$P  #ERR,<%INVALID INPUT>
	  BR  LOOP			;GO GIVE HIM ANOTHER CHANCE
	END
	ADD  VALUE,R1			;ADJUST BIT POSITION
	MOV  R1,R3			;SAVE BIT NUMBER
	ASH  #-3,R3			;AND GET BYTE NUMBER
	BIC  #^C7,R1			;AND BIT WITHIN BYTE
	ADD  BYTE,R3			;ADD IN BYTE WITHIN BLOCK
	MOV  R3,R2			;AND NOTE
	ASH  #-9.,R3			;FIND BLOCK NUMBER
	BIC  #^C177,R3			;...
	ADD  BLOCK,R3			;AND BLOCK WITHIN FILE
	MOV  R1,R4			;SAVE THE OFFSET IN BYTE
	MOV  R3,READ+Q.IOPL+10		;NOTE IN FDB
	DIR$  #READ			;READ A BLOCK
	IF  ,CC
	  DIR$	#WAIT
	END
	IF  ,CS
	  MOV  $DSW,R1			;GET ERROR CODE
	ELSE
	  MOVB	IOST,R1 		;GET ERROR CODE
	END
	IF  ,LT
	  NEG  R1			;AND ERROR MESSAGE NUMBER
	  ERR$P  #ERR,<%ERROR READING FILE : >,R1
	  BR  LOOP			;GO TRY NEXT COMMAND
	END
	BIC  #^C777,R2			;GET BYTE WITHIN BLOCK
	IF  #SW.SE,SETON,OPTION 	;IF WE ARE TO SET THE BIT
	  IFB  MASK(R4),SETON,BUF(R2)
	    ERR$P  #ERR,<%ALREADY SET>
	    JMP  LOOP
	  END
	  BISB	MASK(R4),BUF(R2)	;DO SO
	ELSE
	  IFB  MASK(R4),SETOFF,BUF(R2)
	    ERR$P  #ERR,<%ALREADY RESET>
	    JMP  LOOP
	  END
	  BICB	MASK(R4),BUF(R2)	;OTHERWISE CLEAR THE BIT
	END
	MOV  R3,WRITE+Q.IOPL+10 	;GET BLOCK NUMBER IN FILE AGAIN
	DIR$  #WRITE			;AND WRITE IT OUT
	IF  ,CC 			;IF OK
	  DIR$	#WAIT			;WAIT FOR I/O TO FINISH
	END
	IF  ,CS 			;IF DIRECTIVE REJECTED
	  MOV  $DSW,R1			;GET REASON
	ELSE
	  MOVB	IOST,R1 		;OTHERWISE GET HANDLER STATUS
	END
	IF  ,LT 			;IF ERROR
	  NEG  R1			;AND MESSAGE NUMBER
	  ERR$P  #ERR,<%ERROR WRITING FILE : >,R1
	END
	JMP  LOOP
	.PAGE
;
;	DATA AREAS
;
IN:
	FDBDF$
	FDRC$A	FD.RWM
	FDBK$A	,,,,IOST
	FDOP$A	2,CSIBLK+C.DSDS
;
GCMBLK:
	GCMLB$	1,FID,,5
;
	CSI$
CSIBLK: .BLKB  C.SIZE
	.EVEN
BUF:	.BLKB  512.
;
ERR:
	ERR$B  6,1,<SY0:,[1,2],QIOSYM.MSG>,0
SUB:	.WORD  EF.ASC,BITM,LBITM,0
BITM:   .ASCII  /FID -- /
LBITM=	.-BITM
BIT:    .ASCII  <15><12>/BIT? /
LBIT=	.-BIT
MASK:	.BYTE  1,2,4,10,20,40,100,200
;
SW.SE=	1
SW.BL=	2
SW.BY=	4
SW.AD=	10
	.EVEN
OPTION: .WORD  0
BYTE:	.WORD  0
BLOCK:	.WORD  1
IOST:	.BLKW  2
VALUE:	.WORD  0
;
SWITCH:
	CSI$SW	SE,SW.SE,OPTION
	CSI$SW	BL,SW.BL,OPTION,,,.BL
	CSI$SW	BY,SW.BY,OPTION,,,.BY
	CSI$SW	AD,SW.AD,OPTION,,,.VA
	CSI$ND
.BL:
	CSI$SV	OCTAL,BLOCK,2
	CSI$ND
.BY:
	CSI$SV	OCTAL,BYTE,2
	CSI$ND
.VA:
	CSI$SV	OCTAL,VALUE,2
	CSI$ND
;
READ:
	QIO$  IO.RVB,2,1,,IOST,,<BUF,512.,0,0,0>
WRITE:
	QIO$  IO.WVB,2,1,,IOST,,<BUF,512.,0,0,0>
WAIT:
	WTSE$  1
	.END  START