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.