# SMMPRC - STAGING MEMORY MANAGER PROCESS DRIVER
#
# PURPOSE: DRIVE THE STAGING MEMORY ALGORITHM IN GER-17062
#
# CALLING SEQUENCE:
#
#      LOGICAL = SMMPRC(TERMIN)
#
#      TERMIN IS TRUE IF INTERACTIVE TERMINAL IO IS TO BE USED, FALSE OTHERWISE
#      FUNCTION VALUE IS TRUE IF AN ERROR IS DETECTED DURING PROCESSING
#
# PROGRAMMER: CARL T. MICKELSON
#             GOODYEAR AEROSPACE CORP
#             1210 MASSILLON ROAD
#             AKRON, OHIO 44315
#
# PROJECT: MASSIVELY PARALLEL PROCESSOR (MPP)
#
# DATE: APRIL 1983
#
##
INCLUDE "SMMDEF.RAT"
LOGICAL FUNCTION SMMPRC(TERMIN)
LOGICAL TERMIN
INCLUDE "CSMMDF.RAT"
INCLUDE "CSMMOT.RAT"
LOGICAL ISPL,IDBG
COMMON /SPOOL/ ISPL,IDBG
LOGICAL LARGE
INTEGER IERR,IERMV,IDM,NDM,WRDIM,I,J,N,VDIM
INTEGER*4 STWDS,IAREG
REAL*8 PKWORD,ST1,PKB(NMVMAX),PCENT
INTEGER HEXCHR(0:255)
INTEGER HEXBAS,HIBUMP,LOBUMP
INTEGER*4 OCTCHR(0:255),OCTBAS,TWO56
REAL*8 BINCHR(0:255),BINBAS
BYTE BINVAL(0:7,0:255),ONE,CAREG(0:3)
EQUIVALENCE (BINCHR(0),BINVAL(0,0))
EQUIVALENCE (IAREG,CAREG(0))
LOGICAL INPDES   #-USER INPUT FUNCTION
INTEGER SRTCHK   #-SORT AND CHECK MULTIPLIERS
INTEGER CHKMLT   #-CHECK MOVE MULTIPLIERS
INTEGER UNITY   #-CHECK FOR UNITY MULTIPLIERS
INTEGER DIVIDE   #-DIVIDE DIMENSIONS FOR TRANSFER COUNTERS
INTEGER FILGAP   #-FILL TRANSFER COUNTER GAPS
REAL*8 SDIFF   #-SET DIFFERENCE FUNCTION
REAL*8 SET   #-SET ELEMENT FUNCTION
REAL*8 SINTER   #-SET INTERSECTION FUNCTION
INTEGER INDEX   #-SET ELEMENT SEARCH FUNCTION
INTEGER PERSHF   #-ACCESS MODE AND PERFECT SHUFFLE FUNCTION
INTEGER PRMUSB   #-SUBSTAGER PERMUTATION FUNCTION
INTEGER TRTBAS   #-TREAT BASE FUNCTION
INTEGER ABCDEF   #-A AND BCDEF REGISTER SETUP FUNCTION
INTEGER CTLIFG   #-CONTROL AND INTERFACE GROUP FUNCTION
INTEGER IANDB   #-EXTERNAL IAND FUNCTION (NEEDED DUE TO BYTE DATA FOR OUTPUT)
DATA HEXBAS,HIBUMP,LOBUMP/'00',7,1792/
DATA OCTBAS,TWO56/' 000',256/
DATA BINBAS,ONE/'00000000','1'/
 
DO I = 0,255 $(
   IHI = I/16
   ILO = MOD(I,16)
   HEXCHR(I) = HEXBAS + (256*ILO) + IHI
   IF (ILO > 9) HEXCHR(I) = HEXCHR(I) + LOBUMP
   IF (IHI > 9) HEXCHR(I) = HEXCHR(I) + HIBUMP
   IHI = IAND(ISHFT(I,-6),3)
   IMD = IAND(ISHFT(I,-3),7)
   ILO = IAND(I,7)
   OCTCHR(I) = OCTBAS + (((((ILO*TWO56)+IMD)*TWO56)+IHI)*TWO56)
   BINCHR(I) = BINBAS
   DO J = 0,7
      IF (IAND(I,ISHFT(1,J)) .NE. 0) BINVAL(7-J,I) = ONE
   $)
   SMMPRC = INPDES(TERMIN)
   IF (SMMPRC) RETURN
   IERR = SRTCHK(IERMV)
   IF (IERR .NE. 0) $(
      CALL SMMMSG(IERR)
      WRITE(LSTOUT,99) 'SRTCHK  '
      WRITE(LSTOUT,101) IERMV
      SMMPRC = .TRUE.
      RETURN
      $)
   IERR = CHKMLT(IERMV,IDM,NDM)
   IF (IERR .NE. 0) $(
      CALL SMMMSG(IERR)
      WRITE(LSTOUT,99) 'CHKMLT  '
      IF (IERR == 6) WRITE(LSTOUT,103) IDM,NDM,IERMV
      ELSE WRITE(LSTOUT,102) IDM,IERMV
      SMMPRC = .TRUE.
      RETURN
      $)
   IERR = UNITY(IERMV)
   IF (IERR .NE. 0) $(
      CALL SMMMSG(IERR)
      WRITE(LSTOUT,99) 'UNITY   '
      WRITE(LSTOUT,101) IERMV
      SMMPRC = .TRUE.
      RETURN
      $)
   IERR = DIVIDE(IDM)
   IF (IERR .NE. 0) $(
      CALL SMMMSG(IERR)
      WRITE(LSTOUT,99) 'DIVIDE  '
      IF (IERR == 2) WRITE(LSTOUT,104) IDM
      ELSE WRITE(LSTOUT,101) IDM
      SMMPRC = .TRUE.
      RETURN
      $)
   IERR = FILGAP(IERMV)
   IF (IERR .NE. 0) $(
      CALL SMMMSG(IERR)
      WRITE(LSTOUT,99) 'FILGAP  '
      WRITE(LSTOUT,101) IERMV
      SMMPRC = .TRUE.
      RETURN
      $)
   IF (SMMPRC) RETURN
   CALL RDINIT
   CALL WRDFMT
   CALL WRDFIN(PKWORD,WRDIM)
   WRITE(LSTOUT,108) PKWORD
   IF (WRDIM .NE. 0) $(
      WRITE(LSTOUT,109) WRDIM
      SMMPRC = .TRUE.
      $)
   IF (IDBG .OR. (WRDIM .NE. 0)) $(
   WRITE(LSTOUT,110)
   ST1 = SWORD
   REPEAT $(
      I = INDEX(ST1)
      IF (I == 0) BREAK
      ST1 = SDIFF(ST1,SET(I))
      WRITE(LSTOUT,111) I,LENGTH(I),(MPR(I,J),J=1,NMOVE)
      $)
      $)
   CALL BNKFMT
   CALL BNKFIN(PKB)
   DO J = 1,NMOVE $(
      WRITE(LSTOUT,112) J,PKB(J)
      IF (IDBG) $(
      WRITE(LSTOUT,113) J
      DO N = 5-NB,4 $(
         I = INDEX(SINTER(SPAR(J),SWT(N)))
         IF (I > 0)
            WRITE(LSTOUT,114) N,INTLEN(I),MPR(I,J)
         $)
         $)
      $)
   CALL INMULT
   CALL MAIADR(STWDS,PCENT,LARGE)
   WRITE(LSTOUT,115)STWDS,PCENT
   IF (LARGE) $(
      WRITE(LSTOUT,116)
      SMMPRC = .TRUE.
      $)
   IERR = PERSHF(IDM,IERMV)
   IF (IERR .NE. 0) $(
      CALL SMMMSG(IERR)
      WRITE(LSTOUT,99) 'PERSHF  '
      IF (IERR == 7)
         WRITE(LSTOUT,102) IDM,IERMV
      IF (IERR == 8)
         WRITE(LSTOUT,101) IERMV
      SMMPRC = .TRUE.
      $)
   IERR = PRMUSB(IERMV)
   IF (IERR .NE. 0) $(
      CALL SMMMSG(IERR)
      WRITE(LSTOUT,99) 'PRMUSB  '
      WRITE(LSTOUT,101) IERMV
      SMMPRC = .TRUE.
      $)
IF (IDBG) $(
WRITE(LSTOUT,117)
WRITE(LSTOUT,118) ((J,J+NMOVE),J=1,NMOVE)
WRITE(LSTOUT,117)
DO I=1,NDIM
   WRITE(LSTOUT,119) I,MAIN(I),((MPR(I,J),MPR(I,J+NMOVE)),J=1,NMOVE)
WRITE(LSTOUT,117)
WRITE(LSTOUT,117)
WRITE(LSTOUT,120) (J,J=1,NMOVE)
WRITE(LSTOUT,117)
DO I=0,16
   WRITE(LSTOUT,121) I,(PORT(I,J),J=1,NMOVE)
WRITE(LSTOUT,117)
WRITE(LSTOUT,117)
WRITE(LSTOUT,122) ((J,J+NMOVE),J=1,NMOVE)
WRITE(LSTOUT,117)
DO I=0,12
   WRITE(LSTOUT,123) I,((ASUB(I,J),ASUB(I,J+NMOVE)),J=1,NMOVE)
WRITE(LSTOUT,117)
WRITE(LSTOUT,117)
WRITE(LSTOUT,124) (MODE(J),J=1,NMOVE)
WRITE(LSTOUT,125) (PSHFA(J),J=1,NMOVE)
WRITE(LSTOUT,126) (PSHFB(J),J=1,NMOVE)
   $)
CALL TRNREG(SMDATA)
CALL NEGMLT(SMDATA)
IERR = TRTBAS(SMDATA,IERMV)
IF (IERR .NE. 0) $(
   CALL SMMMSG(IERR)
   WRITE(LSTOUT,99) 'TRTBAS  '
   WRITE(LSTOUT,101) IERMV
   SMMPRC = .TRUE.
   $)
CALL PRMREG(SMDATA)
IERR = ABCDEF(SMDATA)
IF (IERR .NE. 0) $(
   SMMPRC = .TRUE.
   IDM = 15
   FOR ( ; IERR .NE. 0; IERR = IERR/2) $(
      IF (IAND(IERR,1) .NE. 0) CALL SMMMSG(IDM)
      IDM = IDM + 1
      $)
   $)
IERR = CTLIFG(SMDATA)
IF (IERR .NE. 0) $(
   CALL SMMMSG(IERR)
   SMMPRC = .TRUE.
   $)
CALL MULREC(SMDATA)
VDIM = 0
DO J = 1,NMOVE
   VDIM = MAX(VDIM,BASCNT(J))
WRITE(STDOUT) NBANKS,NWORDS,VDIM,NMOVE,STWDS
DO J = 1,NMOVE $(
   WRITE(STDOUT) J,WIDTH(J),RECSIZ(J),BASADR(J),BASCNT(J)
   WRITE(STDOUT) (IMDATA(I,J),I=0,222)
   IF (BASCNT(J) .NE. 0)
      WRITE(STDOUT) (BASWGT(I,J),I=1,BASCNT(J)),(BASLEN(I,J),I=1,BASCNT(J))
IF (IDBG) $(
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,127) J
   WRITE(LSTOUT,117)
   IF (INDEX(SNEGM(J)) > 0) $(
      WRITE(LSTOUT,142)
      ST1 = SNEGM(J)
      REPEAT $(
         I = INDEX(ST1)
         IF (I == 0) BREAK
         WRITE(LSTOUT,143) I
         ST1 = SDIFF(ST1,SET(I))
         $)
      WRITE(LSTOUT,117)
      $)
   WRITE(LSTOUT,128) 1,3
   WRITE(LSTOUT,129)
   DO I = 0,48,2 $(
      WRITE(LSTOUT,137) I,(HEXCHR(IANDB(SMDATA(I+K,J),255)),K=0,1),
                          (OCTCHR(IANDB(SMDATA(I+K,J),255)),K=0,1),
                          (BINCHR(IANDB(SMDATA(I+K,J),255)),K=0,1)
      $)
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,131) 1,3
   WRITE(LSTOUT,129)
   DO I = 50,146,4 $(
      WRITE(LSTOUT,136) I,(HEXCHR(IANDB(SMDATA(I+K,J),255)),K=0,3),
                          (OCTCHR(IANDB(SMDATA(I+K,J),255)),K=0,3),
                          (BINCHR(IANDB(SMDATA(I+K,J),255)),K=0,3)
      $)
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,132) 1,3
   WRITE(LSTOUT,129)
   WRITE(LSTOUT,130) 150,(HEXCHR(IANDB(SMDATA(K,J),255)),K=150,159),
                         (OCTCHR(IANDB(SMDATA(K,J),255)),K=150,159)
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,128) 2,4
   WRITE(LSTOUT,129)
   DO I = 160,208,2 $(
      WRITE(LSTOUT,137) I,(HEXCHR(IANDB(SMDATA(I+K,J),255)),K=0,1),
                          (OCTCHR(IANDB(SMDATA(I+K,J),255)),K=0,1),
                          (BINCHR(IANDB(SMDATA(I+K,J),255)),K=0,1)
      $)
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,131) 2,4
   WRITE(LSTOUT,129)
   DO I = 210,306,4 $(
      WRITE(LSTOUT,136) I,(HEXCHR(IANDB(SMDATA(I+K,J),255)),K=0,3),
                          (OCTCHR(IANDB(SMDATA(I+K,J),255)),K=0,3),
                          (BINCHR(IANDB(SMDATA(I+K,J),255)),K=0,3)
      $)
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,133)
   WRITE(LSTOUT,129)
   DO I = 310,406,4 $(
      DO K = 0,3
         CAREG(K) = SMDATA(I+3-K,J)
      WRITE(LSTOUT,138) I,(HEXCHR(IANDB(SMDATA(I+K,J),255)),K=0,3),
                          (OCTCHR(IANDB(SMDATA(I+K,J),255)),K=0,3),
                          (BINCHR(IANDB(SMDATA(I+K,J),255)),K=0,3),IAREG
      $)
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,134)
   WRITE(LSTOUT,129)
   DO I = 410,426,8 $(
      WRITE(LSTOUT,144) I,(HEXCHR(IANDB(SMDATA(I+K,J),255)),K=0,7),
                          (OCTCHR(IANDB(SMDATA(I+K,J),255)),K=0,7)
      $)
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,132) 2,4
   WRITE(LSTOUT,129)
   WRITE(LSTOUT,130) 434,(HEXCHR(IANDB(SMDATA(K,J),255)),K=434,443),
                         (OCTCHR(IANDB(SMDATA(K,J),255)),K=434,443)
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,135)
   WRITE(LSTOUT,129)
   WRITE(LSTOUT,145) 444,HEXCHR(IANDB(SMDATA(444,J),255)),
                         OCTCHR(IANDB(SMDATA(444,J),255))
   WRITE(LSTOUT,117)
   WRITE(LSTOUT,139) BASCNT(J)
   IF (BASCNT(J) .NE. 0) $(
      WRITE(LSTOUT,140)
      DO I = 1,BASCNT(J)
         WRITE(LSTOUT,141) BASLEN(I,J),BASWGT(I,J)
      $)
   $)
   $)
RETURN
#-FORMAT STATEMENTS
99 FORMAT(7 X,'ROUTINE: ',A8)
101 FORMAT(7 X,'MOVE: ',I2)
102 FORMAT(7 X,'DIMENSION: ',I2,', MOVE: ',I2)
103 FORMAT(7 X,'DIMENSIONS: ',I2,' AND ',I2,', MOVE: ',I2)
104 FORMAT(7 X,'DIMENSION: ',I2)
108 FORMAT(7 X,'STAGER WORD PACKING DENSITY: ',F10.3,' PERCENT')
109 FORMAT(7 X,'FOUND ONLY ',I1,' DIMENSIONS FOR WORD FORMAT')
110 FORMAT(7 X,'STAGER WORD FORMAT SUMMARY',/,
           7 X,'DIMEN    LENGTH    MULTIPLIERS')
111 FORMAT(9 X,I2,X,I10,NMVMAX I10)
112 FORMAT(7 X,'TRANSFER RATE TO MAIN STAGER FOR MOVE ',I2,' IS ',F10.3,
              ' MBYTES/SEC')
113 FORMAT(7 X,'PARALLEL BANK FORMAT SUMMARY, MOVE ',I2,/,
           7 X,'BANK    LENGTH    MULTIPLIER')
114 FORMAT(9 X,I1,X,2 I10)
115 FORMAT(7 X,'DATA ARRAY USES ',I10,' WORDS, OR ',F10.3,' PERCENT OF CAPACITY')
116 FORMAT(7 X,'ARRAY IS TOO LARGE')
117 FORMAT( )
118 FORMAT('DIM   MAIN(DIM)',NMVMAX(' ',2(' MPR(DIM,',I1,')'),:))
119 FORMAT(I3,I10,NMVMAX(X,2 I11,:))
120 FORMAT('INDEX ',NMVMAX(' PORT(I,',I1,')',:))
121 FORMAT(I4,NMVMAX(I10,:))
122 FORMAT('INDEX ',NMVMAX(' ',2(' ASUB(I,',I1,')'),:))
123 FORMAT(I4,NMVMAX(X,2 I10,:))
124 FORMAT('MODE  ',NMVMAX(2 X,'O''',O4,'''',:))
125 FORMAT('PSHFA',NMVMAX(I9,:))
126 FORMAT('PSHFB',NMVMAX(I9,:))
127 FORMAT('HARDWARE CONTROL OUTPUT, MOVE: ',I2)
128 FORMAT('PERMUTATION REGISTER C',I1,'/C',I1)
129 FORMAT('INDEX  DATA')
130 FORMAT(I4,X,10(2 X,A2),/,5 X,10 A4)
131 FORMAT('TRANSFER REGISTER C',I1,'/C',I1)
132 FORMAT('CONTROL GROUP C',I1,'/C',I1)
133 FORMAT('A REGISTER C2/C3')
134 FORMAT('BCDEF REGISTER C2/C3')
135 FORMAT('INTERFACE GROUP')
136 FORMAT(I4,X,4(2 X,A2),2 X,4 A4,3 X,4 A8)
137 FORMAT(I4,X,2(2 X,A2),2 X,2 A4,3 X,2 A8)
138 FORMAT(I4,X,4(2 X,A2),2 X,4 A4,3 X,4 A8,3 X,I11)
139 FORMAT('ADJUSTABLE DIMENSIONS FOR ADDRESSING MULTIPLE RECORDS: ',I2)
140 FORMAT('LENGTH      WEIGHT')
141 FORMAT(I6,2 X,I10)
142 FORMAT('NEGATIVE MULTIPLIER DIMENSIONS')
143 FORMAT(I4)
144 FORMAT(I4,X,8(2 X,A2),/,5 X,8 A4)
145 FORMAT(I4,3 X,A2,2 X,A4)
END