*DECK S$GNIF
          IDENT S$GNIF
          TITLE  S$GNIF - GENERATE INVERT FLOATING SIGN 
          COMMENT GENERATE INVERT FLOATING SIGN 
*CALL LBLPTR
          SPACE  4
**        S$GNIF - GENERATE INVERT FLOATING SIGN
* 
*    CALLING SEQUENCE-
*         S$GNIF(OFFSET,LENGTH,ASC,KEYORSUM); 
* 
*    GIVEN- 
*         OFFSET = NUMBER OF BIT STARTING THE KEY OR SUM FIELD
*                  IN THE EXTERNAL RECORD. THE FIRST BIT IS 0 
*         LENGTH = NUMBER OF BITS IN THE KEY/SUM FIELD OF THE 
*                  EXTERNAL RECORD ( AT LEAST 12 BITS ) 
*         ASC    = NONZERO IF KEY IS ASCENDING
*                = ZERO IF KEY IS DESCENDING
*         KEYORSUM=1 FOR SUM FIELD, 0 FOR KEY 
* 
*    DOES-
*         GENERATES CODE
* 
*    GENERATED CODE DOES- 
*         1. INVERTS
*            THE FIELD INTO THE INTERNAL RECORD, TAKING CLUMPS OF 
*            TEN CHARACTERS AT A TIME. ALL LEADING SPACES ( AND 
*            ANY MINUS SIGN ) ARE TREATED AS LOGICAL ZEROES.
*         2. IF THIS IS A KEY FIELD, IT INVERTS THE LEFT-MOST 
*            BIT TO PREPARE FOR A LOGICAL COMPARE.
*         3. IF THIS IS A DESCENDING KEY FIELD, IT COMPLEMENTS
*            THE BINARY NUMBER. 
*         4. S$GNAPN INCREASES S$LK FOR EACH GROUP APPENDED TO
*            THE INTERNAL RECORD
* 
*    METHOD-
*         EACH GROUP OF TEN CHARACTERS (OR LESS) IS TREATED 
*         AS IF IT WERE POSITIVE UNTIL WE KNOW BETTER. IF AN
*         ENTIRE TEN-CHARACTER GROUP CONSISTS OF NOTHING BUT
*         SPACES - AND IS A KEY FIELD - IT WILL BE INVERTED 
*         AS 4000..00, EVEN THOUGH A MINUS SIGN MAY APPEAR
*         AS THE SIGN OF THE NUMBER IN THE NEXT GROUP OR SOME 
*         SUBSEQUENT GROUP. 
  
  
          ENTRY  S$GNIF 
S$GNIF    SUBR
  
          SB1    1           REMEMBER MLF 
  
          SA2    X1          VALUE OF OFFSET
          SB2    X2          B2 = OFFSET
          SA2    A1+1        ADDRESS OF LENGTH
          SA2    X2          VALUE OF LENGTH
          SB3    X2          B3 = LENGTH
          SA2    A1+2        ADDRESS OF ASC 
          SA2    X2          VALUE OF ASC 
          SB4    X2          B4 = ASC 
          SA4    A1+3        ADDRESS OF KEYORSUM
          SA4    X4          X4 = VALUE OF KEYORSUM 
  
*     SAVE B2, B3 AND B4 SO WE CAN USE THEM OURSELVES 
  
          SX6    B2 
          SA6    SAVEB2 
          SX6    B3 
          SA6    SAVEB3 
          SX6    B4 
          SA6    SAVEB4 
          MX6    0
          SA6    SUMFLAG        NOTE FIRST TIME THROUGH SUM CODE
  
  
*   SET UP DEFAULT (POSITIVE) SIGN IN *X0 
  
          GEN    (MX0 0)
  
*     SET B4 = LENGTH OF 10-OR-LESS-DIGIT GROUP 
  
  
 GNIF1    SB4    60          10 DIGITS
          IFTHEN B3<B4       IF KEY LENGTH LESS THAN 10 DIGITS, 
            SB4    B3          SET B4 TO KEY LENGTH 
            ENDIF.
  
*     GET THE (FIRST) WORD OF THE GROUP 
  
                             B2 = OFFSET OF FIELD WITHIN RECORD 
          CALL   S$GNIWD               *A5 = ADDRESS OF (FIRST) WORD
                                       *X5 = (FIRST) WORD 
                             X5 = OFFSET OF FIELD WITHIN *X5
  
*     IF A SECOND WORD IS NEEDED, GET IT
  
          SB6    60 
          SB7    X5 
          SB7    B6-B7       NUMBER OF POSSIBLE BITS IN *X5 
          IFTHEN B7<B4       IF NEED SECOND WORD, 
            GEN    (BX2 X5) 
         *USES   B6,B7,X0,AX1-3,AX6 
            GEN    (SA5 A5+B1)         *GET NEXT WORD 
            GEN    (MX1 0),X5          *MX1 <OFFSET>
            GEN    (BX5 X1*X5)
            GEN    (BX2 -X1*X2) 
            GEN    (BX5 X5+X2)
            ENDIF.
  
*     LEFT-JUSTIFY THE FIELD
  
          IFTHEN X5"0 
            GEN    (LX5 0),X5 
            ENDIF.
  
*   SET UP A SUBROUTINE CALLED CHKCHAR
  
          NEWLBL NEXT 
          GEN    (EQ "NEXT")
          NEWLBL CHKCHAR
          GENLBL CHKCHAR
          GENMAC (DATA 0) 
          NEWLBL SPACE
          NEWLBL MINUS
          GEN    (SB4 X2) 
          GEN    (EQ B4,B7,"SPACE") 
          GEN    (EQ B4,B6,"MINUS") 
          GEN    (EQ "CHKCHAR") 
          GENLBL SPACE
          GEN    (SX2 1R0)
          GEN    (EQ "CHKCHAR") 
          GENLBL MINUS
          GEN    (MX0 60)              *SET *X0 NEGATIVE
          GEN    (SX2 1R0)             LOGICAL ZERO FOR - 
          GEN    (EQ "CHKCHAR") 
  
          GENLBL NEXT 
  
  
  
*     CONVERT FIELD IN *X5 TO BINARY IN *X4 
*     POSSIBLE CHARACTERS ARE DIGIT, SPACE AND - SIGN 
  
          GEN    (SB7 55B)             *B7 = SPACE
          GEN    (SB6 46B)              *B6 = MINUS SIGN
  
  
          SX7    B4          PRESERVE B4 IN X7 SINCE
                             LOOP WILL DESTROY IT 
  
          GEN    (MX7 -6)         *ONE-BYTE MASK
          GEN    (MX4 0)
 GNIF2    GEN    (LX5 6)               *RIGHT-JUSTIFY NEXT DIGIT
          GEN    (BX2 -X7*X5)          *EXTRACT DIGIT 
          GEN    (RJ "CHKCHAR") 
          NEWLBL NEXT 
          GENLBL NEXT        THESE INSTRUCTIONS FORCE UPPER 
          GEN    (SX2 X2-1R0)          *CONVERT DIGIT TO BINARY 
          GEN    (LX1 B1,X4)    *X4 TIMES 2 
          GEN    (LX4 3)        *X4 TIMES 8 
          GEN    (IX4 X4+X1)    *X4 TIMES 10
          GEN    (IX4 X4+X2)
          SB4    B4-6 
          NE     B4,B0,GNIF2
  
          IFTHEN X4"0           IF THIS IS A SUM FIELD
            SA1    SUMFLAG
            NZ     X1,GNIF3     EXIT IF NOT FIRST TIME
            SX6    1
            SA6    A1            RESET FLAG TO PREVENT INFINITE LOOP
            SA1    SAVEB3        GET BACK ORIGINAL LENGTH 
            SX2    60            LENGTH OF ONE WORD 
            IX2    X1-X2         SEE IF > ONE WORD
            SB4    X2 
            IFTHEN B4>B0         IF SUM FIELD > 10 DIGITS 
              SA1    SAVEB2      GET BACK ORIGINAL OFFSET 
              SB2    X1 
              SB2    B2+60       OFFSET PLUS ORIGINAL 10 DIGITS 
              CALL   S$GNIWD
  
* IF A SECOND WORD IS NEEDED, GET IT
  
              SB6    60 
              SB7    X5 
              SB7    B6-B7       NUMBER OF GOOD BITS IN *X5 
              IFTHEN B7<B4       IF MORE NEEDED 
                GEN    (BX2 X5) 
                GEN    (SA5 A5+B1)
                GEN    (MX1 0),X5 
                GEN    (BX5 X1*X5)
                GEN    (BX2 -X1*X2) 
                GEN    (BX5 X5+X2)
                ENDIF.
  
              IFTHEN X5"0 
                GEN    (LX5 0),X5        LEFT-JUSTIFY FIELD IN *X5
                ENDIF.
  
              SB7    A0 
              SA1    SAVEB3              ORIGINAL LENGTH IN BITS
              BX7    X1                  ORIGINAL LENGTH IN BITS
              EQ     GNIF2
              ENDIF.
            ENDIF.
  
 GNIF3    BSS    0
* DETERMINE NUMBER OF BITS FOR INTERNAL FIELD 
* REMEMBER THAT X7 HAS OLD VALUE OF B4
  
          BX1    X7          PUT OLD B4 INTO X1 
          SX2    1S19/6+1    1/6 * 2**19
          IX1    X1*X2       N/6 * 2**19
          AX1    19          N/6
          SA1    S$TBL1+X1   NUMBER OF BITS FOR UNSIGNED FIELD
  
          SX1    X1+1        INCLUDE SIGN IN LENGTH 
  
          SX6    X1 
          SA6    LENGTH 
  
*     APPLY SIGN IN *X0 TO BINARY NUMBER IN *X4 
  
          GEN    (BX4 X4-X0)         *COMPLEMENT *X4 IF NEGATIVE
  
  
*     IF THIS IS A KEY FIELD, INVERT THE SIGN BIT 
  
          IFTHEN X4=0        IF THIS IS A KEY FIELD,
            GEN    (MX1 1)
            SA1    LENGTH 
            GEN    (LX1 0),X1          *POSITION BIT OVER SIGN POSITION 
            GEN    (BX4 X4-X1)         *INVERT SIGN BIT 
  
*    IF DESCENDING, COMPLEMENT THE BINARY NUMBER IN *X4 
  
          SA1    SAVEB4      GET ORIGINAL VALUE OF ASC/DESC 
          IFTHEN X1=0        IF DESCENDING
            GEN    (BX4 -X4)
            ENDIF.
  
            ENDIF.
  
*     APPEND THIS GROUP TO THE INTERNAL RECORD
  
          SA1    LENGTH      LENGTH OF INTERNAL FIELD 
          SB7    X1 
          SB6    60 
          SB5    B6-B7       OFFSET OF FIELD WITHIN *X4 
          GNAPN  B5,B7                 *APPEND B7 BITS FROM *X4 WITH
                                         B5 UNUSED BITS ON LEFT 
  
*     DECREMENT THE TOTAL LENGTH OF THE FIELD BY THIS GROUP,
*     INCREMENT THE OFFSET, AND LOOP IF MORE TO DO
  
          IFTHEN X4=0            IF THIS IS A KEY FIELD 
            SB3    B3-60
            SB2    B2+60         INCREMENT THE OFFSET 
            GT     B3,B0,GNIF1   IF MORE TO DO, LOOP
            ENDIF.
  
*     RESTORE REGISTERS AND EXIT
  
          SA1    SAVEB2 
          SB2    X1 
          SA1    SAVEB3 
          SB3    X1 
          SA1    SAVEB4 
          SB4    X1 
  
          EXIT
  
  
 LENGTH   BSS    1           LENGTH OF INTERNAL FIELD 
  
 SAVEB2   BSS    1           ORIGINAL VALUE OF B2 
  
 SAVEB3   BSS    1           ORIGINAL VALUE OF B3 
  
 SAVEB4   BSS    1           ORIGINAL VALUE OF B4 
  
 S$TBL1   EXTERNAL           TABLE OF BINARY LENGTHS OF NUMERICS
  
 SUMFLAG  BSS    1           ENSURE SPECIAL SUM CODE EXECUTES ONCE ONLY 
  
  
          END 
