C	PROGRAM BSCOMMON.FT
C	-------------------
C
C
C
	SUBROUTINE BSCOMMON(IOPR)
C
C
C	P LEMKIN
C	NIH
C	BETHESDA, MD
C	
C
C	MARCH 20, 1978
C	MAY 23, 1977
C	JAN 30,1977 /CHANGED IBMSIZE FROM 6 TO 7
C	SEPT 21, 1976
C	SEPT 20, 1976
C	SEPT 16, 1976
C	PURPOSE
C	-------
C	SAVE OR RESTORE COMMON FROM THE TWO FILES:
C		SYS:SVDDTG.DA, AND SYS:SVBMON.DA
C
C	NOTE: ONLY THE COMMON AREA OF SVDDTG IS MODIFIED WITH
C	SVBMON.DA CONTAINING THE REMAINDER OF COMMON WHERE
C	SVDDTG LEAVES OFF.
C
C	IOPR	FUNCTION
C	---	----------
C	0	RESTORE COMMON <== FILES
C	1	SAVE COMMON ==> FILES
C
C
S	OPDEF JMSI 4400
C
C	[0] DISPATCH
	IDDTSIZE=7
	IBMSIZE=7
	IF(IOPR-1)100,200,100
C
C
C	[1] RESTORE COMMON FROM FILES
C	LOOKUP
100	IF(IO(1,'SVDDTG','DA',1))101,103,101
C
101	WRITE(1,102)
102	FORMAT(' SVDDTG.DA ERROR')
	CALL CHAIN('INIBM2')
C
C
C	READ IDDTSIZE BLOCKS INTO COMMON STARTING AT 10000.
S \103,	TAD (6211
S	DCA R1
S	DCA R1# /0000
C
S	CALL 4,IO
S	ARG \IDDTSIZE
S R1,	ARG (0
S	ARG (0
S	ARG (6 /READ
S	DCA \IERR
	IF(IERR)101,104,101
C
C
C	[1.1] RESTORE SVBMON.DA IF EXISTS
104	IF(IO(1,'SVBMON','DA',1))105,107,105
C
105	WRITE(1,106)
106	FORMAT('NO SYS:SVBMON.DA, CONTINUING')
108	RETURN
C
C
C	READ IBMSIZE BLOCKS STARTING AT 13400
S \107,	TAD (6211
S	DCA R2
S	TAD (3400
S	DCA R2#
C
C
S	CALL 4,IO
S	ARG \IBMSIZE
S R2,	ARG (0
S	ARG (0
S	ARG (6 /WRITE
S	DCA \IERR
	IF(IERR)105,108,105
C
C
C
C
C
C	[2] SAVE COMMON FROM FILES
C	LOOKUP
200	IF(IO(1,'SVDDTG','DA',1))201,203,201
C
201	WRITE(1,202)
202	FORMAT('SVDDTG.DA ERR')
	CALL EXIT
C
C
C	GET STARTING BLOCK #
203	IERR=IO(INBLK,I,I,12)
C
C
C	SETUP CALL TO SYSHLR
S	TAD \IDDTSIZE
S	CLL RAL /MULT BY 2 TO GET PAGES
S	RTL; RTL; RTL /LEFT BYTE
S	AND (3700
S	TAD (4010 /ADD READ TO COMMON
S	DCA W1C
C
S	TAD \INBLK
S	DCA W1B /SAVE ABS. BLK #
C
S	TAD (7607 /SYSHLR IN FIELD 0
S	DCA 7
C
S	CPAGE 10
S	6202 /CIF 00
S	JMSI 7
S W1C,	5610
S	0 /BUFFER ADDRESS
S W1B,	0 /ABS BLK ADDRESS
S	SKP
S	JMP \204 /OK, CONTINUE
S	CLA /ERROR
S	JMP \201 /ERROR HANDLER
C
C	[2.1] SAVE SVBMON.DA IF EXISTS
204	IF(IO(1,'SVBMON','DA',1))205,207,205
C
205	WRITE(1,206)
206	FORMAT('SVBMON.DA ERR')
208	CALL EXIT
C
C
C	WRITE IBMSIZE BLOCKS STARTING AT 13400
C	GET STARTING BLOCK #
207	IERR=IO(INBLK,I,I,12)
C
C
C	SETUP CALL TO SYSHLR
S	TAD \IBMSIZE
S	CLL RAL /MULT BY 2 TO GET PAGES
S	RTL; RTL; RTL /LEFT BYTE
S	AND (3700
S	TAD (4010 /ADD READ TO COMMON
S	DCA W2C
C
S	TAD \INBLK
S	DCA W2B /SAVE ABS. BLK #
C
S	TAD (7607 /SYSHLR IN FIELD 0
S	DCA 7
C
S	CPAGE 10
S	6202 /CIF 00
S	JMSI 7
S W2C,	5610
S	3400 /BUFFER ADDRESS
S W2B,	0 /ABS BLK ADDRESS
S	SKP
S	JMP \210 /OK, CONTINUE
S	CLA /ERROR
S	JMP \205 /ERROR HANDLER
C
C	RETURN
210	RETURN
C
C
	END
 