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