*DECK,DCCMPR
      PROC DC$CMPR (ERRSTAT,HILOEQ,DCTABLE,COMPBWP,COMPBCP,LITLENG, 
        TCLASS,TGIBBP,TGIFWA,TSIZE,TSIGNF,TACTLP,TPTLOC); 
      BEGIN 
 #
  *    DC$CMPR                                   PAGE 1 
  *   COMPARE PRIMITIVE 
  *   J.W.PERRY                                  DATE  04/04/74 
  *   M L MOORE - REVISION FOR MFP               11/11/75 
  *   J.W.PERRY - REVISION FOR CDCS 2     DATE 1/17/77
  DC  PURPOSE 
      COMPARE VALUE OF DESIGNATED TARGET ITEM WITH
      DESIGNATED COMPARISON VALUE (USUALLY CHECK LITERAL OR,
      FROM MFP, A SOURCE DBI VALUE SAVED IN A JOIN BUFFER). 
  DC  ENTRY CONDITIONS
        FORMAL PARAMATERS 
      DCTABLE (ARRAY) CONTAINS THE DISPLAY-TO-COLLATING-SEQUENCE TABLE. 
      COMPBWP CONTAINS BEGINNING WORD POS OF COMPARISON VALUE.
      COMPBCP CONTAINS BEGINNING CHAR POS OF COMPARISON VALUE 
      DCTABLE CONTAINS DISPLAY-TO-COLLATING TABLE.
      LITLENG CONTAINS LENGTH OF COMPARISON VALUE (WORDS).
      TCLASS CONTAINS TARGET ITEM CLASS CODE. 
      TGIBBP CONTAINS TARGET ITEM BEGINNING BIT POSITION. 
      TGIFWA CONTAINS TARGET ITEM FWA.
      TSIZE CONTAINS TARGET ITEM SIZE (BITS). 
      TSIGNF CONTAINS SIGN FLAG (TRUE = SIGN OVERPUNCH).
      TACTLP CONTAINS DECIMAL FLAG (TRUE = ACTUAL EMBEDDED POINT).
      TPTLOC CONTAINS DECIMAL LOCATION (NBR OF CHARS TO RIGHT OF DECIMAL
  DC  EXIT CONDITIONS 
      ERRSTAT (FORMAL PARAM 1) NONZERO IF ERROR DETECTED. 
      HILOEQ (FORMAL PARAM 2) = -1 IF TARGET VALUE LESS THAN COMP VALUE.
                              = 0  IF TARGET VAL EQUALS COMPARISON VAL. 
                              = +1 IF TARGET VAL GREATER THAN COMP VAL. 
      ENTRY CELLS UNCHANGED.
  DC  CALLING ROUTINES
      DC$CKVL -- CHECK-VALUE PRIMITIVE
      DC$MKY - MFP MAJOR KEY RETRIEVAL MODULE 
      DC$NKY - MFP SEQUENTIAL RETRIEVAL MODULE
      DC$QUAL - RELATION QUALIFICATION MODULE 
  DC  CALLED ROUTINES 
      STRIPSIGN (EMBEDDED PROC) 
      DC$XFER -- TRANSFER PRIMITIVE 
  DC  NON-LOCAL VARIABLES 
      ERRSTAT (DC$COM)
  DC  DESCRIPTION 
        CURRENT IMPLEMENTATION SUPPORTS COMPARISON OF VALUES WHERE THE
      TARGET ITEM IS ONE OF THE FOLLOWING CLASSES (DATA-CLASS CODE) 
          ALPHANUMERIC
          ALPHABETIC
          DCNUMERIC 
          DCFIXED 
          DCFLOAT 
          INTEGER 
          FIXED 
          FLOATUNNORM 
          FLOATNORM 
          DOUBLE
          COMPLEX 
        THE TARGET ITEM IS AT TGIFWA,TGIBBP, OF CLASS TCLASS, AND 
      SIZE TSIZE (BITS).
        THE VALUE WITH WHICH THE TARGET ITEM IS COMPARED IS AT
      COMPBWP (STARTING AT CHAR COMPBCP) AND EXTENDS FOR LITLENG FULL 
      WORDS.
        FOR ALPHANUMERIC AND ALPHABETIC CLASSES, THE COMPARISON VALUE 
      IS LEFT-JUSTIFIED BLANK FILL (ADDITIONAL BLANK FILL IS SUPPLIED 
      IF TARGET ITEM SIZE EXCEEDS THE LITERAL LENGTH).
        FOR THE NUMERIC DISPLAY CODE CLASSES, THE COMPARISON VALUE IS 
      CONFIGURED EXACTLY AS THE TARGET ITEM (WITH RESPECT TO SIGN 
      POSITION AND REPRESENTATION, DECIMAL POINT POSITION AND REPRES, 
      JUSTIFICATION, AND SIZE (TSIZE ROUNDED UP TO WORDS)). 
      HENCE THE QUANTITIES ARE DIRECTLY COMPARABLE WITH NO CONVERSION.
        FOR REMAINDER OF CLASSES, TARGET ITEM IS NECESSARILY
      WORD-ALIGNED (1 OR 2 WORDS) AND THE COMPARISON VALUE IS 
      DIRECTLY COMPARABLE (IDENTICAL DATA REPRESENTATION).
  
        PROCEDURE 
  
        FOR ALPHANUMERIC DISPLAY CODE ITEMS (MAX 18 DIGITS) STORE 
      TARGET AND LITERAL VALUES IN LOCAL CELLS, STRIPPING SIGN OVERPUN
      AND CHANGING DEC PT (IF ANY) TO ZERO.  COMPARISON IS DETERMINED BY
      OPPOSITE SIGNS (UNLESS COMPARISON VALUE IS ZERO) OR BY COMPARING
      THE STORED STRINGS, UP TO 18 CHARACTERS.
        FOR ALPHANUMERIC ITEMS, COMPARE TARGET AND LITERAL VALUES 
      (UP TO) 60 BITS AT A TIME.  IF NON-EQUALITY IS DETECTED,
      REPLACE CHARACTERS IN BOTH VALUES WITH COLLATING SEQUENCE 
      EQUIVALENTS AND COMPARE.  CONTINUE UNTIL TARGET IS EXHAUSTED
      OR INEQUALITY IS INDICATED. 
        FOR BINARY VALUES COMPARE FIRST WORD OF VALUES DIRECTLY 
      AND COMPARE SECOND WORD FOR DOUBLE, COMPLEX CLASSES,
      IF FIRST WORDS EQUAL. 
      UNNORMALIZED FLOATING POINT VALUES ARE ASSUMED TO HAVE
      EXPONENT 2000 (OR 5777).
        (COMPLEX VALUE X IS CONSIDERED LESS THAN COMPLEX VALUE Y IF 
      REAL PART OF X IS LESS THAN THAT OF Y, OR IF REAL PARTS ARE EQUAL 
      AND IMAGINARY COEFF OF X IS LESS THAN THAT OF Y.) 
 #
# 
      DEFINE UPDATE SYMBOL DCMPR TO TURN ON TRACE (USING SNATCH). 
      DEFINE UPDATE SYMBOL DCMPR2 TO DUMP PARAMETERS (USING SNATCH).
      DEFINE UPDATE SYMBOL DCMPR3 TO DUMP TARGET AND LITERAL VALUES.
      DEFINE UPDATE SYMBOL DCMPR4 TO DUMP COLLATING EQUIVALENTS.
      DEFINE UPDATE SYMBOL DCMPR5 TO DUMP NUMERIC DISPLAY CODE VALUES.
# 
      CONTROL EJECT;
# DDL DATA-CLASS CODES                                                 #
  
        DEF ALPHANUMERIC #0#;          #ALPHANUMERIC DISPLAY CODE # 
        DEF ALPHABETIC   #1#;          #ALPHABETIC DISPLAY CODE # 
        DEF DATABASEKEY  #2#; 
        DEF DCNUMERIC    #3#;          #NUMERIC DISPLAY CODE, SIGN OVPN#
        DEF DCFIXED      #4#;          #NUM DC, WITH DECIMAL PT # 
        DEF DCFLOAT      #5#;          #NUM DC, WITH EXPONENT # 
        DEF DCDOUBLE     #6#;          #DISPLAY CODE DOUBLE PRECISION#
        DEF DCCOMPLEX    #7#;          #DISPLAY CODE COMPLEX #
        DEF DCLOGICAL    #8#;          #DISPLAY CODE LOGICAL #
        DEF BITSTRING    #9#; 
        DEF INTEGER      #10#;         #BINARY INTEGER #
        DEF FIXED        #11#;         #FLOATING POINT, UNNORMALIZED #
        DEF FLOATUNNORM  #12#;         #FLOATING POINT, UNNORMALIZED #
        DEF FLOATNORM    #13#;         #FLOATING POINT, NORMALIZED #
        DEF DOUBLE       #14#;         #FLOATING POINT, DOUBLE PREC. #
        DEF COMPLEX      #15#;         #FLOATING POINT, COMPLEX # 
        DEF LOGICAL      #16#;         #LOGICAL (BINARY 0 OR 1)#
  
  
      #DEFS FOR READABILITY                                            #
        DEF CALL     # #;    #CALL CAN BE USED WHEN CALLING PROCEDURES #
        DEF XCALL    # #;    #XCALL CAN BE USED WHEN CALLING PROCEDURES#
        DEF THRU     #STEP 1 UNTIL#; #SHORTHAND FOR FOR-LOOP USE       #
  
      ITEM ERRSTAT U;        #PARAM 1 - ERROR STATUS (NONZERO IF ERR.) #
      ITEM HILOEQ I;         #PARAM 2 - RESULT OF COMPARISON.          #
      ARRAY DCTABLE[0:7];    #PARAM 3 - DISPLAY-TO-COLLAT-SEQ TABLE.   #
        ITEM DCTVAL U(0,0,60);
      ITEM COMPBWP U;        #PARAM 4 - BWP OF COMPARISON VALUE.       #
      ITEM COMPBCP U;        #PARAM 5 - BCP OF COMPARISON VALUE.       #
      ITEM LITLENG U;        #PARAM 6 - LENGTH OF COMPAR VAL (WORDS).  #
      ITEM TCLASS U;         #PARAM 7 - TARGET ITEM CLASS CODE.        #
      ITEM TGIBBP U;         #PARAM 8 - TARGET ITEM BBP.               #
      ITEM TGIFWA U;         #PARAM 9 - TARGET ITEM FWA.               #
      ITEM TSIZE U;          #PARAM 10 - TARGET ITEM SIZE (BITS).      #
      ITEM TSIGNF B;         #PARAM 11 - TARGET ITEM SIGN FLAG         #
                             #(TRUE = SIGN OVERPUNCH ON RIGHTMOST CHAR)#
      ITEM TACTLP B;         #PARAM 12 - TARGET ITEM DECIMAL FLAG      #
                             #(TRUE = ACTUAL DECIMAL POINT).           #
      ITEM TPTLOC U;         #PARAM 13 - TARGET ITEM DECIMAL LOCATION  #
                             #(NBR CHARS TO RIGHT OF DECIMAL POSITION).#
  
  
      XREF
        BEGIN 
        PROC DC$XFER; 
        END 
  
      BASED ARRAY TARG;      #FOR TARGET ITEM VALUE (FULL-WORD). #
        ITEM TARGWORD;
      BASED ARRAY CKLIT;     #FOR CHECK LITERAL VALUE. #
        ITEM CKLITWORD; 
  
      ITEM NUMTARG C(20);    #DISPLAY CODE NUMERIC TARGET VALUE. #
      ITEM NUMCOMP C(20);    #DISPLAY CODE NUMERIC COMPARISON VALUE. #
      ITEM CHAR C(1);        #SCRATCH . # 
      ITEM TSIGN;            #+ OR - 1, FOR SIGN OF DISPLAY NUM TARGET.#
      ITEM CSIGN;            #+ OR - 1, FOR SIGN OF DISPLAY NUM COMPAR.#
      ITEM ZERO C(20) = "00000000000000000000";  #READ CONST., ZERO. #
      ITEM BLANKS C(10) = "          ";     #READ-ONLY CONSTANT,BLANKS.#
      ITEM BWP1 U;           #BEGINNING WORD POSITION 1. #
      ITEM BWP2 U;           #BEGINNING WORD POSITION 2. #
      ITEM BBP1 U;           #BEGINNING BIT POSITION 1. # 
      ITEM BBP2 U;           #BEGINNING BIT POSITION 2. # 
      ITEM CKLITERAL U;      #FOR CHECK LITERAL WORD. # 
      ITEM I U;              #SCRATCH, LOOP INDEX. #
      ITEM J U;              #LOOP INDEX. # 
      ITEM LENGTH U;         #REMAINING LENGTH (WORDS) OF LIT VALUE.   #
      ITEM SIZE U;           #SIZE OF PORTION OF VALUE TO BE XFERRED. # 
      ITEM SIZELEFT;         #REMAINING BITS TO BE COMPARED. #
      ITEM TARGET U;         #FOR TARGET ITEM WORD. # 
      ITEM BYTEINDEX U;      #BYTE INDEX INTO DCT TABLE. #
      ITEM WORDINDEX U;      #WORD INDEX INTO DCT TABLE. #
      CONTROL EJECT;
*IF DEF,DCMPR,3 
      XREF PROC SNATCHD;               #IN IF DEF DCMPR # 
      XREF PROC SNATCHC;               #IN IF DEF DCMPR # 
      SNATCHC("ENTER CMPR",I,0);       #IN IF DEF DCMPR # 
*IF DEF,DCMPR2,9
*IF -DEF,DCMPR,1
      XREF PROC SNATCHD;               #IN IF DEF DCMPR2 #
      SNATCHD("TGIFWA",TGIFWA);        #IN IF DEF DCMPR2 #
      SNATCHD("TGIBBP",TGIBBP);        #IN IF DEF DCMPR2 #
      SNATCHD("TSIZE",TSIZE); 
      SNATCHD("TCLASS",TCLASS); 
      SNATCHD("COMPBWP",COMPBWP);      #IN IF DEF DCMPR2 #
      SNATCHD("DCTADDR",DCTADDR);      #IN IF DEF DCMPR2 #
      SNATCHD("LITLENG",LITLENG);      #IN IF DEF DCMPR2 #
*IF DEF,DCMPR3,7
      XREF PROC SNATCH;                #IN IF DEF DCMPR3 #
      BASED ARRAY DUMARRAY;            #IN IF DEF DCMPR3 #
        ITEM DUMITEM U;                #IN IF DEF DCMPR3 #
      P<DUMARRAY> = TGIFWA;            #IN IF DEF DCMPR3 #
      SNATCH("TARGET",DUMARRAY,4);     #IN IF DEF DCMPR3 #
      P<DUMARRAY> = COMPBWP;           #IN IF DEF DCMPR3 #
      SNATCH("CK LIT",DUMARRAY,4);     #IN IF DEF DCMPR3 #
      IF #1# TCLASS LQ DCLOGICAL THEN  #DISPLAY-CODE VALUE,  #
        BEGIN                     #  NOT NECESS WORD-ALIGNED IN TARGET.#
        $BEGIN
        IF TCLASS EQ DATABASEKEY
        OR TCLASS GQ DCDOUBLE THEN
          BEGIN 
          ERRSTAT = O"420";  #UNSUPPORTED DATA CLASS. # 
          RETURN; 
          END 
        $END
        SIZELEFT = TSIZE;   #INITIALIZE SIZE = NBR BITS TO COMPARE. # 
          LENGTH = LITLENG;  #INITIALIZE LENGTH (WORDS) OF LIT VALUE.  #
        BWP1 = TGIFWA;       #INITIALIZE BWP OF TARGET ITEM. #
        BBP1 = TGIBBP;       #INITIALIZE BBP OF TARGET ITEM. #
        BWP2 = COMPBWP;      #INITIALIZE BWP OF COMPARISON (CK LIT). #
        BBP2 = COMPBCP * 6;  # INITIALIZE BBP OF COMPARISON # 
        COMPBCP = 0;
  
      IF #1.1# TCLASS GQ DCNUMERIC THEN   #DISPLAY CODE NUMERIC ITEM. # 
        BEGIN 
#  FOR CURRENT IMPLEMENTATION, SIGN INFO IS REPRESENTED ONLY BY 
   OVERPUNCH ON FINAL CHARACTER POSITION OF ITEM. # 
  
        I = TSIZE / 6 - 1;  #FINAL CHARACTER POSITION. #
        J = TSIZE - 6;      #FINAL CHAR POS (BITS). # 
        TSIGN = 1;           #INITIALIZE.  DEFAULT +. # 
        CSIGN = 1;
        NUMTARG = ZERO;      #INITIALIZE RECEIVING CELL. #
  
#  MOVE COMPARISON VALUE TO LOCAL FIXED ARRAY. #
        DC$XFER (BWP2,BBP2,LOC(NUMTARG),0,TSIZE); 
        IF TSIGNF THEN       #SIGN INFO PRESENT. #
          CALL STRIPSIGN(CSIGN); #INTERPRET SIGN OVERPUNCH CHARACTER. # 
        NUMCOMP = NUMTARG;   #MOVE TO COMPARISON VALUE CELL. #
  
#  MOVE TARGET VALUE TO LOCAL FIXED ARRAY. #
        DC$XFER (BWP1,BBP1,LOC(NUMTARG),0,TSIZE); 
        IF TSIGNF THEN       #SIGN INFO PRESENT. #
          CALL STRIPSIGN(TSIGN); #INTERPRET SIGN OVERPUNCH CHARACTER. # 
  
#  VALUES ARE NOW IN FIXED ARRAYS, WITH SIGNS IN TSIGN AND CSIGN. # 
  
        IF #1.12# TACTLP THEN    #ACTUAL DECIMAL POINT SPECIFIED. # 
          BEGIN 
          J = I - TPTLOC;    #POINT LOCATION = CHARS TO RIGHT. #
          IF C<J>NUMTARG NQ "." THEN   #CHARACTER NOT DECIMAL PT. # 
            BEGIN 
            ERRSTAT = O"650";     #CHECK VALUE FAILS. # 
*IF,DEF,DCMPR,1 
            SNATCHC("EXIT7 CMPR",I,0);      #IN IF DEF,DCMPR. # 
            RETURN; 
            END 
  
#  REPLACE DECIMAL POINTS WITH D.C. ZERO, FOR COMPARISON. # 
  
          C<J>NUMTARG = "0";
          C<J>NUMCOMP = "0";
          END     #OF IF 1.12 # 
  
*IF,DEF,DCMPR5,4
*IF,-DEF,DCMPR,1
        XREF PROC SNATCHC;             #IN IF DEF,DCMPR5 #
        SNATCHC("NUM TARG",NUMTARGET[0],18);     #IN IF DEF,DCMPR5 #
        SNATCHC("NUM COMP",NUMCOMPAR[0],18);     #IN IF DEF,DCMPR5 #
#  EXAMINE TARGET ITEM VALUE FOR ALL NUMERIC. # 
        FOR J = 0 THRU I DO  #EXAMINE EACH CHARACTER. # 
          BEGIN 
          CHAR = C<J>NUMTARG; 
          IF CHAR LS O"33" OR CHAR GR O"44" THEN   #NOT NUMERIC. #
            BEGIN 
            ERRSTAT = O"650";     #CHECK VALUE FAILS. # 
*IF,DEF,DCMPR,1 
            SNATCHD("EXIT4 CMPR",ERRSTAT);    #IN IF DEF,DCMPR #
            RETURN; 
            END 
          END  #OF FOR LOOP. #
  
      IF TSIGN NQ CSIGN THEN #VALUES HAVE OPPOSITE SIGN. #
        IF C<0,I>NUMCOMP NQ C<0,I>ZERO THEN #COMPARISON VALUE NOT ZERO.#
#  OUTCOME IS DECIDED BY SIGNS, IF NOT COMPARING +0 WITH -0. #
          BEGIN 
          HILOEQ = TSIGN; 
*IF,DEF,DCMPR,1 
          SNATCHD("EXIT5 CMPR",HILOEQ);     #IN IF DEF,DCMPR #
          RETURN; 
          END 
  
#  COMPARE TARGET AND COMPARISON VALUES. #
      IF NUMTARG GR NUMCOMP THEN   #TARGET VALUE GREATER. # 
        HILOEQ = TSIGN; 
      ELSE
        IF NUMTARG LS NUMCOMP THEN #TARGET VALUE SMALLER. # 
          HILOEQ = - TSIGN; 
        ELSE
          HILOEQ = 0; 
  
*IF,DEF,DCMPR,1 
          SNATCHD("EXIT6 CMPR",HILOEQ);     #IN IF DEF,DCMPR #
      RETURN; 
  
      END #OF IF 1.1# 
  
#  ALPHA OR ALPHANUMERIC DISPLAY CODE VALUE. #
  
# LOOP, COMPARING UP TO 60 BITS AT A TIME, UNTIL TARGET SIZE REACHED. # 
  
        FOR I = 1 WHILE SIZELEFT GR 0 DO
          BEGIN 
          TARGET = BLANKS;   #INITIALIZE THE WORDS TO BE COMPARED. #
          CKLITERAL = BLANKS; 
          IF #2# SIZELEFT LS 60 THEN
            SIZE = SIZELEFT;
          ELSE #2#           #SET SIZE = MIN(60,SIZELEFT). #
            SIZE = 60;
  
# FILL IN LEFTMOST -SIZE- BITS OF TARGET, FROM TARGET ITEM. # 
          XCALL DC$XFER(BWP1,BBP1,LOC(TARGET),0,SIZE);
  
# FILL IN SAME BITS OF CKLITERAL, FROM LITERAL OR LEAVE SET TO BLANKS. #
          IF #3# LENGTH GR 0 THEN 
            XCALL DC$XFER(BWP2,BBP2,LOC(CKLITERAL),0,SIZE); 
*IF DEF,DCMPR3,2
      SNATCH("IN TARG",TARGET,1); 
      SNATCH("IN CK LIT",CKLITERAL,1);
  
# IF VALUES NOT EQUAL, REPLACE CHARACTERS WITH COLLATING SEQ EQUIVS. #
          IF #4# TARGET NQ CKLITERAL THEN 
            BEGIN 
            FOR #5# J = 0 STEP 6 UNTIL 54 DO
              BEGIN 
              WORDINDEX = B<J,3>TARGET; 
              BYTEINDEX = B<J+3,3>TARGET * 6; 
              B<J,6>TARGET = B<BYTEINDEX,6>DCTVAL[WORDINDEX]; 
              WORDINDEX = B<J,3>CKLITERAL;
              BYTEINDEX = B<J+3,3>CKLITERAL * 6;
              B<J,6>CKLITERAL = B<BYTEINDEX,6>DCTVAL[WORDINDEX];
              END #OF FOR 5 # 
*IF DEF,DCMPR4,4
*IF -DEF,DCMPR,1
      XREF PROC SNATCHC;               #IN IF DEF DCMPR4 #
      SNATCHC("TARG COLAT",TARGET,10); #IN IF DEF DCMPR4 #
      SNATCHC("LIT COLAT",CKLITERAL,10);    #IN IF DEF DCMPR4 # 
            IF TARGET LS CKLITERAL THEN 
              BEGIN 
              HILOEQ = -1;
*IF DEF,DCMPR,1 
      SNATCHD("EXIT1 CMPR",HILOEQ);    #IN IF DEF DCMPR # 
              RETURN; 
              END 
  
            IF TARGET GR CKLITERAL THEN 
              BEGIN 
              HILOEQ = 1; 
*IF DEF,DCMPR,1 
      SNATCHD("EXIT2 CMPR",HILOEQ);    #IN IF DEF DCMPR # 
              RETURN; 
              END 
  
            END #OF IF 4# 
  
# FALL THRU. TARGET = CKLENGTH SO FAR. #
          SIZELEFT = SIZELEFT - SIZE; 
          BWP1 = BWP1 + 1;    #INCREMENT TARGET VALUE BWP. #
          BWP2 = BWP2 + 1;    #INCREMENT TARGET VALUE BWP. #
          LENGTH = LENGTH - 1;
          END #OF FOR LOOP, WHILE SIZELEFT GT 0#
  
# FALL THRU LOOP. VALUES EQUAL.  #
        HILOEQ = 0; 
*IF DEF,DCMPR,1 
      SNATCHD("EXIT3 CMPR",HILOEQ);    #IN IF DEF DCMPR # 
        RETURN; 
        END #OF IF 1# 
  
  
      ELSE #1#               #BINARY DATA VALUE, 1 OR 2 WORDS (ALIGNED)#
        BEGIN 
        P<TARG> = TGIFWA;    #SET UP FULL-WORD TARGET ITEM VALUE. # 
        P<CKLIT> = COMPBWP;  #SET UP FULL-WORD CHECK LITERAL VALUE. # 
  
        $BEGIN
        IF TCLASS EQ BITSTRING
        OR TCLASS GQ LOGICAL THEN 
          BEGIN 
          ERRSTAT = O"677";  #UNSUPPORTED DATA CLASS #
          XCALL DC$ERR; 
          RETURN; 
          END 
        $END
  
# PROCESS DATA TYPES INTEGER,FLOATNORM,DOUBLE,COMPLEX # 
# FIXED, FLOATUNNORM.   # 
# NOTE THAT UNNORMALIZED FLOATING POINT VALUES ARE ASSUMED TO HAVE
  EXPONENT 2000 (OR 5777).  # 
  
        FOR I = 0 THRU 1 DO  #PROCESS 1 OR 2 WORDS #
          BEGIN 
          IF #11# TARGWORD[0] LS CKLITWORD[0] THEN
            BEGIN 
            HILOEQ = -1;
*IF DEF,DCMPR,1 
      SNATCHD("EXIT7 CMPR",HILOEQ);    #IN IF DEF DCMPR # 
            RETURN; 
            END #OF IF 11#
  
          IF #12# TARGWORD[0] GR CKLITWORD[0] THEN
            BEGIN 
            HILOEQ = 1; 
*IF DEF,DCMPR,1 
      SNATCHD("EXIT8 CMPR",HILOEQ);    #IN IF DEF DCMPR # 
            RETURN; 
            END #OF IF 12#
  
          IF TCLASS EQ INTEGER
          OR TCLASS EQ FLOATNORM
          OR TCLASS EQ FIXED
          OR TCLASS EQ FLOATUNNORM
          OR I EQ 1 THEN
            BEGIN 
            HILOEQ = 0; 
*IF DEF,DCMPR,1 
      SNATCHD("EXIT9 CMPR",HILOEQ);    #IN IF DEF DCMPR # 
            RETURN; 
            END 
  
          ELSE               #TCLASS EQ DOUBLE OR COMPLEX # 
            BEGIN 
            P<TARG> = TGIFWA + 1;      #LOOK AT SECOND WORD OF EACH VAL#
            P<CKLIT> = COMPBWP + 1; 
            END 
          END #OF FOR I = 0 THRU 1 LOOP#
        END #OF ELSE 1# 
      CONTROL EJECT;
      PROC STRIPSIGN (SIGNVAL); 
      BEGIN 
 #
  *    DC$CMPR                                   PAGE 1 
  *   STRIPSIGN  SUBROUTINE                      DATE  10/21/74 
  *   J.W.PERRY 
  DC  PURPOSE 
      EVALUATE SIGN OVERPUNCH ON FINAL CHARACTER OF NUMERIC DISPLAY CODE
      FIELD, REPLACING FINAL CHARACTER BY NUMERIC.
  DC  ENTRY CONDITIONS
      NUMTARG CONTAINS DISPLAY CODE VALUE (UP TO 19 CHARS). 
      I CONTAINS FINAL CHARACTER POSITION.
      J CONTAINS FINAL CHARACTER POSITION IN BITS.
  DC  EXIT CONDITION
      NUMTARG -- FINAL CHARACTER OF VALUE IS NUMERIC DISPLAY CODE.
      SIGNVAL (FORMAL PARAM) = 1 IF ITEM VALUE WAS POSITIVE.
                             = -1 IF VALUE WAS NEGATIVE.
      I AND J UNALTERED.
  DC  NON-LOCAL VARIABLES 
      NONE
  DC  DESCRIPTION 
      IF FINAL CHARACTER IS -<- OR -A- THRU -I- THEN
        REPLACE WITH -0- THRU -9- 
        RETURN WITH SIGNVAL = +1. 
  
      IF FINAL CHARACTER IS -!- OR -J- THRU -R- 
        REPLACE WITH -0- THRU -9- 
        RETURN WITH SIGNVAL = -1. 
  
       RETURN WITH SIGNVAL = +1.
  
 #
      ITEM SIGNVAL; 
  
      SIGNVAL = 1;           #INITIALIZE, DEFAULT VALUE PLUS. # 
  
      CHAR = C<I>NUMTARG;    #FINAL CHARACTER OF ITEM. #
#  INTERPRET SIGN OVERPUNCH, IF ANY, AND REPLACE WITH NUMERIC CHAR. # 
          IF CHAR GQ "A" AND CHAR LQ "I" THEN 
            B<J,6>NUMTARG = B<J,6>NUMTARG + O"33";
          ELSE
            IF CHAR EQ "<" THEN 
              C<I>NUMTARG = "0";
            ELSE
              IF CHAR GQ "J" AND CHAR LQ "R" THEN 
                BEGIN 
                SIGNVAL = -1; 
                B<J,6>NUMTARG = B<J,6>NUMTARG + O"22";
                END 
              ELSE
                IF CHAR EQ "!" THEN 
                  BEGIN 
                  SIGNVAL = -1; 
                  C<I>NUMTARG = "0";
                  END 
  
      RETURN; 
  
      END      #OF PROC STRIPSIGN#
  
      END #OF PROC DC$CMPR# 
      TERM; 
