'HEAD'  INTERFACE TO CODE GENERATION
C     EDIT DATE   05FEB79  16:57
C     SOURCE FILE GENAJH.FS
C     AUTHOR      A. J. HOWARD
C     CLUSTER     19
      'OUTFILE'   GENDATA.FR
      BLOCK DATA
      'INCLUDE'   GENCMA.IN,P
      DATA  BCC   / 144/   // 090
      DATA  BNE   / 208/   // 0D0
      DATA  CLC   /  24/   // 018
      DATA  JMP   /  76/   // 04C
      DATA  LDAABS/ 173/   // 0AD
      DATA  LDAI  / 169/   // 0A9
      DATA  LDAZP / 165/   // 0A5
      DATA  SBCI  / 233/   // 0E9
      DATA  SEC   /  56/   // 038
      DATA  STAZP / 133/   // 085
      DATA  TAX   / 170/   // 0AA
      DATA  TXA   / 138/   // 08A
      DATA  LOW   / 1/
      DATA  HI    / 2/
      DATA  INTBR / 0/
      DATA  LSTKX / 0/
      DATA  RSTKX / 0/
      END
      'OUTFILE'   IGENAJH.FR
      SUBROUTINE  GEN (OPIN, LEFTIN, RIN)
      INTEGER     OPIN, LEFTIN, RIN
      'INCLUDE'   GENCMA.IN,
      'INCLUDE'   LOGOSAJH.IN,
      'INCLUDE'   OPERSAJH.IN,
      'INCLUDE'   REGSJHP.IN,
      'INCLUDE'   STKDFA.IN,
      EXTERNAL    OLAGN, OLCGN, OLSGN, OLMGN, OLUGN, OLARA, OLARB
      'IF' (LOGICF .EQ. 0)
         CALL FAULTP (4)      // CAN'T GENERATE CODE IN THE NOUNLIST
         RETURN
         'ENDIF'
      OP = OPIN
      LEFT = LEFTIN
      RIGHT = RIN
      'IF' (OP .EQ. -2)
C        PRESET OF INTBR FOR LOOP CODE
C
         INTBR = LEFT
         RETURN
         'ENDIF'
      'IF' (OP .EQ. -1)
C        PRE/POST GEN CALL FOR USER ARROW
C
         LSTKX = LEFT + 2
         RSTKX = RIGHT + 2
         RETURN
         'ENDIF'
1     THIS = LOW              // ASSUME LOW/HI SEQUENCE
      OTHER = HI
      SIDE = LEFT
      EZSTA = .FALSE.
      MORE  = .FALSE.
      CALL DUMST ('GEN0')
      BASE = OP - EQUAL + 1
      GO TO (  100, 100, 100, 100, 100, 100, ^ // = # > >= < <=
               600, ^                          // ->
               200, 200, ^                     // + -
               500, 500, 500, ^                // * / 'MOD'
                 6,   6, ^                     // 'OR' & RELATIONAL
               200, 200, 200, ^                // 'OR' 'XOR' &
               300, 300, 300, 300, 300, 300, ^ // 'LS' 'RS' 'LC' 'RC'
                    ^                          // 'ALS' 'ARS'
               400, 400, 400, 400, ^           // NEG ^ 'DEC' 'COM'
               200  ^   // LOAD
         ), BASE
      'EJECT'
6     CALL FATAL (6)
C     CONDITIONAL OPERATOR
100   CONTINUE   //CALL OVLOD (OLCGN)
      CALL CGEN
      GO TO 1000
200   CONTINUE   //CALL OVLOD (OLAGN)
      CALL AGEN
      GO TO 1000
C     SHIFT OPERATOR
300   CONTINUE   //CALL OVLOD (OLSGN)
      CALL SGEN
      GO TO 1000
C     UNARY OPERATOR
400   CONTINUE   //CALL OVLOD (OLUGN)
      CALL UGEN
      GO TO 1000
C     MULTIPLY, DIVIDE, MOD
500   CONTINUE   //CALL OVLOD (OLMGN)
      CALL MGEN
      GO TO 1000
C     STORE
600   CONTINUE   //CALL OVLOD (OLARA)
      CALL ARAGEN
      'IF' (MORE)
         CONTINUE   //CALL OVLOD (OLARB)
         CALL ARBGEN
         IF (MORE) GO TO 600
         'ENDIF'
1000  IF (MORE) GO TO 1
C     RELEASE ANY CT REGISTERS USED FOR THIS OPERATION
C
      'DOLOOP' I = 4, NRREGS
         TS = STATUS (I)
         IF (TS .EQ. LEFTIN .OR. TS .EQ. LEFTIN + STKSIZ ^
             .OR. TS .EQ. RIN .OR. TS .EQ. RIN + STKSIZ) ^
            STATUS (I) = 0
         'END'
      RETURN
      END
      'HEAD' ARITHMETIC CODE GENERATION
      'OUTFILE'   AGENAJH.FR
N     OVERLAY     OLAGN
      SUBROUTINE  AGEN
C     OP          LOGOS OPERATOR
C     LEFT        STACK POINTER TO LEFT  OPERAND
C     RIGHT       STACK POINTER TO RIGHT OPERAND
      'INCLUDE'   NLISTCFTM.IN,
      'INCLUDE'   OPERSAJH.IN,
      'INCLUDE'   REGSJHP.IN,
      'INCLUDE'   RMCODES.IN,
      'INCLUDE'   STKDFA.IN,
      'INCLUDE'   STKDFB.IN,
      'INCLUDE'   WFLAGSJHP.IN,
      'INCLUDE'   GENCMA.IN,

      'IF' (OP .EQ. COM + 1)  // LOAD
C        LOAD THE AREG WITH LEFT [THIS], IF IT'S NOT THERE
         'IF' (STAREG .NE. LEFT)
            'IF' (MODE (LEFT) .EQ. DPMODE)
               CALL GLXY (XREG)
               THIS = HI
               'ENDIF'
            CALL GENLA
            'ENDIF'
         RETURN
         'ENDIF'
      'EJECT'
C     OP IS  +, -, 'OR', 'XOR', &
      'IF' (MODE (LEFT) .EQ. DPMODE)
         'IF' (OP .EQ. PLUS .OR. OP .EQ. MINUS)
C           OPERATION MUST BE DONE LOW/HI
            'IF' (STAREG .EQ. LEFT .AND. ACTHI .EQ. AREG)
C              SAVE THE HI BYTE, LOAD THE LOW BYTE
               THIS = HI
               OTHER = LOW
               CALL GENMOV
               'ENDIF'
            'ELSE'
C           OP IS 'OR' 'XOR' &. THE OPERATION CAN BE DONE
C           IN EITHER ORDER (LOW/HI OR HI/LOW)
            'IF' (STAREG .EQ. LEFT .AND. ACTHI .EQ. AREG)
C              THE AREG ALREADY HAS THE HI BYTE.
C              DO THE OPERATION HI/LOW
               THIS = HI
               OTHER = LOW
               'ENDIF'
            'ENDIF'
         'ENDIF'
C     LOAD THE AREG WITH LEFT [THIS], IF IT'S NOT THERE
      'IF' (STAREG .NE. LEFT)
         CALL GENLA
         'ENDIF'
C     IF OP IS +, GENERATE $CLC
      'IF' (OP .EQ. PLUS)
         CALL BLDBLK (CLC, WF4)
         'ELSE'
C        IF OP IS -, GENERATE $SEC
         'IF' (OP .EQ. MINUS)
            CALL BLDBLK (SEC, WF4)
            'ENDIF'
         'ENDIF'
C     DO THE OPERATION WITH RIGHT [THIS]
      SIDE = RIGHT
      CALL GENDO
      'EJECT'
      'IF' (MODE (LEFT) .EQ. SPMODE .AND. MODE (RIGHT) .EQ. SPMODE)
         MODE (LEFT) = SPMODE
         ACTHI = 0
         'ELSE'
C        DOUBLE PRECISION OPERATIONS
C        SETUP FOR THE SECOND HALF OF THE OPERATION
         SIDE = LEFT
         CALL GENMOV
C        DO THE OPERATION WITH THE OTHER HALF (NOW THIS HALF)
         SIDE = RIGHT
         CALL GENDO
         MODE (LEFT) = DPMODE
         MODE (RIGHT) = DPMODE
         'ENDIF'
      CALL REGMAN (CLRACX, AREG, 0)
      RETURN
      END
      'HEAD' MULT / DIVIDE / MOD
      'OUTFILE'   MGENAJH.FR
N     OVERLAY     OLMGN
      SUBROUTINE  MGEN
      'INCLUDE'   NLISTCFTM.IN,
      'INCLUDE'   NLNAMEFTM.IN,
      'INCLUDE'   OPERSAJH.IN,
      'INCLUDE'   RMCODES.IN,
      'INCLUDE'   STKDFA.IN,
      'INCLUDE'   STKDFB.IN,
      'INCLUDE'   WFLAGSJHP.IN,
      'INCLUDE'   GENCMA.IN,
      INTEGER     MNAME (6), DNAME (5)
      INTEGER     SNMLST
      DATA        MNAME / 'CXXMULTIPLY ' /
      DATA        DNAME / 'CXXDIVIDE '   /
      'EJECT'
      'IF' (OP .EQ. MULT)
         CALL MOVE (MNAME, NAME, 6)      // *
         CALL PCHAR (NAME, 1, 11)
         'ELSE'
         CALL MOVE (DNAME, NAME, 5)      // / 'MOD'
         CALL PCHAR (NAME, 1, 9)
         'ENDIF'
      'IF' (MODE (LEFT) .EQ. SPMODE)
         CALL PCHAR (NAME, 2, 'SS')
         'ELSE'
         CALL PCHAR (NAME, 2, 'DD')
         'ENDIF'
      'IF' (MODE (RIGHT) .EQ. SPMODE)
         CALL PCHAR (NAME, 3, 'SS')
         'ELSE'
         CALL PCHAR (NAME, 3, 'DD')
         'ENDIF'
      NLX = SNMLST (NAME)
      CALL BLDOP (32, WF8, 0, NLX, WF7)  // JSR
      TS = MODE (LEFT)
      CALL CLRSTK (LEFT)
      NAMEX (LEFT) = REMNLX
      IF (OP .NE. MODOP) BIAS (LEFT) = 4
      'IF' (TS .EQ. DPMODE)
         MODE (LEFT) = DPMODE
         'ELSE'
         'IF' (OP .EQ. MULT .AND. MODE (RIGHT) .EQ. DPMODE)
            MODE (LEFT) = DPMODE
            'ELSE'
            MODE (LEFT) = SPMODE
            'ENDIF'
         'ENDIF'
      CALL REGMAN (CLRACV, 0, 0)
      RETURN
      END
      'HEAD' SHIFT CODE GENERATION
      'OUTFILE'   SGENAJH.FR
N     OVERLAY     OLSGN
      SUBROUTINE  SGEN

      'INCLUDE'   CODE1FTM.IN,
      'INCLUDE'   NLISTCFTM.IN,
      'INCLUDE'   OPERSAJH.IN,
      'INCLUDE'   REGSJHP.IN,
      'INCLUDE'   RMCODES.IN,
      'INCLUDE'   STKDFA.IN,
      'INCLUDE'   STKDFB.IN,
      'INCLUDE'   STKDFC.IN,
      'INCLUDE'   STKDFE.IN,
      'INCLUDE'   WFLAGSJHP.IN,
      'INCLUDE'   GENCMA.IN,
      INTEGER     SEQS, SEQCT, DEXTLI, BMITLI
      INTEGER     SHOP, OPTS, CTNX, SHFTLI
      LOGICAL     VARSHF
      'EJECT'
      MODE (RIGHT) = SPMODE
C     IS SHIFT COUNT A CONSTANT
      'IF' (NAMEX (RIGHT) .EQ. NULLX .AND. OPCODE (RIGHT) .EQ. LDAI)
         VARSHF = .FALSE.        // YES
         SEQS = BIAS (RIGHT)
         'ELSE'
         VARSHF = .TRUE.         // NO
         SEQS = 1
C        GET THE SHIFT COUNT INTO XREG
         SIDE = RIGHT
         CALL GLXY (XREG)
         'ENDIF'
C     LOAD THE VALUE TO BE SHIFTED INTO THE AREG
      'IF' (STAREG .NE. LEFT)
         SIDE = LEFT
         IF (.NOT. VARSHF .AND. SEQS .EQ. 1 ^
             .AND. MODE (LEFT) .EQ. DPMODE  ^
             .AND. (OP .EQ. LSHIFT .OR. OP .EQ. RSHIFT)) GO TO 2000
         CALL GENLA
         IF (MODE (LEFT) .EQ. DPMODE) CALL GENMOV
         STAREG = LEFT
         'ENDIF'
C     CLEAR THE LOC BIT OF LEFT
      LOCFLG (LEFT) = 0
C     CHECK FOR CONSTANT SHIFT OF 0
      IF (SEQS .EQ. 0) RETURN
C     GENERATE THE SEQUENCES FOR SPECIFIC SHIFTS
      SHOP = OP - LSHIFT + 1
      'IF' (MODE (LEFT) .EQ. DPMODE)
         SHOP = SHOP + 6
         CALL REGMAN (SAVREG, AREG, CTNX)
         CTNX = REGS (CTNX)
         'ELSE'
         'IF' (OP .EQ. RCYCLE)
            CALL REGMAN (CTFREE, CTNX, 1)
            CTNX = REGS (CTNX)
            CALL BLDOP (STAZP, WF5, 0, CTNX, WF7)
            'ENDIF'
         'ENDIF'
C     BUILD THE LOOP CODE IF NEEDED
      'IF' (VARSHF)
         CALL DEFTL (TLI)
         DEXTLI = TLI
         TLI = TLI + 1
         CALL BLDBLK (202, WF4)                  // DEX (0CA)
         BMITLI = TLI
         TLI = TLI + 1
         CALL BLDOP (48, WF5, 0, BMITLI, WF9)    // BMI (030)
         'ENDIF'
      'EJECT'
      'DOLOOP' SEQCT = 1, SEQS
         GO TO (100, 200, 300, 400, 100,  200, ^
                500, 600, 700, 800, 900, 1000), SHOP
C        'LS'  'ALS'
100      CALL BLDBLK (10, WF4)                   // ASL AREG
         'NEXT'
C        'RS'  'ARS'
200      CALL BLDBLK (74, WF4)                   // LSR AREG
         'NEXT'
C        'LC'
300      CALL BLDBLK (CLC, WF4)
         CALL BLDBLK (42,  WF4)                  // ROL AREG
         CALL BLDOP  (105, WF5, 0, NULLX, WF7)   // ADC #0
         'NEXT'
C        'RC'
400      CALL BLDOP  (102, WF5, 0, CTNX, WF7)    // ROR CTN FOR CARRY
         CALL BLDBLK (106, WF4)                  // ROR AREG
         'NEXT'
C        'DP' 'LS'
500      CALL BLDOP (  6, WF5, 0, CTNX, WF7)     // ASLZP CTN
         CALL BLDOP ( 38, WF5, 1, CTNX, WF7)     // ROLZP CTN+1
         'NEXT'
C        'DP' 'RS'
600      CALL BLDOP ( 70, WF5, 1, CTNX, WF7)     // LSRZP CTN+1
         CALL BLDOP (102, WF5, 0, CTNX, WF7)     // RORZP CTN
         'NEXT'
C        'DP' 'LC'
700      CALL BLDOP  (LDAZP, WF5, 0, CTNX, WF7)
         CALL BLDBLK (42, WF4)                   // ROL AREG
         CALL BLDOP  (38, WF5, 1, CTNX, WF7)     // ROLZP
         CALL BLDOP  (38, WF5, 0, CTNX, WF7)     // ROLZP
         'NEXT'
C        'DP' 'RC'
800      CALL BLDOP  (LDAZP, WF5, 0, CTNX, WF7)
         CALL BLDBLK (106, WF4)                  // ROR AREG
         CALL BLDOP  (102, WF5, 1, CTNX, WF7)    // RORZP
         CALL BLDOP  (102, WF5, 0, CTNX, WF7)    // RORZP
         'NEXT'
C        'DP' 'ALS'
900      CONTINUE
C        'DP' 'ARS'
1000     CALL FAULTP (15)
         'END'
      'EJECT'
C     BRANCH TO TEST CODE IF VARIABLE SHIFT COUNT
C
      'IF' (VARSHF)
         CALL BLDOP (76, WF8, 0, DEXTLI, WF9)    // JMP
         CALL DEFTL (BMITLI)
         CALL REGMAN (CLRACX, NZREG, 0)
         'ENDIF'
      CALL REGMAN (CLRACX, AREG, 0)
      RETURN
C     'DP' 'LS' 1 OR 'DP' 'RS' 1
2000  'IF' (OP .EQ. LSHIFT)
         CALL GENLA
         CALL BLDBLK (10, WF4)    // ASL A
         CALL GENMOV
         CALL BLDBLK (42, WF4)    // ROR A
         'ELSE'
         THIS = HI
         OTHER = LOW
         CALL GENLA
         CALL BLDBLK (74, WF4)    // LSR A
         CALL GENMOV
         CALL BLDBLK (106, WF4)   // ROL A
         'ENDIF'
      RETURN
      END
      'HEAD' UNARY CODE GENERATION
      'OUTFILE'   UGENAJH.FR
N     OVERLAY     OLUGN
      SUBROUTINE  UGEN
C     GENERATE CODE FOR UNARY OPERATORS -- NEG, INC, DEC, COM
      'INCLUDE'   LOGOSAJH.IN,
      'INCLUDE'   CODE1FTM.IN,
      'INCLUDE'   GENCMA.IN,
      'INCLUDE'   GENCMB.IN,
      'INCLUDE'   NLISTCFTM.IN,
      'INCLUDE'   OPERSAJH.IN,
      'INCLUDE'   REGSJHP.IN,
      'INCLUDE'   RMCODES.IN,
      'INCLUDE'   STKDFA.IN,
      'INCLUDE'   STKDFB.IN,
      'INCLUDE'   STKDFE.IN,
      'INCLUDE'   WFLAGSJHP.IN,
      INTEGER     OPTS, INCTLI, UMODE, OPTYPE, TSTK, LEFTTS
      INTEGER     OP1, OP2
      INTEGER     NLOPS
      LOGICAL     NLTEST
      DATA        TSTK  / 20/
      OPTS = OP - NEG + 1
      LEFTTS = LEFT
      SIDE = RIGHT
      UMODE = MODE (SIDE)
      OPTYPE = 4
      NLX = NAMEX (SIDE)
      'IF' (NLTEST (NLX, REGBIT))
         OPTYPE = NLOPS (REGNUM, NLX)
         'IF' (STATUS (OPTYPE) .EQ. 0)
            STATUS (OPTYPE) = SIDE
            ACTHI = AREG
            ACTLO = OPTYPE
            'ENDIF'
         'IF' (UMODE .EQ. SPMODE)
            ACTHI = 0
            'ELSE'
            OPTYPE = 5
            'ENDIF'
         'ENDIF'
      GO TO (100, 200, 300, 400), OPTS
1     RETURN
      'EJECT'
C     OP IS NEG
C     GET THE AREG
100   CALL REGMAN (SAVREG, AREG, DUMMY)
      IF (ACTLO .EQ. XREG) CALL REGMAN (SAVREG, XREG, DUMMY)
      IF (ACTLO .EQ. YREG) CALL REGMAN (SAVREG, YREG, DUMMY)
      CALL BLDOP (169, WF5, 0, NULLX, WF7)      // LDA =0
      CALL BLDBLK (SEC, WF4)                    // SET CARRY
      CALL GENDO                                // SUBTRACT
      'IF' (UMODE .EQ. DPMODE)
         CALL REGMAN (SAVREG, XREG, DUMMY)
         CALL BLDBLK (TAX, WF4)
         ACTLO = XREG
         CALL BLDOP (169, WF5, 0, NULLX, WF7)   // LDA =0
         THIS = HI
         CALL GENDO                             // SUBTRACT
         'ENDIF'
      CALL REGMAN (CLRACX, AREG, 0)
      GOTO 1
      'EJECT'
C     OP IS INC
200   IF (LEFT .NE. 0) ^
         CALL REGSRC (5, NAMEX (LEFT), 0, 0, 0, 0, 0)
      GO TO (210, 220, 230, 240, 250), OPTYPE
C     INC AREG
210   CALL BLDBLK (CLC, WF4)
      CALL BLDOP  (105, WF5, 1, NULLX, WF7)  // ADC =1
      CALL REGMAN (CLRACX, AREG, 0)
      GO TO 1
C     INC XREG
220   CALL BLDBLK (232, WF4)                 // INX
      GO TO 1
C     INC YREG
230   CALL BLDBLK (200, WF4)                 // INY
      CALL REGMAN (CLRACX, YREG, 0)
      GO TO 1
C     INC CORE
240   'IF' (IAND (OPCODE (SIDE), 7) .EQ. 5)
         CALL GENDO        // INC RIGHT [0]
         'IF' (UMODE .EQ. DPMODE)
C           DOUBLE PRECISION
            INCTLI = TLI
            TLI = TLI + 1
            CALL BLDOP (BNE, WF5, 0, INCTLI, WF9)
            THIS = HI         // HI BYTE
            CALL GENDO        // INC RIGHT [1]
C           DEFINE THE ADDRESS OF THE BNE
            CALL DEFTL (INCTLI)
            CALL REGMAN (CLRACX, NZREG, 0)
            GO TO 1
            'ENDIF'
         'ELSE'
C        MUST ADD 1, BUT IT IS LEFT IN THE AREG
         OP1 = CLC
         OP2 = 105        // ADC
         GO TO 500
         'ENDIF'
      GO TO 345
C     INC  'DP' AREG: CHANGE TO 'DP' AREG + 1
250   OP = PLUS
251   MORE = .TRUE.
      LEFT = RIGHT
      RIGHT = TSTK
      CALL STSET (RIGHT, NULLX, SPMODE, 1, LDAI, WF5, WF7)
      GO TO 1
      'EJECT'
C     OP IS 'DEC'
300   IF (LEFT .NE. 0) ^
         CALL REGSRC (5, NAMEX (LEFT), 0, 0, 0, 0, 0)
      GO TO (310, 320, 330, 340, 350), OPTYPE
C     'DEC' AREG
310   CALL BLDBLK (SEC, WF4)
      CALL BLDOP  (233, WF5, 1, NULLX, WF7)  // SBC =1
      GO TO 1
C     'DEC' XREG
320   CALL BLDBLK (202, WF4)                 // DEX
      GO TO 1
C     'DEC' YREG
330   CALL BLDBLK (136, WF4)                 // DEY
      CALL REGMAN (CLRACX, YREG, 0)
      GO TO 1
C     'DEC' CORE
340   'IF' (UMODE .EQ. SPMODE .AND. IAND (OPCODE (SIDE), 7) .EQ. 5)
C        CAN DO IT DIRECTLY
         CALL GENDO
         'ELSE'
C        MUST SUBTRACT 1, BUT IT IS LEFT IN THE AREG
         OP1 = SEC
         OP2 = 233        // SBC
         GO TO 500
         'ENDIF'
345   CALL REGMAN (SETREG, NZREG, LEFTTS)
      GO TO 1
C     'DEC' 'DP' AREG: CHANGE TO 'DP' AREG - 1
350   OP = MINUS
      GO TO 251
      'EJECT'
C     OP IS 'COM'
400   GO TO (440, 420, 430, 440, 440), OPTYPE
C     'COM' XREG
420   CALL GENTRA (XREG, AREG)
      GO TO 440
C     'COM' YREG
430   CALL GENTRA (YREG, AREG)
440   'IF' (STAREG .NE. SIDE)
         CALL REGMAN (SAVREG, AREG, DUMMY)
         CALL GENDO
         'ENDIF'
      CALL BLDOP (73, WF5, 255, NULLX, WF7)     // EOR =0FF
      CALL REGMAN (CLRACX, AREG, 0)
      IF (UMODE .EQ. SPMODE) GO TO 1
      LEFT = SIDE
      CALL GENMOV
      CALL BLDOP (73, WF5, 255, NULLX, WF7)     // EOR =0FF
      GO TO 1
      'EJECT'
C     COMMON CODE FOR TOUGH INCREMENT AND DECREMENT
500   CALL REGMAN (SAVREG, AREG, DUMMY)
      'DOLOOP' THIS = LOW, HI
         LEFT = SIDE
         RIGHT = 0
         'IF' (THIS .EQ. LOW)
            CALL GENDO
            CALL BLDBLK (OP1, WF4)               // CLC/SEC
            'ELSE'
            'IF' (NEXTOP .GT. RBRACE)
               CALL REGMAN (SAVREG, XREG, DUMMY)
               CALL BLDBLK (TAX, WF4)
               'ENDIF'
            CALL GENDO
            'ENDIF'
         CALL BLDOP  (OP2, WF5, 2-THIS, NULLX, WF7)   // ADC/SBC =1/=0
         RIGHT = SIDE
         LEFT = 0
         BASE = ARROW - EQUAL + 1
         CALL GENDO
         'IF' (UMODE .EQ. SPMODE)
            'BREAK'
            'ENDIF'
         IF (NEXTOP .GT. RBRACE) ACTLO = XREG
         'END'
      CALL REGMAN (SETREG, AREG, LEFTTS)
      CALL GENER (OUT)
      GO TO 345
      END