Google
 

Trailing-Edge - PDP-10 Archives - BB-H580C-SB_1981 - putbin.mac
There are 7 other files named putbin.mac in the archive. Click here to see a list.
TITLE	PUTBIN FOR COBOL V12B
SUBTTL	WRITE A WORD ONTO BINARY FILE	AL BLACKINGTON/CAM



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	P
	%%P==:%%P

;EDITS
;V10*****************
;NAME	DATE		COMMENTS
;********************


TWOSEG
RELOC	400000

ENTRY PUTBIN
EXTERNAL DEVERA, EOTAPE

PUTBIN:	SKIPN	BINDEV		;ARE WE WRITING BINARY FILE?
	POPJ	PP,		;NO--FORGET IT

	SOSG	BINBH+2		;YES--IS BUFFER FULL?
	JRST	PTBIN2		;YES--EMPTY IT
PTBIN1:	IDPB	CH,BINBH+1	;PUT WORD IN BUFFER
	POPJ	PP,

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

	PUSH	PP,CH		;SAVE THE WORD
	GETSTS	BIN,CH		;GET 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 DSK
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		;BACKSPACE
	MTAPE	BIN,13		;ERASE BLOCK
	JRST	PTBIN3		;TRY AGAIN

PTBIN5:	MTAPE	BIN,3		;WRITE 2 EOF'S
	MTAPE	BIN,3
	MTAPE	BIN,11		;REWIND AND UNLOAD

	MOVEI	CH,BINDEV	;GO TO "END OF TAPE" ROUTINE
	PUSHJ	PP,EOTAPE
	SETSTS	BIN,0
	POP	PP,CH		;GET WORD BACK
	JRST	PTBIN1		;RETURN

EXTERNAL BINBH, BINBLK, BINDEV

	END