*DECK S$GNIN
          IDENT  S$GNIN 
          TITLE  S$GNIN -  GENERATE- INVERT NUMERIC CHARACTERS
          COMMENT   GENERATE- INVERT NUMERIC CHARACTERS 
*CALL LBLPTR
          SPACE  4
**        S$GNIN -  GENERATE- INVERT NUMERIC CHARACTERS 
* 
*     CALLING SEQUENCE- 
*         CALL S$GNIN 
* 
*     GIVEN-
*         B2 = BIT OFFSET OF FIELD IN EXTERNAL RECORD.
*         B3 = BIT LENGTH OF FIELD IN EXTERNAL RECORD.
*         B4 = 1 IF ASCENDING, 0 IF DESCENDING
*         X4 = 0 IF KEY FIELD, 1 IF SUM FIELD.
*         A0 = -1 IF THERE IS NO SIGN 
*               0 IF THE SIGN IS *X0 AND ALL CHARACTERS ARE DIGITS. 
*               1 IF THE SIGN IS *X0 AND LEADING CHAR. IS OVERPUNCH.
*               2 IF THE SIGN IS *X0 AND TRAILING CHAR. IS OVERPUNCH. 
*         *X0 = 00000000000000000000B FOR A POSITIVE VALUE. 
*               77777777777777777777B FOR A NEGATIVE VALUE. 
*         S$LK = NUMBER OF BITS OF INFORMATION THAT HAVE BEEN 
*           PREVIOUSLY APPENDED.  (USED BY S$GNAPN) 
*         S$OREC = WORD OFFSET WITHIN WSA$ OF EXTERNAL RECORD.
*           (USED BY S$GNIWD) 
*         S$ORSA = WORD OFFSET WITHIN WSA$ OF RECORD STORAGE AREA.
*           (USED BY S$GNAPN) 
* 
*     DOES- 
*         GENERATES CODE. 
* 
*     GENERATED CODE DOES-
*         (IF A0 = 1 OR 2, )
*             TREATS THE LEADING OR TRAILING CHARACTER AS AN
*              OVERPUNCH AND EXTRACTS THE APPROPRIATE DIGIT FROM IT.
*         FOR EACH GROUP OF 10 OR LESS CHARACTERS IN THE FIELD, 
*             INTERPRETS THEM AS A DECIMAL NUMBER AND CONVERTS THEM 
*              TO BINARY. 
*             (IF X4 = KEY, ) 
*                 INVERTS THE LEFT-MOST BIT.
*                  (THIS PREPARES FOR A LOGICAL COMPARE.) 
*             (IF B4 = DESCENDING, )
*                 COMPLEMENTS THE BINARY NUMBER.
*             APPENDS THE BINARY NUMBER TO THE INTERNAL RECORD, 
*              INCREMENTING S$LK BY THE NUMBER OF INTERNAL BITS.
* 
*     GENERATED CODE USES-
*         B    * * - - - - -     *B1=1, B2=WSA$ 
*         X  0 - 2 3 4 5 6 -
*         A  - - 2 3 - 5 6 -
* 
*     S$GNIN USES-
*         B    * * * * 5 6 7     *B1=1, B2=OFFSET, B3=LENGTH, B4=ASC
*         X  0 1 2 3 * 5 6 -     *X4=KEYORSUM 
*         A  * 1 2 3 - - 6 -     *A0=SIGNPOS
  
  
  
          ENTRY  S$GNIN 
 S$GNIN   SUBR
  
*     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 B4 = LENGTH OF 10-OR-LESS-DIGIT GROUP 
  
 GNIN1    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.
  
*     HANDLE AN OVERPUNCH IF NECESSARY  (IGNORE IF NOT 1ST GROUP) 
  
          SB7    A0          SIGNPOS
          IFTHEN B7=B1       IF SIGNPOS = LEADING OVERPUNCH,
            SA1    SAVEB2      ORIGINAL OFFSET
            SB7    X1 
            IFTHEN B7=B2       IF THIS IS THE LEFT-MOST GROUP,
              GEN    (MX7 -6) 
              GEN    (LX5 6)           *RIGHT-JUSTIFY FIELD 
              GEN    (BX2 -X7*X5) 
              GEN    (SA2 S$STRIP+X2)  *GET DIGIT 
              GEN    (SX2 X2)          *STRIP SIGN BIT
              GEN    (BX5 X5-X2)       *CONVERT OVERPUNCH TO DIGIT
              GEN    (LX5 -6)          *REPOSITION *X5
              ENDIF.
          ELSE-              IF SIGNPOS NOT LEADING OVERPUNCH,
            IFTHEN B7>B1       IF SIGNPOS = TRAILING OVERPUNCH
              SA1    SAVEB2      ORIGINAL OFFSET
              SA2    SAVEB3      ORIGINAL LENGTH
              IX1    X1+X2       OFFSET OF NEXT FIELD 
              SB7    X1 
              SB7    B7-B4       OFFSET OF RIGHT-MOST GROUP 
              IFTHEN B7=B2       IF THIS IS THE RIGHT-MOST GROUP, 
                GEN    (MX7 -6) 
                GEN    (LX5 0),B4      *RIGHT-JUSTIFY OVERPUNCH 
                GEN    (BX2 -X7*X5) 
                GEN    (SA2 S$STRIP+X2) *GET DIGIT
                GEN    (SX2 X2)        *STRIP SIGN BIT
                GEN    (BX5 X5-X2)     *CONVERT OVERPUNCH TO DIGIT
                SB6    60 
                SB7    B6-B4
                GEN    (LX5 0),B7      *REPOSITION *X5
                ENDIF.
              ENDIF.
            ENDIF.
  
*     CONVERT FIELD IN *X5 TO BINARY IN *X4 
  
          SX7    B4          PRESERVE B4 IN X7 SINCE
                             LOOP WILL DESTROY IT 
  
          GEN    (MX7 -6)         *ONE-BYTE MASK
          GEN    (MX4 0)
 GNIN2    GEN    (LX5 6)               *RIGHT-JUSTIFY NEXT DIGIT
          GEN    (BX2 -X7*X5)          *EXTRACT DIGIT 
          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,GNIN2
  
          IFTHEN X4"0          IF THIS IS A SUM FIELD 
            SA1    SUMFLAG
            NZ     X1,GNIN3    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
              IFTHEN B7>B1         IF SIGNPOS = TRAILING OVERPUNCH
                GEN    (MX7 -6) 
                GEN    (LX5 0),B4 
                GEN    (BX2 -X7*X5) 
                GEN    (SA2 S$STRIP+X2) 
                GEN    (SX2 X2) 
                GEN    (BX5 X5-X2)
                SB6     60
                SB7     B6-B4 
                GEN     (LX5 0),B7    REPOSITION *X5
                ENDIF.
              SA1    SAVEB3      ORIGINAL LENGTH IN BITS
              BX7    X1          ORIGINAL LENGTH IN BITS
              EQ     GNIN2
              ENDIF.
            ENDIF.
  
 GNIN3    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
  
          SB7    A0          SIGNPOS
          IFTHEN B7\0        IF SIGNED, 
            SX1    X1+1        INCLUDE SIGN IN LENGTH 
            ENDIF.
  
          SX6    X1 
          SA6    LENGTH 
  
*     APPLY SIGN IN *X0 TO BINARY NUMBER IN *X4 
  
          IFTHEN B7\0        IF SIGNED, 
            GEN    (BX4 X4-X0)         *COMPLEMENT *X4 IF NEGATIVE
            ENDIF.
  
  
*     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,GNIN1   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 
  
 SUMFLAG  BSS    1           ENSURE SPECIAL SUM CODE EXECUTES ONCE ONLY 
  
 S$STRIP  EXTERNAL           TABLE TO STRIP OVERPUNCH SIGNS 
  
 S$TBL1   EXTERNAL           TABLE OF BINARY LENGTHS OF NUMERICS
  
  
          END 
