'HEAD'  STACK UTILITIES
C     EDIT DATE   10DEC78  20:26
C     SOURCE FILE SUTILFTM.FS
C     AUTHOR      A. J. HOWARD
C     CLUSTER     22
      'OUTFILE' MSTAKFTM.FR
      SUBROUTINE MSTAK (INROW, OUTROW)
      INTEGER     INROW, OUTROW
      INTEGER     I
      'INCLUDE'   STKDFA.IN,
      'DOLOOP' I = 1, 13
         STK (OUTROW, I) = STK (INROW, I)
         'END'
      RETURN
      END
      'OUTFILE' CLRSTKFTM.FR
      SUBROUTINE CLRSTK (ROW)
      INTEGER  ROW
      INTEGER     I
      'INCLUDE'   STKDFA.IN,
C     CLEAR A STACK ROW
      'DOLOOP' I = 1, 13
         STK (ROW, I) = 0
         'END'
      RETURN
      END
      'OUTFILE' GENERFTM.FR
      SUBROUTINE GENER (FUNC)
C     PARAMETERS ARE PASSED IN 'ADDR' AND 'NAME' AS NEEDED.
      'INCLUDE'   LOGOSAJH.IN,
      'INCLUDE'   STKDFA.IN,
      'INCLUDE'   STKDFB.IN,
      'INCLUDE'   NLISTCFTM.IN,
      'INCLUDE'   REGSJHP.IN,
      'INCLUDE'   GENCMB.IN,
      INTEGER     TS, AS
      INTEGER     FUNC
      LOGICAL     NLTEST
      EXTERNAL    OLSAV
C     SWITCH TABLE FOR GENERATE - FUNCTION IS PERFORMED,
C     AND GENERATE THEN EXITS TO CALLER.
      GENRET = 1
      GO TO   (10, ^         // TEST STACK
               20, ^         // DO SWAP
               30, ^         // DO TOP DP
               40, ^         // DO NEXT DP
               50, ^         // DO TOP SP
               60, ^         // DO NEXT SP
               70, ^         // DO SAVE FOR CALL
               80, ^         // DO OUT
               90, ^         // GET STACK POINTER
              100, ^         // SET MODEX
              110, ^         // SETX
              120) ^         // CONVERT (SPTR) TO DP
              FUNC
'EJECT'
C     TEST STACK FOR REGISTER OR ACTIVE
10    TS = NAMEX (SPTR)
      IF (NLTEST (TS, REGBIT)) ^
         RETURN
      CALL REGSRC (2, NAMEX (SPTR), MODE  (SPTR), ^
                      SUBX  (SPTR), SUBXM (SPTR), ^
                      BIAS  (SPTR), GENRET)
      IF (GENRET .NE. AREG) GENRET = 0
      RETURN
C     EXCHANGE TOP AND NEXT
20    TS = TOPX
      TOPX = NEXTX
      NEXTX = TS
      GOTO 110       // CALL SETX
C     TOP TO DP
30    RETURN
C     NEXT TO DP
40    RETURN
C     TOP TO SP
50    SPTR = TOPX
      GOTO 601
C     NEXT TO SP
60    SPTR = NEXTX
601   MODE (SPTR) = SPMODE
      RETURN
'EJECT'
C     SAVE CT FOR SUBROUTINE CALL
70    CONTINUE   //CALL OVLOD (OLSAV)
      CALL GSAVE
      RETURN
C     OUT: SET STATUS AND STACK ENTRY TO REGISTER
80    'IF' (ACTHI .NE. 0)
         TS = AREG
         'ELSE'
         TS = ACTLO
         'ENDIF'
      'IF' (TS .NE. 0)
         STATUS (TS) = OPX - 1
         NAMEX (OPX - 1) = REGS (TS)
         SUBX (OPX - 1) = 0
         BIAS (OPX - 1) = 0
         'ENDIF'
      RETURN
90    RETURN
C     SET MODE INDEXES
100   RAWMDX = 2*MODE (TOPX) + MODE (NEXTX) + 1
      MODEX = RAWMDX - (RAWMDX/3)
      RETURN
C     SETX
110   IF (TOPX .NE. 0) OPTOPX = NAMEX (TOPX)
      IF (NEXTX .NE. 0) OPNXTX = NAMEX (NEXTX)
      RETURN
120   RETURN
      END
      'OUTFILE'   GSAVEFTM.FR
N     OVERLAY     OLSAV
      SUBROUTINE  GSAVE
C     SAVE REGISTERS AND CT LOCATIONS FOR PROCEDURE CALL
      'INCLUDE'   STKDFA.IN,
      'INCLUDE'   STKDFB.IN,
      'INCLUDE'   LCFUNCAJH.IN,
      'INCLUDE'   NLNAMEFTM.IN,
      'INCLUDE'   NLISTCFTM.IN,
      'INCLUDE'   REGSJHP.IN,
      'INCLUDE'   TEMPSFTM.IN,
      'INCLUDE'   WFLAGSJHP.IN,
      INTEGER     TS, AS, THIS, OTHER, TIMES, STKX
      INTEGER     STAXY (3)
      INTEGER     INDNAM
      DATA        STAXY / 141, 142, 140/
      'IF' (ACTHI .NE. 0)
         // SAVE 'DP' AREG
         'IF' (ACTHI .EQ. AREG)
            THIS = 1
            OTHER = 0
            'ELSE'
            THIS = 0
            OTHER = 1
            'ENDIF'
I        NAME (1) =   810   // <3>*
P        NAME (1) = 10755   // <3>*
         NLX = INDNAM (DTX, NOUNLC, 2)
         CALL BLDOP (141, WF8, THIS, NLX, WF7)        // STAABS
         TS = ACTREG (OTHER+1)
         IF (TS .EQ. XREG) ^
            CALL BLDOP (142, WF8, OTHER, NLX, WF7)    // STXABS
         'IF' (TS .GT. YREG)
            CALL BLDOP (165, WF5, OTHER, REGS (TS), WF7) // LDAZP
            CALL BLDOP (141, WF8, OTHER, NLX, WF7)    // STAABS
            'ENDIF'
         STKX = STATUS (AREG)
         NAMEX (STKX) = NLX
         STATUS (AREG) = 0
         STATUS (TS) = 0
         ACTHI = 0
         'ENDIF'
      'EJECT'
      // SAVE A, X, Y
      'DOLOOP' AS = AREG, YREG
         STKX = STATUS (AS)
         'IF' (STKX .NE. 0)
I           NAME (1) =  803   // <3>#
P           NAME (1) = 8963   // <3>#
            NLX = INDNAM (STX, NOUNLC, 1)
            CALL BLDOP (STAXY (AS), WF8, 0, NLX, WF7)
            STATUS (AS) = 0
            NAMEX (STKX) = NLX
            'ENDIF'
         'END'
      ACTLO = 0
      // SAVE COMPILER TEMPS
      'DOLOOP' AS = 4, NRREGS
         STKX = STATUS (AS)
         'IF' (STKX .NE. 0)
            'IF' (MODE (STKX) .EQ. DPMODE)
               TIMES = 2
I              NAME (1) =   810   // <3>*
P              NAME (1) = 10755   // <3>*
               NLX = INDNAM (DTX, NOUNLC, 2)
               'ELSE'
               TIMES = 1
I              NAME (1) =  803    // <3>#
P              NAME (1) = 8963    // <3>#
               NLX = INDNAM (STX, NOUNLC, 1)
               'ENDIF'
            'DOLOOP' THIS = 1, TIMES
               CALL BLDOP (165, WF8, THIS - 1, REGS (AS), WF7) // LDAZP
               CALL BLDOP (141, WF8, THIS - 1,       NLX, WF7) // STAABS
               'END'
            STATUS (AS) = 0
            NAMEX (STKX) = NLX
            'ENDIF'
         'END'
      RETURN
      END