'HEAD'  COMPARISON ROUTINES
C     EDIT DATE   09DEC78  15:43
C     SOURCE FILE LCOMPAJH.FS
C     AUTHOR      A.  J. HOWARD
C     CLUSTER     8
      'OUTFILE'   LCOMPAJH.FR
C     EDIT DATE   09DEC78  15:43
C     SOURCE FILE LCOMPAJH.FS
C     AUTHOR      A.  J. HOWARD
N     OVERLAY     OLLCO
      SUBROUTINE  LCOMP (FUNC)
      INTEGER     FUNC
C
C     1 PROCESS RELATIONAL OPERATOR  = # < <= >= >
C     2 FINISH CONDITIONAL STATEMENT NEXT OP :
C     3 CLOSE SIDE  NEXT OP . OR ;
C
      INTEGER     ILBRET, SCRET     // INTERNAL SUBROUTINE RETURNS
      INTEGER     OPTS1,  LDROP
      INTEGER     TS, BROKTS
      INTEGER     COMPOP (6)
      INTEGER     JMP
      'INCLUDE'   LOGOSAJH.IN,
      'INCLUDE'   BLDPOAJH.IN,
      'INCLUDE'   BRACEFTM.IN,
      'INCLUDE'   CODE1FTM.IN,
      'INCLUDE'   CPAREAJH.IN,
      'INCLUDE'   OPERSAJH.IN,
      'INCLUDE'   OPINXJHP.IN,
      'INCLUDE'   WFLAGSJHP.IN,
      'INCLUDE'   GENCOMFTM.IN,
      'INCLUDE'   RMCODES.IN,
      DATA        JMP   /76/
      DATA        COMPOP / 18, 17, 22, 21, 20, 19/
      GO TO (100, 200, 300), FUNC
      'EJECT'
C     PROCESS A RELATIONAL OPERATOR
100   CALL GENER (SETX)
      'IF' (CNLSID (NESTX) .EQ. 0)
         CNLSID (NESTX) = 1
         CNLEND (NESTX) = 0
         PLEVEL = PLEVEL + 1
         STOPS (PLEVEL) = CLX
         'ENDIF'
      CMPFLG = CMPFLG + 1
      OPTS1 = NEXTOP
      CALL SSBUF
      LDROP = 0                   // LEVEL DROP
      ILB = 0
C
C     PEEK PAST ANY )S
      'DO'
         'WHILE' (OPTS1 .EQ. RPAREN)
            LDROP = LDROP + 1
            CALL PEEKFO       // PEEK FOR OPERATOR
            OPTS1 = PEEKS
            'END'
      'IF' (OPTS1 .EQ. OROP)
         TRUEF = 1
         OP = OP - EQUAL
         OP = COMPOP (OP + 1)
         'ELSE'
         TRUEF = -1
         'IF' (OPTS1 .EQ. ANDOP)
            PLEVEL = PLEVEL + 1
            STOPS (PLEVEL) = CLX
            'ELSE'
            'IF' (OPTS1 .EQ. COLON)
               PNESTX = NESTX + 1
               'ELSE'
               CALL FAULTP (34)
               'ENDIF'
            'ENDIF'
         'ENDIF'
      'IF' (OPTS1 .EQ. COLON)
C        CHECK SPECIAL CASES
         CALL PEEKFO
         'IF' (PEEKS .EQ. PERIOD ^
            .OR. PEEKS .EQ. SEMIC ^
            .OR. PEEKS .EQ. RBRACE)
C           : LABEL.  OR  : SUBROUTINE;  OR  : SUBROUTINE 'END'
            ILB = 1
            TRUEF = 1
            OP = OP - EQUAL
            OP = COMPOP (OP + 1)
            'ENDIF'
         'ENDIF'
'EJECT'
C     SET CODE SEQUENCE
      CALL MSTAK (NEXTX, NEXTX+2)
      CALL SETUP (LDAINX, NEXTX)
      CALL SETUP (LDAINX, TOPX)
      CALL GEN (-1, NEXTX, -2)
      CALL GEN (OP, NEXTX, TOPX)
      CALL GEN (-1, -2, -2)
      CALL GENER (OUT)
      'IF' (OPTS1 .EQ. COLON)
         CALL REGLEV (1)      // SET CURRENT CONTENTS
         'ENDIF'
      PLEVEL = PLEVEL - LDROP
      ASSIGN 110 TO ILBRET
      IF (OPTS1 .EQ. OROP) GO TO 500
      GO TO 550
110   PLEVEL = PLEVEL + LDROP
      IF (OPTS1 .EQ. ANDOP) PLEVEL = PLEVEL - 1
      CALL REGMAN (CLRSTA, 0, 0)
      RETURN
      'EJECT'
C     CONDITIONAL STATEMENT TERMINATION
200   'IF' (RELCNT + 1 .NE. CMPFLG)
         CALL REGLEV (1)
         CALL FAULTP (36)
         'ENDIF'
      CMPFLG = 0
      RELCNT = 0
      STOAC  = 0
      'IF' (NESTX .EQ. 9)
         CALL FAULTP (37)
         'ELSE'
         NESTX = NESTX + 1
         'IF' (LOOPF (LSX-1) .EQ. WHILE)
C
C           MOVE THE CONDITIONAL INDEXES TO THE BRACE INDEXES
C
            LSX = LSX - 1
            WHLOW (LSX - 1) = SELX
            TS = STOPS (PLEVEL) + 1
            'DOLOOP' TS = TS, CLX
               L = CPLOC (TS - 1)
               'IF' (L .LT. 0)
                  CPLOC (TS - 1) = 0
                  SUBENT (SELX) = -L
                  CALL STSLX (2)         // BUMP SELX
                  'ENDIF'
               'END'
            WHHIGH (LSX - 1) = SELX
            CNLSID (NESTX - 1) = 2
            CNLTLI (NESTX - 1) = 0
            CNLEND (NESTX - 1) = 0
            GO TO 300         // CLEAR OUT THE REST OF THE CONDITIONAL
            'ENDIF'
         'ENDIF'
      RETURN
      'EJECT'
C     CLOSE SIDE OF A CONDITIONAL
300   TNESTX = NESTX - 1
      'IF' (CNLSID (TNESTX) .LT. 2)
C        TRUE SIDE
         CNLSID (TNESTX) = 2
         CALL REGLEV (2)
         'IF' (NEXTOP .EQ. SEMIC)
            CALL PEEK
            'IF' (PEEKS .NE. SEMIC)
               TS = TLI
               CNLTLI (TNESTX) = TS
               TLI = TLI + 1
               CALL BLDOP (JMP, WF8, 0, TS, WF9)
               'ENDIF'
            'ENDIF'
C
C        CHECK FALSE START IN RANGE OF FIRST BRANCH
C
         IF (CNLEND (TNESTX) + 129 .GE. LC) BROK = BROK + 1
         BRCT = BRCT + 1
         CNLEND (TNESTX) = NEXTOP
         ASSIGN 310 TO ILBRET
         GO TO 500           // FILL IN TRANSFERS TO FALSE
310      CONTINUE
C        FALSE SIDE
         'ELSE'
         NESTX = TNESTX
         PNESTX = NESTX
         IF (PNESTX .EQ. 1) CLX = 2
         CNLSID (NESTX) = 0
         TS = CNLTLI (NESTX)
         'IF' (TS .NE. 0)
            CNLTLI (NESTX) = 0
            CALL DEFTL (TS)
            'ENDIF'
         'IF' (CNLEND (NESTX) .EQ. SEMIC)
            CALL REGLEV (3)
            CALL SET (0, FLSAVE, 6)
            'ENDIF'
         PLEVEL = PLEVEL - 1
         'ENDIF'
      RETURN
      'EJECT'
C     FILL IN FALSE JUMPS
500   ASSIGN 510 TO SCRET
      'FOR' (I = STOPS (PLEVEL); I .LT. CLX; I = I + 1)
         L = -CPLOC (I)
         IF (L .GT. 0) GO TO 575
510      'END'
      GO TO ILBRET

C     FILL IN TRUE JUMPS
550   ASSIGN 560 TO SCRET
      'FOR' (I = STOPS (PLEVEL); I .LT. CLX; I = I + 1)
         L = CPLOC (I)
         IF (L .GT. 0) GO TO 575
560      'END'
      GO TO ILBRET
C     SET COMPARE
575   CALL DEFTL (L)
      CALL REGLEV (5)
      CALL SET (0, FLSAVE, 6)
      CPLOC (I) = 0
      GO TO SCRET
      END