TITLE	PUTBIN FOR RPGII V1
	SUBTTL	WRITE A WORD ONTO BINARY FILE	AL BLACKINGTON/CAM


	TWOSEG
	RELOC	400000

	ENTRY	PUTBIN

PUTBIN:	SKIPN	BINDEV			; ARE WE ERITING BINARY FILE?
	POPJ	PP,			; NO - FORGET IT
	SOSG	BINBH+2			; YES - IS BUFFER FULL?
	JRST	PTBIN2			; YES - GO EMPTY IT

PTBIN1:	IDPB	CH,BINBH+1		; PUT WORD IN BUFFER
	POPJ	PP,			; EXIT

PTBIN2:	AOS	BINBLK			; BUMP BLOCK COUNT
	OUT	BIN,			; WRITE OUT THE BUFFER
	JRST	PTBIN1			; NO - ERRORS - RETURN

	PUSH	PP,CH			; SAVE THE WORD
	GETSTS	BIN,CH			; GET THE STATUS BITS
	MOVSS	CH			; SWAP HALVES
	HRRI	CH,BINDEV		; GET POINTER TO BIN PARAMETERS
	PUSHJ	PP,DEVERA		; GO TO ERROR ROUTINE
	JRST	PTBIN4			; IT IS MAG-TAPE
	USETO	BIN,@BINBLK		; IT IS DISK

PTBIN3:	SETSTS	BIN,0			; CLEAR ERROR FLAG
	POP	PP,CH			; GET WORD BACK
	JRST	PTBIN2+1		; TRY AGAIN

;DEVICE IS MAG-TAPE -- ERASE BLOCK OR REWIND

PTBIN4:	GETSTS	BIN,CH			; END-OF-TAPE?
	TRNE	CH,$EOT			; ?
	JRST	PTBIN5			; YES -
	MTAPE	BIN,7			; NO - BACKSPACE
	MTAPE	BIN,13			; ERASE BLOCK
	JRST	PTBIN3			; TRY AGAIN

PTBIN5:	MTAPE	BIN,3			; WRITE 2 EOF'S
	MTAPE	BIN,3			; LIKE THIS
	MTAPE	BIN,11			; REWIND AND UNLOAD
	MOVEI	CH,BINDEV		; GO TO "END OF TAPE" ROUTINE
	PUSHJ	PP,EOTAPE		; RIGHT THERE
	SETSTS	BIN,0			; CLEAR STATUS
	POP	PP,CH			; GET WORD BACK
	JRST	PTBIN1			; AND TRY AGAIN


EXTERNAL DEVERA, EOTAPE, BINBH, BINBLK, BINDEV


	END