Google
 

Trailing-Edge - PDP-10 Archives - red405a2 - uetp/lib/v4b.fml
There are 15 other files named v4b.fml in the archive. Click here to see a list.
	LOGICAL CALCSORT(3)
*	DBMS
	INVOKE SS1 OF V4B.
	DATA CALCSORT/8,'CALCSORTZZ'/

*	DBMS
	OPEN AREA AREA1 USAGE-MODE IS EXCL UPDATE PRIVACY KEY ABC.

	ACCEPT *,JMAX

	DO 10 I=10,-10,-1
	PROFES=I
*	DBMS
	STORE CALCREC SUPPRESS CALCSORT,AREA UPDATES.
*	DBMS
	MOVE STATUS CALCREC RECORD TO I1.
*	DBMS
	MOVE STATUS CALCSORT SET TO I2.
*	DBMS
	MOVE STATUS AREA1 AREA TO I3.
*	TYPE 101,I1,I2,I3
10	CONTINUE

	DO 11 I=-10,10
	PROFES=I
	CALL JSTRAN(CALCSORT(2),PROFES+15)
	  DO 12 J=1,JMAX
	  SKMASK(1)=RAN(X)*2**34
	  TYPE *,SKMASK(1)
	  SKMASK(2)=0
*	DBMS
	  STORE SORTREC.
12	  CONTINUE
	CALL JETRAN(CALCSORT(2),PROFES+15)
11	CONTINUE

	CALL STATS

	CALL JBTRAN(15)

*	DBMS
	FIND	OWNER OF SYS-SET SET.
	IF (ERSTAT.NE.0) STOP 'ERROR'

	DO 21 I=1,100000
*	DBMS
	FIND NEXT RECORD OF SYS-SET SET.
	IF (ERSTAT.EQ.307) GOTO 99
	IF (ERSTAT.NE.0) STOP 'ERROR'
*	DBMS
	GET SORTREC.
	IF (ERSTAT.NE.0) STOP 'ERROR'
	TYPE *,SKMASK(1)
	IF (.NOT. MEMBER('CALCSORT')) STOP 'PRED'
*	DBMS
	FIND OWNER OF CALCSORT SUPPRESS ALL.
	IF (ERSTAT.NE.0) STOP 'ERROR'
*	DBMS
	GET CALCREC.
	IF (ERSTAT.NE.0) STOP 'ERROR'
21	CONTINUE

*	DBMS
99	CLOSE AREA AREA1.
	CALL STATS

101	FORMAT(1H ,3(O12,X))
*	DBMS
	END V4B.