'HEAD'  PASS 1 CODE GENERATION
C     EDIT DATE   18JAN79  21:41
C     SOURCE FILE CODE1FTM.FS
C     AUTHOR      F. T. MICKEY
C     CLUSTER     21
      'OUTFILE' BLDBLKFTM.FR
      SUBROUTINE BLDBLK (OBWORD, WFLAG)
      'INCLUDE' LOGOSAJH.IN,
      'INCLUDE' WFLAGSJHP.IN,
      'INCLUDE' CODE1FTM.IN,
      'INCLUDE' NLISTCFTM.IN,
      'INCLUDE' LCONSTAJH.IN,
      INTEGER OBWORD, OW, WFLAG, WF, PRIORS
      INTEGER WFSTEP (17)
      LOGICAL     NLTEST
C                                     1 1 1 1 1 1 1 1
C                   1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7
      DATA WFSTEP / 1,0,0,1,2,0,0,3,0,0,0,0,0,0,0,0,0 /
      DATA PRIORS / 0/
      OW = OBWORD
      WF = WFLAG
      'IF' (WF .EQ. WF7 .OR. WF .EQ. WF12 ^
            .OR. WF .EQ. WF13 .OR. WF .EQ. WF16)
C        NAME LIST INDEX
         'IF' (OW .NE. 0)
            N = IAND (OW, 32767)
            'IF' (NLTEST (N, REGBIT))
               CALL FAULTP (35)   // "ILLEGAL REGISTER USE"
               OW = NULLX
               'ENDIF'
            'IF' (N .EQ. STPTRX)
               CALL FAULTP (70)
               OW = NULLX
               'ENDIF'
            CALL NLSET (N, USEBIT)
            'ELSE'
            CALL FAULTP (10)       // "MISSING NAME (OPERAND)"
            OW = NULLX
            'ENDIF'
         'ENDIF'
'EJECT'
      'IF' (WF .NE. WF6 .OR. OW .NE. 0)
         WO (WOPTR) = WF
         WO (WOPTR+1) = OW
         WOPTR = WOPTR + 2
         IF (WOPTR .GE. 64) CALL WRITWO
         CALL LIST (LOWWF, OW, WF)
         'IF' (WF .EQ. WF5 .OR. WF .EQ. WF8)
            PRIORS = WFSTEP (WF)
            'ELSE'
            'IF' (WF .NE. WF6)
               IF (WF .EQ. WF7 .AND. PRIORS .EQ. 0) PRIORS = 2
               LC = LC + WFSTEP (WF) + PRIORS
               PRIORS = 0
               'ENDIF'
            'ENDIF'
         'ENDIF'
      IF (TLI .GE. 125) ^
         CALL FAULTP (89)          // "FLOWCHART TOO COMPLEX"
      RETURN
      END
      'OUTFILE' WRITWOFTM.FR
C
C     WRITE A BLOCK TO THE DISC SCRATCH FILE
C
      SUBROUTINE WRITWO
      'INCLUDE' CODE1FTM.IN,
      CALL WRSEQ (SS2, WO, 128)
      WOPTR = 1
      RETURN
      END
      'OUTFILE' WRBLOKFTM.FR
C
C     WRITES THE LAST BLOCK TO SCRATCH, FOLOWED BY THE
C     TRANSFER LIST.
C
      SUBROUTINE WRBLOK
      'INCLUDE' WFLAGSJHP.IN,
      'INCLUDE' CODE1FTM.IN,
      NRFCH = NRFCH + 1
      CALL BLDBLK (0, WF3)
      IF (WOPTR .NE. 1) CALL WRITWO
C     WRITE TRANSFER LIST
      CALL WRSEQ (SS, TL, 256)
      TLI = 1
      RETURN
      END
      'OUTFILE' BLDOPFTM.FR
      SUBROUTINE BLDOP (OPIN, WF, BIAS, NLX, NLXWF)
      'INCLUDE' WFLAGSJHP.IN,
      INTEGER     OPIN, WF, BIAS, NLX, NLXWF
      CALL BLDBLK (BIAS, WF6)
      CALL BLDBLK (OPIN, WF)
      IF (WF .NE. WF4) CALL BLDBLK (NLX, NLXWF)
      RETURN
      END