*DECK GMOVLIT 
          IDENT  GMOVLIT
          TITLE  GMOVLIT -  GENERATE MOVE = LOAD LITERAL
          MACHINE  ANY,I
          SST 
          COMMENT  GENERATE MOVE = LOAD LITERAL 
          SPACE  4
**        GMOVLIT -  GENERATE MOVE = LOAD LITERAL 
* 
*         CONTAINS- 
*                CGLI2AE     LITERAL TO ALPHANUMERIC-EDITED ITEM
*                CGLI2AN     LITERAL TO ALPHANUMERIC ITEM 
*                CGLI2C1     LITERAL TO COMP-1 ITEM 
*                CGLI2C2     LITERAL TO COMP-2 ITEM 
*         CGLI2C4     LITERAL TO COMP-4 ITEM
*                CGLI2ND     LITERAL TO NUMERIC DISPLAY ITEM
*                CGLI2NE     LITERAL TO NUMERIC-EDITED ITEM 
*                CGLI2RA     LITERAL TO ALPHANUMERIC REGISTER 
*                CGLI2RN     LITERAL TO REGISTER NUMERIC
*                CGLI2R1     LITERAL TO REGISTER COMP-1 
*                CGLI2R2     LITERAL TO REGISTER COMP-2, S.P. 
*                CGLI2R4     LITERAL TO REGISTER COMP-2, D.P. 
          EJECT 
  
*      COMDECKS 
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
  
          EJECT 
*      MODULE DECLARATION 
  
 GMOVLIT  MODULE
  
  
*      LINKAGE FROM CALLING ROUTINES IN OTHER MODULES 
  
 BINVAL   KNIL   BINVAL 
 CLIT2RN  KNIL   CLIT2RN
 CRN2BIN  KNIL   CRN2BIN
 EXAMBIN  KNIL   EXAMBIN
 LI2AE    KNIL   CGLI2AE     * FROM GMOVE 
 LI2AN    KNIL   CGLI2AN     * FROM GMOVE 
 LI2BD    KNIL   CGLI2BD
 LI2C1    KNIL   CGLI2C1     * FROM GMOVE 
 LI2C4    KNIL   CGLI2C4     * FROM GMOVE 
 LI2C2    KNIL   CGLI2C2     * FROM GMOVE 
 LI2ND    KNIL   CGLI2ND     * FROM GMOVE 
 LI2NE    KNIL   CGLI2NE     * FROM GMOVE 
 LI2RA    KNIL   CGLI2RA     * FROM GMOVE 
 LI2RN    KNIL   CGLI2RN     * FROM GMOVE 
 LI2R1    KNIL   CGLI2R1     * FROM GMOVE 
 LI2R2    KNIL   CGLI2R2     * FROM GMOVE 
 LI2R4    KNIL   CGLI2R4     * FROM GMOVE 
  
  
*      LINKAGE TO ROUTINES IN OTHER MODULES 
  
 ADNAT    LINK   ADNAT
 ADPDNAT  LINK   ADPDNAT
 AN2AN    LINK   CGAN2AN     * TO GANMOVE 
 AN2AE    LINK   CGAN2AE     * TO GMOVE 
 AN2VG    LINK   CGAN2VG
 BD2BD    LINK   CGBD2BD
 EDITPAT  LINK   EDITPAT
 R22ND    LINK   CGR22ND     * TO GMOVR2
 SCANLIT  LINK   SCANLIT     * TO SCANLIT 
 STRBLNK  LINK   CGSTBLK     * TO GMOVSUB 
 SETXREG  LINK   CGSETXW     * TO GMOVSUB 
 SETBXPK  LINK   CGSBXPK     * TO GMOVSUB 
 ADDSPCS  LINK   CGADSPC     * TO GMOVSUB 
 SETBREG  LINK   CGSETB4     * TO GMOVSUB 
 LDHILO1  LINK   CGHILO1     * TO GMOVSUB 
 LDHILO2  LINK   CGHILO2     * TO GMOVSUB 
 LIT2RN   LINK   LIT2RN      * TO LIT2RN
 MOVHILO  LINK   CGMHILO     * TO GMOVSUB 
 GTADBCP  LINK   CGGTABP     * TO GMOVSUB 
 GETSPCS  LINK   CGGTSPC     * TO GMOVSUB 
 GTSPCLF  LINK   CGGTSPL     * TO GMOVSUB 
 GTSPCRT  LINK   CGGTSPR     * TO GMOVSUB 
 STORIT1  LINK   CGSTOR1     * TO GMOVSUB 
 STORIT2  LINK   CGSTOR2     * TO GMOVSUB 
 AN2RA    LINK   CGAN2RA     * TO GANMOVE 
 LITPOOL  LINK   LITPOOL     * TO LITPOOL 
 RN2BIN   LINK   RN2BIN      * TO RN2BIN
 RN2ND    LINK   CGRN2ND     * TO GMOVSTO 
 LOADP1P4 LINK   CGLODP1
 ND2C1    LINK   CGND2C1
 ND2C2    LINK   CGND2C2
 ND2ND    LINK   CGND2ND
 ND2NE    LINK   CGND2NE
 POOLQLT  LINK   POOLQLT
 R22C2    LINK   CGR22C2     * TO GMOVE 
 R22RN    LINK   CGR22RN
 STORC1C2 LINK   CGSTORC
 STORC4   LINK   STORC4      * TO GMOVSUB 
 SUBDNAT  LINK   SUBDNAT
 STORP1P4 LINK   CGSTOP1     * TO GSTORP1 
 SUBLOAD  LINK   SUBLOAD     * TO GSUBSC
 SUBREF   LINK   SUBREF 
 SPCFILL  LINK   CGSPCFL     * TO GMOVSUB 
 CGREGMV  LINK   CGREGMV     * COPY REGTABLE ENTRY
  
          RETURN
  
*      LINKAGE VARIABLES TO/FROM OTHER MODULES
  
          USE    /PARMS/
 PARM1    BSS    1
 PARM2    BSS    1
 PARM3    BSS    1
 PARM4    BSS    1
          USE    *
  
  
*      FIXED TABLE EQUATES
  
 LABLNUM  EQU    T16
 SPACFLG  EQU    T17
 ZEROFLG  EQU    T18
*CALL GMOVCOM 
  
  
*      REGTABLE EQUATES 
  
 MOVEREGA EQU    REGB 
 MOVEREGB EQU    REGC 
  
  
*      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
 VREGU    EQU    VREG16 
 VREGW    EQU    VREG18 
 VREGX    EQU    VREG4
  
  
*      MISCELLANEOUS EQUATES
  
  
  
*      SYMBOLIC PARAMETER DEFINITIONS 
  
 CBZEROS  SETSY  (EXT$OF,C.ZEROS) 
 CMUBLOCK SETSY  (USETB$OF,USECMU)
 CODBLOCK SETSY  (USETB$OF,USECODE) 
 FWARECV  SETSY  (FWA$OF,REGC)
 RECADDR  SETSY  (FWA$OF,MOVEREGB)
 BLANKS   SETSY  (EXT$OF,C.BLANK) 
 SRCADDR  SETSY  (FWA$OF,MOVEREGA)
 LOVALADR SETSY  (EXT$OF,C.LOVAL),HILOFLG 
 LOCLABL  SETSY  (LOCAL$OF,LABLNUM) 
 FWASOURC SETSY  (FWA$OF,REGB)
          SPACE  4
          LISTSEC  BINVAL 
          TITLE  BINVAL -  EXTRACT BINARY VALUE FROM LITERAL
**        BINVAL -  EXTRACT BINARY VALUE FROM LITERAL 
* 
*         REGT = REG_N DESCRIBING LITERAL:  
*                  ADDRESS, LENGTH OF LITERAL 
*                  DESIRED NUMLENOF 
*                  DESIRED POINTOF
*                  WHETHER SIGN IS ALLOWED = SIGNOF 
* 
*         CALLZ  BINVAL 
* 
*         SETS P1 = BINARY VALUE OF LITERAL.
*         SETS P2 = TYPE OF VALUE:  
* 
*         P1     P2     P3     P4 
*         --     --     --     -- 
*         N       0                 SA1    =N;  NOT TYPES 1_11
*         0       1                 MX1    0
*         1       2                 SX1    B1 
*         2       3      1          SX1    B1+B1
*         -1,-3,  4      A          MX1    A
*         N       5      A          2<N<2'17;  N=2'A
*         N       6      A      B   2<N<2'17;  N=2'A+2'B;  A>B
*         N       7      A      B   2<N<2'17;  N=2'A-2'B;  A>B
*         N       8                 -2'17<N<2'17;  NOT TYPES 1_7
*         N       9      A          N\2'17;  N=2'A
*         N      10      A      B   N\2'17;  N=2'A+2'B;  A>B
*         N      11      A      B   N\2'17;  N=2'A-2'B;  A>B
  
  
 BINVAL   EGO    3
  
*      CONVERT LITERAL TO REGISTER NUMERIC
  
          MOVEZ  (LITREFOF,REGT),P1 
          MOVEZ  (NUMLENOF,REGT),P2 
          MOVEZ  (POINTOF,REGT),P3
          MOVEZ  (SIGNOF,REGT),P4 
          CALLZ  CLIT2RN
*         SETS P1 = MOST SIGNIFICANT 10 DIGITS
*         SETS P2 = LEAST SIGNIFICANT 10 DIGITS 
  
*      CONVERT REGISTER NUMERIC TO COMP-1 
  
          MOVEZ  (POINTOF,REGT),P3
          CALLZ  CRN2BIN
*         SETS P3 = COMP-1 VALUE
  
*      ANALYZE COMP-1 VALUE AND SET P1, P2, P3, P4
  
          MOVEZ  P3,P1                           PUT VALUE IN P1
          CALLZ  EXAMBIN                         SET P2, P3, P4 
  
          RETURN
          SPACE  4
          LISTSEC  CLIT2RN
          TITLE  CLIT2RN -  CALL LIT2RN 
**        CLIT2RN -  CALL LIT2RN
* 
*         P1 = REFERENCE TO LITERAL 
*                2/1, 10/NUMBER OF CHARACTERS, 48/ADDRESS 
*         P2 = (NUMLENOF,REGC)
*         P3 = (POINTOF,REGC) 
*         P4 = (SIGNOF,REGC)
* 
*         CALLS  CLIT2RN
* 
*         SETS P1 = MOST SIGNIFICANT DIGITS OF RESULT 
*                     (IF 2-WORD RESULT)
*         SETS P2 = LEAST SIGNIFICANT DIGITS OF RESULT
*         SETS P3 = C.ZEROS 
  
  
 CLIT2RN  EXECUTE  CCLIT2RN 
          RETURN
 CCLIT2RN CON    *           ENTRY/EXIT WORD
          RJ     LOADP1_P4   LOAD P1_P4 INTO PARM1_PARM4
          SX6    PARM1       ADDRESS OF REF 
          SA6    CLIT2RNA 
          SX6    PARM2       ADDRESS OF NUMLEN
          SA6    CLIT2RNA+1 
          SX6    PARM3       ADDRESS OF POINT 
          SA6    CLIT2RNA+2 
          SX6    PARM4       ADDRESS OF SIGN
          SA6    CLIT2RNA+3 
          SA1    CLIT2RNA    A1 = ADDRESS OF PARAMETER LIST 
          RJ     LIT2RN      CONVERT LITERAL TO REGISTER NUMERIC
          SA1    CLIT2RNB    MS 
          SA2    CLIT2RNC 
          BX6    X1 
          LX7    X2 
          SA6    PARM1
          SA7    PARM2
          SA1    =10H0000000000  C.ZEROS
          BX6    X1 
          SA6    PARM3
          RJ     STORP1_P4   STORE PARM1_PARM4 INTO P1_P4 
          EQ     CCLIT2RN    EXIT 
          SPACE  4
 CLIT2RNA BSS    1           ADDRESS OF REF                WORD 1 
          BSS    1           ADDRESS OF NUMLEN             WORD 2 
          BSS    1           ADDRESS OF POINT              WORD 3 
          BSS    1           ADDRESS OF SIGN               WORD 4 
          CON    CLIT2RNB    ADDRESS OF MS                 WORD 5 
          CON    CLIT2RNC    ADDRESS OF LS                 WORD 6 
  
 CLIT2RNB BSS    1           MS 
 CLIT2RNC BSS    1           LS 
          SPACE  4
          LISTSEC  CRN2BIN
          TITLE  CRN2BIN -  CALL RN2BIN 
**        CRN2BIN -  CALL RN2BIN
* 
*         P1 = MOST SIGNIFICANT 10 DIGITS 
*                (NINE-S COMPLEMENT IF NEGATIVE)
*         P2 = LEAST SIGNIFICANT 10 DIGITS
*                (NINE-S COMPLEMENT IF NEGATIVE)
*         P3 = SCALING FACTOR:  
*                RESULT WILL BE DIVIDED BY 10'P3
* 
*         EXECUTE  CRN2BIN
* 
*         SETS P1 = MOST SIGNIFICANT PART OF D.P. COMP-2 VALUE. 
*         SETS P2 = LEAST SIGNIFICANT PART OF D.P. COMP-2 VALUE.
*         SETS P3 = COMP-1 VALUE. 
  
  
 CRN2BIN  EXECUTE  CCRN2BIN 
          RETURN
  
 CCRN2BIN CON    *           ENTRY/EXIT WORD
          RJ     LOADP1_P4   LOAD FROM P1_P4 INTO PARM1_PARM4 
          SX6    PARM1       ADDRESS OF MS
          SA6    CRN2BINA 
          SX6    PARM2       ADDRESS OF LS
          SA6    CRN2BINA+1 
          SX6    PARM3       ADDRESS OF SCALE 
          SA6    CRN2BINA+2 
          SA1    CRN2BINA    A1 = ADDRESS OF PARAMETER LIST 
          RJ     RN2BIN      CONVERT REGISTER NUMERIC TO BINARY 
          SA1    CRN2BINB    MSCOMP2
          SA2    CRN2BINC    LSCOMP2
          BX6    X1 
          LX7    X2 
          SA6    CRN2BINE    CORRECTLY SCALED MSCOMP2 
          SA7    CRN2BINF    CORRECTLY SCALED LSCOMP2 
  
*      NOW SET COMP-1 VALUE,  KEEPING DIGITS TO RIGHT OF DECIMAL POINT
  
          SX6    =0          ADDRESS OF ZERO SCALE
          SA6    CRN2BINA+2 
          SA1    CRN2BINA    A1 = ADDRESS OF PARAMETER LIST 
          RJ     RN2BIN 
          SA1    CRN2BINE    CORRECTLY SCALED MSCOMP2 
          SA2    CRN2BINF    CORRECTLY SCALED LSCOMP2 
          BX6    X1 
          LX7    X2 
          SA6    PARM1
          SA7    PARM2
          SA1    CRN2BIND    COMP1
          BX6    X1 
          SA6    PARM3
          RJ     STORP1_P4   STORE INTO P1_P4 FROM PARM1_PARM4
          EQ     CCRN2BIN    EXIT 
          SPACE  4
 CRN2BINA BSS    1           ADDRESS OF MS                 WORD 1 
          BSS    1           ADDRESS OF LS                 WORD 2 
          BSS    1           ADDRESS OF SCALE              WORD 3 
          CON    CRN2BINB    ADDRESS OF MSCOMP2            WORD 4 
          CON    CRN2BINC    ADDRESS OF LSCOMP2            WORD 5 
          CON    CRN2BIND    ADDRESS OF COMP1              WORD 6 
  
 CRN2BINB BSS    1           MSCOMP2
 CRN2BINC BSS    1           LSCOMP2
 CRN2BIND BSS    1           COMP1
  
 CRN2BINE BSS    1           CORRECTLY SCALED MSCOMP2 
 CRN2BINF BSS    1           CORRECTLY SCALED LSCOMP2 
          SPACE  4
          LISTSEC  EXAMBIN
          TITLE  EXAMBIN -  EXAMINE BINARY VALUE FOR SPECIAL CASES
**        EXAMBIN -  EXAMINE BINARY VALUE FOR SPECIAL CASES 
* 
*         P1 = BINARY VALUE 
* 
*         CALLZ  EXAMBIN
* 
*         SETS P2 = TYPE OF VALUE:  
* 
*         P1     P2     P3     P4 
*         --     --     --     -- 
*         N       0                 SA1    =N;  NOT TYPES 1_11
*         0       1                 MX1    0
*         1       2                 SX1    B1 
*         2       3      1          SX1    B1+B1
*         -1,-3,  4      A          MX1    A
*         N       5      A          2<N<2'17;  N=2'A
*         N       6      A      B   2<N<2'17;  N=2'A+2'B;  A>B
*         N       7      A      B   2<N<2'17;  N=2'A-2'B;  A>B
*         N       8                 -2'17<N<2'17;  NOT TYPES 1_7
*         N       9      A          N\2'17;  N=2'A
*         N      10      A      B   N\2'17;  N=2'A+2'B;  A>B
*         N      11      A      B   N\2'17;  N=2'A-2'B;  A>B
  
  
 EXAMBIN  EXECUTE  EXAMBINC 
          RETURN
  
 EXAMBINC CON    *           ENTRY/EXIT WORD
  
*      LOAD FROM P1_P4 INTO PARM1_PARM4 
  
          RJ     LOADP1_P4
  
*      EXAMINE THE VALUE
  
          SA1    PARM1       N
  
*      CHECK FOR TYPE 1:  N = 0 
  
          SX6    1           SET TYPE IN CASE N = 0 
          ZR     X1,EXAMBN2  IF N = 0 
  
*      CHECK FOR TYPE 2:  N = 1 
  
          SX6    2           SET TYPE IN CASE N = 1 
          SB7    X1-1 
          ZR     B7,EXAMBN2  IF N = 1 
  
*      CHECK FOR TYPE 3:  N = 2 
  
          SX7    B1 
          SX6    3           SET TYPE IN CASE N = 2 
          SB7    X1-2 
          ZR     B7,EXAMBN2  IF N = 2 
  
*      CHECK FOR TYPE 4:  -1, -3, -7, -15 # 1-2'A 
  
          CX7    X1          X7 = NUMBER OF BITS IN X1;  X7 \ 1 
          SB7    X7-1 
          MX3    1
          AX3    X3,B7       FIRST (X7) BITS ARE ONE-S
          IX2    X3-X1
          SX6    4           SET TYPE IN CASE VALUE = 1-2'(60-X7) 
          ZR     X2,EXAMBN2  IF N QUALIFIES 
  
*      CHECK IF N FITS IN 18 BITS 
  
          SX2    X1          LOWER 18 BITS, SIGN EXTENDED 
          IX2    X2-X1
          ZR     X2,EXAMBN3  IF N FITS IN 18 BITS 
  
*      CH(CK FOR TYPE 0:  N @ -2'17 
  
          SX6    0           SET TYPE IN CASE N @ -2'17 
          NG     X1,EXAMBN2  IF N @ -2'17 
  
*      CHECK FOR TYPE 9:  N\2'17;  N=2'A
  
          SB7    X7-1        (NUMBER OF BITS IN X1) - 1 
          ZR     B7,EXAMBN13 IF N = 2'A 
  
*      CHECK FOR TYPE 10:  N = 2'A+2'B
  
          SB7    X7-2        (NUMBER OF BITS IN X1) - 2 
          ZR     B7,EXAMBN15 IF N = 2'A+2'B 
  
*      CHECK FOR TYPE 11:  N\2'17;  N=2'A-2'B 
  
*         LOOKING FOR 000...000111...111000...000 (BASE 2)
*         X3 = 111...111000...000 (BASE 2)
  
          SX5    59 
 EXAMBN1  LX3    -1          PUT ANOTHER ZERO BIT IN BIT 59 
          IX2    X1-X3
          ZR     X2,EXAMBN20 IF MATCH 
          SX5    X5-1        DECREMENT COUNT
          NZ     X5,EXAMBN1  IF MORE CASES TO CHECK,  LOOP
  
*      MUST BE TYPE 0:  NOTHING SPECIAL 
  
          SX6    0           SET TYPE 
  
*      EXIT,  SETTING P2 = (X6) AND P3 = (X7) 
  
 EXAMBN2  SA6    PARM2       P2 = TYPE NUMBER 
          SA7    PARM3       P3 = POSSIBLE PARAMETER
          RJ     STORP1_P4   STORE INTO P1_P4 FROM PARM1_PARM4
          EQ     EXAMBINC    EXIT 
  
  
*      VALUE FITS IN 18 BITS
  
 EXAMBN3  BSS    0
  
*      CHECK FOR TYPE 8:  -2'17<N<-1
  
          SX6    8           SET TYPE 
          NG     X1,EXAMBN2  IF -2'17<N<-1,  GO SET TYPE AND EXIT 
  
*      CHECK FOR TYPE 5:  2<N<2'17;  N=2'A
  
          SB7    X7-1        (NUMBER OF BITS IN X1) - 1 
          ZR     B7,EXAMBN5  IF N = 2'A 
  
*      CHECK FOR TYPE 6:  2<N<2'17;  N=2'A+2'B;  A>B
  
          SB7    X7-2        (NUMBER OF BITS IN X1) - 2 
          ZR     B7,EXAMBN7  IF N = 2'A+2'B 
  
*      CHECK FOR TYPE 7:  2<N<2'17;  N=2'A-2'B;  A>B
  
*         LOOKING FOR 000...000111...111000...000 (BASE 2)
*         X3 = 111...111000...000 (BASE 2)
  
          LX3    19          PUT MOST SIGNIFICANT BIT AT BIT 19 
          SX5    18          BIT NUMBER OF MOST SIGNIFICANT BIT 
 EXAMBN4  LX3    -1          PUT ANOTHER ZERO BIT IN BIT 59 
          IX2    X1-X3
          ZR     X2,EXAMBN12 IF MATCH 
          SX5    X5-1        DECREMENT COUNT
          NZ     X5,EXAMBN4  IF MORE POSITIONS TO TRY,  LOOP
  
*      MUST BE TYPE 8:  2<N<2'17;  NOTHING ELSE 
  
          SX6    8           SET TYPE 
          EQ     EXAMBN2     GO SET TYPE AND EXIT 
  
  
*      TYPE 5:  2<N<2'17;  N=2'A
  
 EXAMBN5  SX6    5           SET TYPE 
          SX7    16          FIRST GUESS OF POWER OF 2
          LX1    59-16       SHIFT BIT 16 INTO BIT 59 
 EXAMBN6  NG     X1,EXAMBN2  IF CORRECT POWER OF 2,  EXIT 
          LX1    1           CHECK FOR NEXT POWER OF 2
          SX7    X7-1        DECREMENT POWER
          EQ     EXAMBN6     TRY NEXT POWER 
  
  
*      TYPE 6:  2<N<2'17;  N=2'A+2'B;  A>B
  
 EXAMBN7  SX7    16          A
          LX1    59-16       SHIFT BIT 16 INTO BIT 59 
 EXAMBN8  NG     X1,EXAMBN9  IF CORRECT VALUE FOR A 
          LX1    1           TRY NEXT LOWER POWER 
          SX7    X7-1 
          EQ     EXAMBN8
  
 EXAMBN9  SX6    X7-1        B
          LX1    1
 EXAMBN10 NG     X1,EXAMBN11 IF CORRECT VALUE FOR B 
          LX1    1           TRY NEXT BIT 
          SX6    X6-1 
          EQ     EXAMBN10 
  
 EXAMBN11 SA6    PARM4       P4 = B 
          SX6    6           SET TYPE 
          EQ     EXAMBN2     GO SET P2, P3 AND EXIT 
  
  
*      TYPE 7:  2<N<2'17;  N=2'A-2'B;  A>B
  
*         X1 IS (60-X5) BINARY ZEROS,  (X7) BINARY ONES,  REST ZEROS
  
 EXAMBN12 IX6    X5-X7       B
          SA6    PARM4       P4 = B 
          BX7    X5          A
          SX6    7           SET TYPE 
          EQ     EXAMBN2     GO SET P2, P3 AND EXIT 
  
  
*      TYPE 9:  N\2'17;  N=2'A
  
 EXAMBN13 SX6    9           SET TYPE 
          SX7    59          FIRST GUESS OF POWER OF 2
 EXAMBN14 NG     X1,EXAMBN2  IF CORRECT POWER OF 2,  EXIT 
          LX1    1           CHECK FOR NEXT POWER OF 2
          SX7    X7-1        DECREMENT POWER
          EQ     EXAMBN14    TRY NEXT POWER 
  
  
*      TYPE 10:  N\2'17;  N=2'A+2'B;  A>B 
  
 EXAMBN15 SX7    58          A
          LX1    1
 EXAMBN16 NG     X1,EXAMBN17 IF CORRECT VALUE FOR A 
          LX1    1           TRY NEXT LOWER POWER 
          SX7    X7-1 
          EQ     EXAMBN16 
  
 EXAMBN17 SX6    X7-1        B
          LX1    1
 EXAMBN18 NG     X1,EXAMBN19 IF CORRECT VALUE FOR B 
          LX1    1           TRY NEXT BIT 
          SX6    X6-1 
          EQ     EXAMBN18 
  
 EXAMBN19 SA6    PARM4       P4 = B 
          SX6    10          SET TYPE 
          EQ     EXAMBN2     GO SET P2, P3 AND EXIT 
  
  
*      TYPE 11:  N\2'17;  N=2'A-2'B;  A>B 
  
*         X1 IS (60-X5) BINARY ZEROS,  (X7) BINARY ONES,  REST ZEROS
  
 EXAMBN20 IX6    X5-X7       B
          SA6    PARM4       P4 = B 
          BX7    X5          A
          SX6    11          SET TYPE 
          EQ     EXAMBN2     GO SET P2, P3 AND EXIT 
          SPACE  4
          LISTSEC  LI2AE
          TITLE  LI2AE -  LITERAL TO ALPHANUMERIC-EDITED ITEM 
**        LI2AE -  LITERAL TO ALPHANUMERIC-EDITED ITEM
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION ITEM.
* 
*         CALLZ  LI2AE
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
 LI2AE    EGO    2
  
*      EXAMINE LITERAL AND NOTE CHARACTERISTICS 
  
          IFZ    ((SPACESOF,REGB),EQ,1),LI2AEA   IF SPACES
          BRANCH LI2AEB                          POOLED LITERAL 
  
  
 LI2AE1   LABEL              (ALL RETURN HERE)
  
*      VREG1 = V.R.N. OF FIRST SOURCE WORD
*      P5 = BCP OF LITERAL
*      P6 = LENGTH OF LITERAL 
  
*      CREATE DUMMY REGTABL/DNAT TO REFERENCE THE EDIT PATTERN
  
          MOVEZ  REGU1,REGT 
          CALLZ  ADPDNAT
  
*      ANALYZE AND POOL THE EDIT PATTERN
  
          MOVEZ  P6,P1                           = (BYTLENOF,REGB)
*         REGC = REGTABL INDEX TO DESTINATION ITEM
*         REGT = REGTABL INDEX FOR EDIT PATTERN 
          EXECUTE EDITPAT 
  
*      LOAD THE FIRST WORD OF THE EDIT PATTERN
  
          IFTHEN (RECSUBS,EQ,0)                  IF NO SUBSCRIPTING 
            NOTE   LI2AE
            GEN    SBBPK,(VREGOF,VREG2),,((FWA$OF,REGU1)) 
          ELSEZ                                  IF SUBSCRIPTED 
            NOTE   LI2AE1 
          MOVEZ  RECSUBS,P1 
          MOVEZ  (BCPOF,REGC),P2
          GEN    SXBPK,(VREGOF,VREG4),,((FWA$OF,REGC))
          CALLZ  GTADBCP
*    SETS VREG4 = FWA DESTINATION 
*    SETS VREG5 = BCP DESTINATION 
          GEN    SLRBPK,(VREGOF,VREG2),,((FWA$OF,REGU1))
          GEN    SHL,VREG4,6
          GEN    LOR,(VREGOF,VREG4),VREG4,VREG5 
          GEN    SHL,VREG4,24 
          GEN    MASK,(VREGOF,VREG6),24 
          GEN    SHL,VREG6,48 
          GEN    LIMP,(VREGOF,VREG6),VREG2,VREG6
          GEN    LOR,(VREGOF,VREG5),VREG6,VREG4 
          GEN    SSRAPB,VREG5,VREG2 
            GEN    SBAPB,(VREGOF,VREG2),VREG2 
            ENDIFZ
  
*      CONSTRUCT SOURCE DESCRIPTOR
  
          LSHIFT P5,11
          ADDZ   P5,P6,P5 
          NOTE   LI2AE2 
          GEN    SXBPK,(VREGOF,VREG3),,P5 
  
*      NOW CALL C.EDIT
  
          IFTHEN ((LATALLOF,MOVEREGA),EQ,1) 
          ANDIF  ((BYTLENOF,MOVEREGB),GE,32)
            GENOBJ  N=C.AL2AE,I=(VREG1,VREG2,VREG3) 
          ELSEZ 
            GENOBJ  N=C.EDIT,I=(VREG1,VREG2,VREG3)
          ENDIFZ
  
          RETURN
A,B       EJECT 
**        LI2AEA -  LITERAL IS SPACES 
* 
*         SETS P5 = BCP, P6 = LENGTH
  
  
 LI2AEA   LABEL 
          NOTE   LI2AEA 
          GEN    SBBPK,(VREGOF,VREG1),,((EXT$OF,C.BLANK)) 
          MOVEZ  0,P5                            BCP
          MOVEZ  1,P6                            LENGTH 
          BRANCH LI2AE1                          RETURN 
          SPACE  4
**        LI2AEB -  LITERAL IS POOLED 
* 
*         SETS P5 = BCP, P6 = LENGTH. 
  
  
 LI2AEB   LABEL 
          NOTE   LI2AEB 
          MOVEZ  (BCPOF,REGB),P5
          MOVEZ  (BYTLENOF,REGB),P6              LENGTH 
          GEN    SBBPK,(VREGOF,VREG1),,((FWA$OF,REGB))
          BRANCH LI2AE1                          RETURN 
          SPACE  4
          LISTSEC  LI2AN
          TITLE  LI2AN -  LITERAL TO ALPHANUMERIC ITEM
**        LI2AN -  LITERAL TO ALPHANUMERIC ITEM 
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION ITEM.
* 
*         CALLZ  LI2AN
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
 LI2AN    EGO    2
          SUBZ   (FIGVALOF,MOVEREGA),1,HILOFLG
          IFZ    (HILOFLG,GE,0),LI2AN050
          MOVEZ  (SPACESOF,MOVEREGA),SPACFLG
          IFZ    (SPACFLG,NE,0),LI2AN050
          MOVEZ  (ZEROSOF,MOVEREGA),ZEROFLG 
          IFZ    (ZEROFLG,EQ,0),LI2AN025
*                            HANDLE ZEROS LIKE SPACES FOR MOVE TO NON-
*                            VARIABLY-SUBSCRIPTED AN
          IFZ    (RECSUBS,EQ,0),LI2AN050
 LI2AN025 LABEL 
          IFTHEN ((MAJMSCOF,MOVEREGA),EQ,LITMSEC) 
            MOVEZ  1,POOLFLG
          ELSEZ 
            MOVEZ  0,POOLFLG
          ENDIFZ
  
*      MOST LI2AN MOVES CAN BE PROCESSED LIKE AN2AN MOVES 
          IFTHEN (POOLFLG,EQ,0) 
          ANDIF  ((TYPEOF,MOVEREGB),EQ,VARGROUP)
            BRANCH AN2VG
          ENDIFZ
          IFTHEN ((LATALLOF,MOVEREGA),EQ,0) 
          ANDIF  ((TYPEOF,MOVEREGB),EQ,VARGROUP)
            BRANCH AN2VG
          ENDIFZ
  
          IFZ    (POOLFLG,EQ,0),AN2AN 
          IFZ    ((LATALLOF,MOVEREGA),EQ,0),AN2AN 
  
*      LITERAL IS A SPECIAL CASE- EXTRACT USEFUL INFORMATION BEFORE 
*      GOING TO A SPECIFIC PROCESSOR
  
 LI2AN050 LABEL 
          MOVEZ  (BCPOF,MOVEREGB),RECBCP
          MOVEZ  (BYTLENOF,MOVEREGA),SENDSIZE 
          MOVEZ  (BYTLENOF,MOVEREGB),RECSIZE
          ADDZ   RECBCP,RECSIZE,RECECP
  
*      PROCESS SUBSCRIPTED RECEIVING FIELDS ELSEWHERE 
  
          IFZ    (RECSUBS,NE,0),LI2SA 
  
*      BRANCH TO THE APPROPRIATE PROCESSOR
  
          IFZ    (HILOFLG,GE,0),LI2AN900
          IFZ    (SPACFLG,NE,0),LI2AN500
          IFTHEN  (ZEROFLG,NE,0)  IF ZEROS, CREATE DNAT FOR 
*                                             RCV OF TYPE -COMP-
            MOVEZ  REGU1,REGT  SET UP REG FOR ADPDNAT 
            CALLZ  ADPDNAT   ALLOCATE DNAT ENTRY POINTED TO VIA REGT
            MOVEZ  REGC,P1    (T1)=INDEX OF NEW DNAT ENTRY
            MOVEZ  REGT,P2
            EXECUTE  CGREGMV  COPY REGTABLE INFO FROM REGC TO REGT
            MOVEZ  T1,(REGPTROF,REGT)  POINT TO NEW DNAT ENTRY
            MOVEZ  (DNATOF,REGC),(DNATOF,REGT)  REGC DNAT TO REGT DNAT
            MOVEZ  COMP,(TYPEOF,REGT)  RCV IS TYPE -COMP- 
            MOVEZ  COMP,(TYPEOF,MOVEREGA)  SET CORRECT TYPE FOR SPCFILL 
            MOVEZ  REGT,REGC  REGC POINTS TO NEW DNAT 
            BRANCH  LI2AN500
          ENDIFZ
          IFZ    (RECSIZE,LE,10),AN2AN  CONSTANT REFERENCE MODIFIERS
          EJECT 
*OP.BDP   IFEQ   OP.BDP,OP.NO      PUT BACK IN WHEN CMU STUFF CODED 
  
************************************************************************
*                                                                      *
*      LONG REPEATING LITERALS TO UNSUBSCRIPTED ALPHANUMERIC MOVE      *
*      PROCESSOR  (NON-CMU)                                            *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE NON-CMU CODE TO MOVE A REPEATING LITERAL (NOT ALL   *
*         SPACES) TO AN UNSUBSCRIPTED RECEIVING FIELD WITH AN          *
*         OCCURRENCE LENGTH > 30 CHARS                                 *
*                                                                      *
*      NOTE-                                                           *
*         THE REASON THIS CODE IS SO INEFFICIENT IS BECAUSE CBMOVE     *
*         USES AND DESTROYS SO MANY REGISTERS                          *
*                                                                      *
************************************************************************
  
 LI2AN100 LABEL 
          NOTE   LI2AN100 
  
*      SET B3 TO ADDRESS OF RECEIVING FIELD 
  
          GEN    SBBPK,(VREGOF,VREGB),,RECADDR
  
*      SET B4 TO BCP OF RECEIVING FIELD 
  
          MOVEZ  RECBCP,P1
          CALLZ  SETBREG
          MOVEZ  VREGX,VREGC
  
*      SET XJ TO NUMBER OF CHARS IN RECEIVING FIELD (= NUM OF CHARS TO
*      MOVE)
  
          GEN    SXBPK,(VREGOF,VREGA),,RECSIZE
          GEN    HOLDR,VREGA
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    LABEL$,LOCLABL 
  
*      SET B7 TO SIZE OF LITERAL
  
          GEN    SBBPK,(VREGOF,VREGD),,SENDSIZE 
  
*      SET B5 TO FWA OF LITERAL 
  
          GEN    SBBPK,(VREGOF,VREGE),,SRCADDR
  
*      SET B6 TO BCP OF LITERAL (=0)
  
          GEN    SBBPB,(VREGOF,VREGF) 
  
*      SET X2 TO NUMBER OF BLANKS TO PAD (=0) 
  
          GEN    MASK,(VREGOF,VREGG)
  
*      CALL CBMOVE TO DO MOVE 
  
          GENOBJ N=C.MOVE,I=(VREGB,VREGX,VREGE,VREGF,VREGD,VREGG),O=((VR
,EGOF,VREGB),(VREGOF,VREGC))
  
*      DECREMENT COUNT OF CHARS TO BE MOVED BY COUNT OF CHARS JUST MOVED
  
          SUBZ   0,SENDSIZE,SENDSIZE
          GEN    SXXPK,VREGA,VREGA,SENDSIZE 
  
*      IF THERE ARE ENOUGH CHARS LEFT TO STORE THE WHOLE POOLED LIT-
*      LOOP 
  
          GEN    SBXPK,(VREGOF,VREGH),VREGA,SENDSIZE
          SUBZ   0,SENDSIZE,SENDSIZE
          GEN    LT$,,VREGH,LOCLABL 
  
*      SET UP TO STORE INTO LAST PART OF RECEIVING FIELD WHICH IS 
*      SHORTER THAN THE POOLED LITERAL
  
*      SET B7 TO NUMBER OF CHARS TO STORE 
  
          GEN    SBXPB,(VREGOF,VREGD),VREGA 
  
*      SET B6 TO THE BCP OF THE SOURCE FIELD (=0) 
  
          GEN    SBBPB,(VREGOF,VREGF) 
  
*      SET B5 TO THE FWA OF THE POOLED LITERAL
  
          GEN    SBBPK,(VREGOF,VREGE),,SRCADDR
  
*      SET X2 TO THE NUMBER OF BLANKS TO PAD (=0) 
  
          GEN    MASK,(VREGOF,VREGG)
  
*      CALL CBMOVE TO DO MOVE 
  
          GENOBJ N=C.MOVN,I=(VREGB,VREGC,VREGE,VREGF,VREGD,VREGG) 
          GEN    RFREE,VREGA
          RETURN
  
*OP.BDP   ENDIF                    PUT BACK IN WHEN CMU STUFF CODED 
          EJECT 
 OP.BDP   IFEQ   OP.BDP,OP.NO 
  
************************************************************************
*                                                                      *
*      SPACES TO ALPHANUMERIC MOVE PROCESSOR  (NON-CMU)                *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE NON-CMU CODE TO MOVE (A LITERAL WHOSE VALUE IS ALL) *
*         SPACES TO AN UNSUBSCRIPTED RECEIVING FIELD                   *
*                                                                      *
************************************************************************
  
 LI2AN500 LABEL 
          IFZ    (RECECP,GT,10),LI2AN550
  
************************************************************************
*      GENERATE CODE TO MOVE SPACES TO A SP RECEIVING FIELD            *
************************************************************************
  
          NOTE   LI2AN500 
          MOVEZ  RECSIZE,P5 
          MOVEZ  RECBCP,P6
          CALLZ  GETSPCS   SR,BR;VREGA
          MOVEZ  RECBCP,P3
          MOVEZ  RECSIZE,P4 
          CALLZ  STORIT1   KR,BR,SR,VREGA;VREGC 
          RETURN
          SPACE  4
*      PROCESS SPACES TO A DP OR TP OR EP RECEIVING FIELD 
  
 LI2AN550 LABEL 
          IFZ    (RECECP,GT,20),LI2AN580
  
*      RECEIVING FIELD IS DP
  
          IFZ    (RECBCP,LT,8),LI2AN580 
          IFZ    (RECECP,GT,12),LI2AN580
  
************************************************************************
*      GENERATE CODE TO MOVE SPACES TO A DP RECEIVING FIELD IN THE     *
*      SPECIAL CASE WHICH REQUIRES NO LOADS (BOTH THE PART OF THE      *
*      RECEIVING FIELD LYING IN THE FIRST WORD AND THE PART IN THE     *
*      SECOND WORD ARE LESS THAN 3 CHARS LONG                          *
************************************************************************
  
          NOTE   LI2AN550 
          SUBZ   10,RECBCP,P5 
          MOVEZ  RECBCP,P6
          CALLZ  GETSPCS   10-BR,BR;VREGA 
          MOVEZ  RECBCP,P3
          MOVEZ  P5,P4
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   RECECP,10,P5 
          MOVEZ  0,P6 
          CALLZ  GETSPCS   (BR+SR)-10,0;VREGA 
          MOVEZ  P5,P6
          CALLZ  STORIT2   VREGC,(BR+SR)-10,VREGA;VREGC 
          RETURN
          SPACE  4
************************************************************************
*      GENERATE CODE TO MOVE SPACES TO A DP (OTHER THAN THE ABOVE      *
*      SPECIAL CASE) OR TP OR EP RECEIVING FIELD.  IN ALL THESE CASES  *
*      IT IS MORE EFFICIENT TO DO 1 LOAD OF C.BLANK AND MASK THAN TO   *
*      LOAD WORD(S) FROM C.FILLT OR SET X-REGS TO 55B OR 5555B         *
************************************************************************
  
*                  ARITH21: [(FIXED-1)MOD 10]+1 
*                  ARITH22: (FIXED+9)/10
 LI2AN580 LABEL 
          NOTE   LI2AN580 
          SUBZ   10,RECBCP,P5 
          CALLZ  GTSPCRT   10-BR;VREGA
          MOVEZ  RECBCP,P3
          MOVEZ  P5,P4
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   (ARITH22,RECECP),2,P5
          CALLZ  STRBLNK   [(BR+SR+9)/10]-2,VREGC 
          MOVEZ  (ARITH21,RECECP),P6
          CALLZ  GTSPCLF   [(BR+SR-1)MOD 10]+1;VREGA
          CALLZ  STORIT2   VREGC;[(BR+SR-1)MOD 10]+1,VREGA;VREGC
          RETURN
  
 OP.BDP   ENDIF 
  
 OP.BDP   IFEQ   OP.BDP,OP.YES
************************************************************************
*                                                                      *
*      SPACES TO ALPHANUMERIC MOVE PROCESSOR  (CMU)                    *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE CMU CODE TO MOVE (A LITERAL WHOSE VALUE IS ALL)     *
*         SPACES TO AN UNSUBSCRIPTED RECEIVING FIELD                   *
*                                                                      *
************************************************************************
  
 LI2AN500 LABEL 
          NOTE   LI2AN500 
          MOVEZ  0,RECOFST
          MOVEZ  RECSIZE,P4 
          MOVEZ  RECBCP,P3
          CALLZ  SPCFILL
          RETURN
  
 OP.BDP   ENDIF 
  
          EJECT 
************************************************************************
*                                                                      *
*      HIGH-VALUE OR LOW-VALUE TO ALPHANUMERIC MOVE PROCESSOR (NON-CMU)*
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE NON-CMU CODE TO MOVE HIGH-VALUES OR LOW-VALUES TO   *
*         AN UNSUBSCRIPTED RECEIVING FIELD.  THIS CODE IS ONLY USED    *
*         WHEN ALPHABET NAMES AND SET COLLATING SEQUENCE CLAUSES ARE   *
*         PRESENT IN THE SOURCE PROGRAM (VALUE OF HIGH-VALUE OR LOW-   *
*         VALUE IS UNKNOWN AT COMPILE TIME)                            *
*                                                                      *
************************************************************************
  
 LI2AN900 LABEL 
  
*      COMMON PARAMETER SETUP FOR ALL CASES 
  
          MOVEZ  RECBCP,P1
          MOVEZ  RECBCP,P3
  
          IFZ    (RECECP,GT,10),LI2AN920
  
************************************************************************
*      GENERATE CODE TO MOVE HIGH-VALUES OR LOW-VALUES TO A SP         *
*      RECEIVING FIELD.                                                *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*         P1=BR 
*         P2=BR 
  
          NOTE   LI2AN900 
          MOVEZ  RECSIZE,P2 
          CALLZ  LDHILO1   KL,BR,SR;VREGA,VREGB 
          MOVEZ  RECSIZE,P4 
          CALLZ  STORIT1   KR,BR,SR,VREGA;VREGC 
          RETURN
          SPACE  4
*      BEGIN PROCESSING HIGH-VALUE OR LOW-VALUE TO DP OR TP OR EP 
*      RECEIVING FIELD
  
 LI2AN920 LABEL 
  
*      COMMON PARAMETER SETUP FOR ALL DP, TP OR EP CASES
  
          SUBZ   10,RECBCP,P2 
          SUBZ   10,RECBCP,P4 
  
          IFZ    (RECECP,GT,30),LI2AN960
          IFZ    (RECECP,GT,20),LI2AN940
  
************************************************************************
*      GENERATE CODE TO MOVE HIGH-VALUES OR LOW-VALUES TO A DP
*      RECEIVING FIELD.                                                *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*         P1=BR 
*         P2=10-BR
*         P3=BR 
*         P4=10-BR
  
          NOTE   LI2AN920 
          CALLZ  LDHILO1   KL,BR,10-BR;VREGA,VREGB
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   RECECP,10,P6 
          CALLZ  LDHILO2   VREGB,(BR+SR)-10;VREGA 
          CALLZ  STORIT2   VREGC,(BR+SR)-10,VREGA;VREGC 
          RETURN
          SPACE  4
************************************************************************
*      GENERATE CODE TO MOVE HIGH-VALUES OR LOW-VALUES TO A TP         *
*      RECEIVING FIELD.                                                *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*         P1=BR 
*         P2=10-BR
*         P3=BR 
*         P4=10-BR
  
 LI2AN940 LABEL 
          NOTE   LI2AN940 
          CALLZ  LDHILO1   KL,BR,10-BR;VREGA,VREGB
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          MOVEZ  10,P6
          CALLZ  LDHILO2   VREGB,10YVREGA 
          CALLZ  STORIT2   VREGC,10,VREGA;VREGC 
          SUBZ   RECECP,20,P6 
          CALLZ  LDHILO2   VREGB,(BR+SR)-20;VREGA 
          CALLZ  STORIT2   VREGC,(BR+SR)-20,VREGA;VREGC 
          RETURN
          SPACE  4
************************************************************************
*      GENERATE CODE TO MOVE HIGH-VALUES OR LOW-VALUES TO AN EP        *
*      RECEIVING FIELD                                                 *
************************************************************************
          SPACE  4
          LISTSEC  LI2C4
          TITLE  LI2C4 - LITTERAL TO COMP-4 ITEM
************************************************************************
*         REGB=  DNAT POINTER TO SOURCE LITTERAL                       *
*         REGC=  DNAT POINTER TO DESTINATION ITEM                      *
*                                                                      *
*         CALLZ  LI2C4                                                 *
*                                                                      *
*         GENERATES CODE TO PERFORM THE INDICATED MOVE                 *
*                                                                      *
************************************************************************
 LI2C4    EGO    2
          NOTE   LI2C4
* 
*     CREATE DUMMY DNAT 
* 
          MOVEZ  REGU1,REGT 
          CALLZ  ADNAT
          MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGU1) 
          MOVEZ  (POINTOF,REGC),(POINTOF,REGU1) 
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGU1) 
* 
*     CONVERT LITTERAL IN REGB TO R1 (IN REGU1) 
* 
          PUSH   REGC                            SAVE ORIGINAL DESTINAT.
          MOVEZ  REGU1,REGC 
          CALLZ  LI2R1                           CONVERT (REG) _ (REGC) 
          POP    REGC 
* 
*     STORE RESULT
* 
          MOVEZ  (TREGOF,REGU1),P1
          CALLZ  STORC4 
          CALLZ  SUBDNAT
          RETURN
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*         P1=BR 
*         P2=10-BR
*         P3=BR 
*         P4=10-BR
  
*                  ARITH21: [(FIXED-1)MOD 10]+1 
*                  ARITH22: (FIXED+9)/10
 LI2AN960 LABEL 
          NOTE   LI2AN960 
          CALLZ  LDHILO1   KL,BR,10-BR;VREGA,VREGB
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   (ARITH22,RECECP),2,P5
          CALLZ  MOVHILO   [(BR+SR+9)/10]-2,VREGB,VREGC 
          MOVEZ  (ARITH21,RECECP),P6
          CALLZ  LDHILO2   VREGB,[(BR+SR-1)MOD 10]+1;VREGA
          CALLZ  STORIT2   VREGC,[(BR+SR-1)MOD 10]+1,VREGA;VREGC
          TITLE  LI2SA -  LITERAL TO SUBSCRIPTED ALPHANUM MOVE PROCESSOR
************************************************************************
*                                                                      *
*      LI2SA - LITERAL TO SUBSCRIPTED ALPHANUMERIC MOVE PROCESSOR      *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE CODE TO MOVE THOSE SPECIAL CASE LITERALS WHICH CAN"T*
*         BE HANDLED LIKE DATA ITEMS (E.G. SPACES) TO A SUBSCRIPTED    *
*         RECEIVING FIELD                                              *
*                                                                      *
************************************************************************
  
 LI2SA    LABEL 
          IFZ    (HILOFLG,GE,0),LI2SA900
          IFZ    (SPACFLG,NE,0),LI2SA500
  
  
*OP.BDP   IFEQ   OP.BDP,OP.NO      PUT BACK IN WHEN CMU STUFF CODED 
  
************************************************************************
*                                                                      *
*      LONG REPEATING LITERALS TO SUBSCRIPTED ALPHANUMERIC PROCESSOR   *
*      (NON-CMU)                                                       *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE NON-CMU CODE TO MOVE A REPEATING LITERAL (NOT ALL   *
*         SPACES) TO A SUBSCRIPTED RECEIVING FIELD WITH AN OCCURRENCE  *
*         LENGTH > 30 CHARS                                            *
*                                                                      *
*      NOTE-                                                           *
*         THE REASON THIS CODE IS SO INEFFICIENT IS BECAUSE CBMOVE     *
*         USES AND DESTROYS SO MANY REGISTERS                          *
*                                                                      *
************************************************************************
  
 LI2SA100 LABEL 
          NOTE   LI2SA100 
  
*      SET B3 TO THE FWA OF THE "0-TH" OCCURRENCE OF THE RECEIVING FIELD
  
          GEN    SBBPK,(VREGOF,VREGB),,RECADDR
  
*      PICK UP SUBSCRIPT, SHIFT OFF LOWER 30 BITS AND ADD IT TO THE 
*      BCP OF THE "0-TH" OCCURRENCE OF THE RECEIVING FIELD.  SET B4 
*      TO THIS VALUE WHICH EQUALS THE CHAR OFFSET OF THE RECEIVING
*      FIELD
  
          MOVEZ  REGC,P2
          CALLZ  SUBREF 
          GEN    SBXPB,(VREGOF,VREGC),P3
          MOVEZ  P4,VREGA 
          GEN    HOLDR,VREGA
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    LABEL$,LOCLABL 
  
*      SET B7 TO SIZE OF POOLED LITERAL 
  
          MOVEZ  (GSCODEOF,MOVEREGB),T1 
          IFTHEN ((RFLCPTYP,T1),NE,0) 
            GEN    SBBPK,(VREGOF,VREGX),,SENDSIZE 
            GEN    HOLDR,VREGX
            GEN    SBXPB,(VREGOF,VREGH),VREGA 
            MOVEZ  (LOCLAB,LABEL1),LABEL1 
            GEN    LT$,VREGX,VREGH,((LOCAL$OF,LABEL1))
            GEN    SBXPB,VREGX,VREGA   USER RECEIVER LENGTH 
            GEN    LABEL$,((LOCAL$OF,LABEL1)) 
            GEN    SBBPB,(VREGOF,VREGD),VREGX 
            GEN    RFREE,VREGX
          ELSEZ 
          GEN    SBBPK,(VREGOF,VREGD),,SENDSIZE 
          ENDIFZ
  
*      SET B5 TO FWA OF LITERAL 
  
          GEN    SBBPK,(VREGOF,VREGE),,SRCADDR
  
*      SET B6 TO BCP OF LITERAL (=0)
  
          GEN    SBBPB,(VREGOF,VREGF) 
  
*      SET X2 TO NUMBER OF BLANKS TO PAD (=0) 
  
          GEN    MASK,(VREGOF,VREGG)
  
*      CALL CBMOVE TO DO MOVE 
  
          GENOBJ N=C.MOVE,I=(VREGB,VREGC,VREGE,VREGF,VREGD,VREGG),O=((VR
,EGOF,VREGB),(VREGOF,VREGC))
  
*      DECREMENT COUNT OF CHARS TO BE MOVED BY COUNT OF CHARS JUST MOVED
  
          SUBZ   0,SENDSIZE,SENDSIZE
          GEN    SXXPK,VREGA,VREGA,SENDSIZE 
  
*      IF THERE ARE ENOUGH CHARS LEFT TO STORE THE WHOLE POOLED LIT-
*      LOOP 
  
          GEN    SBXPK,(VREGOF,VREGH),VREGA,SENDSIZE
          SUBZ   0,SENDSIZE,SENDSIZE
          GEN    LT$,,VREGH,LOCLABL 
  
*      SET UP TO STORE INTO LAST PART OF RECEIEVING FIELD WHICH IS
*      SHORTER THAN THE POOLED LITERAL
  
*      SET B7 TO NUMBER OF CHARS TO STORE 
  
          GEN    SBXPB,(VREGOF,VREGD),VREGA 
          MOVEZ  (GSCODEOF,MOVEREGB),T1 
          IFTHEN ((RFLCPTYP,T1),NE,0) 
            MOVEZ  (LOCLAB,LABEL1),LABEL1 
            GEN    GE$,,VREGD,((LOCAL$OF,LABEL1)) 
          ENDIFZ
  
*      SET B6 TO THE BCP OF THE SOURCE FIELD (=0) 
  
          GEN    SBBPB,(VREGOF,VREGF) 
  
*      SET B5 TO THE FWA OF THE POOLED LITERAL
  
          GEN    SBBPK,(VREGOF,VREGE),,SRCADDR
  
*      SET X2 TO THE NUMBER OF BLANKS TO PAD (=0) 
  
          GEN    MASK,(VREGOF,VREGG)
  
*      CALL CBMOVE TO DO MOVE 
  
          GENOBJ N=C.MOVN,I=(VREGB,VREGC,VREGE,VREGF,VREGD,VREGG) 
          MOVEZ  (GSCODEOF,MOVEREGB),T1 
          IFTHEN ((RFLCPTYP,T1),NE,0) 
            GEN    LABEL$,((LOCAL$OF,LABEL1)) 
          ENDIFZ
          GEN    RFREE,VREGA
          RETURN
  
*OP.BDP   ENDIF                    PUT BACK IN WHEN CMU STUFF CODED 
          EJECT 
          IFEQ   OP.BDP,OP.NO 
  
************************************************************************
*                                                                      *
*      SPACES TO SUBSCRIPTED ALPHANUMERIC MOVE PROCESSOR  (NON-CMU)    *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE NON-CMU CODE TO MOVE (A LITERAL WHOSE VALUE IS ALL) *
*      SPACES TO A SUBSCRIPTED RECEIVING FIELD                         *
*                                                                      *
************************************************************************
  
 LI2SA500 LABEL 
          NOTE   LI2SA500 
  
*      SET B3 TO FWA OF "0-TH" OCCURRENCE OF RECEIVING FIELD
  
          GEN    SBBPK,(VREGOF,VREGC),,RECADDR
  
*      PICK UP SUBSCRIPT, SHIFT OFF LOWER 30 BITS AND ADD TO BCP OF 
*      "0-TH" OCCURRENCE OF ITEM.  SET B4 TO THIS VALUE WHICH IS THE
*      CHAR OFFSET OF THE RECEIVING FIELD 
  
          MOVEZ  REGC,P2
          CALLZ  SUBREF 
          GEN    SBXPB,(VREGOF,VREGU),P3
          MOVEZ  P4,VREGW 
  
*      SET B7=0 SO THAT CBMOVE WILL KNOW TO FILL RECEIVING FIELD WITH 
*      BLANKS 
  
          GEN    SBBPB,(VREGOF,VREGE) 
  
*      CALL CBMOVE TO DO THE MOVE 
  
          GENOBJ N=C.MOVS,I=(VREGC,VREGU,VREGE,VREGW) 
          RETURN
  
 OP.BDP   ENDIF 
  
 OP.BDP   IFEQ   OP.BDP,OP.YES
  
************************************************************************
*                                                                      *
*      SPACES TO SUBSCRIPTED ALPHANUMERIC MOVE PROCESSOR (CMU)         *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE CMU CODE TO MOVE (A LITERAL WHOSE VALUE IS ALL)     *
*         SPACES TO A SUBSCRIPTED RECEIVING FIELD                      *
*                                                                      *
************************************************************************
  
 LI2SA500 LABEL 
          MOVEZ  (GSCODEOF,MOVEREGB),T1 
          IFZ    ((RFLCPTYP,T1),NE,0),LI2SA800
          IFZ    (RECSIZE,GT,150),LI2SA530
  
************************************************************************
*      GENERATE CODE TO MOVE LESS THAN 150 SPACES TO A SUBSCRIPTED     *
*      RECEIVING FIELD                                                 *
************************************************************************
  
          NOTE   LI2SA500 
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    USE$,CMUBLOCK
          GEN    PLIST
          GEN    LABEL$,LOCLABL 
          GEN    MD$,RECSIZE,BLANKS,0,RECADDR,RECBCP
          GEN    ENDPL
          GEN    USE$,CODBLOCK
  
          GEN    SLRBPK,(VREGOF,VREGA),,LOCLABL 
          GEN    MASK,(VREGOF,VREGB)
          MOVEZ  RECSUBS,P1 
          CALLZ  SUBLOAD
          MOVEZ  P1,VREGC 
          GEN    MASK,(VREGOF,VREGD)
          GENOBJ N=C.CMUMV,I=(VREGA,VREGB,VREGC,VREGD)
          RETURN
          SPACE  4
************************************************************************
*      GENERATE CODE TO MOVE MORE THAN 150 SPACES TO A SUBSCRIPTED     *
*      RECEIVING FIELD                                                 *
************************************************************************
  
 LI2SA530 LABEL 
          NOTE   LI25A530 
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    USE$,CMUBLOCK
          GEN    PLIST
          GEN    LABEL$,LOCLABL 
          GEN    MD$,150,BLANKS,0,RECADDR,RECBCP
          GEN    ENDPL
          GEN    USE$,CODBLOCK
  
          GEN    SLRBPK,(VREGOF,VREGA),,LOCLABL 
          GEN    MASK,(VREGOF,VREGB)
          MOVEZ  RECSUBS,P1 
          CALLZ  SUBLOAD
          MOVEZ  P1,VREGC 
          SUBZ   RECSIZE,150,RECSIZE
          GEN    SXBPK,(VREGOF,VREGD),,RECSIZE
          GENOBJ N=C.CMUMV,I=(VREGA,VREGB,VREGC,VREGD)
          RETURN
  
 LI2SA800 LABEL 
          NOTE   LI2SA800    REFERENCE MODIFICATION 
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    USE$,CMUBLOCK
          GEN    PLIST
          GEN    LABEL$,LOCLABL 
          GEN    MD$,0,BLANKS,0,RECADDR,0 
          GEN    ENDPL
          GEN    USE$,CODBLOCK
          GEN    MASK,(VREGOF,VREGA),0           NOT JUSTIFIED
          GEN    SXBPB,(VREGOF,VREGB),VREGB0,VREGB1 
          GEN    SLRBPK,(VREGOF,VREGC),,LOCLABL 
          GEN    SXBPB,(VREGOF,VREGD),VREGB0,VREGB0 
          MOVEZ  MOVEREGB,P2
          CALLZ  SUBREF 
          GENOBJ N=C.CMURF,I=(VREGA,VREGB,P4,VREGC,P3,VREGD)
          RETURN
 OP.BDP   ENDIF 
          EJECT 
************************************************************************
*                                                                      *
*      HIGH-VALUE OR LOW-VALUE TO SUBSCRIPTED AN PROCESSOR (NON-CMU)   *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE NON-CMU CODE TO MOVE HIGH-VALUES OR LOW-VALUES TO   *
*      A SUBSCRIPTED RECEIVING FIELD.  THIS CODE IS ONLY USED WHEN     *
*      ALPHABET NAMES AND SET COLLATING SEQUENCE CLAUSES ARE PRESENT   *
*      IN THE SOURCE PROGRAM (VALUE OF HIGH-VALUE OR LOW-VALUE IS      *
*      UNKNOWN AT COMPILE TIME)                                        *
*                                                                      *
************************************************************************
  
 LI2SA900 LABEL 
          GEN    SBBPK,(VREGOF,VREGC),,RECADDR
          MOVEZ  REGC,P2
          CALLZ  SUBREF 
          GEN    SBXPB,(VREGOF,VREGU),P3
          GEN    SBXPB,(VREGOF,VREGX),P4
          GEN    SLRBPK,(VREGOF,VREGA),,LOVALADR
          GENOBJ N=C.MVHL,I=(VREGC,VREGU,VREGX,VREGA) 
          RETURN
          SPACE  4
          LISTSEC  LI2C1
 LI2BD    EJECT 
**        LI2BD - LITERAL TO BOOLEAN DISPLAY
 LI2BD    EGO    2
          IFZ    ((LATALLOF,MOVEREGA),NE,0),LI2AN   ALL LITERAL 
          IFTHEN ((GSCODEOF,REGC),EQ,0)          DESTINATION UNMODIFIED 
          ANDIF  ((BYTLENOF,REGB),EQ,(BYTLENOF,REGC))      NO FILL
            BRANCH  LI2AN 
          ENDIFZ
          CALLZ  BD2BD       ALL BOOLEAN LITERALS POOLED AS DISPLAY 
          RETURN
          TITLE  LI2C1 -  LITERAL TO COMP-1 ITEM
**        LI2C1 -  LITERAL TO COMP-1 ITEM 
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION ITEM.
* 
*         CALLZ  LI2C1
* 
*         GENERATES CODE TO PERFORM THE INDICATED MVOE. 
  
  
 LI2C1    EGO    2
          NOTE   LI2C1
          IFTHEN ((PLTQUOTE,REGB),NE,0)          QUOTED LITERAL 
            CALLZ  QLIT2NUM 
            CALLZ  ND2C1
            RETURN
          ENDIFZ
  
*      CREATE A DUMMY DNAT
  
          MOVEZ  (EQUALS,REGU1),REGT
          CALLZ  ADNAT                           CREATE REGU1 DNAT
          MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGU1) 
          MOVEZ  (POINTOF,REGC),(POINTOF,REGU1) 
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGU1) 
  
*      CONVERT LITERAL (IN REGB) TO R1 (IN REGU1) 
  
          MOVEZ  REGC,SAVREGC1                   SAVE ORIGINAL DEST.
          MOVEZ  (EQUALS,REGU1),REGC             THIS DEST. IS REGU1
          CALLZ  LI2R1                           CONVERT (REGB) _ (REGC)
          MOVEZ  SAVREGC1,REGC                   RESTORE ORIGINAL DEST. 
  
*      STORE R1 (IN REGU1) INTO C1 (IN REGC)
  
          MOVEZ  (TREGOF,REGU1),P1
          CALLZ  STORC1C2 
  
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          RETURN
          SPACE  4
          LISTSEC  LI2C2
          TITLE  LI2C2 -  LITERAL TO COMP-2 ITEM
**        LI2C2 -  LITERAL TO COMP-2 ITEM 
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION ITEM.
* 
*         CALLZ  LI2C2
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
 LI2C2    EGO    2
          NOTE   LI2C2
          IFTHEN ((PLTQUOTE,REGB),NE,0)          QUOTED LITERAL 
            CALLZ  QLIT2NUM 
            CALLZ  ND2C2
            RETURN
          ENDIFZ
  
*      CREATE A DUMMY DNAT
  
          MOVEZ  (EQUALS,REGU1),REGT
          CALLZ  ADNAT                           CREATE REGU1 DNAT
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGU1) 
          MOVEZ  (POINTOF,REGB),(POINTOF,REGU1) 
          MOVEZ  (SIGNOF,REGB),(SIGNOF,REGU1) 
          MOVEZ  (POINTOF,REGC),(POINTOF,REGU1) 
          MOVEZ  (SIGNOF,REGC),(SIGNOF,REGU1) 
  
*      CONVERT LITERAL (IN REGB) TO R2 (IN REGU1) 
  
          MOVEZ  REGC,SAVREGC1                   SAVE ORIGINAL DEST.
          MOVEZ  (EQUALS,REGU1),REGC             THIS DEST. IS REGU1
          CALLZ  LI2R2                           CONVERT (REGB) _ (REGC)
          MOVEZ  SAVREGC1,REGC                   RESTORE ORIGINAL DEST. 
  
*      STORE R2 (IN REGU1) INTO C2 (IN REGC)
  
          MOVEZ  (TREGOF,REGU1),P1
          CALLZ  STORC1C2 
  
          CALLZ  SUBDNAT                         DELETE REGU1 DNAT
          RETURN
          SPACE  4
          LISTSEC  LI2ND
          TITLE  LI2ND -  LITERAL TO NUMERIC DISPLAY ITEM 
**        LI2ND -  LITERAL TO NUMERIC DISPLAY ITEM
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION ITEM.
* 
*         CALLZ  LI2ND
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
 LI2ND    EGO    2
          SUBZ    (FIGVALOF,REGB),1,HILOFLG 
          IFZ     (HILOFLG,GE,0),LI2ND0 
          IFTHEN ((MAJMSCOF,REGB),EQ,LITMSEC)  POOLED LITERAL 
          ANDIF  ((TYPEOF,REGB),EQ,COMP)
            MOVEZ  1,POOLFLG
            CALLZ  AN2AN
            RETURN
          ENDIFZ
  
          IFTHEN ((MAJMSCOF,REGB),EQ,LITMSEC)    POOLED LITERAL 
          ANDIF  ((TYPEOF,REGB),EQ,ALPHNUM) 
            MOVEZ  1,POOLFLG
            CALLZ  ND2ND
            RETURN
          ENDIFZ
          IFTHEN ((PLTQUOTE,REGB),NE,0)          QUOTED LITERAL 
          ANDIF  ((FIGVALOF,REGB),EQ,0) 
            CALLZ  QLIT2NUM 
            CALLZ  ND2ND
            RETURN
          ENDIFZ
*      IF COMP-2 LITERAL,  GO PROCESS 
  
          MOVEZ  (LITREFOF,REGB),P1 
          EXECUTE  SCANLIT                       SEARCH FOR *E* 
          IFZ    (P2,LT,0),LI2ND1                IF *E* FOUND,  JUMP
          NOTE   LI2ND
  
 LI2ND0   LABEL 
*      CREATE DUMMY DNAT
  
          MOVEZ  (EQUALS,REGU1),REGT
          CALLZ  ADNAT                           CREATE REGU1 DNAT
          MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGU1) 
          MOVEZ  (POINTOF,REGC),(POINTOF,REGU1) 
          ANDZ   (SIGNOF,REGB),(SIGNOF,REGC),(SIGNOF,REGU1) 
  
*      CONVERT LITERAL (IN REGB) TO RN (IN REGU1) 
  
          MOVEZ  REGC,SAVREGC1                   SAVE ORIGINAL DEST.
          MOVEZ  (EQUALS,REGU1),REGC             THIS DEST. IS REGU1
          CALLZ  LI2RN                           CONVERT (REGB) _ (REGC)
          MOVEZ  SAVREGC1,REGC                   RESTORE ORIGINAL DEST. 
  
*      STORE RN (IN REGU1) INTO ND (IN REGC)
  
          MOVEZ  REGB,SAVREGB1                   SAVE ORIGINAL SOURCE 
          MOVEZ  (EQUALS,REGU1),REGB             THIS SOURCE IS REGU1 
          CALLZ  RN2ND                           CONVERT (REGB) _ (REGC)
          MOVEZ  SAVREGB1,REGB                   RESTORE ORIGINAL SOURCE
  
          CALLZ  SUBDNAT
          RETURN
  
  
*      MOVE *E*-TYPE FLOATING POINT LITERAL TO NUMERIC DISPLAY
  
 LI2ND1   LABEL 
          NOTE   LI2ND1 
*         P1 = (LITREFOF,REGB)
          EXECUTE  LIT2RN                        P5 = 0, P6 = COMP-2 LIT
          MOVEZ  0,(BCPOF,REGB) 
          MOVEZ  10,(BYTLENOF,REGB) 
          MOVEZ  REGB,REGT                       LIT DESCRIBED BY REGB
          MOVEZ  0,P1                            P2 = VALUE, NOT ADDRESS
          MOVEZ  P6,P2                           SET COMP-2 LITERAL 
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) = ADDR 
          GEN    SLRBPK,(VREGOF,VREG1),,((FWA$OF,REGB)) 
          MOVEZ  REGU1,REGT 
          CALLZ  ADNAT
          MOVEZ  VREG1,(TREGOF,REGU1) 
*         MOVEZ  0,(POINTOF,REGU1)               (SET BY *ADNAT*) 
*         MOVEZ  0,(NUMLENOF,REGU1)              (SET BY *ADNAT*) 
          MOVEZ  1,(SIGNOF,REGU1)                LITERAL MAY BE SIGNED
          PUSH   REGB                            SAVE ORIGINAL SOURCE 
          MOVEZ  REGU1,REGB                      THIS SOURCE IS REGU1 
          CALLZ  R22ND                           MOVE (REGB) TO (REGC)
          POP    REGB                            RESTORE ORIGINAL SOURCE
          RETURN
          SPACE  4
          LISTSEC  LI2NE
          SPACE  4
          TITLE  LI2NE -  LITERAL TO NUMERIC-EDITED ITEM
**        LI2NE -  LITERAL TO NUMERIC-EDITED ITEM 
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION ITEM.
* 
*         CALLZ  LI2NE
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
 LI2NE    EGO    2
          IFTHEN ((MAJMSCOF,REGB),EQ,LITMSEC) 
            MOVEZ  1,POOLFLG
            CALLZ  ND2NE
            RETURN
          ENDIFZ
          IFTHEN ((PLTQUOTE,REGB),NE,0)          QUOTED LITERAL 
          ANDIF  ((FIGVALOF,REGB),EQ,0) 
            CALLZ  QLIT2NUM 
            CALLZ  ND2NE
            RETURN
          ENDIFZ
  
*      CREATE DUMMY DNAT IN REGU1 
  
          MOVEZ  REGU1,REGT 
          CALLZ  ADNAT                           CREATE TEMPORARY DNAT
          MOVEZ  18,(NUMLENOF,REGU1)             ENSURE 2 WORDS 
          MOVEZ  (POINTOF,REGB),(POINTOF,REGU1) 
          MOVEZ  (SIGNOF,REGB),(SIGNOF,REGU1) 
  
*      CONVERT LITERAL (IN REGB) TO 2-WORD RN (IN REGU1)
  
          PUSH   REGC                            SAVE ORIG. DESTINATION 
          MOVEZ  REGU1,REGC                      THIS DEST. IS REGU1
          CALLZ  LI2RN                           CONVERT (REGB) _ (REGC)
          POP    REGC                            RESTORE ORIGINAL DEST. 
  
*      CREATE DUMMY DNAT TO REFERENCE EDIT PATTERN
  
          MOVEZ  REGU2,REGT 
          CALLZ  ADPDNAT                         CREATE PERMANENT DNAT
  
*      ANALYZE EDIT PATTERN AND MAYBE POOL EDIT PATTERN 
  
          SUBZ   18,(POINTOF,REGB),P1            (INTLENOF,TEMP)
*         REGC = REGTABL INDEX TO DESTINATION ITEM
*         REGT = REGTABL INDEX FOR POSSIBLE EDIT PATTERN
          EXECUTE  EDITPAT
*         SETS P1 
  
*      IF SHORT ZZZ CASE,  PROCESS IT AND RETURN
  
          IFTHEN (P1,NE,0)                       IF ZZZ CASE
            CALLZ  LI2NEC                          PROCESS
            RETURN                                 RETURN 
            ENDIFZ
  
*      CONVERT NINE-S COMPLEMENT SIGN TO TRAILING OVERPUNCH SIGN
  
          NOTE   LI2NE
          IFTHEN ((SIGNOF,REGB),EQ,1)            IF SOURCE SIGNED 
            GEN    MASK,(VREGOF,VREG4),54 
            GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGU1) 
            GEN    SHR,VREG3,59 
            GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGU1),VREG3 
            GEN    LXOR,(VREGOF,VREG2),(TREGP1OF,REGU1),VREG3 
            GEN    LIMP,(VREGOF,VREG4),VREG2,VREG4
            GEN    SLRXPK,(VREGOF,VREG4),VREG4,((EXT$OF,C.ZN),-1R0) 
            GEN    LAND,(VREGOF,VREG4),VREG4,VREG3
            GEN    SXXPB,(VREGOF,VREG4),VREG4 
            GEN    LXOR,(VREGOF,VREG2),VREG2,VREG4
          ELSEZ                                  IF SOURCE UNSIGNED 
            GEN    XMIT,(VREGOF,VREG1),(TREGOF,REGU1) 
            GEN    XMIT,(VREGOF,VREG2),(TREGP1OF,REGU1) 
            ENDIFZ
  
*      STORE VALUE IN C.BUFF
  
          GEN    SSRBPK,VREG1,,((EXT$OF,C.BUFF))
          GEN    SSRAPB,VREG2,VREG1,VREGB1
  
*      DELETE DUMMY REGU1 DNAT
  
          CALLZ  SUBDNAT
  
*      HANDLE TRUNCATION OF SOURCE
  
          SUBZ   18,(POINTOF,REGB),T1            (INTLENOF,TEMP)
          IFTHEN (T1,GT,(INTLENOF,REGC))
            SUBZ   T1,(INTLENOF,REGC),T2
          ELSEZ 
            MOVEZ  0,T2 
            ENDIFZ
  
          SUBZ   18,T2,P1                        EDITED LENGTH
          ADDZ   T2,2,T2                         BCP + IGNORED DIGITS 
          QUOTZ  T2,10,T3                        WORD BIAS
          MOVEZ  (ARITH17,T2),T2                 NEW BCP = T2-T2/10*10
  
*      CONSTRUCT SOURCE DESCRIPTOR
  
          ADDZ   T2,20B,T2                       3/SIGN=001, 4/BCP
          LSHIFT T2,11                           3/SIGN, 4/BCP, 11/0
          ADDZ   T2,P1,T1                        3/SIGN, 4/BCP, 11/LEN
  
          IFTHEN (P1,EQ,0)                       IF SOURCE EFFECTIVELY 0
           ANDIF ((SIGNOF,REGB),EQ,1)              AND NEGATIVE 
            MOVEZ  1,P1                          PERSERVE -0 DIGIT
            MOVEZ  1,T3                          WORD BIAS
            MOVEZ  9,T2                          BCP
            ENDIFZ
  
*      PROCESS ACCORDING TO SUBSCRIPTING OF DESTINATION 
  
          IFTHEN (RECSUBS,EQ,0)                  IF DEST. NOT SUBSCR. 
            CALLZ  LI2NEA 
          ELSEZ                                  IF DEST. SUBSCRIPTED 
            CALLZ  LI2NEB 
            ENDIFZ
  
          RETURN
A         EJECT 
**        LI2NEA -  NON-TRIVIAL CASE,  DESTINATION NOT SUBSCRIPTED
* 
*         T1 = SOURCE DESCRIPTOR. 
*         T3 = WORD BIAS FROM *C.BUFF*
  
  
 LI2NEA   LABEL 
          NOTE   LI2NEA 
          GEN    SBBPK,(VREGOF,VREG1),,((EXT$OF,C.BUFF),T3) 
          GEN    SBBPK,(VREGOF,VREG2),,((FWA$OF,REGU2)) 
          GEN    SXBPK,(VREGOF,VREG3),,T1 
          GENOBJ N=C.EDIT,I=(VREG1,VREG2,VREG3) 
  
          RETURN
B         EJECT 
**        LI2NEB -  NON-TRIVIAL CASE,  DESTINATION SUBSCRIPTED
* 
*         T1 = SOURCE DESCRIPTOR. 
*         T3 = WORD BIAS FROM *C.BUFF*. 
  
  
 LI2NEB   LABEL 
          NOTE   LI2NEB 
          MOVEZ  RECSUBS,P1 
          MOVEZ  (BCPOF,REGC),P2
          GEN    SXBPK,(VREGOF,VREG4),,((FWA$OF,REGC))
          CALLZ  GTADBCP
*         SETS VREG4 = ACTUAL FWA OF SOURCE 
*         SETS VREG5 = ACTUAL BCP OF SOURCE 
          GEN    SLRBPK,(VREGOF,VREG2),,((FWA$OF,REGU2))
          GEN    SHL,VREG4,6
          GEN    LOR,(VREGOF,VREG4),VREG4,VREG5 
          GEN    SHL,VREG4,24 
          GEN    MASK,(VREGOF,VREG6),4
          GEN    SHL,VREG6,28 
          GEN    MASK,(VREGOF,VREG7),18 
          GEN    SHL,VREG7,48 
          GEN    LOR,(VREGOF,VREG6),VREG6,VREG7 
          GEN    LIMP,(VREGOF,VREG6),VREG2,VREG6
          GEN    LOR,(VREGOF,VREG6),VREG6,VREG4 
          GEN    SSRAPB,VREG6,VREG2 
          GEN    SBAPB,(VREGOF,VREG2),VREG2 
          GEN    SBBPK,(VREGOF,VREG1),,((EXT$OF,C.BUFF),T3) 
          GEN    SXBPK,(VREGOF,VREG3),,T1 
          GENOBJ N=C.EDIT,I=(VREG1,VREG2,VREG3) 
  
          RETURN
C         EJECT 
**        LI2NEC -  ZZZ CASE
* 
*         VREG1 = MOST SIGNIFICANT PART OF RN VALUE 
*         VREG2 = LEAST SIGNIFICANT PART OF RN VALUE
  
  
 LI2NEC   LABEL 
          NOTE   LI2NEC 
          GEN    MASK,(VREGOF,VREG3),P1          INDICATE DIGITS
          GENOBJ N=C.EDITZ,I=(VREG3,VREG2),O=((VREGOF,VREG1)) 
          MOVEZ  VREG1,(TREGOF,REGU1) 
          MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGU1) 
*         (POINTOF,REGU1) ALREADY = 0 
  
*      CONVERT RN (IN REGU1) TO ND (IN REGC)
  
          PUSH   REGB                            SAVE ORIGINAL SOURCE 
          MOVEZ  REGU1,REGB                      THIS SOURCE IS REGU1 
          CALLZ  RN2ND                           CONVERT (REGB) _ (REGC)
          POP    REGB                            RESTORE ORIGINAL SOURCE
          RETURN
          SPACE  4
          LISTSEC  LI2RA
          TITLE  LI2RA -  LITERAL TO REGISTER ALPHANUMERIC
**        LI2RA -  LITERAL TO REGISTER ALPHANUMERIC 
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION REGISTER.
* 
*         CALLZ  LI2RA
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
 LI2RA    EGO    2
  
          SUBZ   (FIGVALOF,MOVEREGA),1,HILOFLG
          IFZ    (HILOFLG,GE,0),LI2RA050
          MOVEZ  (SPACESOF,MOVEREGA),SPACFLG
          IFZ    (SPACFLG,NE,0),LI2RA050
          IFTHEN ((MAJMSCOF,MOVEREGA),EQ,LITMSEC) 
            MOVEZ  1,POOLFLG
          ELSEZ 
            MOVEZ  0,POOLFLG
          ENDIFZ
  
*      MOST LI2RA MOVES CAN BE PROCESSED LIKE AN2RA MOVES 
  
          BRANCH AN2RA
  
*      PROCESS SPECIAL CASE LOADS 
*      EXTRACT USEFUL INFORMATION BEFORE GOING TO A SPECIFIC PROCESSOR
  
 LI2RA050 LABEL 
          MOVEZ  (BCPOF,MOVEREGB),RECBCP
          MOVEZ  (BYTLENOF,MOVEREGA),SENDSIZE 
          MOVEZ  (BYTLENOF,MOVEREGB),RECSIZE
  
          IFZ    (HILOFLG,GE,0),LI2RA900
          EJECT 
************************************************************************
*                                                                      *
*      SPACES TO REGISTER-ALPHANUMERIC MOVE PROCESSOR                  *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE CODE TO LOAD SPACES INTO 1 OR 2 VIRTUAL REGISTERS   *
*         (THE ASSEMBLER WILL THROW OUT THE XMIT INSTRUCTION)          *
*                                                                      *
************************************************************************
  
 LI2RA500 LABEL 
          NOTE   LI2RA500 
          GEN    SLRBPK,(VREGOF,VREGA),,BLANKS
          MOVEZ  VREGA,(TREGOF,MOVEREGB)
          IFTHEN (RECSIZE,GT,10)
            GEN    XMIT,(VREGOF,VREGB),VREGA
          ENDIFZ
          RETURN
          EJECT 
************************************************************************
*                                                                      *
*      HI-VALUES OR LOW-VALUES TO ALPHANUMERIC-REGISTER PROCESSOR      *
*                                                                      *
*      PURPOSE-                                                        *
*         GENERATE CODE TO LOAD HIGH-VALUES OR LOW-VALUES FOLLOWED     *
*         BY BLANK FILL INTO 1 OR 2 REGISTERS                          *
*                                                                      *
************************************************************************
  
 LI2RA900 LABEL 
  
*      COMMON PARAMETER SETUP FOR ALL CASES 
  
          MOVEZ  0,P1 
  
          IFZ    (SENDSIZE,GT,10),LI2RA970
  
************************************************************************
*      GENERATE CODE TO LOAD LESS THAN 11 HIGH-VALUES OR LOW-VALUES    *
*      RETURN 1 REGISTER                                               *
************************************************************************
  
          NOTE   LI2RA900 
          MOVEZ  SENDSIZE,P2
          CALLZ  LDHILO1   KL,0,SS;VREGA,VREGB
          SUBZ   10,SENDSIZE,P5 
          MOVEZ  SENDSIZE,P6
          CALLZ  ADDSPCS   10-SS,SS,VREGA;VREGA 
          MOVEZ  VREGA,(TREGOF,MOVEREGB)
          RETURN
          SPACE  4
************************************************************************
*      GENERATE CODE TO LOAD MORE THAN 10 HIGH-VALUES OR LOW VALUES    *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*         P1=0
  
 LI2RA970 LABEL 
          NOTE   LI2RA970 
          MOVEZ  10,P2
          CALLZ  LDHILO1   KL,0,10;VREGA,VREGB
          MOVEZ  VREGA,VREGC
          SUBZ   SENDSIZE,10,P6 
          CALLZ  LDHILO2   VREGB,SS-10;VREGA
          SUBZ   20,SENDSIZE,P5 
          CALLZ  ADDSPCS   20-SS,SS-10,VREGA;VREGA
          GEN    XMIT,(VREGOF,VREGD),VREGC
          GEN    XMIT,(VREGOF,VREGE),VREGA
          MOVEZ  VREGA,(TREGOF,MOVEREGB)
          RETURN
          SPACE  4
          LISTSEC  LI2RN
          TITLE  LI2RN -  LITERAL TO REGISTER NUMERIC 
**        LI2RN -  LITERAL TO REGISTER NUMERIC
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION REGISTER.
* 
*         CALLZ  LI2RN
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
* 
*         THE PERMANENT DNAT ASSOCIATED WITH THE REGB LITERAL 
*         IS USED TO REFERENCE ANY POOLED LITERAL.
  
  
 LI2RN    EGO    2
          NOTE   LI2RN
  
*      IF LITERAL IS HIGH-VALUE OR LOW-VALUE,  GO PROCESS 
  
          SUBZ   (FIGVALOF,REGB),1,HILOFLG       0=LOW-VALUE, 1=HIGH
          IFZ    (HILOFLG,GE,0),LI2RN8
          IFTHEN  ((LATALLOF,REGB),EQ,0)
  
*      ANALYZE THE LITERAL
  
          MOVEZ  (LITREFOF,REGB),P1 
          MOVEZ  (NUMLENOF,REGC),P2 
          MOVEZ  (POINTOF,REGC),P3
          MOVEZ  (SIGNOF,REGC),P4 
          CALLZ  CLIT2RN
*         SETS P1 = MOST SIGNIFICANT DIGITS OF RESULT 
*         SETS P2 = LEAST SIGNIFICANT DIGITS OF RESULT
*         SETS P3 = C.ZEROS 
  
*      IF FLOATING POINT LITERAL,  PROCESS AND RETURN 
  
          IFZ    (P1,EQ,0),LI2RNB 
  
*      PROPAGATE POSSIBLE *ALL* LITERAL 
  
          ELSEZ 
            MOVEZ  (NUMLENOF,REGB),P3 
            MOVEZ  (NUMLENOF,REGC),P4 
            EXECUTE LI2RNA
            ENDIFZ
  
*      DETERMINE WHETHER 2-WORD RESULT
  
          SUBZ   (NUMLENOF,REGC),10,T1
          ADDZ   T1,(SIGNOF,REGC),T1             T1 > 0 IFF 2 WORDS 
          IFZ    (T1,GT,0),LI2RN2                IF 2-WORD RESULT 
  
*      HANDLE 1-WORD RESULT 
 LI2RN1   LABEL                                  (CROSS-REFS ONLY)
          NOTE   LI2RN1 
  
          IFTHEN (P2,EQ,P3)                      IF (P2) = C.ZEROS
            GEN    SLRBPK,(VREGOF,VREG1),CBZEROS
          ELSEZ                                  IF (P2) " C.ZEROS
            MOVEZ  0,(BCPOF,REGB) 
            MOVEZ  10,(BYTLENOF,REGB) 
            MOVEZ  REGB,REGT
            MOVEZ  0,P1                          P2 = VALUE, NOT ADDRESS
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
            GEN    SLRBPK,(VREGOF,VREG1),,FWASOURC
            ENDIFZ
  
          MOVEZ  VREG1,(TREGOF,REGC)
  
          RETURN
  
  
*      2-WORD RESULT
  
 LI2RN2   LABEL 
          IFZ    (P1,EQ,P3),LI2RN5               IF MOST SIG. = C.ZEROS 
          IFZ    (P2,EQ,P3),LI2RN4               IF LEAST SIG. = C.ZEROS
  
*      BOTH PARTS ARE NON-ZERO
  
 LI2RN3   LABEL                                  (CROSS-REFS ONLY)
          NOTE   LI2RN3 
          MOVEZ  0,(BCPOF,REGB) 
          MOVEZ  20,(BYTLENOF,REGB) 
          MOVEZ  REGB,REGT
          MOVEZ  P2,P3                           P3 = LEAST SIG. DIGITS 
          MOVEZ  P1,P2                           VALUE TO BE POOLED 
          MOVEZ  0,P1                            P2, P3 = VALUE 
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
          GEN    SLRBPK,(VREGOF,VREG1),,FWASOURC           VREG1
          GEN    SLRAPB,(VREGOF,VREG2),VREG1,VREGB1        VREG2=VREG1+1
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*      MOST SIGNIFICANT DIGITS " C.ZEROS,  LEAST SIGNIFICANT = C.ZEROS
  
 LI2RN4   LABEL 
          NOTE   LI2RN4 
          MOVEZ  0,(BCPOF,REGB) 
          MOVEZ  10,(BYTLENOF,REGB) 
          MOVEZ  REGB,REGT
          MOVEZ  P1,P2                           VALUE TO BE POOLED 
          MOVEZ  0,P1                            P2 = VALUE, NOT ADDRESS
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
          GEN    SLRBPK,(VREGOF,VREG1),,FWASOURC           VREG1
          GEN    SLRBPK,(VREGOF,VREG2),,CBZEROS            VREG2=VREG1+1
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*      MOST SIGNIFICANT DIGITS = C.ZEROS
  
 LI2RN5   LABEL 
          IFZ    (P2,EQ,P3),LI2RN7               IF LEAST SIG. = C.ZEROS
  
*      MOST SIGNIFICANT DIGITS = C.ZEROS,  LEAST SIGNIFICANT " C.ZEROS
  
 LI2RN6   LABEL                                  (CROSS-REFS ONLY)
          NOTE   LI2RN6 
          MOVEZ  0,(BCPOF,REGB) 
          MOVEZ  10,(BYTLENOF,REGB) 
          MOVEZ  REGB,REGT
          MOVEZ  0,P1                            P2 = VALUE, NOT ADDRESS
*         P2 = VALUE OF LITERAL 
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
          GEN    SLRBPK,(VREGOF,VREG1),,CBZEROS            VREG1
          GEN    SLRBPK,(VREGOF,VREG2),,FWASOURC           VREG2=VREG1+1
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*      MOST SIGNIFICANT DIGITS = C.ZEROS,  LEAST SIGNIFICANT = C.ZEROS
  
 LI2RN7   LABEL 
          NOTE   LI2RN7 
          GEN    SLRBPK,(VREGOF,VREG1),,CBZEROS            VREG1
          GEN    XMIT,(VREGOF,VREG2),VREG1                 VREG2=VREG1+1
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
A         EJECT 
**        LI2RNA -  PROPAGATE *ALL* LITERAL 
* 
*      GIVEN: 
*         P1 = MOST SIGNIFICANT 10 DIGITS 
*         P2 = LEAST SIGNIFICANT 10 DIGITS
*         P3 = NUMBER OF DIGITS IN LITERAL
*         P4 = NUMBER OF DIGITS IN DESTINATION. 
* 
*      DOES:  
*         THE (P3) DIGITS FROM THE LITERAL ARE ALIGNED LEFT 
*           IN THE (P4) DIGIT FIELD (WHICH IS ITSELF IS RIGHT-JUSTIFIED 
*           IN P1/P2),  AND THEN THE (P3) DIGITS ARE PROPAGATED RIGHT.
*         CHARACTERS OUTSIDE THE (P4) DIGIT FIELD ARE DISPLAY ZEROS.
  
  
 LI2RNA   BSS    1
          SA2    A1+B1       X2 = ADDRESS OF P2 
          SA2    X2          X2 = VALUE OF P2 
          MX0    -6          77777777777777777700B
          SA3    A1+2        X3 = ADDRESS OF P3 
          SA3    X3          X3 = VALUE OF P3 
          SB7    X3 
          SA3    A1+3        X3 = ADDRESS OF P4 
          SA3    X3          X3 = VALUE OF P4 
          SB6    X3 
          SA1    X1          X1 = VALUE OF P1 
  
*      LEFT-JUSTIFY, ZERO-FILL (P3) DIGITS FROM LITERAL INTO X1/X2
  
          SB5    20 
          SB5    B5-B7       NUMBER OF CHARACTERS TO LEFT SHIFT X1/X2 
 LI2RNA1  LX1    6           BCDEFGHIJA 
          LX2    6           LMNOPQRSTK 
          BX1    X0*X1       BCDEFGHIJ: 
          BX3    -X0*X2      :::::::::K 
          BX1    X1+X3       BCDEFGHIJK 
          BX2    X0*X2       LMNOPQRST: 
          SB5    B5-B1
          NZ     B5,LI2RNA1  IF MORE SHIFTING NEEDED,  LOOP 
          BX3    X1          COPY X1/X2 INTO X3/X4
          LX4    X2 
  
*      CREATE THE DESTINATION LITERAL IN X6/X7
  
          SA5    =10H0000000000    FILL WITH DISPLAY ZEROS
          LX6    X5 
          BX7    X5 
 LI2RNA2  LX1    6           BCDEFGHIJA 
          LX2    6           LMNOPQRSTK 
          LX6    6           SHIFT MOST SIGNIFICANT DIGITS OF RESULT
          LX7    6           SHIFT LEAST SIGNIFICANT DIGITS OF RESULT 
          BX5    -X0*X7      COPY DIGIT FROM LEAST TO MOST
          BX6    X6*X0
          BX6    X6+X5
          BX7    X0*X7       CLEAR POSITION FOR NEW DIGIT 
          BX5    -X0*X1      :::::::::A 
          NZ     X5,LI2RNA3  IF NOT YET END OF LITERAL
          BX1    X3          RESET THE LITERAL
          BX2    X4 
          LX1    6           BCDEFGHIJA 
          LX2    6           LMNOPQRSTK 
          BX5    -X0*X1      :::::::::A 
 LI2RNA3  BX7    X7+X5       APPEND DIGIT TO RESULT 
          BX1    X0*X1       BCDEFGHIJ: 
          BX5    -X0*X2      :::::::::K 
          BX1    X1+X5       BCDEFGHIJK 
          SB6    B6-B1       DECREMENT NUMBER OF DIGIT POSITIONS TO FILL
          NZ     B6,LI2RNA2  IF MORE DIGITS NEEDED,  LOOP 
  
          SA6    A1          STORE MOST SIGNIFICANT 10 DIGITS INTO P1 
          SA7    A2          STORE LEAST SIGNIFICANT 10 DIGITS INTO P2
          EQ     LI2RNA      EXIT 
  
  
*      LOAD HIGH-VALUE OR LOW-VALUE 
  
 LI2RN8   LABEL 
          NOTE   LI2RN8 
          GEN    SLRBPK,(VREGOF,VREG1),,((EXT$OF,C.LOVAL),HILOFLG)
          ADDZ   (NUMLENOF,REGC),(SIGNOF,REGC),T1 
          IFTHEN (T1,GT,10)                      IF 2-REGISTER DEST.
            GEN    XMIT,(VREGOF,VREG2),VREG1               VREG2=VREG1+1
            ENDIFZ
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
B         EJECT 
**        LI2RNB -  LOAD FLOATING POINT LITERAL INTO RN (IN REGC) 
* 
*      GIVEN: 
*         P1 = 0
*         P2 = COMP-2 VALUE OF LITERAL
* 
*      DOES:  
*         GENERATES OBJECT CODE TO CONVERT THE LITERAL. 
* 
*      USES:  
*         REGU2 
*         REGU4  (BY R22RN) 
*         REGU1  (BY R12RN VIA R22RN) 
  
  
 LI2RNB   LABEL 
          NOTE   LI2RNB 
  
*      POOL AND LOAD THE FLOATING POINT (COMP-2) LITERAL
  
          MOVEZ  0,(BCPOF,REGB) 
          MOVEZ  10,(BYTLENOF,REGB) 
          MOVEZ  REGB,REGT
*         P2 = VALUE
*         P1 = 0                                 P2 = VALUE, NOT ADDRESS
          EXECUTE LITPOOL                        SET ((FWA$OF,REGB))
          GEN    SLRBPK,(VREGOF,VREG1),,((FWA$OF,REGB)) 
  
*      CREATE TEMPORARY REGISTER DNAT FOR R2 (IN REGU2) 
  
          MOVEZ  REGU2,REGT 
          CALLZ  ADNAT
          MOVEZ  VREG1,(TREGOF,REGU2) 
*         MOVEZ  0,(NUMLENOF,REGU2)              (SET BY *ADNAT*) 
*         MOVEZ  0,(POINTOF,REGU2)               (SET BY *ADNAT*) 
          MOVEZ  1,(SIGNOF,REGU2)                LITERAL MAY BE SIGNED
  
*      MOVE R2 (IN REGU2) TO RN (IN REGC) 
  
          PUSH   REGB                            SAVE ORIGINAL SOURCE 
          MOVEZ  REGU2,REGB                      THIS SOURCE IS REGU2 
          CALLZ  R22RN                           MOVE (REGB) TO (REGC)
          POP    REGB                            RESTORE ORIGINAL SOURCE
  
          CALLZ  SUBDNAT                         DELETE REGU2 DNAT
          RETURN
          SPACE  4
          LISTSEC  LI2R1
          TITLE  LI2R1 -  LITERAL TO REGISTER COMP-1
**        LI2R1 -  LITERAL TO REGISTER COMP-1 
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION REGISTER.
* 
*         CALLZ  LI2R1
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
*         SETS (TREGOF,VREGC) = VIRTUAL REGISTER NUMBER OF RESULT REG.
  
  
 LI2R1    EGO    2
          NOTE   LI2R1
  
*      CONVERT LITERAL TO BINARY VALUE
  
          MOVEZ  (NUMLENOF,REGC),(NUMLENOF,REGB)
          MOVEZ  (POINTOF,REGC),(POINTOF,REGB)
          ANDZ   (SIGNOF,REGB),(SIGNOF,REGC),(SIGNOF,REGB)
          MOVEZ  REGB,REGT
          CALLZ  BINVAL 
*         SETS P1 = BINARY VALUE OF LITERAL 
*         SETS P2 = TYPE OF VALUE 
  
*      SPLIT ACCORDING TO TYPE OF VALUE 
  
          GOTOCASE  P2
            CASE    0,LI2R11                     NOT TYPES 1_11 
            CASE    1,LI2R12                     0
            CASE    2,LI2R13                     1
            CASE    3,LI2R14                     2
            CASE    4,LI2R15                     -1, -3, -7, -15, ... 
            CASE    5,LI2R16                     2<N<2'17;  N=2'A 
            CASE    6,LI2R16                     2<N<2'17; N=2'A+2'B;A>B
            CASE    7,LI2R16                     2<N<2'17; N=2'A-2'B;A>B
            CASE    8,LI2R16                     -2'17<N<2'17;  NOT 1_7 
            CASE    9,LI2R17                     N\2'17;  N=2'A 
            CASE    10,LI2R11                    N\2'17;  N=2'A+2'B 
            CASE    11,LI2R11                    N\2'17;  N=2'A-2'B; A>B
            ENDCASE 
  
  
*      TYPE 0:  NOTE TYPES 1_11 
*      TYPE 10:  N\2'17;  N=2'A+2'B;  A>B 
*      TYPE 11:  N\2'17;  N=2'A-2'B;  A>B 
  
 LI2R11   LABEL 
          NOTE   LI2R11 
          MOVEZ  0,(BCPOF,REGB) 
          MOVEZ  10,(BYTLENOF,REGB) 
          MOVEZ  REGB,REGT
          MOVEZ  P1,P2                           VALUE TO BE POOLED 
          MOVEZ  0,P1                            P1 = VALUE, NOT ADDRESS
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
*         SETS (FWA$OF,REGB) = ADDRESS OF LITERAL 
  
          GEN    SLRBPK,(VREGOF,VREG1),,FWASOURC
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*      TYPE 1:  N = 0 
  
 LI2R12   LABEL 
          NOTE   LI2R12 
          GEN    MASK,(VREGOF,VREG1),0
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*      TYPE 2:  N = 1 
  
 LI2R13   LABEL 
          NOTE   LI2R13 
          GEN    SXBPB,(VREGOF,VREG1),,VREGB1 
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*      TYPE 3:  N = 2 
  
 LI2R14   LABEL 
          NOTE   LI2R14 
          GEN    SXBPB,(VREGOF,VREG1),VREGB1,VREGB1 
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*      TYPE 4:  N = -1, -3, -7, -15, ...   #   1-2'(60-P3)
  
 LI2R15   LABEL 
          NOTE   LI2R15 
          GEN    MASK,(VREGOF,VREG1),P3 
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*      TYPE 5:  2 < N < 2'17;  N = 2'A
*      TYPE 6:  2 < N < 2'17;  N = 2'A+2'B;  A > B
*      TYPE 7:  2 < N < 2'17;  N = 2'A-2'B;  A > B
*      TYPE 8:  -2'17 < N < 2'17;  NOT TYPES 5_7
  
 LI2R16   LABEL 
          NOTE   LI2R16 
          GEN    SXBPK,(VREGOF,VREG1),,P1 
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
  
  
*      TYPE 9:  N \ 2'17;  N = 2'A
  
 LI2R17   LABEL 
          NOTE   LI2R17 
          GEN    MASK,(VREGOF,VREG1),1
          ADDZ   P3,1,T1
          GEN    SHL,VREG1,T1 
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
          SPACE  4
          LISTSEC  LI2R2
          TITLE  LI2R2 -  LITERAL TO REGISTER COMP-2, S.P.
**        LI2R2 -  LITERAL TO REGISTER COMP-2, S.P. 
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION REGISTER.
* 
*         CALLZ  LI2R2
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
 LI2R2    EGO    2
          NOTE   LI2R2
  
*      CONVERT LITERAL TO REGISTER NUMERIC
  
          MOVEZ  (LITREFOF,REGB),P1 
          MOVEZ  (NUMLENOF,REGB),P2 
          MOVEZ  (POINTOF,REGB),P3
          ANDZ   (SIGNOF,REGB),(SIGNOF,REGC),P4 
          CALLZ  CLIT2RN
*         SETS P1 = MOST SIGNIFICANT DIGITS 
*         SETS P2 = LEAST SIGNIFICANT 10 DIGITS 
  
*      CONVERT REGISTER NUMERIC TO BINARY 
  
          SUBZ   (POINTOF,REGB),(POINTOF,REGC),P3 
          CALLZ  CRN2BIN
*         SETS P1 = MOST SIGNIFICANT PART OF D.P. COMP-2 VALUE
  
*      POOL THE COMP-2 VALUE
  
          MOVEZ  0,(BCPOF,REGB) 
          MOVEZ  10,(BYTLENOF,REGB) 
          MOVEZ  REGB,REGT
          MOVEZ  P1,P2                           P2 = VALUE TO BE POOLED
          MOVEZ  0,P1                            P2 = VALUE, NOT ADDRESS
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
*         SETS (FWA$OF,REGB) = ADDRESS OF LITERAL 
  
*      LOAD THE COMP-2 VALUE
  
          GEN    SLRBPK,(VREGOF,VREG1),,FWASOURC
  
          MOVEZ  0,(POINTOF,REGC)                SET SCALE FACTOR 
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGC) NO. DECIMAL DIGITS 
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
          SPACE  4
          LISTSEC  LI2R4
          TITLE  LI2R4 -  LITERAL TO REGISTER COMP-2, D.P.
**        LI2R4 -  LITERAL TO REGISTER COMP-2, D.P. 
* 
*         REGB = DNAT POINTER TO SOURCE LITERAL.
*         REGC = DNAT POINTER TO DESTINATION REGISTERS. 
* 
*         CALLZ  LI2R4
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
*         THE PERMANENT DNAT ASSOCIATED WITH THE INCOMING LITERAL 
*         IS CHANGED AND USED TO REFERENCE THE POOLED LITERAL.
  
  
 LI2R4    EGO    2
          NOTE   LI2R4
  
*      CONVERT LITERAL TO REGISTER NUMERIC
  
          MOVEZ  (LITREFOF,REGB),P1 
          MOVEZ  (NUMLENOF,REGB),P2 
          MOVEZ  (POINTOF,REGB),P3
          MOVEZ  (SIGNOF,REGB),P4 
          CALLZ  CLIT2RN
*         SETS P1 = MOST SIGNIFICANT DIGITS 
*         SETS P2 = LEAST SIGNIFICANT 10 DIGITS 
  
*      CONVERT REGISTER NUMERIC TO BINARY 
  
          SUBZ   (POINTOF,REGB),(POINTOF,REGC),P3 
          CALLZ  CRN2BIN
*         SETS P1 = MOST SIGNIFICANT PART OF D.P. COMP-2 VALUE
*         SETS P2 = LEAST SIGNIFICANT PART OF D.P. COMP-2 VALUE 
  
*      POOL THE D.P. COMP-2 VALUE 
  
          MOVEZ  REGB,REGT                       REGT = PARAMETER 
          MOVEZ  0,(BCPOF,REGT) 
          MOVEZ  20,(BYTLENOF,REGT) 
          MOVEZ  P2,P3                           LEAST SIG. OF VALUE
          MOVEZ  P1,P2                           MOST SIG. OF VALUE 
          MOVEZ  0,P1                            P2,P3 = VALUE, " ADDR. 
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
  
*      LOAD THE VALUE 
  
          GEN    SLRBPK,(VREGOF,VREG1),,((FWA$OF,REGT))    VREG1
          GEN    SLRAPB,(VREGOF,VREG2),VREG1,VREGB1 
  
          MOVEZ  0,(POINTOF,REGC)                SET SCALE
          MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGC) NO. DECIMAL DIGITS 
          MOVEZ  VREG1,(TREGOF,REGC)
          RETURN
          SPACE  4
          EJECT 
**        QLIT2NUM
*         POOL QUOTED LITERAL FOR MOVE TO NUMERIC DESTINATION 
  
  
 QLIT2NUM EGO    2
          MOVEZ  REGB,REGT
          IFTHEN ((TYPEOF,REGC),EQ,COMP2) 
            MOVEZ  14,P1
          ELSEZ 
            MOVEZ  (INTLENOF,REGC),P1 
          ENDIFZ
          EXECUTE POOLQLT 
          MOVEZ  (BYTLENOF,REGB),(NUMLENOF,REGB)
          MOVEZ  0,(POINTOF,REGB) 
          RETURN
          LISTSEC  *
          SPACE  4
          END 
