*DECK XCOMP 
          IDENT  XCOMP
 XCOMP    TITLE  XCOMP  --  8-BIT COMPARE ROUTINE 
*       8-BIT COMPARE ROUTINE 
*** 
*     XCOMP IS A FUNCTION OR SUBROUTINE USED TO COMPARE TWO DATA
*      FIELD IN ANY OF THE FOLLOWING FORMS-- 6 BIT DISPLAY CODE,
*      EBCDIC OR ASCII. 
*         IT IS A USER CALLED ROUTINE.
          SPACE  3
**    CALLING SEQUENCE--
*        CALL 
*         OR    XCOMP XY,SRC1,SRC2,STATUS,LEN,POS1,POS2.
*        ENTER
*        IN COBOL ALL PARAMETERS FROM LEN ON ARE OPTIONAL.
*         IN FORTRAN POS1 AND POS2 ARE OPTIONAL.
*        XY = CONVERSION TYPES FOR THE 2 SRCE FIELDS  (INPUT PARAM) 
*             A=ASCII 
*             C=EBCDIC
*             X=D.P.C.
*             THE FIRST CODE SPECIFIED DETERMINES THE COLLATING 
*             SEQUENCE TO BE USED 
*        SRC1 = SUBJECT SOURCE POINTER   (INPUT PARAMETER)
*        SRC2 = OBJECT SOURCE POINTER    (INPUT PARAMETER)
* 
*        STATUS = OUTPUT PARAMETER SET TO 
*                -1.0  IF SRC1 LT SRC2
*                0.0 IF SRC1 = SRC2 
*                +1.0 IF SRC1 GT SRC2 
* 
*        LEN = NUMBER OF CHRS TO COMPARE, OPTIONAL FOR COBOL. 
*              IN COBOL IF LEN IS NOT SPECIFIED, THE LONGER 
*              LENGTH IS USED, BLANK FILLING THE SHORTER (IN
*              CHRS) FIELD. 
* 
*        POS1 = BEGINNING CHR POSITION FOR SRC1 FIELD. DEFAULT
*               VALUE =1. CHRS ARE NUMBERED LEFT TO RIGHT BEGINNING 
*               WITH 1. 
*        POS2 = BEGINNING CHR POSITION FOR SRC2 FIELD 
* 
          SPACE  1
*CALL COM1
          SPACE  4
 TC.XCOMP VFD    42/5HXCOMP,18/XCOMP   TRACEBACK WORD 
 NOMORE   SX2    B0 
 SETSTAT  PX6    X2 
          SA4    T.STAT      PTR TO STATUS WORD 
          SX7    B0 
          NX6    X6 
          ZR     X4,XCOMP    NO STATUS WORD 
          SA6    X4 
* 
 XCOMP    JP     400000B+*   ENTRY
          SX7    TC.XCOMP 
          SB2    2           INPUT TO T.CRACK 
          SB6    BACK1       RETURN ADDR
          EQ     TDCRACK
 BACK1    SA1    T.S1        CHR SIZE--FIRST SOURCE FIELD 
          SA2    T.S2                --2ND--
          SA3    T.XY 
          SB7    T.CNVT      CONVERSION TABLE INFO
          SA4    X1          SIZE-1 
          SX5    X3-3        XY CODE - 3
          SA2    X2          SIZE-2 
          PL     X5,LOOP1    BR IF XY CODE IS NOT 0, 1, OR 2 (XX,AA,CC) 
* 
* X=Y 
* 
          SB6    BACKA       RETRN ADDRESS FOR NXBITS 
          SA1    T.SRC1      UNUSED BITS,BCP,SOURCE-1 PTR 
          SX2    60          NUM OF BITS TO GET 
          EQ     NXBITS      PICK UP 60 BITS FROM FIELD-1 
 BACKA    SX3    X2-60
          NG     X3,LOOP1        BR IF NOT AT LEAST 60 BITS LEFT
          SA7    T.SAVEA0    SAVE UPDATED PTR WORD
          BX5    X6          MOVE 60 BITS TO X5 
          SA1    T.SRC2      PTR WORD FOR SOURCE-2
          SB6    BACKB       RETURN ADDRESS 
          EQ     NXBITS      GET 60 BITS FROM FIELD-2 
 BACKB    SX3    X2-60
          NG     X3,LOOP1        BR IF NOT AT LEAST 60 BITS LEFT
          IX0    X6-X5
          NZ     X0,LOOP1    BR IF 60 BITS NOT EQ 
          SA1    T.SAVEA0    RETRIEVE UPDATED PTR WORD FOR FIELD 1
          SA7    T.SRC2      STORE UPDATED PTR WRD FOR FIELD-2
          SB6    BACKA       RTRN ADD FOR NXBITS
          MX0    24 
          BX7    X1 
          BX3    X0*X1       UNUSED BITS IN FIELD-1 
          SA7    T.SRC1      UPDATED PTR WRD FOR FIELD-1
          ZR     X3,ENDCK    BR IF NO MORE BITS 
          EQ     NXBITS      GET NEXT 60 BITS 
 LOOP1    SB6    BACK2       RETURN ADDR FOR NXBITS 
          SA1    T.SRC1      PTR WRD-FIELD-1
          SX2    A4          C(T.S1)
          EQ     NXBITS 
 BACK2    ZR     X2,ENDCK          BR IF NOT MORE CHRS
          BX5    X6          MOVE CHR TO X5 
          SA7    A1          UPDATED PTR WRD TO T.SRC1
          SA1    T.SRC2      PTR WRD--FIELD-2 
          SB6    BACK3       RETRN ADDR FOR NXBITS
          SX2    A2          C(T.S2)
          EQ     NXBITS 
 BACK3    BSS    0
          SA3    T.XY        XY PARAMETER CODE
          SA7    A1          UPDATED PTR WRD TO T.SRC2
          SA1    B7+X3       T.CNVT+X3 = CONVERSION INFO FOR Y TO X 
          ZR     X1,NOCNVT   BR IF NO CONVERSION NEEDED 
          SB5    X1          T.6TAB OR T.HXTBL PTR
          LX1    42          RT JUST LEFT SHIFT CNT 
          SB4    X1          LEFT SHIFT CNT 
          LX1    42          MASK-RT JUST 
          SX0    X1          MASK 
          SA3    B5+X6       TABLE BASE + CHR TO CONVERT
          AX7    X3,B4       RT JUST NEW CHR
          BX6    X0*X7       MASK OFF NEW CHR 
 NOCNVT   IX0    X6-X5       SRCE2-SRCE1
          NZ     X0,COLLATE  BR IF NOT EQ 
          SB6    BACK2       NXBITS RETRN 
          SA1    T.SRC1      PTR WRD
          SX2    A4          T.S1 
          EQ     NXBITS 
 ENDCK    SA1    T.EXL1      EXCESS BITS IN FIELD-1 
          SA3    T.EXL2      EXCESS BITS IN FIELD-2 
          BX2    X1+X3
          ZR     X2,SETSTAT  BR IF EQUAL LENGTH FIELDS
          SA3    T.XY        CONV. CODE INDEX 
          SA5    BLKCNVT+X3       SPACE VALUE 
          NZ     X1,SRC2SHT    BR IF FIELD-2 SHORTER
          AX5     12         PROPER SPACE VALUE 
          SA3    T.EXL2 
          SA1    T.SRC2      PTR WORD FOR FIELD-2 
          MX0    24 
          LX3    36          ALIGN UNUSED BIT CNT 
          BX7    -X0*X1      MAKE ROOM FOR BIT CNT
          IX1    X7+X3       INSERT NEW UNUSED BIT CNT
          SB6    BACK4       NXBITS RTRN ADDR 
          SX2    A2          C(T.S2)
          EQ     NXBITS      GET NEXT A2 BITS 
 BACK4    ZR     X2,NOMORE   BR IF NO MORE CHRS IN FIELD-2
          SA3    T.XY 
          SA7    A1          UPDATED PTR TO T.SRC2
          SA1    B7+X3       T.CNVT+XY CODE--CONV.INFO
          ZR     X1,NOCNV2   BR IF NO CONVERSION NEEDED 
          SB5    X1          T.6TAB OR T.HXTBL PTR
          LX1    42          RT JUST SHFT CNT 
          SA3    B5+X6       TABLE BASE+CHR TO CONVERT
          SB4    X1          SHFT CNT 
          LX1    42          RT JUST MASK 
          SX0    X1          MASK 
          AX7    X3,B4       RT JUST CONVERTED CHR
          BX6    X0*X7       MASK 
 NOCNV2   IX0    X6-X5
          SA1    A7          RESTORE T.SRC2 TO X1 
          ZR     X0,NXBITS   IF EQ GET NEXT CHR 
          EQ     COLLATE     UNEQUAL
 SRC2SHT  BSS    0           SOURCE-1 LONGER THAN 2 
          LX5    48 
          AX5    48          SPACE IN FIELD-2 
          SX6    X5 
          SA5    T.XY 
          SA3    B7+X5       T.CNVT+CODE TYPE 
          ZR     X3,NXT15    BR IF NO CONVERSION NEEDED 
          SB5    X3          T.6TAB OF T.HXTBL PTR
          LX3    42          RT JUST SHFT CNT 
          SB6    X3          SHIFT CNT
          LX3    42          RT JUST MASK 
          SX0    X3          MASK 
          SA5    B5+X6       TABLE BASE+CHR TO CONVERT
          AX7    X5,B6       RT JUST CONVERTED CHR
          BX6    X0*X7       MASK NEW CHR 
 NXT15    BSS    0
          MX0    24 
          SA3    T.SRC1      FIELD-1 PTR WRD
          LX1    36          ALIGN NEW LENGTH 
          SB6    BACK5       NXBITS RETRN 
          SX2    A4          CHR SIZE--FIELD-1
          BX7    -X0*X3      MAKE HOLE IN SRC PTR WRD 
          IX1    X7+X1
          BX5    X6      SV BLANK 
          EQ     NXBITS      GET NEXT CHR 
 BACK5    ZR     X2,NOMORE   BR IF NO MORE CHRS (SRC1 = SRC2) 
          IX0    X5-X6
          ZR     X0,NXBITS
          BX1    X6          EXCHANGE X5 AND X6 
          SX6    X5 
          AX5    X1 
          IX0    X6-X5
 COLLATE  SX3    A4-6        C(T.S1)-6
          NZ     X3,NOT6     BR IF FIELD 1 NOT D.P.C. 
* 
*  COLLATE X5 AND X6
* 
          SA3    X6+SIXTAB
          SA1    X5+SIXTAB
          SX6    X3          SRC2 CHR COLLATED
          SX5    X1          SRC1 CHR COLLATED
          IX0    X6-X5
 NOT6     NG     X0,SRC1BIG 
          SX2    -1 
          EQ     SETSTAT
 SRC1BIG  SX2    1
          EQ     SETSTAT
 BLKCNVT  BSS    0
          VFD    36/0,12/SPACE.X,12/SPACE.X      X-X  0 
          VFD    36/0,12/SPACE.A,12/SPACE.A      A-A  1 
          VFD    36/0,12/SPACE.C,12/SPACE.C      C-C 2
          VFD    36/0,12/SPACE.A,12/SPACE.X   A-X  3                    TB8    3
          VFD    36/0,12/SPACE.C,12/SPACE.X  C-X  4                     TB8    4
          VFD    36/0,12/SPACE.X,12/SPACE.A  X-A  5                     TB8    5
          VFD    36/0,12/SPACE.C,12/SPACE.A  C-A  6                     TB8    6
          VFD    36/0,12/SPACE.X,12/SPACE.C  X-C  7                     TB8    7
          VFD    36/0,12/SPACE.A,12/SPACE.C  A-C  8                     TB8    8
          END 
