*DECK GMOVLOD 
          IDENT  GMOVLOD
          TITLE  GMOVLOD -  GENERATE MOVE = LOAD NUMERIC DISPLAY
          MACHINE  ANY,I
          SST 
          COMMENT  GENERATE MOVE = LOAD NUMERIC DISPLAY 
          SPACE  4
**        GMOVLOD -  GENERATE MOVE = LOAD NUMERIC DISPLAY 
*                    (UNROUNDED)
* 
* ND2RN   LINK   CGND2RN
* 
*         REGB = DNAT POINTER TO SOURCE ITEM. 
*         REGC = DNAT POINTER TO DESTINATION REGISTER.
* 
*         CALLZ  ND2RN
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
          TITLE  ND2RN
  
*      COMDECKS 
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
  
*CALL CCT 
  
  
*      MODULE DECLARATION 
  
 GMOVLOD  MODULE
  
  
*      LINKAGE FROM CALLING ROUTINES IN OTHER MODULES 
  
 ND2RN    KNIL   CGND2RN     * FROM GMOVE 
  
  
*      LINKAGE TO CALLED ROUTINES IN OTHER MODULES
  
 ADNAT    LINK   ADNAT
 RN2RN    LINK   CGRN2RN
 SCLOAD   LINK   SCLOAD 
 SUBDNAT  LINK   SUBDNAT
 SUBLOAD  LINK   SUBLOAD
 SETXXPK  LINK   CGSXXPK     * TO GMOVSUB 
  
*      FIXED TABLE EQUATES
  
 BCP      EQU    T5 
 ECP      EQU    T6 
 BCPMASK  EQU    T7 
 LENMASK  EQU    T8 
 LSHIFTCT EQU    T10
 LABEL1   EQU    P9          LABEL NUMBER FOR LABEL *LOCLAB1* 
 LOADREG  EQU    REGT17 
  
  
*      MISCELLANEOUS EQUATES
  
  
  
*      SYMBOLIC PARAMETER DEFINITIONS 
  
 CBSTRP   SETSY  (EXT$OF,C.STRP)
 CBZEROS  SETSY  (EXT$OF,C.ZEROS) 
 FWASOURC SETSY  (FWA$OF,REGB)
 LOCLAB1  SETSY  (LOCAL$OF,LABEL1)
 SUBSOURC SETSY  (SUBTMPOF,SENDSUBS)
          EJECT 
**        ND2RN -  NUMERIC DISPLAY TO REGISTER NUMERIC
* 
*         REGB = DNAT POINTER TO SOURCE ITEM
*         (SIGNOF,REGB) 
*         (LDSIGNOF,REGB) 
*         (SCHAROF,REGB)
*         (NUMLENOF,REGB) 
*         (BYTLENOF,REGB) 
*         REGC = DNAT POINTER TO DESTINATION REGISTER 
*         (SIGNOF,REGC) 
*         (NUMLENOF,REGC) 
* 
*         CALLZ  ND2RN
* 
*         SETS (TREGOF,REGC) = VIRTUAL REGISTER NUMBER OF REGISTER
*           CONTAINING RESULT.
*         USES-  (NONE) 
* 
*         ALSO CALLED BY- 
*                ND2AE
*                ND2C1
*                ND2C2
*                ND2NE
*                ND2R1
*                ND2R2
*                ND2R4
  
  
 ND2RN    EGO    2
  
          QUOTZ  (NUMLENOF,REGC),11,T2           0 FOR 1-10, ELSE 1 
          IFTHEN ((NUMLENOF,REGC),EQ,10)         IF 10 DIGIT DESTINATION
           ANDIF ((SIGNOF,REGC),EQ,1)             AND SIGNED
            MOVEZ  1,T2 
            ENDIFZ
  
  
          SUBZ   0,(POINTOF,REGC),T1
          IFZ    ((INTLENOF,REGB),LE,T1),ND2RN6  IF SOURCE TOO SMALL
          SUBZ   0,(POINTOF,REGB),T1
          IFZ    ((INTLENOF,REGC),LE,T1),ND2RN6  IF SOURCE TOO LARGE
  
          IFZ    ((GSCODEOF,REGB),NE,0),ND2RN4   IF SOURCE SUBSCRIPTED
          IFZ    ((CCTBIT,LBZ),EQ,1),ND2RN3 
          MOVEZ  (BCPOF,REGB),BCP 
          IFTHEN ((SCHAROF,REGB),EQ,1)
          ANDIF  ((LDSIGNOF,REGB),EQ,1) 
            ADDZ   1,BCP,BCP
          ENDIFZ
          MOVEZ  0,T3 
          IFTHEN (BCP,EQ,10)
            MOVEZ  0,BCP
            MOVEZ  1,T3 
          ENDIFZ
          ADDZ   BCP,(NUMLENOF,REGB),ECP
          IFZ    (ECP,LE,10),ND2RN1   SOURCE IN ONE WORD
          IFZ    (ECP,LE,20),ND2RN2   SOURCE IN TWO WORDS 
          BRANCH ND2RN7               SOURCE IN THREE WORDS 
          SPACE  3
 ND2RN1   LABEL              SOURCE IN ONE WORD 
          IFTHEN (T2,EQ,0)
            CALLZ  ND2RNA 
            RETURN
          ENDIFZ
          MOVEZ  LOADREG,REGT 
          CALLZ  ADNAT
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGT)
          MOVEZ  (POINTOF,REGB),(POINTOF,REGT)
          MOVEZ  (SIGNOF,REGB),(SIGNOF,REGT)
          PUSH   REGC 
          MOVEZ  REGT,REGC
          CALLZ  ND2RNA 
          POP    REGC 
          PUSH   REGB 
          MOVEZ  REGT,REGB
          CALLZ  RN2RN
          POP    REGB 
          CALLZ  SUBDNAT
          RETURN
          SPACE  3
 ND2RN2   LABEL              SOURCE IN TWO WORDS
          CALLZ  ND2RNB 
          RETURN
          SPACE  3
  
  
*                            COMPLICATED, NON-SUBSCRIPTED CASES 
 ND2RN3   LABEL 
          NOTE   ND2RN3 
          ANDZ   (LDSIGNOF,REGB),(SCHAROF,REGB),T1
          ADDZ   T1,(BCPOF,REGB),T1 
          GEN    SXBPK,(VREGOF,VREG2),,T1 
          CALLZ  ND2RNC 
          RETURN
  
  
*                            SOURCE IS SUBSCRIPTED
 ND2RN4   LABEL 
  
          IFTHEN ((SUBSCOF,REGB),NE,0)           SPECIAL CASE 
          ANDIF  ((CCTBIT,LBZ),EQ,0)             AND NOT LBZ
            BRANCH ND2RN5 
          ENDIFZ
          NOTE   ND2RN4 
          MOVEZ  (GSCODEOF,REGB),P1 
          CALLZ  SUBLOAD
          GEN    SHR,P1,30
          MOVEZ  P1,VREG17
          ANDZ   (SCHAROF,REGB),(LDSIGNOF,REGB),T1
          ADDZ   (BCPOF,REGB),T1,P1 
          CALLZ  SETXXPK
          MOVEZ  VREG17,VREG2 
          CALLZ  ND2RNC 
          RETURN
  
  
*                            SPECIAL CASE SUBSCRIPTED 
 ND2RN5   LABEL 
          NOTE   ND2RN5 
          IFTHEN (T2,EQ,0)   TRUE IF 1-10 CHRS
            CALLZ  ND2RNE 
            RETURN
          ENDIFZ
          MOVEZ  LOADREG,REGT 
          CALLZ  ADNAT
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGT)
          MOVEZ  (POINTOF,REGB),(POINTOF,REGT)
          MOVEZ  (SIGNOF,REGB),(SIGNOF,REGT)
          PUSH    REGC
          MOVEZ  REGT,REGC
          CALLZ  ND2RNE 
          POP    REGC 
          PUSH   REGB 
          MOVEZ  LOADREG,REGB 
          CALLZ  RN2RN
          POP    REGB 
          CALLZ  SUBDNAT
          RETURN
          RETURN
*                            SOURCE FIELD DOES NOT CONTRIBUTE ANY DIGITS
*                              TO DESTINATION REGISTERS 
*                            DESTINATION IS 2 REGISTERS 
 ND2RN6   LABEL 
          NOTE   ND2RN6 
          GEN    SLRBPK,(VREGOF,VREG1),CBZEROS         VREG1
          GEN    XMIT,(VREGOF,VREG2),VREG1             VREG2=VREG1+1
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
          SPACE  3
 ND2RN7   LABEL              SOURCE IN THREE WORDS
          CALLZ  ND2RND 
          RETURN
ND2RNA    EJECT 
**        ND2RNA -  SOURCE CONTAINED IN 1 WORD
*                   DESTINATION IS 1 REGISTER 
* 
*         THE PATHOLOGICAL CASES WHERE THE SOURCE DOES NOT CONTRIBUTE 
*           ANY DIGITS TO THE RESULT HAVE BEEN ELIMINATED PREVIOUSLY. 
* 
*         CALLZ  ND2RNA 
* 
*         SETS (TREGOF,REGC) = VIRTUAL REGISTER NUMBER OF REGISTER
*           CONTAINING RESULT.
  
  
ND2RNA    EGO    3
          NOTE   ND2RNA 
*                            COMPUTE BCP OF NUMERIC PART
*                            (ASSUMES SCHAR, LDSIGN = 0 IF SIGN = 0)
          ANDZ   (SCHAROF,REGB),(LDSIGNOF,REGB),T1
          ADDZ   (BCPOF,REGB),T1,T1 
*                            COMPUTE BCPMASK, LENMASK 
          MINZ   (INTLENOF,REGB),(INTLENOF,REGC),T2        NUMLEN-POINT 
          MINZ   (POINTOF,REGB),(POINTOF,REGC),T3 
          ADDZ   T2,T3,LENMASK
          SUBZ   (INTLENOF,REGB),T2,T2                     NUMLEN-POINT 
          ADDZ   T1,T2,BCPMASK
          ADDZ   T1,(INTLENOF,REGB),T2
          SUBZ   10,(POINTOF,REGC),T3 
          SUBZ   (ARITH8,T2),(ARITH8,T3),LSHIFTCT          6*T2,6*T3
          QUOTZ  (ARITH9,LSHIFTCT),6,LSHIFTCT             LSHIFTCT MOD60
          SUBZ   (ARITH8,BCPMASK),(ARITH8,LSHIFTCT),BCPMASK  6* 
          QUOTZ  (ARITH9,BCPMASK),6,BCPMASK 
          GEN    SLRBPK,(VREGOF,VREG1),,FWASOURC
  
          IFZ    ((SIGNOF,REGB),EQ,0),ND2RNA6    IF SOURCE UNSIGNED 
          IFZ    ((SCHAROF,REGB),EQ,1),ND2RNA3   IF SEPARATE SIGN 
  
          IFTHEN ((LDSIGNOF,REGB),EQ,1)          IF LEADING INCLUDED
            ADDZ   (BCPOF,REGB),1,T1
          ELSEZ                                  IF TRAILING INCLUDED 
            MOVEZ  (ARITH1,REGB),T1                        BCPOF+BYTLENOF 
            MOVEZ  (ARITH17,T1),T1                         T1 (MOD 10)
            ENDIFZ
  
          IFZ    (LENMASK,EQ,10),ND2RNA2         IF NO ZERO PADDING 
  
*                            SOURCE HAS INCLUDED SIGN 
*                            ZERO PADDING REQUIRED
*                            LENMASK = LENGTH OF ZERO-PADDING MASK
*                            BCPMASK = BCP OF ZERO-PADDING MASK 
*                            T1 = LEFT-SHIFT COUNT TO RIGHT-JUSTIFY SIGN
 ND2RNA1  LABEL                                  (CROSS-REFS ONLY)
          NOTE   ND2RNA1
          GEN    SHL,VREG1,(ARITH8,T1)                     6*T1 
          GEN    MASK,(VREGOF,VREG5),54 
          GEN    LIMP,(VREGOF,VREG4),VREG1,VREG5
          GEN    SLRXPK,(VREGOF,VREG3),VREG4,CBSTRP 
          GEN    SXXPB,(VREGOF,VREG4),VREG3 
          GEN    LXOR,(VREGOF,VREG1),VREG1,VREG4
          SUBZ   (ARITH8,LSHIFTCT),(ARITH8,T1),T1          6*LSHIFTCT,T1
          GEN    SHL,VREG1,(ARITH9,T1)                     T1 (MOD 60)
  
          GEN    SLRBPK,(VREGOF,VREG4),,CBZEROS 
          GEN    MASK,(VREGOF,VREG5),(ARITH8,LENMASK)      6*LENMASK
  
          IFTHEN (BCPMASK,NE,0) 
            GEN    SHL,VREG5,(ARITH7,BCPMASK)              60-6*BCPMASK 
            ENDIFZ
  
          GEN    LAND,(VREGOF,VREG1),VREG1,VREG5
          GEN    LIMP,(VREGOF,VREG4),VREG4,VREG5
          GEN    IADD,(VREGOF,VREG1),VREG4,VREG1
  
          IFTHEN ((SIGNOF,REGC),EQ,1)            IF DESTINATION SIGNED
            MOVEZ  VREG1,P1 
            MOVEZ  VREG3,P2 
            CALLZ  SIGNSS 
            ENDIFZ
  
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE HAS INCLUDED SIGN 
*                            ZERO PADDING NOT NEEDED
*                            T1 = LEFT-SHIFT COUNT TO RIGHT-JUSTIFY SIGN
 ND2RNA2  LABEL 
          NOTE   ND2RNA2
          GEN    SHL,VREG1,(ARITH8,T1)                     6*T1 
          GEN    MASK,(VREGOF,VREG5),54 
          GEN    LIMP,(VREGOF,VREG4),VREG1,VREG5
          GEN    SLRXPK,(VREGOF,VREG3),VREG4,CBSTRP 
          GEN    SXXPB,(VREGOF,VREG4),VREG3 
          GEN    LXOR,(VREGOF,VREG1),VREG1,VREG4
          SUBZ   (ARITH8,LSHIFTCT),(ARITH8,T1),T1          6*LSHIFTCT,T1
          GEN    SHL,VREG1,(ARITH9,T1)                     T1 (MOD 60)
  
          IFTHEN ((SIGNOF,REGC),EQ,1)            IF DESTINATION SIGNED
            MOVEZ  VREG1,P1 
            MOVEZ  VREG3,P2 
            CALLZ  SIGNSD 
            MOVEZ  P3,(TREGOF,REGC) 
            RETURN
            ENDIFZ
  
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE HAS SEPARATE SIGN 
*                            LENMASK = LENGTH OF ZERO-PADDING MASK
*                            BCPMASK = BCP OF ZERO-PADDING MASK 
 ND2RNA3  LABEL 
          IFZ    ((SIGNOF,REGC),EQ,0),ND2RNA5    IF DESTINATION UNSIGNED
  
          IFTHEN ((LDSIGNOF,REGB),EQ,1)          IF LEADING SEPARATE
            MOVEZ  (BCPOF,REGB),T1
            IFZ    (T1,EQ,9),ND2RNA7   SIGN ALONE IN FIRST WORD 
          ELSEZ                                  IF TRAILING SEPARATE 
            SUBZ   (ARITH1,REGB),1,T1                      BCP+BYTLENOF 
            IFZ    (T1,EQ,10),ND2RNA4            IF SIGN IN NEXT WORD 
            ENDIFZ
  
*                            SOURCE HAS SEPARATE SIGN 
*                            DESTINATION IS SIGNED
*                            LENMASK = LENGTH OF ZERO-PADDING MASK
*                            BCPMASK = BCP OF ZERO-PADDING MASK 
*                            T1 = CHARACTER POSITION OF SIGN
 ND2RNA3A LABEL 
          NOTE   ND2RNA3
          GEN    XMIT,(VREGOF,VREG3),VREG1
          ADDZ   (ARITH8,T1),4,T1                          6*T1 
          GEN    SHL,VREG3,T1 
          GEN    SLRBPK,(VREGOF,VREG4),,CBZEROS 
          GEN    SHL,VREG1,(ARITH8,LSHIFTCT)               6*LSHIFTCT 
          GEN    MASK,(VREGOF,VREG5),(ARITH8,LENMASK)      6*LENMASK
  
          IFTHEN (BCPMASK,NE,0) 
            GEN    SHL,VREG5,(ARITH7,BCPMASK)              60-6*BCPMASK 
            ENDIFZ
  
          GEN    LAND,(VREGOF,VREG1),VREG1,VREG5
          GEN    LIMP,(VREGOF,VREG4),VREG4,VREG5
          GEN    IADD,(VREGOF,VREG1),VREG4,VREG1
          MOVEZ  VREG1,P1 
          MOVEZ  VREG3,P2 
          CALLZ  SIGNSS 
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE HAS TRAILING SEPARATE SIGN
*                            SIGN IS IN NEXT WORD 
*                            LENMASK = LENGTH OF ZERO-PADDING MASK
*                            BCPMASK = BCP OF ZERO-PADDING MASK 
 ND2RNA4  LABEL 
          NOTE   ND2RNA4
          GEN    SLRAPB,(VREGOF,VREG2),VREG1,VREGB1 
          GEN    SLRBPK,(VREGOF,VREG6),,CBZEROS 
          GEN    SHL,VREG2,4                     BIT 59 = 1 IFF NEGATIVE
  
          GEN    SHL,VREG1,(ARITH8,LSHIFTCT)
          ADDZ   BCPMASK,LENMASK,T1 
          IFTHEN (T1,NE,10)  MASK NOT RIGHT JUSTIFIED 
            GEN    MASK,(VREGOF,VREG5),(ARITH8,LENMASK)    60*LENMASK 
            GEN    SHL,VREG5,(ARITH7,BCPMASK)              60-6*BCPMASK 
            GEN    LAND,(VREGOF,VREG1),VREG1,VREG5
            GEN    LIMP,(VREGOF,VREG4),VREG6,VREG5
            GEN    IADD,(VREGOF,VREG1),VREG4,VREG1
          ELSEZ 
            GEN    MASK,(VREGOF,VREG5),(ARITH7,LENMASK)    60-6*LENMASK 
            GEN    LIMP,(VREGOF,VREG1),VREG1,VREG5
            GEN    LAND,(VREGOF,VREG4),VREG6,VREG5
            GEN    IADD,(VREGOF,VREG1),VREG4,VREG1
            ENDIFZ
  
          IFTHEN   (LENMASK,EQ,10)
            MOVEZ  VREG1,P1 
            MOVEZ  VREG2,P2 
            CALLZ  SIGNSD 
            MOVEZ  P3,(TREGOF,REGC) 
            ELSEZ 
            MOVEZ  VREG1,P1 
            MOVEZ  VREG2,P2 
            CALLZ  SIGNSS 
            MOVEZ  VREG1,(TREGOF,REGC)
          ENDIFZ
          RETURN
  
  
*                            SOURCE HAS SEPARATE SIGN 
*                            SEPARATE SIGN
*                            DESTINATION IS UNSIGNED
*                            LENMASK = LENGTH OF ZERO-PADDING MASK
*                            BCPMASK = BCP OF ZERO-PADDING MASK 
 ND2RNA5  LABEL 
          NOTE   ND2RNA5
          GEN    MASK,(VREGOF,VREG5),(ARITH8,LENMASK)      6*LENMASK
          GEN    SLRBPK,(VREGOF,VREG4),,CBZEROS 
  
          IFTHEN (BCPMASK,NE,0) 
            GEN    SHL,VREG5,(ARITH7,BCPMASK)              60-6*BCPMASK 
            ENDIFZ
  
          GEN    SHL,VREG1,(ARITH8,LSHIFTCT)               6*LSHIFTCT 
          GEN    LAND,(VREGOF,VREG1),VREG1,VREG5
          GEN    LIMP,(VREGOF,VREG4),VREG4,VREG5
          GEN    IADD,(VREGOF,VREG1),VREG1,VREG4
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS UNSIGNED 
*                            LENMASK = LENGTH OF ZERO-PADDING MASK
*                            BCPMASK = BCP OF ZERO-PADDING MASK 
 ND2RNA6  EQU    ND2RNA5                         (SAME AS ABOVE)
          SPACE  3
*                            SIGN LEADING SEPARATE, ALONE IN WORD 
*                            DESTINATION SIGNED 
 ND2RNA7  LABEL 
          NOTE   ND2RNA7
          GEN    SHL,VREG1,58 
          GEN    MASK,(VREGOF,VREG5),(ARITH8,LENMASK)   6*LENMASK 
          GEN    SLRAPB,(VREGOF,VREG2),VREG1,VREGB1 
          GEN    SLRBPK,(VREGOF,VREG4),,CBZEROS 
          IFTHEN (BCPMASK,NE,0) 
            GEN    SHL,VREG5,(ARITH7,BCPMASK)           60-6*BCPMASK
          ENDIFZ
          GEN    SHL,VREG2,(ARITH8,LSHIFTCT)
          GEN    LAND,(VREGOF,VREG2),VREG2,VREG5
          GEN    LIMP,(VREGOF,VREG6),VREG4,VREG5
          GEN    IADD,(VREGOF,VREG2),VREG2,VREG6
          IFTHEN (LENMASK,EQ,10)
            MOVEZ  VREG2,P1 
            MOVEZ  VREG1,P2 
            CALLZ  SIGNSD 
            MOVEZ  P3,(TREGOF,REGC) 
          ELSEZ 
            MOVEZ  VREG2,P1 
            MOVEZ  VREG1,P2 
            CALLZ  SIGNSS 
            MOVEZ  VREG2,(TREGOF,REGC)
          ENDIFZ
          RETURN
 ND2RNB   EJECT 
**        ND2RNB - SOURCE SPANS TWO WORDS 
* 
 ND2RNB   EGO    3
          NOTE   ND2RNB 
          SUBZ   ECP,10,ECP 
          IFZ    ((NUMLENOF,REGB),GT,10),ND2RNB5
          GEN    SLRBPK,(VREGOF,VREG1),,((FWA$OF,REGB),T3)
          GEN    MASK,(VREGOF,VREG2),(ARITH8,BCP)    6*BCP
          GEN    LIMP,(VREGOF,VREG3),VREG1,VREG2
          GEN    SHL,VREG3,(ARITH8,ECP)              6*ECP
          GEN    SLRAPB,(VREGOF,VREG4),VREG1,VREGB1 
          GEN    MASK,(VREGOF,VREG5),(ARITH8,ECP)    6*ECP
          GEN    LAND,(VREGOF,VREG6),VREG4,VREG5
          GEN    SHL,VREG6,(ARITH8,ECP)              6*ECP
          GEN    LOR,(VREGOF,VREG1),VREG6,VREG3 
          IFTHEN  ((NUMLENOF,REGB),NE,10) 
            GEN    SLRBPK,(VREGOF,VREG2),,CBZEROS 
            SUBZ   10,(NUMLENOF,REGB),T1
            GEN    MASK,(VREGOF,VREG3),(ARITH8,T1)    6*T1
            GEN    LAND,(VREGOF,VREG4),VREG3,VREG2
            GEN    LOR,(VREGOF,VREG1),VREG1,VREG4 
            ENDIFZ
          CALLZ  GETSIGN     SIGN 
          CALLZ  ALIGN       MATCH TO RECEIVER
          RETURN
          SPACE  3
 ND2RNB5  LABEL              NUMLEN SOURCE GT 10
          NOTE   ND2RNB5
          GEN    SLRBPK,(VREGOF,VREG2),,((FWA$OF,REGB),T3)
          GEN    SHL,VREG2,(ARITH8,ECP)          6*ECP
          SUBZ   20,(NUMLENOF,REGB),T1
          GEN    MASK,(VREGOF,VREG3),(ARITH8,T1) 6*T1 
          GEN    LIMP,(VREGOF,VREG4),VREG2,VREG3
          GEN    SLRBPK,(VREGOF,VREG5),,CBZEROS 
          GEN    LAND,(VREGOF,VREG6),VREG3,VREG5
          IFTHEN (ECP,EQ,10)
            GEN    LOR,(VREGOF,VREG1),VREG4,VREG6 
            GEN    SLRAPB,(VREGOF,VREG2),VREG2,VREGB1 
          ELSEZ 
            SUBZ   10,ECP,T1
            GEN    MASK,(VREGOF,VREG3),(ARITH8,T1)   6*T1 
            GEN    LAND,(VREGOF,VREG7),VREG2,VREG3
            GEN    SLRAPB,(VREGOF,VREG5),VREG2,VREGB1 
            GEN    SHL,VREG5,(ARITH8,ECP) 
            GEN    LIMP,(VREGOF,VREG8),VREG5,VREG3
            GEN    LOR,(VREGOF,VREG1),VREG4,VREG6 
            GEN    LOR,(VREGOF,VREG2),VREG7,VREG8 
          ENDIFZ
          CALLZ  GETSIGN     SIGN 
          CALLZ  ALIGN       MATCH TO RECEIVER
          RETURN
C         EJECT 
**        ND2RNC -  GENERAL CASE
* 
*         VREG2 = VIRTUAL REGISTER NUMBER OF X-REGISTER WITH BCP
* 
*         CALLZ  ND2RNC 
* 
* 
*         SETS (TREGOF,REGC) = VIRTUAL REGISTER NUMBER OF REGISTER
*           CONTAINING (MOST SIGNIFICANT) DIGITS OF RESULT. 
  
  
 ND2RNC   EGO    3
          SUBZ   (POINTOF,REGC),(POINTOF,REGB),T3 
  
*      CHECK FOR SPECIAL CASE 
  
          MINZ   (NUMLENOF,REGB),(NUMLENOF,REGC),T1 
  
          IFTHEN ((SIGNOF,REGB),EQ,0)            IF SOURCE UNSIGNED 
           ANDIF (T1,LE,10)                       AND 1-REGISTER RESULT 
           ANDIF (T3,EQ,0)                        AND NO SCALING
            BRANCH  ND2RNC2                        GO PROCESS 
            ENDIFZ
  
          IFTHEN ((SIGNOF,REGB),EQ,1)            IF SOURCE SIGNED 
           ANDIF ((SCHAROF,REGB),EQ,0)            AND OVERPUNCH SIGN
           ANDIF ((LDSIGNOF,REGB),EQ,0)           AND TRAILING SIGN 
           ANDIF (T1,LT,10)                       AND 1-REGISTER RESULT 
           ANDIF (T3,EQ,0)                        AND NO SCALING
            BRANCH  ND2RNC3                        GO PROCESS 
            ENDIFZ
  
          ADDZ   T3,18,T1 
  
          IFTHEN (T1,GE,11)                      IF -7 @ SCALE @ 7
          ANDIF  (T1,LE,25) 
            SUBZ   T1,10,T1 
          ELSEZ 
            MOVEZ  0,T1 
            ENDIFZ
  
          IFTHEN ((INTLENOF,REGC),GE,(INTLENOF,REGB)) 
            MOVEZ  0,T4                          NO TRUNCATION
          ELSEZ 
            SUBZ   20,(NUMLENOF,REGC),T4
            ENDIFZ
  
          MULTZ  T1,2,T2                         MAKE ROOM FOR 1 BIT
          ADDZ   T2,(SIGNOF,REGC),T2             1 IFF DEST. IS SIGNED
          LSHIFT T2,5                            MAKE ROOM FOR 5 BITS 
          ADDZ   T2,T4,T2                        TRUNCATION INDICATOR 
          LSHIFT T2,1                            MAKE ROOM FOR 1 BIT
          ADDZ   T2,(SCHAROF,REGB),T2            1 IFF SOURCE SEP. SIGN 
          LSHIFT T2,1                            MAKE ROOM FOR 1 BIT
          ADDZ   T2,(LDSIGNOF,REGB),T2           1 IFF SOURCE LEAD SIGN 
          LSHIFT T2,1                            MAKE ROOM  FOR 1 BIT 
          ADDZ   T2,(SIGNOF,REGB),T2             1 IFF SOURCE SIGNED
          LSHIFT T2,5                            MAKE ROOM FOR 5 BITS 
          ADDZ   T2,(NUMLENOF,REGB),T2           LENGTH OF SOURCE 
  
          IFZ    (T1,EQ,0),ND2RNC1               IF HIDEOUS SCALING 
          NOTE   ND2RNC 
  
          GEN    SXBPK,(VREGOF,VREG1),,T2 
          GEN    SBBPK,(VREGOF,VREG3),,FWASOURC 
          GENOBJ N=C.ND2RN,I=(VREG1,VREG2,VREG3),O=((VREGOF,VREG1),(VREG
,OF,VREG2))                                                VREG2=VREG1+1
 ND2RNC0  LABEL 
  
          ADDZ   (NUMLENOF,REGC),(SIGNOF,REGC),T1 
          IFTHEN (T1,GT,10)                      IF 2-REG DESTINATION 
            MOVEZ  VREG1,(TREGOF,REGC)             POINT TO MOST SIG. 
          ELSEZ                                  IF 1-REG DESTINATION 
            MOVEZ  VREG2,(TREGOF,REGC)             POINT TO LEAST SIG.
            ENDIFZ
          RETURN
  
  
  
  
*                            SCALE < -7  OR  SCALE > 7
 ND2RNC1  LABEL 
          NOTE   ND2RNC1
  
          GEN    SBBPK,(VREGOF,VREG4),,T3        ACTUAL SCALE 
          GEN    SXBPK,(VREGOF,VREG1),,T2        REST OF DESCRIPTOR 
          GEN    PACK,(VREGOF,VREG1),VREG4,VREG1
          GEN    SBBPK,(VREGOF,VREG3),,FWASOURC 
          GENOBJ N=C.ND2RN,I=(VREG1,VREG2,VREG3),O=((VREGOF,VREG1),(VREG
,OF,VREG2))                                                VREG2=VREG1+1
          BRANCH ND2RNC0
          SPACE  4
*                            SOURCE IS UNSIGNED 
*                            RESULT HAS/NEEDS 10 OR LESS SOURCE DIGITS
*                            NO SCALING 
*                            VREG2 = V.R.N. OF X-REGISTER WITH BCP
*                            T1 = NUMBER OF REAL DIGITS TO LOAD 
 ND2RNC2  LABEL 
          NOTE   ND2RNC2
          GEN    SBBPK,(VREGOF,VREG1),,((FWA$OF,REGB))
  
          SUBZ   (NUMLENOF,REGB),(NUMLENOF,REGC),T2 
          IFTHEN (T2,GT,0)
            GEN    SXXPK,(VREGOF,VREG2),VREG2,T2
            ENDIFZ
  
          GEN    SBBPK,(VREGOF,VREG3),,T1 
          GEN    SLRBPK,(VREGOF,VREG4),,((EXT$OF,C.ZEROS))
         GENOBJ N=C.N12RN,I=(VREG1,VREG2,VREG3,VREG4),O=((VREGOF,VREG1))
  
          IFTHEN ((CCTBIT,LBZ),EQ,1)
            GENOBJ N=C.AOPTN,I=(VREG1),O=((VREGOF,VREG1)) 
            ENDIFZ
  
          ADDZ   (NUMLENOF,REGC),(SIGNOF,REGC),T1 
          IFTHEN (T1,GT,10) 
            GEN    SLRBPK,(VREGOF,VREG2),,((EXT$OF,C.ZEROS))
            GEN    XMIT,(VREGOF,VREG3),VREG1               VREG3=VREG2+1
            MOVEZ  VREG2,(TREGOF,REGC)
          ELSEZ 
            MOVEZ  VREG1,(TREGOF,REGC)
            ENDIFZ
  
          RETURN
          SPACE  4
*                            SOURCE HAS TRAILING OVERPUNCH SIGN 
*                            RESULT HAS/NEEDS LESS THAN 10 SOURCE DIGITS
*                            NO SCALING 
*                            VREG2 = V.R.N. OF X-REGISTER WITH BCP
*                            T1 = NUMBER OF REAL DIGITS TO LOAD 
 ND2RNC3  LABEL 
          NOTE   ND2RNC3
          GEN    SBBPK,(VREGOF,VREG1),,((FWA$OF,REGB) 
  
          SUBZ   (NUMLENOF,REGB),(NUMLENOF,REGC),T2 
          IFTHEN (T2,GT,0)
            GEN    SXXPK,(VREGOF,VREG2),VREG2,T2
            ENDIFZ
  
          GEN    SBBPK,(VREGOF,VREG3),,T1 
          GEN    SLRBPK,(VREGOF,VREG4),,((EXT$OF,C.ZEROS))
         GENOBJ N=C.N22RN,I=(VREG1,VREG2,VREG3,VREG4),O=((VREGOF,VREG1))
  
          IFTHEN ((SIGNOF,REGC),EQ,0)            IF DEST. UNSIGNED
            GEN    XMIT,(VREGOF,VREG3),VREG1
            GEN    SHR,VREG3,59 
            GEN    LXOR,(VREGOF,VREG1),VREG1,VREG3
            ENDIFZ
  
          IFTHEN ((NUMLENOF,REGC),GE,10)
           ANDIF ((SIGNOF,REGC),EQ,1) 
            GEN    SLRBPK,(VREGOF,VREG2),,((EXT$OF,C.ZEROS))
            GEN    XMIT,(VREGOF,VREG4),VREG1
            GEN    SHR,VREG4,59 
            GEN    LXOR,(VREGOF,VREG2),VREG2,VREG4         VREG2
            GEN    XMIT,(VREGOF,VREG3),VREG1               VREG3=VREG2+1
            MOVEZ  VREG2,(TREGOF,REGC)
            RETURN
            ENDIFZ
  
          IFTHEN ((NUMLENOF,REGC),GT,10)
            GEN    SLRBPK,(VREGOF,VREG2),,((EXT$OF,C.ZEROS))
            GEN    XMIT,(VREGOF,VREG3),VREG1               VREG3=VREG2+1
            MOVEZ  VREG2,(TREGOF,REGC)
          ELSEZ 
            MOVEZ  VREG1,(TREGOF,REGC)
            ENDIFZ
  
          RETURN
 ND2RND   EJECT 
**        ND2RND - SOURCE SPANS THREE WORDS 
* 
 ND2RND   EGO    3
          NOTE   ND2RND 
          SUBZ   ECP,20,ECP 
          GEN    SLRBPK,(VREGOF,VREG1),,FWASOURC
          GEN    MASK,(VREGOF,VREG2),(ARITH8,BCP)     6*BCP 
          GEN    LIMP,(VREGOF,VREG3),VREG1,VREG2
          GEN    SHL,VREG3,(ARITH8,ECP)               6*ECP 
          SUBZ   BCP,ECP,T1 
          GEN    MASK,(VREGOF,VREG4),(ARITH8,T1)      6*T1
          GEN    SLRBPK,(VREGOF,VREG5),,CBZEROS 
          GEN    LAND,(VREGOF,VREG6),VREG4,VREG5
          GEN    LOR,(VREGOF,VREG7),VREG6,VREG3 
          GEN    SLRAPB,(VREGOF,VREG1),VREG1,VREGB1 
          GEN    SHL,VREG1,(ARITH8,ECP)               6*ECP 
          GEN    MASK,(VREGOF,VREG2),(ARITH7,ECP)     60-6*ECP
          GEN    LIMP,(VREGOF,VREG3),VREG1,VREG2
          GEN    LAND,(VREGOF,VREG4),VREG1,VREG2
          GEN    SLRAPB,(VREGOF,VREG1),VREG1,VREGB1 
          GEN    SHL,VREG1,(ARITH8,ECP)               6*ECP 
          GEN    LIMP,(VREGOF,VREG5),VREG1,VREG2
          GEN    LOR,(VREGOF,VREG1),VREG7,VREG3 
          GEN    LOR,(VREGOF,VREG2),VREG4,VREG5 
          CALLZ  GETSIGN
          CALLZ  ALIGN
          RETURN
**        ND2RNE             SPECIAL CASE SUBSCRIPTED 
* 
 ND2RNE   EGO    3
          MOVEZ  REGB,P1     SUBSCRIPTED DNAT 
          MOVEZ  1,P2        JUSTIFY RIGHT
          MOVEZ  0,P3        DONT FILL
          CALLZ  SCLOAD 
          MOVEZ  P4,VREG1    WORD CONTAINING ITEM 
*      DUPLICATE ND2RNA SETUP 
          ANDZ   (SCHAROF,REGB),(LDSIGNOF,REGB),T1
          SUBZ   10,(BYTLENOF,REGB),T4           BCP
          ADDZ   T4,T1,T1 
          MINZ   (INTLENOF,REGB),(INTLENOF,REGC),T2 
          MINZ   (POINTOF,REGB),(POINTOF,REGC),T3 
          ADDZ   T2,T3,LENMASK
          SUBZ   (INTLENOF,REGB),T2,T2
          ADDZ   T1,T2,BCPMASK
          ADDZ   T1,(INTLENOF,REGB),T2
          SUBZ   10,(POINTOF,REGC),T3 
          SUBZ   (ARITH8,T2),(ARITH8,T3),LSHIFTCT 
          QUOTZ  (ARITH9,LSHIFTCT),6,LSHIFTCT 
          SUBZ   (ARITH8,BCPMASK),(ARITH8,LSHIFTCT),BCPMASK 
          QUOTZ  (ARITH9,BCPMASK),6,BCPMASK 
          IFZ    ((SIGNOF,REGB),EQ,0),ND2RNA6    SOURCE UNSIGNED
          IFZ    ((SCHAROF,REGB),EQ,0),ND2RN5A   SEPARATE CHARACTER 
          IFZ    ((SIGNOF,REGC),EQ,0),ND2RNA5    DESTINATION UNSIGNED 
          IFTHEN ((LDSIGNOF,REGB),EQ,1) 
            SUBZ   10,(BYTLENOF,REGB),T1
          ELSEZ 
            MOVEZ  9,T1 
          ENDIFZ
          BRANCH ND2RNA3A 
          SPACE  3
 ND2RN5A  LABEL              INCLUDED SIGN
          IFTHEN ((LDSIGNOF,REGB),EQ,1)          LEADING SIGN 
            SUBZ   10,(BYTLENOF,REGB),T1
            ADDZ   1,T1,T1                       BCP+1
          ELSEZ                                  TRAILING SIGN
            MOVEZ  0,T1 
          ENDIFZ
          IFZ    (LENMASK,EQ,10),ND2RNA2
          BRANCH ND2RNA1
 ALIGN    EJECT 
***       ALIGN - CONVERT LOADED ITEM TO REQUIRED NUMLEN AND POINT
* 
 ALIGN    EGO    4
          MOVEZ  LOADREG,REGT 
          CALLZ  ADNAT
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGT)
          MOVEZ  (POINTOF,REGB),(POINTOF,REGT)
          MOVEZ  (SIGNOF,REGB),(SIGNOF,REGT)
          MOVEZ  VREG1,(TREGOF,REGT)
          PUSH   REGB 
          MOVEZ  REGT,REGB
          CALLZ  RN2RN
          POP    REGB 
          CALLZ  SUBDNAT
          RETURN
 GETSIGN  EJECT 
**        GETSIGN - CONVERT SIGN TO NINE"S COMPLEMENT 
* 
 GETSIGN  EGO    4
          IFZ    ((SIGNOF,REGB),EQ,0),RETURN
          IFTHEN ((SCHAROF,REGB),EQ,0)
            CALLZ  GETIN
          ELSEZ 
            CALLZ  GETSC
          ENDIFZ
          NOTE   GETSIGN
          IFTHEN ((NUMLENOF,REGB),LT,10)
            MOVEZ  VREG1,P1 
            MOVEZ  VREG3,P2 
            CALLZ  SIGNSS 
          ENDIFZ
          IFTHEN ((NUMLENOF,REGB),EQ,10)
            MOVEZ  VREG1,P1 
            MOVEZ  VREG3,P2 
            CALLZ  SIGNSD 
            MOVEZ  P3,VREG1 
          ENDIFZ
          IFTHEN ((NUMLENOF,REGB),GT,10)
            GEN    XMIT,(VREGOF,VREG1),VREG1
            GEN    XMIT,(VREGOF,VREG2),VREG2
            GEN    HOLDR,VREG1
            GEN    HOLDR,VREG2
            MOVEZ  (LOCLAB,T1),T1 
            GEN    PL$,VREG3,,((LOCAL$OF,T1)) 
            GEN    SLRBPK,(VREGOF,VREG10),,CBZEROS
            GEN    ISUB,(VREGOF,VREG11),VREG10,VREG1
            MOVEZ  (LOCLAB,T2),T2 
            GEN    NZ$,VREG11,,((LOCAL$OF,T2))
            GEN    ISUB,(VREGOF,VREG11),VREG10,VREG2
            GEN    ZR$,VREG11,,((LOCAL$OF,T1))
            GEN    LABEL$,((LOCAL$OF,T2)) 
            GEN    COMPL,VREG1,,VREG1 
            GEN    COMPL,VREG2,,VREG2 
            GEN    LABEL$,((LOCAL$OF,T1)) 
            GEN    RFREE,VREG1
            GEN    RFREE,VREG2
          ENDIFZ
          RETURN
          SPACE  3
 GETSC    EGO    5           SIGN SEPARATE CHARACTER
          NOTE   GETSC
          IFTHEN ((LDSIGNOF,REGB),EQ,1) 
            ADDZ   (ARITH2,REGB),4,T1                 6*BCP 
            GEN    SLRBPK,(VREGOF,VREG3),,FWASOURC
          ELSEZ 
            SUBZ   (ARITH1,REGB),1,T1 
            MOVEZ  0,T2 
            IFZ    (T1,LT,10),GETSC1
            SUBZ   T1,10,T1            SPANS TWO WORDS
            ADDZ   1,T2,T2
            IFZ    (T1,LT,10),GETSC1
            SUBZ   T1,10,T1            SPANS THREE WORDS
            ADDZ   1,T2,T2
 GETSC1   LABEL 
            GEN    SLRBPK,(VREGOF,VREG3),,((FWA$OF,REGB),T2)
            ADDZ   (ARITH8,T1),4,T1 
          ENDIFZ
          GEN    SHL,VREG3,T1 
          RETURN
          SPACE  3
 GETIN    EGO    5           SIGN INCLODED
          IFZ    ((LDSIGNOF,REGB),EQ,0),GETIN1
          NOTE   GETIN
          IFTHEN ((NUMLENOF,REGB),LE,10)
            SUBZ   11,(NUMLENOF,REGB),T1
          ELSEZ 
            SUBZ   21,(NUMLENOF,REGB),T1
          ENDIFZ
          GEN    SHL,VREG1,(ARITH8,T1)
          GEN    MASK,(VREGOF,VREG4),54 
          GEN    LIMP,(VREGOF,VREG5),VREG1,VREG4
          GEN    SLRXPK,(VREGOF,VREG3),VREG5,CBSTRP 
          GEN    SXXPB,(VREGOF,VREG6),VREG3 
          GEN    LXOR,(VREGOF,VREG1),VREG1,VREG6
          GEN    SHL,VREG1,(ARITH7,T1)           60-6*T1
          RETURN
          SPACE  3
 GETIN1   LABEL              SIGN TRAILING
          NOTE   GETIN1 
          GEN    MASK,(VREGOF,VREG4),54 
          IFTHEN ((NUMLENOF,REGB),LE,10)
            GEN    LIMP,(VREGOF,VREG5),VREG1,VREG4
            GEN    SLRXPK,(VREGOF,VREG3),VREG5,CBSTRP 
            GEN    SXXPB,(VREGOF,VREG6),VREG3 
            GEN    LXOR,(VREGOF,VREG1),VREG1,VREG6
          ELSEZ 
            GEN    LIMP,(VREGOF,VREG5),VREG2,VREG4
            GEN    SLRXPK,(VREGOF,VREG3),VREG5,CBSTRP 
            GEN    SXXPB,(VREGOF,VREG6),VREG3 
            GEN    LXOR,(VREGOF,VREG2),VREG2,VREG6
          ENDIFZ
          RETURN
          SPACE  4
          EJECT 
**
*         SIGNSS - GENERATE SIGN CODE FOR SINGLE PRECISION SOURCE 
*                  AND DESTINATION
*         INPUT 
*                P1 - VREG NUMBER OF LOADED ITEM
*                P2 - VREG NUMBER OF SIGN 
 SIGNSS   EGO    5
          NOTE   SIGNSS 
          GEN    HOLDR,P1 
          MOVEZ  (LOCLAB,T1),T1 
          GEN    PL$,P2,,((LOCAL$OF,T1))
          GEN    SLRBPK,(VREGOF,VREG10),,CBZEROS
          GEN    ISUB,(VREGOF,VREG11),VREG10,P1 
          GEN    ZR$,VREG11,,((LOCAL$OF,T1))
          GEN    COMPL,P1,,P1 
          GEN    LABEL$,((LOCAL$OF,T1)) 
          GEN    RFREE,P1 
          RETURN
          EJECT 
**
*         SIGNSD - GENERATE SIGN CODE FOR SINGLE PRECISION SOURCE,
*                  DOUBLE PRECISION DESTINATION 
*         INPUT 
*                P1 - VREG NUMBER OF LOADED ITEM
*                P2 - VREG NUMBER OF SIGN 
*         OUTPUT
*                P3   -  VREG NUMBER OF LOADED DOUBLE PRECISION ITEM
 SIGNSD   EGO    5
          NOTE   SIGNSD 
          GEN    SLRBPK,(VREGOF,VREG10),,CBZEROS
          GEN    XMIT,(VREGOF,VREG11),VREG10
          GEN    XMIT,(VREGOF,VREG12),P1
          GEN    HOLDR,VREG11 
          GEN    HOLDR,VREG12 
          MOVEZ  (LOCLAB,T1),T1 
          GEN    PL$,P2,,((LOCAL$OF,T1))
          GEN    ISUB,(VREGOF,VREG13),VREG10,VREG12 
          GEN    ZR$,VREG13,,((LOCAL$OF,T1))
          GEN    COMPL,VREG11,,VREG11 
          GEN    COMPL,VREG12,,VREG12 
          GEN    LABEL$,((LOCAL$OF,T1)
          GEN    RFREE,VREG11 
          GEN    RFREE,VREG12 
          MOVEZ  VREG11,P3
          RETURN
          END 
