         TITLE    'ACQCONST-B00,08/21/73,DWG702985'
         SYSTEM   SIG7F
         CSECT    1
         PCC      0                 CONTROL CARDS NOT PRINTED.
ACQCONS@ RES      0                 ORIGIN OF CONSTANT ACQ. MODULE.
*
*  REF'S  AND  DEF'S
*
         DEF      ACQCONS@                  = START OF ACQCONST MODULE.
         DEF      ACQCONST          ACQUIRE CONSTANT -- ENTRY PT.
 SPACE 3                        REFS TO PROCEDURE:
*                               REFS TO PROCEDURE:
         REF      ACQCC             ACQ. CURRENT CHAR AND ITS CODE.
         REF      ACQCODE           ACQ. CURRENT CHAR'S CODE.
 SPACE 2
*                               REFS TO CONTEXT:
         REF      CONSTDT           DBLWD TEMP.
         REF      CONSTDTX          EXTRA DBLWD TEMP.
         REF      CONSTAD           DBLWD TEMP -- 1ST WD IS ALWAYS ZERO.
         REF      CONSTBUF          BUFFER TO HOLD CONSTS (FOR VECTORS).
         REF      CONSTTYP          TYPE-OF-CONSTANT INDICATOR:
*                                     0 OR 1 = LOGICAL.
*                                        > 1 = INTEGER.
*                                        - 1 = REAL.
         REF      NSPILLED          TEMP FOR NO.OF DIGITS SPILLED.
*                               REFS TO CONSTANTS
         REF      ZEROZERO          0,0
         REF      F0F9              '0','9'
         REF      X4E1              X'4E100000', 0
         REF      BITPOS            32-WD BIT-TBL (BITPOS-K CONTAINS A
*                                     WD HAVING A 1 ONLY IN BIT POS. K).
*
*  EQU'S RELATED TO CONTEXT
*
CONSTTMP EQU      NSPILLED          TEMP WD
 SPACE
*
*  STANDARD EQU'S
*                    REGISTERS
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
*  OTHER EQU'S
*
NEGSIGN  EQU      X'72'             INTERNAL (EBCDIC) NEGATIVE SIGN.
FNEG     EQU      2                 FLAGS NEGATIVE REAL NOS.
ENEG     EQU      1                 FLAGS REAL NOS. WITH NEG. EXPONENTS.
*
*  DOUBLEWORD CONSTANTS
*
         BOUND    8
PTORE    DATA     '.','E'
PTORNEG  DATA     '.',NEGSIGN
M100P100 DATA     -100,100
1TENTH   DATA     X'0CCCCCCC',X'CCCCCCCE'  ANY NO. LESS THAN THIS CAN BE
*                                   MULTIPLIED BY 10 WITHOUT OVERFLOW.
 SPACE
X4E      DATA     X'4E000000',0
*
*  WORD CONSTANTS
*
X488     DATA     X'48800000'
EXPON48  DATA     X'48000000'
 PAGE
*
*  POWERS OF TEN
*
*        THE POWERS OF TEN USED FOR SCALING ARE DEFINED IN TABLES BELOW.
*        EACH POWER HAS THREE NUMBERS ASSOCIATED: (P) POWER (SEE TENP),
*        (F) FRACTION (SEE TENF), AND (E) BINARY EXPONENT (SEE TENE).
*        THEY SATISFY:
*                       1 <= P <= 13
*                       10**P = F*(2**E)
*                       .5 <= F < 1.0
*
*        CURRENTLY USED P-VALUES ARE:  1, 4, AND 13.
*
TENP     EQU      %-1
         DATA     1,4,13
NTENS    EQU      %-TENP-1
*
TENE     EQU      %-1
         DATA     4,14,44
*
TENF     EQU      %-1
         DATA     X'50000000'    =  10     * 2**(-4)
         DATA     X'4E200000'    =  10**4  * 2**(-14)
         DATA     X'48C27395'    =  10**13 * 2**(-44)
 PAGE
************************************************************************
*                                                                      *
*  ACQCONST -- SUBROUTINE TO ACQUIRE CONSTANTS (VECTOR OR SCALAR) THAT *
*        ARE IN INTERNAL FORM, PRODUCING THE REAL OR INTEGER EQUIVS.   *
*        IN THE CONSTANT BUFFER -- CONSTBUF.  THE TYPE OF THE CONSTANT *
*        IS PRODUCED IN -- CONSTTYP:                                   *
*                                   0 OR 1  INDICATES LOGICAL DOMAIN,  *
*                                      > 1  INDICATES INTEGER DOMAIN,  *
*                                   AND -1  INDICATES REAL DOMAIN.     *
*                                                                      *
*        ACQCONST IS ENTERED WHEN (IN REASONABLE CONTEXT) A DIGIT,     *
*        DECIMAL POINT, OR NEGATIVE SIGN IS PICKED UP.  IT IS POSSIBLE *
*        THAT, DUE TO SYNTAX ERROR, ACQCONST WILL NOT ENCOUNTER A      *
*        NUMBER; HOWEVER, ACQCONST DOES NOT GENERATE ANY ERROR DIAGS.  *
*        IN FACT, THE ONLY ERROR IT RECOGNIZES IS AN OVERFLOW -- WHICH *
*        RESULTS IN A UNIQUE EXIT.  UNDERFLOW PRODUCES A ZERO (IN THE  *
*        APPROPRIATE DOMAIN).                                          *
*                                                                      *
*        ACQCONST ATTEMPTS TO OPTIMIZE THE HANDLING OF INTEGER DOMAIN  *
*        CONSTANTS BY UTILIZING SOMEWHAT REDUNDANT PROCEDURE.  IT ALSO *
*        ATTEMPTS TO STAY IN INTEGER DOMAIN AS LONG AS POSSIBLE, FOR   *
*        EXAMPLE ' 1.23E5 ' WILL BE TREATED AS AN INTEGER UNLESS THE   *
*        CONSTANT ALREADY HAS CONTAINED PRIOR REAL NUMBERS.            *
*                                                                      *
*        REGS:   R4 -- LINK; EXIT (EFFECTIVELY) IS VIA                 *
*                                   0,R4 IF OVERFLOW OR                *
*                                   1,R4 IF NO OVERFLOW (ACTUALLY, THE *
*                                        NORMAL EXIT IS MADE BY LINKING*
*                                        THRU 'ACQCC' OR 'ACQCODE' IN  *
*                                        ORDER TO INSURE THAT THE CHAR *
*                                        AND CODE (NON-BLANK) THAT     *
*                                        TERMINATES THE CONSTANT IS    *
*                                        READY FOR FURTHER CODESTRING  *
*                                        WORK.                         *
*                R1 -- (ENTRY) PTS AT DIGIT, DEC.PT, OR NEG.SIGN.      *
*                      (EXIT) PTS AT TERMINATION CHAR (POSSIBLY SAME   *
*                             AS AT ENTRY IF SYNTAX ERROR).            *
*                R2 -- (ENTRY) CONTAINS DIGIT, DEC.PT, OR NEG.SIGN.    *
*                      (EXIT) CONTAINS TERMINATION CHAR (NON-BLANK).   *
*                R3 -- (EXIT) CONTAINS CODE FOR TERMINATION CHAR.      *
*                R6 -- (EXIT) CONTAINS THE NO.OF NUMBERS IN THE        *
*                             CONSTANT (ZERO IF SYNTAX ERROR).         *
*                R5 THRU R14 ARE VOLATILE.                             *
*                                                                      *
ACQCONST AI,R4    1                 ASSUME NO-OVERFLOW EXIT.
         LI,R6    0                 R6 = NO.OF NOS. IN CONSTANT.
         STW,R6   CONSTTYP          TYPE 0 -- START AS LOGICAL CONSTANT.
         BAL,R5   NSET              DO SET-UPS FOR NUMBER.
ISET     LI,R9    0                 R9 = INTEGER ACCUMULATOR.
         AI,R2    -'0'              DOES MAGNITUDE START WITH DIGIT...
         BGEZ     IDIG1             YES, 1ST DIGIT.
IPT      LI,R5    RPT               NO, DEC.PT.
IE       LI,R8    0
         B        TRYREAL
IOK      AI,R2    -'0'              STRIP OFF HI-ORDER DIGIT OF EBCDIC.
IDIG1    STW,R2   CONSTAD+1         (INDICATES PRESENCE OF A DIGIT).
         AW,R9    CONSTAD+1         ACCUMULATE IT.
         BNOV     INXT
         LI,R5    PNXT              OH-OH, INTEGER REACHES R9'S SIGN-BIT
         B        TOOBIG
IDIG     MI,R8    10                PREPARE FOR NEXT ACCUMULATE.
         BNOV     IOK
         LI,R5    PM                OH-OH, INTEGER TOO BIG.
TOOBIG   LI,R11   0                 PREPARE TO ENTER THE 'PACK' ROUTINE,
         STW,R11  NSPILLED
         LI,R14   RPTQ                LIKE STARTING A REAL NO.
TRYREAL  SLD,R8   1                 REAL NO. IS SHIFTED 1.
         LI,R3    0                 R3 = DECIMAL EXPONENT.
         B        0,R5
INXT     AI,R1    1                 GET NEXT CHAR.
         LB,R2    0,R1
         CLM,R2   F0F9              CK FOR DIGIT.
         BCR,9    IDIG              YES.
         CLM,R2   PTORE             NO, CK FOR DEC.PT OR AN E.
         BCS,9    IZ                  NO -- END INTEGER.
         BCR,2    IPT                 DEC.PT.
         BCS,4    IZ                  NO -- END INTEGER.
         LI,R5    RE                  E
         B        IE
RICK     LW,R7    CONSTTYP          ARE WE IN INTEGER DOMAIN, SO FAR...
         BLZ      RZ                  NO -- REAL.
         CW,R8    X488                YES, IS REAL VALUE TO BIG FOR INTG
         BGE      REALSW            YEP, SWITCH TO REAL DOMAIN.
         STD,R8   CONSTDTX          NOPE, SAVE OUR REAL VALUE.
         FAL,R8   X4E               CK FOR LOSS OF FRACTION.
         CD,R8    CONSTDTX
         BNE      REALSW8             YES, SWITCH TO REAL DOMAIN.
         FAL,R8   X4E1                NO, GET INTEGER VALUE IN R9.
IZ       STS,R9   CONSTTYP          (THIS GIVES INTG VS LOGL INDICATION)
         AI,R10   -FNEG             CK FOR NEGATIVE NO.
         BLZ      ISTORE            NO, POSITIVE.
         LCW,R9   R9                YES, NEGATE.
         STS,R1   CONSTTYP          INSURE TYPE=INTEGER, NOT LOGICAL.
ISTORE   STW,R9   CONSTBUF,R6       STORE THE INTEGER.
         LI,R5    ISET              EXIT 'FINQ' TO ISET IF NO. SEEMS UP.
FINQ     XW,R1    CONSTAD+1         SAVE R1, TEST FOR NO DIGITS ACCUM.
         CI,R1    18                (R1<19 MEANS DIGIT OCCURRED).
         BG       ACQCC      -EXIT- NO, R1 PTS AT FALSE-NO.-START; REACQ
         LW,R1    CONSTAD+1         OK, RESTORE R1.
         AI,R6    1                 WE HAVE 1 MORE NO. IN THE CONSTANT.
         CI,R2    ' '               DID WE END ON A BLANK...
         BE       BLNKSKIP            YES, SKIP IT.
         CLM,R2   PTORNEG             NO, CK FOR DEC.PT OR NEG.SIGN...
         BCS,9    NSET              NOPE, OK.
         BCR,2    DBLNUM            DEC.PT (UNEXPECTED).
         BCS,4    NSET              NOPE, OK.
*                                   NEG.SIGN (UNEXPECTED).
DBLNUM   LI,R6    0                 SYNTAX ERROR INDICATION.
         B        ACQCODE    -EXIT- ACQ CHAR'S CODE.
BLNKQ    CI,R2    ' '               SKIP BLANKS.
         BNE      NSET
BLNKSKIP AI,R1    1
         LB,R2    0,R1
         B        BLNKQ
NSET     STW,R1   CONSTAD+1   (>19) SAVE CURR.CHAR LOC IN CASE FALSE-ST.
         LI,R10   0                 CLEAR NEG-FLAGS FOR NO. AND EXPON.
         CLM,R2   F0F9              CK FOR DIGIT.
         BCR,9    0,R5              YES, WORK THAT NO.
         CLM,R2   PTORNEG           NO, CK FOR DEC.PT OR NEG.SIGN.
         BCS,9    ACQCODE    -EXIT- NEITHER; ACQ CHAR'S CODE.
         BCR,2    0,R5              DEC.PT (COULD BE FALSE-START).
         BCS,4    ACQCODE    -EXIT- NEITHER.
         LI,R10   FNEG              NEG-SIGN -- SET NEG-FLAG FOR NO. --
         AI,R1    1                   (COULD BE FALSE-START).
         LB,R2    0,R1              GET NEXT CHAR.
         CLM,R2   F0F9              CK FOR DIGIT AFTER NEG-SIGN...
         BCR,9    0,R5                YES, WORK THAT NO.
         CI,R2    '.'                 NO, CK FOR DEC.PT...
         BE       0,R5                  YEP (COULD BE FALSE-START).
         BDR,R1   ACQCC      -EXIT- REACQ NEG-SIGN FOR FALSE-START.
         B        0,R5
REALSW8  LD,R8    CONSTDTX          RESTORE REAL VALUE.
REALSW   LW,R7    R6                GET NO.OF EARLIER INTEGERS...
         BEZ      REALD               NONE, NO NEED TO CONVERT.
REALC    LW,R12   CONSTBUF-1,R7       SOME; IN REVERSE ORDER, CONVERT
         LI,R13   0                     OLD INTEGERS TO REALS.
         SAD,R12  -8
         EOR,R12  EXPON48
         FAL,R12  ZEROZERO
         STD,R12  CONSTBUF-2,R7
         BDR,R7   REALC
REALD    LI,R7    -1                SET REAL DOMAIN INDICATION.
         STW,R7   CONSTTYP
RZ       AI,R10   -FNEG             CK FOR NEGATIVE NO.
         BLZ      RSTORE            NO, POSITIVE.
         LCD,R8   R8                YES, NEGATE.
RSTORE   STD,R8   CONSTBUF,R6       STORE THE REAL NO.
         BAL,R5   FINQ              MAKE FINALIZATION QUERIES.
         LD,R8    ZEROZERO          CONTINUE -- CLEAR REAL ACCUMULATOR
         LI,R14   RPTQ              EXIT FROM 'PACK' TO 'RPTQ'.
PACK     LI,R11   0                 R11 = NO.OF DIGITS PACKED.
         STW,R11  NSPILLED          (CLEAR NO.OF DIGITS SPILLED, TOO).
PDQ      CLM,R2   F0F9              DIGIT QUERY...
         BCR,9    PDIG                YES, DIGIT.
         B       *R14                 NO, EXIT FROM PACK.
PDIG     CD,R8    1TENTH            SEE IF ACCUM. WOULD OVERFLOW...
         BL       POK                 NO.
         MTW,1    NSPILLED            YES, COUNT THAT DIGIT POSITION,
         B        PNXT              BUT DON'T ACCUMULATE ANY MORE.
POK      AI,R11   1                 COUNT THE DIGIT TO BE PACKED.
         STD,R8   CONSTDT           MULTIPLY CURRENT ACCUMULATION
         SLD,R8   2                   BY 10  (IT WAS GUARANTEED THAT
         AD,R8    CONSTDT             THIS WILL REACH NO FURTHER THAN
         SLD,R8   1                   BIT POS. 1 OF R8).
PM       AI,R2    -'0'              (POST-MULT) STRIP EBCDIC CODE OFF.
         SLS,R2   1           NOTE--INSURE ACCUM. BIT POS. 63 NOT USED;
*                                     THUS PACK PRODUCES A 62-BIT NO.,
*                                     AND BITS 0 AND 63 ARE ZERO.  (THE
*                                     REASON IS TO ALLOW ACCUM TO BE
*                                     SPLIT INTO 2 31-BIT WDS LATER;
*                                     OTHERWISE, SIGNS COULD CAUSE
*                                     CONFUSION).
         STW,R2   CONSTAD+1         (CONSTAD+0 IS ALWAYS ZERO).
         AD,R8    CONSTAD           ACCUMULATE.
PNXT     AI,R1    1
         LB,R2    0,R1              GET NEXT CHAR.
         B        PDQ
RPTQ     LW,R3    NSPILLED          R3 = DECIMAL EXPONENT (DE).
         CI,R2    '.'               DECIMAL PT. QUERY...
         BNE      REQ                 NO, TRY FOR E.
RPT      AI,R1    1                 GET CHAR AFTER DEC PT.
         LB,R2    0,R1
         BAL,R14  PACK              ACCUMULATE FRACTION DIGITS, IF ANY.
         SW,R3    R11               DECR DE BY THAT MANY DIGITS.
REQ      CI,R2    'E'               E QUERY...
         BNE      REAL                NO, PROCESS REAL NO.
RE       XW,R1    CONSTAD+1         SAVE R1, TEST FOR NO DIGITS YET
         CI,R1    18                  (R1 < 19 MEANS DIGIT OCCURRED)...
         BG       ACQCC       -EXIT-  NO, R1 PTS AT FALSE-START, REACQ.
         XW,R1    CONSTAD+1           OK, RE-EXCHANGE.
         AI,R1    1                 GET NEXT CHAR.
         LB,R2    0,R1
         CLM,R2   F0F9              DIGIT...
         BCR,9    RED                 YES, E FOLLOWED BY DIGIT.
         CI,R2    NEGSIGN             NO, NEGATIVE SIGN...
         BE       RENQ              YES.
         LI,R2    'E'               NO, RESTORE THE E, PT TO IT, AND
         BDR,R1   REAL                PROCESS REAL NO.
RENQ     AI,R10   ENEG              SET EXPONENT-NEGATIVE FLAG.
         AI,R1    1                 GET NEXT CHAR.
         LB,R2    0,R1
         CLM,R2   F0F9              DIGIT...
         BCR,9    RED                 YES.
         LI,R2    NEGSIGN             NO, RESTORE THE NEG.SIGN, BACK UP
         BDR,R1   REAL
RED      STD,R8   CONSTDTX          SAVE ACCUM. 'FRACTION'
         LD,R8    ZEROZERO          CLEAR TO ACCUM. EXPONENT.
         BAL,R14  PACK              ACCUM. IT.
         OR,R8    NSPILLED          CK FOR RIDICULOUSLY BIG EXPONENT...
         BEZ      REOK                NO, OK SO FAR
         CI,R10   ENEG                YES, CK O'FLO VS U'FLO.
         BANZ     UFLO
         B        -1,R4       -EXIT-  OVERFLOW
*
REOK     SLS,R9   -1                ACCUM. EXP. WAS SHIFTED 1.
         CI,R10   ENEG              CK EXPONENT SIGN...
         BAZ      RPE                 POSITIVE.
         SW,R3    R9                  NEGATIVE, DECR. DE.
         B        ROUT
RPE      AW,R3    R9                INCR. DE.
ROUT     BNOV     RGO               GO UNLESS RESULT RIDICULOUSLY BIG...
         BLZ      -1,R4       -EXIT-  OVERFLOW  (SIGN REVERSAL).
UFLO     LD,R8    ZEROZERO            UNDERFLOW -- ASSUME ZERO REAL NO.
         B        RICK              CK FOR REALLY INTEGER
RGO      LD,R8    CONSTDTX          RESTORE ACCUM. FRACTION.
REAL     CD,R8    ZEROZERO          TEST FOR ZERO...
         BEZ      RICK                YES, CK FOR REALLY INTEGER.
         CLM,R3   M100P100            NO, IS DE REASONABLE...
         BCR,9    BINORM                OK -- DO BINARY NORMALIZATION.
HIORLO   BG       -1,R4       -EXIT-  OVERFLOW
         LD,R8    ZEROZERO            UNDERFLOW -- ASSUME ZERO REAL NO.
         B        RICK              CK FOR REALLY INTEGER.
BINORM   AI,R8    0                 IF FRACTION'S HI-HALF IS 0,
         BEZ      RNORM               USE RIGHT-HAND NORMALIZATION.
         LI,R5    63                R5= BIN.EXP (BE) -- PRESET & BIASED.
LLOOP    SLD,R8   1                 LEFT SHIFT,
         AI,R5    -1                  DECR. BE,
         AI,R8    0                     TEST FRACTION'S SIGN...
         BGZ      LLOOP                   + -- SHIFT AGAIN.
         B        CLRBIT0                 - -- CLEAR SIGN POS. AND GO.
RNORM    LI,R5    -1                R5= BIN.EXP (BE) -- PRESET & BIASED.
RLOOP    SCD,R8   -1                ROTATE RIGHT,
         AI,R5    1                   INCR. BE,
         AI,R9    0                     TEST LO-HALF EMPTIED OF 1'S...
         BNEZ     RLOOP                   NO, RE-CYCLE.
CLRBIT0  SLD,R8   -1                MOVE OVER TO CLEAR SIGN BIT.
         LI,R7    NTENS             R7 = 'TEN-POWER' NO.
         AI,R3    0                 TEST DECIMAL EXPONENT (DE)...
         BLEZ     DENORZ              NEGATIVE OR ZERO.
         LI,R14   0                   POSITIVE, CLEAR TOP WORD OF THE
         STW,R14  CONSTDT               DBLWD TEMP.
DEPOS    SW,R3    TENP,R7           TRY SCALING DOWN DE...
         BLZ      DEPR                TOO FAR, RECOVER IT.
         STW,R8   CONSTTMP            OK, SAVE HI HALF OF FRACTION.
         SLS,R9   -1                GET MAGNITUDE OF LO HALF.
         MW,R8    TENF,R7           MULT BY A PURE POWER OF TEN.
         SLD,R8   1                 PREPARE TO ADD IN THE LO HALF'S
         STW,R8   CONSTDT+1           PRODUCT (CONSTDT+0 IS ZERO).
         LW,R9    CONSTTMP          RECOVER HI HALF FOR ITS
         MW,R8    TENF,R7             MULTIPLICATION.
         AD,R8    CONSTDT           ADD IN THE LO HALF'S PRODUCT.
         SLD,R8   1
         CW,R8    BITPOS-1          POST-NORMALIZE.
         BANZ     DEPBE
         SLD,R8   1
         AI,R5    -1
DEPBE    AW,R5    TENE,R7           ADJ BINARY EXPONENT.
         B        DEPOS
DEPR     AW,R3    TENP,R7           RECOVER DE.
         BEZ      DEZERO              OK, IT IS ZEROED.
         BDR,R7   DEPOS               TRY ANOTHER PURE POWER OF TEN.
*         NEVER FALLS THRU.
DENORZ   BEZ      DEZERO            OK, DE IS ZEROED.
DENEG    AW,R3    TENP,R7           TRY SCALING UP DE...
         BGZ      DENR                TOO FAR, RECOVER IT.
         CW,R8    TENF,R7           POSITION DIVIDEND TO GET NORM. QUOT.
         BL       DENQ
         SLD,R8   -1
         AI,R5    1
DENQ     SLD,R8   -1
         DW,R8    TENF,R7           HI-ORDER QUOTIENT.
         STW,R9   CONSTTMP          SAVE IT.
         LW,R9    TENF,R7           NEW DIVIDEND = HI-ORDER REMAINDER
         SLD,R8   -1                  + HALF OF DIVISOR (FOR ROUNDING).
         DW,R8    TENF,R7           LO-ORDER QUOTIENT.
         SLS,R9   1                 PACK IT TOGETHER
         LW,R8    CONSTTMP            WITH THE HI-ORDER QUOTIENT.
         SW,R5    TENE,R7           ADJ BINARY EXPONENT.
         B        DENEG
DENR     SW,R3    TENP,R7           RECOVER DE.
         BEZ      DEZERO              OK, IT IS ZEROED.
         BDR,R7   DENEG               TRY ANOTHER PURE POWER OF TEN.
*         NEVER FALLS THRU.
DEZERO   AI,R5    1+4*64            BIAS BINARY EXPON (APPX HEX EXPON).
         LI,R7    3                 CK ITS 2 LOW BITS.
         AND,R7   R5                CALC SHIFT NECESSARY TO NORMALIZE
         CI,R7    1                   HEXADECIMALLY.
         BLE      NSHIFT
         AI,R7    -4
NSHIFT   SLD,R8   -8,R7             POSITION FRACTION.
         SW,R5    R7                CORRECT BINARY EXPONENT.
         SAS,R5   -2                CHANGE TO (EXCESS-64) HEX EXPONENT.
         STB,R5   R8                SET CHARACTERISTIC OF REAL NO.
         CI,R5    X'FFF80'          WAS IT IN RANGE (0 - 127)...
         BAZ      RICK                YES -- CK FOR REALLY INTEGER.
         AI,R5    0                   NO, TEST IT FOR AN
         B        HIORLO                O'FLO VS U'FLO DETERMINATION.
 PAGE
************************************************************************
 SPACE 2
Z        SET      %-ACQCONS@        SIZE OF ACQCONST IN HEX.
 SPACE
Z        SET      Z+Z/10*6+Z/100*96+Z/1000*1536 SIZE IN DECIMAL.
 SPACE 2
         END

