*DECK S$GNRN
          IDENT  S$GNRN 
          TITLE  S$GNRN -  GENERATE- REVERT NUMERIC CHARACTERS
          COMMENT   GENERATE- REVERT NUMERIC CHARACTERS 
*CALL LBLPTR
          SPACE  4
**        S$GNRN -  GENERATE- REVERT NUMERIC CHARACTERS 
* 
*   CALLING SEQUENCE- 
*         CALL   S$GNRN 
* 
*   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 = 0 FOR NO OVERPUNCH,
*              1 FOR LEADING OVERPUNCH
*              2 FOR TRAILING OVERPUNCH 
* 
*   DOES- 
*         GENERATES CODE
* 
*   GENERATED CODE DOES-
*         FOR EACH GROUP OF 10 OR FEWER CHARACTERS TO BE FILLED 
*         IN THE EXTERNAL RECORD -
*          1. ASKS S$GNRNX FOR THE APPROPRIATE NUMBER OF BITS 
*          2. IF X4 = KEY 
*                INVERTS (I.E. RESTORES) THE LEFTMOST BIT 
*          3. IF B4 = DESCENDING
*                COMPLEMENTS THE BINARY NUMBER
*          4. IF THIS IS THE FIRST GROUP
*                PRESERVES THE SIGN IN *X0
*                  (00000000000000000000B IF POSITIVE)
*                  (77777777777777777777B IF NEGATIVE)
*          5. CONVERTS THE BINARY NUMBER TO ITS ABSOLUTE VALUE
*          6. CONVERTS THE BINARY NUMBER TO DECIMAL DISPLAY AND 
*             STORES THE RESULT IN THE EXTERNAL RECORD
  
          ENTRY  S$GNRN 
S$GNRN    SUBR
  
* SAVE ORIGINAL VALUES OF B2,B3,B4 AND X4 
  
          SB1    1           REMEMBER MLF 
          SX6    B2 
          SA6    SAVEB2 
          SX6    B3 
          SA6    SAVEB3 
          SX6    B4 
          SA6    SAVEB4 
          SX6    X4 
          SA6    SAVEX4 
  
* SET UP A WORD OF CHARACTER ZEROS FOR GENERATED CODE TO USE
* ALSO SET ASIDE A WORD TO HOLD RECORD DESCRIPTOR 
  
          NEWLBL NEXT 
          GEN    (EQ "NEXT")
          NEWLBL ZEROS
          GENLBL ZEROS
          GENMAC (DATA 10H0000000000) 
          NEWLBL HOLDX6 
          GENLBL HOLDX6 
          GENMAC (DATA 0) 
          GENLBL NEXT 
  
* SET B4 = LENGTH OF A GROUP OF 10 OR FEWER DIGITS
  
GNRNTOP   SB4    60 
          IFTHEN B3<B4
            SB4  B3 
            ENDIF.
  
          SA4    SAVEX4      GET VALUE FOR KEYORSUM 
          IFTHEN X4"0        IF A SUM FIELD 
            SB7    B4          HOLD TEMPORARY B4 IN B7
            SB4    B3          RETAIN LARGE LENGTH IF NECESSARY 
            ENDIF.
  
* NOW FIGURE OUT HOW MANY BITS THAT IS INTERNALLY 
  
          SX1    B4 
          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        NUMBER OF BITS FOR SIGNED FIELD
          IFTHEN X4"0        IF A SUM FIELD 
            SB4    B7          UNDO SWITCH OF PREVIOUS LINES
            ENDIF.
  
* ASK S$GNRNX FOR THAT MANY BITS
* S$GNRNX DESTROYS B4 AND *X0, UNFORTUNATELY
  
          SX7    B4 
          SA7    SAVEB42     SAVE INTERMEDIATE B4 
  
  
          SB5    X1 
          GEN    (BX7 X0) 
                             S$IRRL, S$LR,S$LK,S$ORSA 
          CALL   S$GNRNX               *X4 CONTAINS INTERNAL FIELD
         *USES   B4,B6,B7,X0,AX1-3,AX6
                             X5 = OFFSET WITHIN *X4 OF INTERNAL FIELD 
                             S$LK INCREMENTED BY B5 
  
          GEN    (BX0 X7) 
  
* LEFT-JUSTIFY THE FIELD
  
          IFTHEN X5"0 
            GEN    (LX4 0),X5 
         *USES   B6,B7,X0,AX1-3,AX6 
            ENDIF.
* INVERT (I.E. RESTORE) LEFTMOST BIT IF NECESSARY 
  
          SA1    SAVEX4      GET VALUE FOR KEYORSUM 
          IFTHEN X1=B0       IF THIS IS A KEY FIELD 
            GEN    (MX1 1)   ONE-BIT MASK 
            GEN    (BX4 X4-X1) INVERT SIGN BIT
            ENDIF.
  
* COMPLEMENT BINARY NUMBER IN *X4 IF NECESSARY
  
          SA1    SAVEB4      GET VALUE FOR ASC/DESC 
          IFTHEN X1=B0       IF DESCENDING
            GEN    (BX4 -X4) INVERT NUMBER
            ENDIF.
  
* BY NOW WE HAVE THE TRUE SIGN IN LEFTMOST BIT, SO SAVE 
* IT IF THIS IS THE FIRST GROUP 
* ALSO SAVE RECORD DESCRIPTOR IN SAME CASE
  
          SA1    SAVEB2      GET ORIGINAL OFFSET
          SB7    X1          B7 IS ORIGINAL OFFSET
          IFTHEN B7=B2       IF THIS IS THE LEFTMOST GROUP
            GEN    (BX0 X4) 
            GEN    (AX0 60)  PROPAGATE SIGN BIT ACROSS WORD 
            GEN    (SA6 "HOLDX6") 
            ENDIF.
  
* NOW CONVERT THE BINARY NUMBER TO ITS ABSOLUTE VALUE 
  
          NEWLBL NEXT 
          GEN    (PL,X4,"NEXT") 
          GEN    (BX4 -X4)
          GENLBL NEXT 
  
* SHIFT THE ENORMOUS NUMBER OVER TO PROPER POSITION 
*  ON THE RIGHT 
  
          SB6    60 
          IFTHEN B5<B6
            SB6    B6-B5      60 MINUS BIT LENGTH 
            GEN    (AX4 0),B6 
            ENDIF.
  
          SA1    SAVEX4 
          IFTHEN X1"0 
            SA1    SAVEB3 
            SB3    X1 
            SB7    60 
            IFTHEN B3>B7     IF SUM FIELD > 60 BITS 
              EQ     GNRN2     GO DO SPECIAL CODE 
              ENDIF.
            ENDIF.
  
  
  
* GET READY FOR CONVERSION
  
          SA1    SAVEB42     GET INTERMEDIATE B4 BACK 
          SB4    X1 
          GEN    (MX6 0)     CLEAR RESULT REGISTER - *X6
          GEN    (SX7 10)    INTEGER 10 
          GEN    (PX5 X7,B0)
          GEN    (NX5)       FLOATING POINT 10 (NORMALIZED) 
  
* EXTRACT THE LEAST SIGNIFICANT DIGITS ONE BY ONE 
  
GNRN1     GEN    (PX1 X4,B0)  PACK AND NORMALIZE *X4
          GEN    (NX1)             INTO *X1 
          GEN    (FX2 X1/X5)  F.P. - X1/10
          GEN    (UX2 X2,B7)
          GEN    (LX2 B7)     INTEGER - X1/10 
          GEN    (IX3 X2*X7)  INTEGER - X1/10*10
          GEN    (IX3 X4-X3)  LEAST SIGNIFICANT DIGIT 
          GEN    (BX6 X6+X3)  STUFF IT INTO *X6 
          GEN    (LX6 -6)     SHIFT AROUND FOR NEXT TIME
          SB4    B4-6         6 MORE BITS REVERTED
          GEN    (BX4 X2) 
          NZ     B4,GNRN1    LOOP IF MORE TO DO 
  
* WHEN WE GET HERE, THE NUMBER IS LYING IN *X6
* IN THE FOLLOWING FORMAT -:  
*      01020304050607101112 
* SO NOW ADD 10 CHARACTER ZEROS TO IT 
  
          GEN    (SA1 "ZEROS")
          GEN    (IX7 X1+X6)
  
* CHECK TO SEE IF WE HAVE A LEADING OVERPUNCH 
  
          SB7    A0 
          IFTHEN B7=B1       IF LEADING OVERPUNCH 
            SA1    SAVEB2 
            SB7    X1        X1=ORIGINAL OFFSET 
            IFTHEN  B7=B2    IF THIS IS FIRST GROUP 
              NEWLBL NEXT 
              GEN  (PL X0,"NEXT")       *SKIP OVERPUNCH IF POSITIVE 
              GEN  (MX6 6)              *ONE-BYTE MASK
              GEN  (BX6 X6*X7)          *LEADING DIGIT IN *X6 
              GEN  (SX5 33B)            *DISPLAY ZERO 
              GEN  (LX5 54)             *MOVE TO LEFT EDGE
              NEWLBL ZERO 
              GEN  (IX5 X5-X6)
              GEN  (ZR X5,"ZERO")       *ZERO IS A SPECIAL CASE 
              GEN  (SX5 22B)            *AMOUNT TO SUBTRACT 
              GEN  (LX5 54) 
              GEN  (IX7 X7-X5)          *PUNCH IT 
              GEN  (EQ "NEXT")
              GENLBL ZERO 
              GEN  (SX5 33B)            *AMOUNT TO ADD
              GEN  (LX5 54) 
              GEN  (IX7 X7+X5)            *PUNCH IT 
              GENLBL NEXT 
              ENDIF.
            ENDIF.
  
  
* CHECK TO SEE IF WE HAVE A TRAILING OVERPUNCH
  
          SB7    B3 
          SB7    B7-60
          IFTHEN B7@B0           IF THIS IS LAST GROUP
            SB7 2 
            SB6    A0 
            IFTHEN B6=B7       IF TRAILING OVERPUNCH
              NEWLBL  NEXT
              GEN  (PL X0,"NEXT")          *SKIP OVERPUNCH IF POSITIVE
              GEN  (BX6 X7)                *COPY RESULT REGISTER
              GEN  (LX6 0),B3              *RIGHT-JUSTIFY FINAL CHAR
              GEN  (MX5 -6) 
              GEN  (BX4 -X5*X6)            *ISOLATE FINAL CHARACTER 
              GEN  (SX3 33B)               *DISPLAY ZERO
              GEN  (IX3 X3-X4)
              NEWLBL ZERO 
              GEN  (ZR X3,"ZERO")         *ZERO IS A SPECIAL CASE 
              GEN  (SX5 22B)               *AMOUNT TO SUBTRACT
              SB7  60 
              SB7  B7-B3
              GEN  (LX5 0),B7              *MOVE UNDER FINAL DIGIT
              GEN  (IX7 X7-X5)             *PUNCH IT
              GEN  (EQ "NEXT")
              GENLBL ZERO 
              GEN  (SX5 33B)               *AMOUNT TO ADD 
              SB7  60 
              SB7  B7-B3
              GEN  (LX5 0),B7 
              GEN  (IX7 X7+X5)
              GENLBL NEXT 
              ENDIF.
            ENDIF.
  
* ALL CONVERTED NOW, SO STORE IT IN EXTERNAL RECORD 
* UNFORTUNATELY, S$GNRST DESTROYS *X0 
  
          GEN    (BX4 X0) 
  
  
          SX5    0           OFFSET IN *X7 IS ALWAYS ZERO 
          SB5    60 
          IFTHEN B3<B5
            SB5    B3        IF LENGTH < 60 
            ENDIF.
                             B2 HAS OFFSET IN EXTERNAL RECORD 
  
          CALL   S$GNRST
  
          GEN    (BX0 X4) 
  
  
* DECREMENT THE TOTAL LENGTH OF THE FIELD BY THIS GROUP,
* INCREMENT THE OFFSET, AND LOOP IF MORE TO DO
  
          GEN    (SA1 "HOLDX6") 
          GEN    (BX6 X1) 
          SB3    B3-60       DECREMENT LENGTH 
          SB2    B2+60       INCREMENT OFFSET 
          GT     B3,B0,GNRNTOP
  
  
* RESTORE REGISTERS AND EXIT
  
  
  
          SA1    SAVEB2 
          SB2    X1 
          SA1    SAVEB3 
          SB3    X1 
          SA1    SAVEB4 
          SB4    X1 
          SA4    SAVEX4 
  
  
          EXIT
 GNRN2    BSS    0                  HANDLE LONG DISPLAY SUM FIELDS
          GENMAC (VFD 12/0100B,18/=XSVR=,12/0,18/=XS$LREGS) 
  
*  THE ABOVE IS A GENERATED RJ TO SVR= WITH S$LREGS AS SAVE AREA
  
          GEN    (SX1 =XS$LREGS)
          GEN    (CALL XJR=)        RESTORE REGISTERS IMMEDIATELY 
  
* THE NEXT CALL DESTROYS MOST REGISTERS IN THE GENERATED CODE 
  
          GEN    (CALL S$LNGSM) 
          GEN    (BX7 X1) 
          GEN    (SA7 =XS$NEWX1)
          GEN    (BX7 X2) 
          GEN    (SA7 =XS$NEWX2)
          GEN    (SX1 =XS$LREGS)
          GEN    (CALL XJR=)
  
* NOW PUT OUR GOOD STUFF INTO THE EXTERNAL RECORD 
  
          SA1    SAVEB3             LENGTH OF TOTAL EXTERNAL FIELD
          SX2    60 
          IX2    X1-X2              EXTERNAL FIELD - 60 
          SB5    X2                 NUMBER OF EXTERNAL BITS IN S$NEWX1
          GEN    (SA1 =XS$NEWX1)
          GEN    (BX7 X1) 
          SX5    60 
          SX4    B5 
          IX5    X5-X4              OFFSET IN *X7 OF GOOD STUFF 
  
* CHECK TO SEE IF WE HAVE A LEADING OVERPUNCH 
  
          SB7    A0 
          IFTHEN B7=B1              IF LEADING OVERPUNCH
            NEWLBL NEXT 
            NEWLBL NEXT2
            GEN  (PL X0,"NEXT2")       *SKIP OVERPUNCH IF POSITIVE
            GEN  (MX6 6)               *ONE-BYTE MASK 
            GEN  (LX7 0),X5            *SHIFT FIRST DIGIT TO LEFT 
            GEN  (BX6 X6*X7)           *LEADING DIGIT IN *X6
            GEN  (SX5 33B)             *DISPLAY ZERO
            GEN  (LX5 54)              *MOVE TO LEFT EDGE 
            NEWLBL ZERO 
            GEN  (IX5 X5-X6)
            GEN  (ZR X5,"ZERO")        *ZERO IS A SPECIAL CASE
            GEN  (SX5 22B)             *AMOUNT TO SUBTRACT
            GEN  (LX5 54) 
            GEN  (IX7 X7-X5)           *PUNCH IT
            GEN  (EQ "NEXT")
            GENLBL ZERO 
            GEN  (SX5 33B)             *AMOUNT TO ADD 
            GEN  (LX5 54) 
            GEN  (IX7 X7+X5)           *PUNCH IT
            GENLBL NEXT 
            SB7    60 
            SB6    X5 
            SB7    B7-B6
            GEN    (LX7 0),B7          *REPOSITION *X7
            GENLBL NEXT2
            ENDIF.
  
          GEN    (BX4 X0)            *PRESERVE SIGN REGISTER IN *X4 
          CALL   S$GNRST
          GEN    (BX0 X4)            *RESTORE SIGN REGISTER 
* THAT WAS THE FIRST CLUMP. THE SECOND CLUMP IS ALWAYS 60 BITS
  
          SB2    B2+B5               INCREMENT THE OFFSET IN EXT REC
          SB5    60                  ALWAYS 60 BITS 
          SX5    0                   OFFSET ALWAYS ZERO, REG IS FULL
          GEN    (SA1 =XS$NEWX2)
          GEN    (BX7 X1) 
  
* CHECK TO SEE IF WE HAVE A TRAILING OVERPUNCH
  
          SB7 2 
          SB6    A0 
          IFTHEN B6=B7                IF TRAILING OVERPUNCH 
            NEWLBL NEXT 
            GEN  (PL X0,"NEXT")         *SKIP OVERPUNCH IF POSITIVE 
            GEN  (BX6 X7)               *COPY RESULT REGISTER 
            GEN  (MX5 -6) 
            GEN  (BX4 -X5*X6)           *ISOLATE FINAL CHARACTER
            GEN  (SX3 33B)              *DISPLAY ZERO 
            GEN  (IX3 X3-X4)
            NEWLBL ZERO 
            GEN  (ZR X3,"ZERO")         *ZERO IS A SPECIAL CASE 
            GEN  (SX5 22B)              *AMOUNT TO SUBTRACT 
            GEN  (IX7 X7-X5)            *PUNCH IT 
            GEN  (EQ "NEXT")
            GENLBL ZERO 
            GEN  (SX5 33B)              *AMOUNT TO ADD
            GEN  (IX7 X7+X5)
            GENLBL NEXT 
            ENDIF.
          GEN    (BX4 X0)             PRESERVE SIGN REGISTER IN *X4 
          CALL   S$GNRST
          GEN    (BX0 X4)             RESTORE SIGN REGISTER 
          GEN    (SA1 "HOLDX6") 
          GEN    (BX6 X1) 
          SA1    SAVEB2 
          SB2    X1 
          SA1    SAVEB3 
          SB3    X1 
          SA1    SAVEB4 
          SB4    X1 
          SA4    SAVEX4 
  
          EXIT
  
  
  
SAVEB2    BSS    1           ORIGINAL VALUE OF B2 
  
SAVEB3    BSS    1           ORIGINAL VALUE OF B3 
  
SAVEB4    BSS    1           ORIGINAL VALUE OF B4 
  
SAVEB42   BSS    1           INTERMEDIATE B4 STORAGE
  
SAVEX4    BSS    1           ORIGINAL VALUE OF X4 
  
S$STRIP   EXTERNAL           TABLE TO STRIP OVERPUNCHES 
  
S$TBL1    EXTERNAL           TABLE OF BINARY LENGTHS OF NUMERICS
  
          END 
