*DECK GMOVR1
          IDENT  GMOVR1 
          TITLE  GMOVR1 - GENERATE R12XX MOVES
  
          MACHINE  ANY,I
          SST 
          COMMENT  GENERATE R12XX MOVES 
          SPACE  4
**        GMOVR1 - GENERATE R12XX MOVES 
* 
* R12AE   LINK   CGR12AE
* R12AN   LINK   CGR12AN
* R12C1   LINK   CGR12C1
* R12C2   LINK   CGR12C2
* R12ND   LINK   CGR12ND
* R12NE   LINK   CGR12NE
* R12RN   LINK   CGR12RN
* R12R1   LINK   CGR12R1
* R12R2   LINK   CGR12R2
* R12R4   LINK   CGR12R4
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
  
*      COMDECKS 
  
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
  
*CALL CCT 
  
          EJECT 
 GMOVR1   MODULE
  
*      REGTABLE EQUATES 
  
  
 MOVEREGA EQU    REGB 
 MOVEREGB EQU    REGC 
 MOVEREGD EQU    REGQ 
 MOVEREGE EQU    REGR 
 MOVEREGF EQU    REGS 
 MOVEREGM EQU    REGM 
  
*      VIRTUAL REGISTER EQUATES 
  
 VREGA    EQU    VREG1
 VREGB    EQU    VREG2
 VREGC    EQU    VREG3
 VREGD    EQU    VREG9
 VREGE    EQU    VREG5
 VREGF    EQU    VREG6
 VREGG    EQU    VREG7
 VREGH    EQU    VREG8
 VREGI    EQU    VREG9
 VREGJ    EQU    VREG10 
 VREGK    EQU    VREG11 
 VREGL    EQU    VREG12 
 VREGU    EQU    VREG16 
 VREGV    EQU    VREG17 
 VREGW    EQU    VREG18 
 VREGX    EQU    VREG4
 VREGAC   EQU    VREG1
  
*      FIXED TABLE EQUATES
  
  
*      ERROR EQUATES
  
 MOVEERR1 EQU    4301 
  
*      MISCELLANEOUS EQUATES
  
  
*      LINKAGE FROM CALLING ROUTINES IN OTHER MODULES 
  
 R12AE    KNIL   CGR12AE
 R12AN    KNIL   CGR12AN
 R12C1    KNIL   CGR12C1
 R12C2    KNIL   CGR12C2
 R12C4    KNIL   CGR12C4
 R12ND    KNIL   CGR12ND
 R12NE    KNIL   CGR12NE
 R12RN    KNIL   CGR12RN
 R12R1    KNIL   CGR12R1
 R12R2    KNIL   CGR12R2
 R12R4    KNIL   CGR12R4
  
*      LINKAGE TO CALLED ROUTINES IN OTHER MODULES
  
 ADNAT    LINK   ADNAT       * TO CGSTART 
 RN2AE    LINK   CGRN2AE     * TO GMOVRN
 RN2ND    LINK   CGRN2ND     * TO GMOVSTO 
 RN2NE    LINK   CGRN2NE     * TO GMOVRN
 STORC1C2 LINK   CGSTORC     * TO GMOVSUB 
 STORC4   LINK   STORC4      *  TO  GMOVSUB 
 SUBDNAT  LINK   SUBDNAT     * TO CGSTART 
  
*      SYMBOLIC PARAMETER DEFINITIONS 
  
 CBFTENS  SETSY  (EXT$OF,C.FTENS),T1
 CBITENS  SETSY  (EXT$OF,C.ITENS),T1
 CBZEROS  SETSY  (EXT$OF,C.ZEROS) 
#0.1S20   CONSTANT  1S20/10+1 
#0.01S23  CONSTANT  1S23/100+1
#5'6      CONSTANT  5*5*5*5*5*5 
#5'7      CONSTANT  5*5*5*5*5*5*5 
          SPACE  4
          LISTSEC  R12AE
          TITLE  R12AE -  REGISTER COMP-1 TO ALPHANUMERIC-EDITED ITEM 
**        R12AE -  REGISTER COMP-1 TO ALPHANUMERIC-EDITED ITEM
* 
*         REGB = DNAT POINTER TO SOURCE REGISTER. 
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER. 
*         (NUMLENOF,REGB) = NUMBER OF DIGITS IN SOURCE VALUE. 
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 999V99 _ 2)
*         (SIGNOF,REGB) = 1 IFF SOURCE IS SIGNED. 
*         REGC = DNAT POINTER TO DESTINATION ITEM.
* 
*         CALLZ  R12AE
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
* 
*         USES-  REGU2
*                SAVREGB1    (ALSO BY RN2AE)
*                REGU1       (BY RN2AE) 
*                SAVREGC1    (BY RN2AE) 
  
  
 R12AE    EGO    2
          NOTE   R12AE
  
*      CREATE A DUMMY DNAT
  
          MOVEZ  (EQUALS,REGU2),REGT             REGU2 TO POINT TO DNAT 
          CALLZ  ADNAT                           CREATE DNAT
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGU2) 
          MOVEZ  (POINTOF,REGB),(POINTOF,REGU2) 
          MOVEZ  0,(SIGNOF,REGU2) 
  
*      CONVERT R1 (IN REGB) TO RN (IN REGU2)
  
          PUSH   REGC 
          MOVEZ  (EQUALS,REGU2),REGC             THIS DEST. IS REGU2
          CALLZ  R12RN                           CONVERT (REGB) _ (REGC)
          POP    REGC 
  
*      CONVERT RN (IN REGU2) TO AE (IN REGC)
  
          PUSH   REGB 
          MOVEZ  (EQUALS,REGU2),REGB             THIS SOURCE IS REGU2 
          CALLZ  RN2AE                           CONVERT (REGB) _ (REGC)
          POP    REGB 
  
          CALLZ  SUBDNAT                         DELETE REGU2 DNAT
          RETURN
          SPACE  4
          LISTSEC  R12AN
          TITLE  R12AN -  REGISTER COMP-1 TO ALPHANUMERIC ITEM
**        R12AN -  REGISTER COMP-1 TO ALPHANUMERIC ITEM 
* 
*         REGB = DNAT POINTER TO SOURCE REGISTER
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER. 
*         (NUMLENOF,REGB) = NUMBER OF DIGITS IN SOURCE VALUE. 
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 9999V99 _ 2) 
*         (SIGNOF,REGB) = 1 IFF SOURCE IS SIGNED. 
*         REGC = DNAT PONTER TO DESTINATION ITEM. 
* 
*         CALLZ  R12AN
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
 R12AN    EGO    2
          NOTE   R12AN
          ERROR  MOVEERR1 
          RETURN
          SPACE  4
          LISTSEC  R12C1
          TITLE  R12C1 -  REGISTER COMP-1 TO COMP-1 
**        R12C1 -  REGISTER COMP-1 TO COMP-1
* 
*         REGB = DNAT POINTER TO SOURCE REGISTER. 
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER. 
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 999 _ 0) 
*         (NUMLENOF,REGB) = NUMBER OF DECIMAL DIGITS. 
*         REGC = DNAT POINTER TO DESTINATION ITEM.
*         (FWA$OF,REGC) = ADDRESS.
*         (POINTOF,REGC) = POSITOIN OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 9PP _ 2) 
* 
*         CALLZ  R12C1
* 
*         GENERATES CODE TO PERFORM ANY NECESSARY SCALING 
*           AND STORE THE RESULT. 
* 
*         USES-  REGU1
*                SAVREGC1 
* 
*         USES-  REGU1
*                SAVREGC1 
  
  
 R12C1    EGO    2
  
*      CREATE A DUMMY DESTINATION DNAT
  
          MOVEZ  (EQUALS,REGU1),REGT             REGU1 TO POINT TO DNAT 
          CALLZ  ADNAT                           CREATE DNAT
          MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGU1) 
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGU1) 
          MOVEZ  (POINTOF,REGC),(POINTOF,REGU1) 
          MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGU1) 
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGU1) 
  
*      SCALE R1 (IN REGB) TO R1 (IN REGU1)
  
          PUSH   REGC 
          MOVEZ  (EQUALS,REGU1),REGC             THIS DEST. IS REGU1
          CALLZ  R12R1                           CONVERT (REGB) _ (REGC)
  
          POP    REGC 
  
          CALLZ  SUBDNAT                         DELETE DUMMY DNAT
  
*      CONVERT R1 (IN REGU1) TO C1 (IN REGC)
  
          NOTE   R12C1
          MOVEZ  (TREGOF,REGU1),P1
          CALLZ  STORC1C2 
  
          RETURN
          SPACE  4
          LISTSEC  R12C2
          TITLE  R12C2 -  REGISTER COMP-1 TO COMP-2 
**        R12C2 -  REGISTER COMP-1 TO COMP-2
* 
*         REGB = DNAT POINTER TO SOURCE REGISTER. 
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER. 
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 999V99 _ 2)
*         (NUMLENOF,REGB) = NUMBER OF DECIMAL DIGITS. 
*         REGC = DNAT POINTER TO DESTINATION ITEM.
*         (FWA$OF,REGC) = ADDRESS OF DESTINATION ITEM.
* 
*         CALLZ  R12C2
* 
*         GENERATES CODE TO PERFORM ANY NECESSARY SCALING,
*           CONVERTS TO COMP-2 FORMAT AND STORES RESULT INTO MEMORY.
* 
*         USES-  REGU1
  
  
 R12C2    EGO    2
          NOTE   R12C2
  
          MOVEZ  (TREGOF,REGB),VREG1
  
          SUBZ   0,(POINTOF,REGB),T1
*         (POINTOF,REGC) = 0
          IFZ    (T1,EQ,0),R12C22                IF NO SCALING
          IFZ    (T1,EQ,1),R12C23                IF MULT BY 10
  
  
*                            MULTIPLY BY 10'-(POINTOF,REGB) 
 R12C21   LABEL 
          NOTE   R12C21 
          SUBZ   0,T1,T1
          GEN    SLRBPK,(VREGOF,VREG4),,CBFTENS  (+T1)
          GEN    PACK,(VREGOF,VREG1),,VREG1 
          GEN    NORM,(VREGOF,VREG1),,VREG1 
          GEN    FMUL,(VREGOF,VREG1),VREG1,VREG4
  
          MOVEZ  VREG1,P1 
          CALLZ  STORC1C2 
  
          RETURN
  
  
*                            NO SCALING 
 R12C22   LABEL 
          NOTE   R12C22 
          GEN    PACK,(VREGOF,VREG1),,VREG1 
          GEN    NORM,(VREGOF,VREG1),,VREG1 
  
          MOVEZ  VREG1,P1 
          CALLZ  STORC1C2 
  
          RETURN
  
  
*                            MULTIPLY BY 10 
          SPACE  4
          LISTSEC  R12C4
          TITLE  R12C4 - STORE COMP-1 REGISTER TO COMP-4 ITEM 
************************************************************************
*         R12C4  -REGITER COMP-1 TO COMP-4 ITEM                        *
*                                                                      *
*         REGB=  DNAT POINTER TO SOURCE REGISTER                       *
*         REGC=  DNAT POINTER  TO DESTIN. ITEM                         *
*                                                                      *
*         CALLZ  R12C4                                                 *
*                                                                      *
*         GENERATE CODE TO DO THE NECESSARY SCALING                    *
*                            AND STORE THE RESULT                      *
*                                                                      *
*         USES   REGU1                                                 *
************************************************************************
* 
 R12C4    EGO    2
* 
*      CREATE A DUMMY DESTINATION DNAT
* 
          MOVEZ  REGU1,REGT                       REGU1 POINTS TO DNAT
          CALLZ  ADNAT
          MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGU1) 
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGU1) 
          MOVEZ  (POINTOF,REGC),(POINTOF,REGU1) 
* 
*      SCALE  R1 (IN REGB) TO R1 (IN REGU1) 
          PUSH   REGC 
          MOVEZ  REGU1,REGC                         THIS DESTIN IS REGU1
          CALLZ  R12R1                              CONVERT AND SCALE 
          POP    REGC 
* 
          CALLZ  SUBDNAT                            DELETE DNAT 
* 
*       NOW STORE RESULT
* 
          NOTE   R12C4
          MOVEZ  (TREGOF,REGU1),P1
          CALLZ  STORC4 
* 
          RETURN
 R12C23   LABEL 
          NOTE   R12C23 
          GEN    IADD,(VREGOF,VREG2),VREG1,VREG1           *2 
          GEN    SHL,VREG1,3                               *8 
          GEN    IADD,(VREGOF,VREG1),VREG1,VREG2           *10
          GEN    PACK,(VREGOF,VREG1),,VREG1 
          GEN    NORM,(VREGOF,VREG1),,VREG1 
  
          MOVEZ  VREG1,P1 
          CALLZ  STORC1C2 
  
          RETURN
          SPACE  4
          LISTSEC  R12ND
          TITLE  R12ND -  REGISTER COMP-1 TO NUMERIC DISPLAY ITEM 
**        R12ND -  REGISTER COMP-1 TO NUMERIC DISPLAY ITEM
* 
*         REGB = DNAT POINTER TO SOURCE REGISTER. 
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER. 
*         (NUMLENOF,REGB) = NUMBER OF DIGITS IN SOURCE VALUE. 
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 9V999 _ 3) 
*         (SIGNOF,REGB) = 1 IFF SOURCE IS SIGNED. 
*         REGC = DNAT POINTER TO DESTINATION ITEM.
*         FWARECV = ADDRESS OF DESTINATION. 
*         (NUMLENOF,REGC) = NUMBER OF DIGITS IN DESTINATION.
*         (POINTOF,REGC) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.
*         (SIGNOF,REGC) = 1 IFF DESTINATION IS SIGNED.
*         (LDSIGNOF,REGC) = U IFF DESTINATION HAS LEADING SIGN. 
*         (SCHAROF,REGC) = 1 IFF DESTINATION HAS SEPARATE SIGN. 
* 
*         CALLZ  R12ND
* 
*         GENERATES CODE TO PERFOMR THE INDICATED MOVE. 
* 
*         USES-  REGU2
*                SAVREGB1 
*                SAVREGC2 
*                REGU1       (BY R12RN) 
*                SAVREGC1    (BY R12RN) 
  
  
 R12ND    EGO    2
          NOTE   R12ND
  
*      CREATE A DUMMY DNAT
  
          MOVEZ  (EQUALS,REGU2),REGT             REGU2 TO POINT TO DNAT 
          CALLZ  ADNAT                           CREATE DNAT
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGU2) 
          MOVEZ  (POINTOF,REGB),(POINTOF,REGU2) 
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGU2) 
  
*      CONVERT R1 (IN REGB) TO RN (IN REGU2)
  
          PUSH   REGC 
          MOVEZ  (EQUALS,REGU2),REGC             THIS DEST. IS REGU2
          CALLZ  R12RN                           CONVERT (REGB) _ (REGC)
          POP    REGC 
  
*      CONVERT RN (IN REGU2) TO ND (IN REGC)
  
          PUSH   REGB 
          MOVEZ  (EQUALS,REGU2),REGB             THIS SOURCE IS REGU2 
          CALLZ  RN2ND                           CONVERT (REGB) _ (REGC)
          POP    REGB 
  
          CALLZ  SUBDNAT                         DELETE REGU2 DNAT
          RETURN
          SPACE  4
          LISTSEC  R12NE
          TITLE  R12NE -  REGISTER COMP-1 TO NUMERIC-EDITED ITEM
**        R12NE -  REGISTER COMP-1 TO NUMERIC-EDITED ITEM 
* 
*         REGB = DNAT POINTER TO SOURCE REGISTER. 
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER. 
*         (NUMLENOF,REGB) = NUMBER OF DIGITS IN SOURCE. 
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 99V999 _ 3)
*         (SIGNOF,REGB) =  1 IFF SOURCE IS SIGNED.
*         REGC = DNAT POINTER TO DESTINATION ITEM.
* 
*         CALLZ  R12NE
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
* 
*         USES-  REGU2
*                SAVREGB1 
*                SAVREGC2 
*                REGU1       (BY R12RN, AND BY RN2NE) 
*                SAVREGC1    (BY R12RN, AND BY RN2NE) 
  
  
 R12NE    EGO    2
          NOTE   R12NE
  
*      CREATE A DUMMY DNAT
  
          MOVEZ  (EQUALS,REGU2),REGT             REGU2 TO POINT TO DNAT 
          CALLZ  ADNAT                           CREATE DNAT
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGU2) 
          MOVEZ  (POINTOF,REGB),(POINTOF,REGU2) 
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGU2) 
  
*      CONVERT R1 (IN REGB) TO RN (IN REGU2)
  
          PUSH   REGC                            SAVE ORIG. DESTINATION 
          MOVEZ  REGU2,REGC                      THIS DEST. IS REGU2
          CALLZ  R12RN                           CONVERT (REGB) _ (REGC)
          POP    REGC                            RESTORE ORIGINAL DEST. 
  
*      CONVERT RN (IN REGU2) TO NE (IN REGC)
  
          PUSH   REGB                            SAVE ORIGINAL SOURCE 
          MOVEZ  REGU2,REGB                      THIS SOURCE IS REGU2 
          CALLZ  RN2NE                           CONVERT (REGB) _ (REGC)
          POP    REGB                            RESTORE ORIGINAL SOURCE
  
          CALLZ  SUBDNAT                         DELETE REGU2 DNAT
          RETURN
          SPACE  4
          LISTSEC  R12RN
          TITLE  R12RN -  REGISTER COMP-1 TO REGISTER NUMERIC DISPLAY 
**        R12RN -  REGISTER COMP-1 TO REGISTER NUMERIC DISPLAY
* 
*         CALLING ROUTINE MUST ENSURE THAT SCALING DOES NOT RESULT
*         IN MORE THAN 14 DIGITS
* 
* 
*         REGB = DNAT POINTER TO SOURCE REGISTER. 
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER. 
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 999V99 _ 2)
*         (NUMLENOF,REGB) = NUMBER OF DECIMAL DIGITS. 
*         REGC = DNAT POINTER TO DESTINATION ITEM.
*         FWARECV = ADDRESS OF DESTINATION ITEM.
*         (POINTOF,REGC) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.
*         (NUMLENOF,REGC) = NUMBER OF DECIMAL DIGITS. 
* 
*         CALLZ  R12RN
* 
*         SCALES THE COMP-1 ITEM AND CONVERTS IT TO NUMERIC DISPLAY.
* 
*         USES-  REGU1
*                SAVREGC1 
* 
*         ALSO CALLED BY- 
*                C12NE
*                R22RN
  
  
 R12RN    EGO    2
          NOTE   R12RN
  
*      CREATE A DUMMY DNAT
  
          MOVEZ  (EQUALS,REGU1),REGT             REGU1 TO POINT TO DNAT 
          CALLZ  ADNAT                           CREATE DNAT
          MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGU1) 
          MOVEZ  (POINTOF,REGC),(POINTOF,REGU1) 
          MOVEZ  (SIGNOF,REGB),(SIGNOF,REGU1) 
  
*      CONVERT R1 (IN REGB) TO R1 (IN REGU1)
  
          PUSH   REGC 
          MOVEZ  (EQUALS,REGU1),REGC             THIS DEST. IS REGU1
          CALLZ  R12R1                           SCALE (REGB) _ (REGC)
          POP    REGC 
  
*      SET T2 = 1 IFF DESTINATION IS 2 REGISTER 
  
          QUOTZ  (NUMLENOF,REGC),11,T2           0 IFF 1-10, ELSE 1 
          IFTHEN ((NUMLENOF,REGC),EQ,10)         IF 10 DIGIT DESTINATION
           ANDIF ((SIGNOF,REGC),EQ,1)              AND DEST. SIGNED 
            MOVEZ  1,T2                              THEN T2 = 1
            ENDIFZ
  
*      CONVERT THE REGISTER DESCRIBED BY THE REGU1 DNAT 
*      INTO NUMERIC DISPLAY AS DESCRIBED BY THE REGC DNAT.
  
          SUBZ   (POINTOF,REGC),(POINTOF,REGB),T1 
          ADDZ   T1,(NUMLENOF,REGB),T1 ADJUSTED SENDING LENGTH
          IFZ    (T1,EQ,1),R12RN1                IF 1 DIGIT 
          IFZ    (T1,EQ,2),R12RN5                IF 2 DIGITS
          IFZ    (T1,LE,6),R12RN12               IF 3-6 DIGITS
          IFZ    (T1,LE,9),R12RN19               IF 7-9 DIGITS
          IFZ    (T1,EQ,10),R12RN22              IF 10 DIGITS 
          BRANCH R12RN29                         IF 11-14 DIGITS
  
  
*                            1 DIGIT SOURCE 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS ONE WORD
 R12RN1   LABEL 
          IFZ    ((SIGNOF,REGU1),EQ,0),R12RN3    IF SOURCE UNSIGNED 
          IFZ    (T2,EQ,1),R12RN2                IF 2 WORD DESTINATION
  
          NOTE   R12RN1 
          GEN    SLRBPK,(VREGOF,VREG2),,CBZEROS 
          GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
          GEN    SHR,VREG3,59 
          GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGU1),VREG3 
          GEN    IADD,(VREGOF,VREG1),VREG2,VREG1
  
          IFTHEN ((SIGNOF,REGC),EQ,1)            IF DESTINATION SIGNED
            GEN    LXOR,(VREGOF,VREG1),VREG1,VREG3
            ENDIFZ
  
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          RETURN
  
  
*                            1 DIGIT SOURCE 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS TWO WORDS 
 R12RN2   LABEL 
          NOTE   R12RN2 
          GEN    SLRBPK,(VREGOF,VREG1),,CBZEROS            VREG1
          MOVEZ  (VREGOF,VREG2),VREG2                      VREG2=VREG1+1
          GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
          GEN    SHR,VREG3,59 
          GEN    LXOR,(VREGOF,VREG4),(TREGOF,REGU1),VREG3 
          GEN    IADD,VREG2,VREG1,VREG4                    VREG2
  
          IFTHEN ((SIGNOF,REGC),EQ,1)            IF DESTINATION SIGNED
            GEN    LXOR,(VREGOF,VREG1),VREG1,VREG3         VREG1
            GEN    LXOR,(VREGOF,VREG2),VREG2,VREG3         VREG2=VREG1+1
            ENDIFZ
  
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          RETURN
  
  
*                            1 DIGIT SOURCE 
*                            SOURCE IS UNSIGNED 
*                            DESTINATION IS 1 WORD
 R12RN3   LABEL 
          IFZ    (T2,EQ,1),R12RN4                IF 2 WORD DESTINATION
  
          NOTE   R12RN3 
          GEN    SLRBPK,(VREGOF,VREG2),,CBZEROS 
          GEN    IADD,(VREGOF,VREG1),VREG2,(TREGOF,REGU1) 
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            1 DIGIT SOURCE 
*                            SOURCE IS UNSIGNED 
*                            DESTINATION IS 2 WORDS 
 R12RN4   LABEL 
          NOTE   R12RN4 
          GEN    SLRBPK,(VREGOF,VREG1),,CBZEROS            VREG1
          GEN    IADD,(VREGOF,VREG2),VREG1,(TREGOF,REGU1)  VREG2=VREG1+1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            2 DIGIT SOURCE 
 R12RN5   LABEL 
          IFZ    ((SIGNOF,REGB),EQ,0),R12RN10    IF SOURCE UNSIGNED 
          IFZ    ((SIGNOF,REGC),EQ,1),R12RN8     IF DESTINATION SIGNED
          IFZ    (T2,EQ,1),R12RN7                IF 2-WORD DESTINATION
  
*                            SOURCE IS 2 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS UNSIGNED
*                            DESTINATION IS 1 WORD
 R12RN6   LABEL                                  (CROSS-REFS ONLY)
          NOTE   R12RN6 
          GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
          GEN    SHR,VREG3,59 
          GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGU1),VREG3 
          GENOBJ N=C.R1U02,I=(VREG1),O=((VREGOF,VREG1)) 
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
*                            SOURCE IS 2 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS UNSIGNED
*                            DESTINATION IS 2 WORDS 
 R12RN7   LABEL 
          NOTE   R12RN7 
          GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
          GEN    SHR,VREG3,59 
          GEN    LXOR,(VREGOF,VREG2),(TREGOF,REGU1),VREG3 
          MOVEZ  (VREGOF,VREG1),VREG1                      RESERVE VREG1
          GENOBJ N=C.R1U02,I=(VREG2),O=((VREGOF,VREG2))    VREG2=VREG1+1
          GEN    SLRBPK,VREG1,,CBZEROS                     VREG1
          CALLZ  SUBDNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 2 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS SIGNED
*                            DESTINATION IS 1 WORD
 R12RN8   LABEL 
          IFZ    (T2,EQ,1),R12RN9                IF 2-WORD DESTINATION
  
          NOTE   R12RN8 
          GENOBJ N=C.R1S02,I=((TREGOF,REGU1)),O=((VREGOF,VREG1))
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 2 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS SIGNED
*                            DESTINATION IS 2 WORDS 
 R12RN9   LABEL 
          NOTE   R12RN9 
          MOVEZ  (VREGOF,VREG1),VREG1                      RESERVE VREG1
          GENOBJ N=C.R1S02,I=((TREGOF,REGU1)),O=((VREGOF,VREG2))
                                                           VREG2=VREG1+1
          GEN    SLRBPK,(VREGOF,VREG4),,CBZEROS 
          GEN    XMIT,(VREGOF,VREG3),VREG2
          GEN    SHR,VREG3,59 
          GEN    LXOR,VREG1,VREG4,VREG3                    VREG1
          CALLZ  SUBDNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 2 DIGITS 
*                            SOURCE IS UNSIGNED 
*                            DESTINATION IS 1 WORD
 R12RN10  LABEL 
          IFZ    (T2,EQ,1),R12RN11               IF 2-WORD DESTINATION
  
          NOTE   R12RN10
          GENOBJ N=C.R1U02,I=((TREGOF,REGU1)),O=((VREGOF,VREG1))
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 2 DIGITS 
*                            SOURCE IS UNSIGNED 
*                            DESTINATION IS 2 WORDS 
 R12RN11  LABEL 
          NOTE   R12RN11
          MOVEZ  (VREGOF,VREG1),VREG1                      RESERVE VREG1
          GENOBJ N=C.R1U02,I=((TREGOF,REGU1)),O=((VREGOF,VREG2))
                                                           VREG2=VREG1+1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          GEN    SLRBPK,VREG1,,CBZEROS                     VREG1
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 3-6 DIGITS 
 R12RN12  LABEL 
          IFZ    ((SIGNOF,REGB),EQ,0),R12RN17    IF SOURCE UNSIGNED 
          IFZ    ((SIGNOF,REGC),EQ,1),R12RN15    IF DESTINATION SIGNED
          IFZ    (T2,EQ,1),R12RN14               IF 2-WORD DESTINATION
  
*                            SOURCE IS 3-6 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS UNSIGNED
*                            DESTINATION IS 1 WORD
 R12RN13  LABEL                                  (CROSS-REFS ONLY)
          NOTE   R12RN13
          GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
          GEN    SHR,VREG3,59 
          GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGU1),VREG3 
          GENOBJ N=C.R1U06,I=(VREG1),O=((VREGOF,VREG1)) 
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 3-6 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS UNSIGNED
*                            DESTINATION IS 2 WORDS 
 R12RN14  LABEL 
          NOTE   R12RN14
          GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
          GEN    SHR,VREG3,59 
          GEN    LXOR,(VREGOF,VREG2),(TREGOF,REGU1),VREG3 
          MOVEZ  (VREGOF,VREG1),VREG1                      RESERVE VREG1
          GENOBJ N=C.R1U06,I=(VREG1),O=((VREGOF,VREG2))    VREG2=VREG1+1
          GEN    SLRBPK,VREG1,,CBZEROS                     VREG1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 3-6 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS SIGNED
*                            DESTINATION IS 1 WORD
 R12RN15  LABEL 
          IFZ    (T2,EQ,1),R12RN16               IF 2-WORD DESTINATION
  
          NOTE   R12RN15
          GENOBJ N=C.R1S06,I=((TREGOF,REGU1)),O=((VREGOF,VREG1))
          CALLZ  SUBDNAT                         DELETE REGUI DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 3-6 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS SIGNED
*                            DESTINATION IS 2 WORDS 
 R12RN16  LABEL 
          NOTE   R12RN16
          MOVEZ  (VREGOF,VREG1),VREG1                      RESERVE VREG1
          GENOBJ N=C.R1S06,I=((TREGOF,REGU1)),O=((VREGOF,VREG2))
                                                           VREG2=VREG1+1
          GEN    SLRBPK,(VREGOF,VREG4),,CBZEROS 
          GEN    XMIT,(VREGOF,VREG3),VREG2
          GEN    SHR,VREG3,59 
          GEN    LXOR,VREG1,VREG4,VREG3 
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 3-6 DIGITS 
*                            SOURCE IS UNSIGNED 
*                            DESTINATION IS 1 WORD
 R12RN17  LABEL 
          IFZ    (T2,EQ,1),R12RN18               IF 2-WORD DESTINATION
  
          NOTE   R12RN17
          GENOBJ N=C.R1U06,I=((TREGOF,REGU1)),O=((VREGOF,VREG1))
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 3-6 DIGITS 
*                            SOURCE IS UNSIGNED 
*                            DESTINATION IS 2 WORDS 
 R12RN18  LABEL 
          NOTE   R12RN18
          MOVEZ  (VREGOF,VREG1),VREG1                      RESERVE VREG1
          GENOBJ N=C.R1U06,I=((TREGOF,REGU1)),O=((VREGOF,VREG2))
                                                           VREG2=VREG1+1
          GEN    SLRBPK,VREG1,,CBZEROS                     VREG1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 7-9 DIGITS 
 R12RN19  LABEL 
          IFZ    ((SIGNOF,REGB),EQ,0),R12RN23    IF SOURCE UNSIGNED 
          IFZ    ((SIGNOF,REGC),EQ,0),R12RN25    IF DESTINATION UNSIGNED
          IFZ    (T2,EQ,1),R12RN21               IF 2-WORD DESTINATION
  
*                            SOURCE IS 7-9 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS SIGNED
*                            DESTINATION IS 1 WORD
R12RN20   LABEL                                  (CROSS-REFS ONLY)
          NOTE   R12RN20
          GENOBJ N=C.R1S09,I=((TREGOF,REGU1)),O=((VREGOF,VREG1))
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 7-9 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS SIGNED
*                            DESTINATION IS 2 WORDS 
 R12RN21  LABEL 
          NOTE   R12RN21
          MOVEZ  (VREGOF,VREG1),VREG1                      RESERVE VREG1
          GENOBJ N=C.R1S09,I=((TREGOF,REGU1)),O=((VREGOF,VREG2))
                                                           VREG2=VREG1+1
          GEN    SLRBPK,VREG1,,CBZEROS                     VREG1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 10 DIGITS
 R12RN22  LABEL 
          IFZ    ((SIGNOF,REGB),EQ,1),R12RN25    IF SOURCE SIGNED 
  
*                            SOURCE IS 7-10 DIGITS
*                            SOURCE IS UNSIGNED 
 R12RN23  LABEL                                  (ALSO FROM R12RN19+1)
          IFZ    (T2,EQ,1),R12RN24               IF 2-WORD DESTINATION
  
*                            SOURCE IS 7-10 DIGITS
*                            SOURCE IS UNSIGNED 
*                            DESTINATION IS 1 WORD
          NOTE   R12RN23
          GENOBJ N=C.R1U10,I=((TREGOF,REGU1)),O=((VREGOF,VREG1))
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 7-10 DIGITS
*                            SOURCE IS UNSIGNED 
*                            DESTINATION IS 2 WORDS 
 R12RN24  LABEL 
          NOTE   R12RN24
          MOVEZ  (VREGOF,VREG1),VREG1                      RESERVE VREG1
          GENOBJ N=C.R1U10,I=((TREGOF,REGU1)),O=((VREGOF,VREG2))
                                                           VREG2=VREG1+1
          GEN    SLRBPK,VREG1,,CBZEROS                     VREG1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 7-10 DIGITS
*                            SOURCE IS SIGNED 
 R12RN25  LABEL                                 (R12RN19+2 OR R12RN22+1)
          IFZ    ((SIGNOF,REGC),EQ,1),R12RN28    IF DESTINATION SIGNED
          IFZ    (T2,EQ,1),R12RN27               IF 2-WORD DESTINATION
  
*                            SOURCE IS 7-10 DIGITS
*                            SOURCE IS SIGNED 
*                            DESTINATION IS UNSIGNED
*                            DESTINATION IS 1 WORD
 R12RN26  LABEL                                  (CROSS-REFS ONLY)
          NOTE   R12RN26
          GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
          GEN    SHR,VREG3,59 
          GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGU1),VREG3 
          GENOBJ N=C.R1U10,I=(VREG1),O=((VREGOF,VREG1)) 
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 7-10 DIGITS
*                            SOURCE IS SIGNED 
*                            DESTINATION IS UNSIGNED
*                            DESTINATION IS 2 WORDS 
 R12RN27  LABEL 
          NOTE   R12RN27
          GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
          GEN    SHR,VREG3,59 
          GEN    LXOR,(VREGOF,VREG4),(TREGOF,REGU1),VREG3 
          MOVEZ  (VREGOF,VREG1),VREG1                      RESERVE VREG1
          GENOBJ N=C.R1U10,I=(VREG4),O=((VREGOF,VREG2)) 
                                                           VREG2=VREG1+1
          GEN    SLRBPK,VREG1,,CBZEROS                     VREG1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            SOURCE IS 10 DIGITS
*                            (7-9 DIGITS HANDLED AT R12RN20 AND R12RN21)
*                            SOURCE IS SIGNED 
*                            DESTINATION IS SIGNED
 R12RN28  LABEL 
          NOTE   R12RN28
          GENOBJ N=C.R1S10,I=((TREGOF,REGU1)),O=((VREGOF,VREG1),(VREGOF,
,VREG2))                                                   VREG2=VREG1+1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          IFTHEN  ((NUMLENOF,REGC),LT,10) 
            MOVEZ  VREG2,(TREGOF,REGC)
          ELSEZ 
            MOVEZ  VREG1,(TREGOF,REGC)
          ENDIFZ
          RETURN
  
  
*                            SOURCE IS 11-14 DIGITS 
 R12RN29  LABEL 
          IFZ    ((SIGNOF,REGB),EQ,0),R12RN31    IF SOURCE UNSIGNED 
          IFZ    ((SIGNOF,REGC),EQ,1),R12RN31    IF DESTINATION SIGNED
  
*                            SOURCE IS 11-14 DIGITS 
*                            SOURCE IS SIGNED 
*                            DESTINATION IS UNSIGNED
 R12RN30  LABEL                                  (CROSS-REFS ONLY)
          NOTE   R12RN30
          GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
          GEN    SHR,VREG3,59 
          GEN    LXOR,(VREGOF,VREG4),(TREGOF,REGU1),VREG3 
          GENOBJ N=C.R1S14,I=(VREG4),O=((VREGOF,VREG1),(VREGOF,VREG2))
                                                           VREG2=VREG1+1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          IFTHEN  (T2,EQ,0) 
            MOVEZ  VREG2,(TREGOF,REGC)
          ELSEZ 
            MOVEZ  VREG1,(TREGOF,REGC)
          ENDIFZ
          RETURN
  
  
*                            SOURCE IS 11-14 DIGITS 
*                            SOURCE IS SIGNED OR UNSIGNED 
*                            DESTINATION IS SIGNED
 R12RN31  LABEL 
          NOTE   R12RN31
          GENOBJ N=C.R1S14,I=((TREGOF,REGU1)),O=((VREGOF,VREG1),(VREGOF,
,VREG2))                                                   VREG2=VREG1+1
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          IFTHEN  (T2,EQ,0) 
            MOVEZ  VREG2,(TREGOF,REGC)
          ELSEZ 
            MOVEZ  VREG1,(TREGOF,REGC)
          ENDIFZ
          RETURN
          SPACE  4
          LISTSEC  R12R1
          TITLE  R12R1 -  REGISTER COMP-1 TO REGISTER COMP-1
**        R12R1 -  REGISTER COMP-1 TO REGISTER COMP-1 
* 
*         REGB = DNAT POINTER FOR SOURCE REGISTER 
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 99PPP _ -3)
*         (NUMLENOF,REGB) = NUMBER OF DECIMAL DIGITS IN SOURCE
*         REGC = DNAT POINTER FOR RESULT REGISTER 
*         (POINTOF,REGC) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC PP999 _ 5) 
* 
*         CALLZ  R12R1
* 
*         GENERATES CODE TO PERFORM ANY NECESSARY SCALING.
*         SETS (TREGOF,REGC) = VIRTUAL REGISTER NUMBER OF RESULT REG. 
* 
*         USES-  (NONE) 
* 
*         ALSO CALLED BY- 
*                C12C1
*                C12R1
  
  
 R12R1    EGO    2
          SUBZ   (POINTOF,REGC),(POINTOF,REGB),T1  RELATIVE SCALING 
          ADDZ   T1,18,T2                          DEAL WITH POSITIVES
          IFZ    (T2,LT,0),R12R111               IF ERROR 
          IFZ    (T2,GT,36),R12R112              IF ERROR 
          IFZ    (T2,LT,16),R12R19               IF GENERAL CASE
          IFZ    (T2,GT,25),R12R110              IF GENERAL CASE
          GOTOCASE  T2
            CASE    16,R12R11                    E.G. 99999 _ 999PP 
            CASE    17,R12R12                    E.G. 99999 _ 9999P 
            CASE    18,R12R13                    E.G. 99999 _ 99999 
            CASE    19,R12R14                    E.G. 9999P _ 99999 
            CASE    24,R12R17                    E.G. 99PPPPPP_99999999 
            CASE    25,R12R18                    E.G. 9PPPPPPP_99999999 
            ENDCASE 
          BRANCH R12R15                          E.G. 999999PP_99999999 
*                                                            ...
*                                                     999PPPPP_99999999 
  
  
*                            DIVIDE BY 100
 R12R11   LABEL 
          IFZ    ((NUMLENOF,REGB),GT,6),R12R19   IF SIZE TOO BIG
          NOTE   R12R11 
          GEN    SXBPK,(VREGOF,VREG1),,#0.01S23 
          GEN    IMUL,(VREGOF,VREG1),VREG1,(TREGOF,REGB)
          GEN    SHR,VREG1,23 
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  R12R1A                          ENSURE RESULT SIZE OK
          RETURN
  
  
*                            DIVIDE BY 10 
 R12R12   LABEL 
          IFZ    ((NUMLENOF,REGB),GT,5),R12R19   IF SIZE TOO BIG
          NOTE   R12R12 
          GEN    SXBPK,(VREGOF,VREG1),,#0.1S20
          GEN    IMUL,(VREGOF,VREG1),VREG1,(TREGOF,REGB)
          GEN    SHR,VREG1,20 
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  R12R1A                          ENSURE RESULT SIZE OK
          RETURN
  
  
*                            NO SCALING 
 R12R13   LABEL 
          NOTE   R12R13 
          GEN    XMIT,(VREGOF,VREG1),(TREGOF,REGB)
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  R12R1A                          ENSURE RESULT SIZE OK
          RETURN
  
  
*                            MULTIPLY BY 10 
 R12R14   LABEL 
          NOTE   R12R14 
          GEN    IADD,(VREGOF,VREG1),(TREGOF,REGB),(TREGOF,REGB)
          GEN    XMIT,(VREGOF,VREG2),(TREGOF,REGB)
          GEN    SHL,VREG2,3
          GEN    IADD,(VREGOF,VREG1),VREG1,VREG2
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  R12R1A                          ENSURE RESULT SIZE OK
          RETURN
  
  
*                            MULTIPLY BY 10'N, N=2, 3, 4, 5 
 R12R15   LABEL 
          NOTE   R12R15 
          MOVEZ  10,T2                           COMPUTE 10'N 
 R12R16   LABEL 
          MULTZ  T2,10,T2 
          SUBZ   T1,1,T1
          IFZ    (T1,NE,1),R12R16 
  
          GEN    SXBPK,(VREGOF,VREG1),,T2 
          GEN    IMUL,(VREGOF,VREG1),VREG1,(TREGOF,REGB)
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  R12R1A                          ENSURE RESULT SIZE OK
          RETURN
  
  
*                            MULTIPLY BY 10'6 
 R12R17   LABEL 
          NOTE   R12R17 
          GEN    SXBPK,(VREGOF,VREG1),,#5'6 
          GEN    IMUL,(VREGOF,VREG1),VREG1,(TREGOF,REGB)
          GEN    SHL,VREG1,6                     * 2'6 = 10'6 
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  R12R1A                          ENSURE RESULT SIZE OK
          RETURN
  
  
*                            MULTIPLY BY 10'7 
 R12R18   LABEL 
          NOTE   R12R18 
          GEN    SXBPK,(VREGOF,VREG1),,#5'7 
          GEN    IMUL,(VREGOF,VREG1),VREG1,(TREGOF,REGB)
          GEN    SHL,VREG1,7                     * 2'7 = 10'7 
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  R12R1A                          ENSURE RESULT SIZE OK
          RETURN
  
  
*                            DIVIDE BY 10'N, 1 @ N @ 18 
*                            (GENERAL CASE) 
 R12R19   LABEL 
          NOTE   R12R19 
          GEN    SLRBPK,(VREGOF,VREG1),,CBFTENS  (+T1)
          GEN    PACK,(VREGOF,VREG2),,(TREGOF,REGB) 
          GEN    NORM,(VREGOF,VREG2),,VREG2 
          GEN    RDIV,(VREGOF,VREG1),VREG2,VREG1
          GEN    UNP,(VREGOF,VREG1),(VREGOF,VREG2),VREG1
          GEN    SHLB,(VREGOF,VREG1),VREG2,VREG1
          MOVEZ  VREG1,(TREGOF,REGC)
          CALLZ  R12R1A                          ENSURE RESULT SIZE OK
          RETURN
  
  
*                            MULTIPLY BY 10'N, 7 < N @ 18 
 R12R110  LABEL 
          NOTE   R12R110
          SUBZ   T1,1,T1
          GEN    SLRBPK,(VREGOF,VREG1),,CBITENS 
          GEN    IMUL,(VREGOF,VREG1),VREG1,(TREGOF,REGB)
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*                            DIVIDE BY 10'N, N>18 
 R12R111  LABEL 
          NOTE   R12R111
          ERROR  70001B 
          MOVEZ  0,T2                            DIVIDE BY 10'18
          BRANCH R12R19 
  
  
*                            MULTIPLY BY 10'N, N>18 
 R12R112  LABEL 
          NOTE   R12R112
          ERROR  70002B 
          MOVEZ  36,T2                           MULTIPLY BY 10'18
          BRANCH R12R110
A         EJECT 
**        R12R1A -  ENSURE REGISTER COMP1 RESULT IS NOT TOO BIG 
* 
*         (TREGOF,REGC) = V. R. N. OF COMP-1 REGISTER.
*         CALLZ  R12R1A 
* 
*         GENERATES CODE TO ENSURE THE THE DECIMAL REPRESENTATION 
*           OF THE COMP-1 VALUE IN REGISTER (TREGOF,REGC) WILL FIT
*           IN (NUMLENOF,REGC) DECIMAL DIGITS.
  
  
 R12R1A   LABEL 
*    CHECK FOR ABSOLUTE VALUE NEEDED
          IFTHEN ((SIGNOF,REGB),EQ,1) 
          ANDIF  ((SIGNOF,REGC),EQ,0) 
            GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGC)
            GEN    SHR,VREG3,59 
            GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGC),VREG3
            MOVEZ  VREG1,(TREGOF,REGC)
          ENDIFZ
          IFZ    ((CCTBIT,CHKCOMP1),EQ,0),RETURN
          SUBZ   (POINTOF,REGC),(POINTOF,REGB),T1 
          ADDZ   (NUMLENOF,REGB),T1,T1           TRUE SIZE OF RESULT
          MOVEZ  (NUMLENOF,REGC),T2              SPECIFIED SIZE FOR RES.
          IFZ    (T1,LE,T2),RETURN               IF TRUE SIZE FITS
  
          NOTE   R12R1A 
  
          IFTHEN (T2,LE,5)
            MOVEZ  1,T3 
 R12R1A1    LABEL 
            MULTZ  T3,10,T3 
            SUBZ   T2,1,T2
            IFZ    (T2,NE,0),R12R1A1
            GEN    SXBPK,(VREGOF,VREG2),,T3 
          ELSEZ 
            GEN    SLRBPK,(VREGOF,VREG2),,((EXT$OF,C.ITENS),T2) 
            ENDIFZ
  
          GEN    PACK,(VREGOF,VREG1),,(TREGOF,REGC) 
          GEN    NORM,(VREGOF,VREG1),,VREG1 
          GEN    PACK,(VREGOF,VREG3),,VREG2 
          GEN    NORM,(VREGOF,VREG3),,VREG3 
          GEN    FDIV,(VREGOF,VREG3),VREG1,VREG3
          GEN    UNP,(VREGOF,VREG3),(VREGOF,VREG4),VREG3
          GEN    SHLB,(VREGOF,VREG3),VREG4,VREG3
          GEN    IMUL,(VREGOF,VREG3),VREG2,VREG3
          GEN    ISUB,(VREGOF,VREG1),(TREGOF,REGC),VREG3
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
          SPACE  4
          LISTSEC  R12R2
          TITLE  R12R2 -  REGISTER COMP-1 TO REGISTER COMP-2
**        R12R2 -  REGISTER COMP-1 TO REGISTER COMP-2 
* 
*         REGB = DNAT POINTER TO SOURCE REGISTER. 
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER. 
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 9V99 _ 2)
*         (NUMLENOF,REGB) = NUMBER OF DECIMAL DIGITS. 
*         (SIGNOF,REGB) = 1 IFF SOURCE IS SIGNED. 
*         REGC = DNAT POINTER TO DESTINATION REGISTER.
*         (SIGNOF,REGC) = 1 IFF DESTINATION IS SIGNED.
* 
*         CALLZ  R12R2
* 
*         SETS (POINTOF,REGC) SUCH THAT THE TRUE VALUE OF THE REGISTER
*           IS EQUAL TO THE VALUE IN VIRTUAL REGISTER (TREGOF,REGC) 
*           TIMES 10'(-(POINTOF,REGC)). 
*         SETS (TREGOF,REGC) = VIRTUAL REGISTER NUMBER OF RESULT REG. 
* 
*         USES-  (NONE) 
* 
*         ALSO CALLED BY- 
*                C12R2
*                C12R4
*                R12R4
  
  
 R12R2    EGO    2
          NOTE   R12R2
  
          IFTHEN ((SIGNOF,REGB),EQ,1)            IF SOURCE SIGNED 
           ANDIF ((SIGNOF,REGC),EQ,0)             AND DESTINATION UNSIGN
            GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGB)
            GEN    SHR,VREG3,59 
            GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGB),VREG3
          ELSEZ                                  IF SIGN KEPT 
            MOVEZ  (TREGOF,REGB),VREG1
            ENDIFZ
  
          GEN    PACK,(VREGOF,VREG1),,VREG1 
          GEN    NORM,(VREGOF,VREG1),,VREG1 
          SUBZ   (POINTOF,REGB),(POINTOF,REGC),T1 
          IFTHEN (T1,NE,0)
            GEN  SLRBPK,(VREGOF,VREG4),,CBFTENS (+T1) 
            GEN  FMUL,(VREGOF,VREG1),VREG1,VREG4
          ENDIFZ
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
          SPACE  4
          LISTSEC  R12R4
          TITLE  R12R4 -  REGISTER COMP-1 TO REGISTER D.P. COMP-2 
**        R12R4 -  REGISTER COMP-1 TO REGISTER D.P. COMP2 
* 
*         REGB = DNAT POINTER TO SOURCE REGISTER. 
*         (TREGOF,REGB) = VIRTUAL REGISTER NUMBER OF SOURCE REGISTER. 
*         (POINTOF,REGB) = POSITION OF LEAST SIGNIFICANT DIGIT
*           RELATIVE TO DECIMAL POINT.   (E.G. PIC 999V99 _ 2)
*         (SIGNOF,REGB) = 1 IFF SOURCE IS SIGNED. 
*         REGC = DNAT POINTER TO DESTINATION REGISTERS. 
*         (SIGNOF,REGC) = 1 IFF DESTINATION IS SIGNED.
* 
*         CALLZ  R12R4
* 
*         USES-  REGU1
  
  
 R12R4    EGO    2
          NOTE   R12R4
  
*      CREATE A DUMMY DNAT
  
          MOVEZ  REGU1,REGT                      ENTRY REGU1 _ DNAT 
          CALLZ  ADNAT                           CREATE DNAT
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGU1) 
          MOVEZ  (POINTOF,REGC),(POINTOF,REGU1) 
  
*      CONVERT R1 (IN REGB) TO R2 (IN REGU1)
  
          PUSH   REGC                            SAVE ORIG. DESTINATION 
          MOVEZ  REGU1,REGC                      THIS DEST. IS REGU1
          CALLZ  R12R2                           CONVERT (REGB) _ (REGC)
          POP    REGC                            RESTORE ORIGINAL DEST. 
  
*      CONVERT R2 (IN REGU1) TO R4 (IN REGC)
  
          GEN    XMIT,(VREGOF,VREG1),(TREGOF,REGU1)        VREG1
          GEN    MASK,(VREGOF,VREG2),0                     VREG2=VREG1+1
          MOVEZ  VREG1,(TREGOF,REGC)
  
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          RETURN
          SPACE  4
          LISTSEC  *
          END 
