File: MULTI.03 of Tape: Various/Decus/decus-2

(Source file text) 

---

/THIS SUBROUTINE WILL HANDLE MULTI-REEL FILES,AND HAS
/	SIX ENTRY POINTS
/
/VERSION 03
/
/
/SPOOP(FILE NAME) WILL OPEN AN OUTPUT FILE ON DEVICE
/	DTA1. IT WILL REJECT THE FILE IF THERE ARE LESS 
/	THAN 650(10) FREE BLOCKS AND TRY AGAIN,UNLESS THE
/	USER RESPONDS WITH AN A (ACCEPT IT).
/
/WRTCH(NO ARG) IS CALLED AFTER A WRITE(4,X) STATEMENT
/	AND WILL CHECK THE SPACE LEFT. IF IT
/	IS TWO BLOCKS OR LESS IT WILL WRITE A '999 ' IN 
/	COLUMNS 1-4, WRTIE 'END ' IN THE NEXT
/	COLUMNS 1-4, CLOSE THE CURRENT FILE AND OPEN ANOTHER
/	ONE WITH THE NAME OF SPOOP + 0001 ON DEVICE DTA2.
/	IT WILL THEN ALTERNATE BETWEEN DTA1 AND DTA2.
/
/SPOCL(NO ARG) WILL WRITE '999 ' IN COLS 1-4,'END ' IN
/	COLS 1-4 AND THEN CLOSE THE FILE
/
/SPIOP(FILE NAME) WILL OPEN AN INPUT FILE ON DEVICE DTA5
/
/RDCHK(SWITCH) IS CALLED AFTER A READ(4,X) LIST STATEMENT
/	AND WILL EXAMINE THE NEXT 4 COLUMNS. IF THEY CONTAIN
/	A'EN  ', IT WILL RETURN THE ARGUMENT SWITCH TO
/	A 1 (NOT A TRUE EOF), OR 0 (A TRUE EOF). IF IT
/	IS NOT A TRUE EOF, IT WILL OPEN A NEW INPUT FILE AS IN
/	WRTCH ABOVE, ALTERNATING DEVICES BETWEEN DTA5 AND DTA6.
/
/
ENTRY	SPOOP		/SPECIAL OUTPUT OPEN
ENTRY	WRTCH		/WRITE CHECK
ENTRY	SPOCL		/SPECIAL OUTPUT CLOSE
ENTRY	SPIOP		/SPECIAL INPUT OPEN
ENTRY	RDCHK		/READ CHECK
/
/
/
/
OPDEF	CDF1	6211	/CHANGE TO DATA FIELD 1
OPDEF	CDFZ	6201	/CHACGE TO DATA FIELD 0
OPDEF	TADI	1400	/TAD INDIRECT
OPDEF	DCAI	3400	/DCA INDIRECT
OPDEF	ISZI	2400	/ISZ INDIRECT
DEVO,	TEXT 'DTA1'	/DECTAPE 1
S746,	746		/LOCATION OF AVAIL FILE SIZE
SPOOP,	BLOCK 2		/ENTRY POINT
	TAD I SPOOP	/GET THE ADDR OF FILE NAME
	DCA NAMEO
	INC SPOOP#
	TADI SPOOP#
	DCA NAMEO#
	INC SPOOP#
RETRY,	CALL 2,OOPEN	/AND OPEN THE FILE
	ARG DEVO
NAMEO,	ARG 0
	CDFZ
	TADI S746	/GET THE FILE LENGTH(-)
	TAD (1224	/TEST FOR >650(10)
	SMA CLA
	JMP TOOSML
DNOPN,	RETRN SPOOP	/AND GO HOME
TOOSML,	CALL 2,READ	/WRITE A NASTY GRAM
	ARG (1
	ARG MSG1	/AND PRINT IT
	CALL 1,IOH
	ARG WRTCH
	CALL 1,IOH
	ARG 0
	TAD WRTCH	/WAS IT AN 'A '
	TAD (7640
	SNA CLA
	JMP DNOPN	/YUP - - ACCEPT IT
	CDF1		/LETS INHIBIT 'IOER' MESSAGE
	TAD DEVO#	/GET OUT DEV NO
	AND (3		/AND MASK ALL BUT THE LASE TWO BITS
	TAD (7764
	DCA WRTCH
	TADI WRTCH	/AND GET THE TABLE ENTRY
	AND (7770	/AND ZERO THE FILE OPEN BITS
	DCAI WRTCH	/AND STORE IT AWAY
	JMP RETRY	/AND TRY AGAIN
MSG1,	5047		/('REEL NOT EMPTY-PLEASE RELOAD',A1)
	2205
	0514
	4016
	1724
	4005
	1520
	2431
	5520
	1405
	0123
	0540
	2205
	1417
	0104
	4754
	0161
	5100
WRTCH,	BLOCK 2		/CHECK FOR END OF FILE
	CDFZ
	IAC RAL		/SET AC=2
	TADI S746	/GET FILE LENGTH
	SMA CLA
	JMP OPNEXT	/FULL - OPEN NEXT
	RETRN WRTCH
OPNEXT,	CALL 2,WRITE	/WRITE THE GOODIES
	ARG (4
	ARG MSG2
	CALL 1,IOH
	ARG MORE
	CALL 1,IOH
	ARG 0
	CALL 0,OCLOS	/AND CLOSE THE FILE
	TAD DEVO#
	CMA
	AND (3		/STRIP ALL BUT LAST TWO BITS
	DCA SPOOP
	TAD DEVO#	/GET THE DEV AGAIN
	AND (7774
	TAD SPOOP
	DCA DEVO#
	TAD NAMEO	/BUMP FILE NAME BY 1
	DCA OXXX
	STL RTL		/STE AC=2
	TAD NAMEO#
	DCA SPOOP
OXXX,	HLT		/SET TO CDF CALLING
	ISZI SPOOP
	TAD WRTCH	/AND SAVE THE RETURN
	DCA SPOOP
	TAD WRTCH#
	DCA SPOOP#
	JMP RETRY	/AND GO TO OPENING ROUTINE
	PAGE
SPOCL,	BLOCK 2		/CLOSE THE OUTPUT FILE
	CALL 2,WRITE
	ARG (4
	ARG MSG2
	CALL 1,IOH
	ARG ENDX
	CALL 1,IOH
	ARG 0
	CALL 0,OCLOS	/AND CLOSE THE FILE
	TAD (161	/RESET LAST HALF OF DEVO
	DCA DEVO#
	RETRN SPOCL
DEVI,	TEXT 'DTA5'	/DECTAPE 5
SPIOP,	BLOCK 2		/SPECIAL IOPEN
	TAD I SPIOP	/GET THE NAME
	DCA NAMEI
	INC SPIOP#
	TADI SPIOP#
	DCA NAMEI#
	INC SPIOP#
OPN,	CALL 2,IOPEN	/AND OPEN THE FILE
	ARG DEVI
NAMEI,	ARG 0
	RETRN SPIOP	/AND GO HOME
RDCHK,	BLOCK 2		/READ CHECK
	TAD I RDCHK	/PICK UP THE LOC OF ARG
	DCA SPIOP	/USE SP TO SAVE TWO LOCS
	INC RDCHK#
	TADI RDCHK#
	DCA SPIOP#
	INC RDCHK#
	CALL 2,READ
	ARG (4
	ARG MSG4	/READ THE FIRST TWO CHARS
	CALL 1,IOH
	ARG SPOCL
	TAD SPOCL		/AND TEST IT FOR 'MO'
	TAD (6261
	SZA CLA		/IS IT 'MO'???
	JMP DONE
	IAC
	DCA I SPIOP	/AND SET THE SWITHH
	TAD NAMEI	/BUMP INPUT NAME BY 1
	DCA IXXX
	STL RTL
	TAD NAMEI#
	DCA SPIOP
IXXX,	HLT		/SET TO CDF CALLING
	ISZI SPIOP
	TAD DEVI#	/AND SWAP DEV NAME
	CMA
	AND (3
	DCA SPIOP
	TAD DEVI#
	AND (7774
	TAD SPIOP
	DCA DEVI#
	TAD RDCHK	/AND SET UP RETURN
	DCA SPIOP
	TAD RDCHK#
	DCA SPIOP#
	JMP OPN		/AND OPEN ANOTHER REEL
DONE,	DCA I SPIOP	/SET THE RETURN SWITCH
	RETRN RDCHK	/AND GO HOME
MORE,   TEXT 'MORE'     /MORE TO COME
ENDX,   TEXT 'END '     /THATS ALL FOLKS
MSG4,	5001		/(A2)
	6251
	0000
	LAP		/WE NEED THE LAST TWO LOCS
MSG2,	5047		/('999' ,/,A4)
	7171
	7147
	4054
	5754
	0164
	5100
	END

---