*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/15 17:51:25  mclareni
* Initial revision
*
*
          IDENT ULEFT
*
* CERN PROGLIB# M410    ULEFT           .VERSION KERNCDC  1.06  780614
*
          ENTRY ULEFT
*
*     CALL ULEFT (CH,JL,JR)
*                              COMPASS VERSION  MAY 1978, JZ
*
*         REGISTER ASSIGNMENTS
*
*         X1  CH(JTK)          B1  ADR(CH(0))
*         X2  CH(JTK+1)        B2  JL
*                              B3  JR
*         X4  BLANK WORD       B4  JTK
*
          USE   /SLATE/
 NDIGIT   BSS   1
 JEND     BSS   39
          USE
*
          VFD   30/5HULEFT,30/ULEFT
 ULEFT    DATA  0              X1= ADR(CH)
          SB7   1
          SA2   A1+B7          X2= ADR(JL)
          SA3   A2+B7          X3= ADR(JR)
          SA4   BLANK          X4= ALL BLANKS
          SA2   X2             X2= JL
          SA3   X3             X3= JR
          SB1   X1             B1= ADR(CH(1))
          SB1   B1-B7          B1= ADR(CH(0))
          SB2   X2             B2= JL
          SB3   X3             B3= JR
          SB5   B2                 JEND = JL IN CASE
          LT    B3,B2,HOME
          SB4   B2-B7          B4= JTK = JL-1
          SA2   B1+B2          X2= CH(JTK+1) = CH(JL)
*
*         LOOP TO FIND FIRST BLANK
*
          SB5   B3+B7              JEND = JR+1 IN CASE NO BLANK
 LOOP1    EQ    B4,B3,HOME
          BX1   X2             X1= CH(JTK)
          SA2   A2+B7          X2= CH(JTK+1)  READ AHEAD
          IX3   X1-X4
          SB4   B4+B7          B4= JTK
          NZ    X3,LOOP1
*
*         LOOP TO RUN OVER FIRST STRING OF BLANKS
*
          SB5   B4             B5= JEND = JTK OF FIRST BLANK
 LOOP2    EQ    B4,B3,HOME
          BX1   X2             X1= CH(JTK)
          SA2   A2+B7          X2= CH(JTK+1)  READ AHEAD
          IX3   X1-X4
          SB4   B4+B7          B4= JTK
          ZR    X3,LOOP2
*
*         LOOP TO COPY
*
          BX6   X1                 STORE FIRST NON-BLANK CHAR
          SA6   B1+B5
          SB6   B4             B6= JTK OF LAST NON-BLANK CHAR
 LOOP3    EQ    B4,B3,END3
          BX6   X2             X6= CH(JTK)
          SA2   A2+B7          X2= CH(JTK+1)  READ AHEAD
          IX3   X6-X4
          SB4   B4+B7          B4= JTK
          ZR    X3,LOOP3
          SA6   A6+B7
          SB6   B4             B6= JTK OF LAST NON-BLANK CHAR
          EQ    LOOP3
*
*         LOOP TO BLANK TRAILING WORDS
*
 END3     SB5   A6-B1          B5= JPUT OF LAST STORED
          SB4   B6-B5          B4= N CHAR. TO BE CLEARED
          BX6   X4
          SB5   B5+B7              JEND = JPUT+1
 LOOP4    SA6   A6+B7
          SB4   B4-B7
          NE    B4,B0,LOOP4
*
 HOME     SX7   B5                 JEND
          SX6   B5-B2              NDIG = JEND - JL
          SA6   NDIGIT
          SA7   A6+B7
          EQ    ULEFT
*
 BLANK    DATA  55555555555555555555B
          END
#ifdef CERNLIB_TCGEN_ULEFT
#undef CERNLIB_TCGEN_ULEFT
#endif
