*DECK GMOVSA
          IDENT  GMOVSA 
          TITLE  GMOVSA - GENERATE SA2XX MOVES
  
          MACHINE  ANY,I
          SST 
          COMMENT  GENERATE SA2XX MOVES 
          SPACE  4
**        GMOVSA - GENERATE SA2XX MOVES 
* 
* SA2AN   KNIL   CGSA2AN
* SA2RA   KNIL   CGSA2RA
* 
*         REGB = DNAT POINTER TO SOURCE.
*         REGC = DNAT POINTER TO DESTINATION
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
  
*      COMDECKS 
  
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
  
*CALL CCT 
  
          EJECT 
 GMOVSA   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
  
 MASK1    EQU    T5 
 MASK2    EQU    T6 
 SHIFTCT  EQU    T17
  
  
*      MISCELLANEOUS EQUATES
  
  
*      LINKAGE FROM CALLING ROUTINES IN OTHER MODULES 
  
 OP.BDP   IFEQ   OP.BDP,OP.NO 
 SA2AN    KNIL   CGSA2AN
 OP.BDP   ENDIF 
 SA2RA    KNIL   CGSA2RA
  
*      LINKAGE TO CALLED ROUTINES IN OTHER MODULES
  
 ADDSPCS  LINK   CGADSPC     * TO GMOVSUB 
 GETSPCS  LINK   CGGTSPC     * TO GMOVSUB 
 SCLOAD   LINK   SCLOAD      * TO GSUBSC
 SCSTORE  LINK   SCSTORE     * TO GSUBSC
 SETBREG  LINK   CGSETB4     * TO GMOVSUB 
 SETBXPK  LINK   CGSBXPK     * TO GMOVSUB 
 SETXREG  LINK   CGSETXW     * TO GMOVSUB 
 SETXXPK  LINK   CGSXXPK     * TO GMOVSUB 
 SPCFLRT  LINK   CGAPBLK     * TO GMOVSUB 
 STORIT1  LINK   CGSTOR1     * TO GMOVSUB 
 STORIT2  LINK   CGSTOR2     * TO GMOVSUB 
 STRBLNK  LINK   CGSTBLK     * TO GMOVSUB 
 SUBLOAD  LINK   SUBLOAD     * TO GSUBSC
 SUBREF   LINK   SUBREF 
  
*      SYMBOLIC PARAMETER DEFINITIONS 
  
 BLANKS   SETSY  (EXT$OF,C.BLANK) 
 RECADDR  SETSY  (FWA$OF,MOVEREGB)
 SRCADDR  SETSY  (FWA$OF,MOVEREGA),ADOFSET
 TMPBFAD  SETSY  (EXT$OF,C.BUFF)
          SPACE  4
 OP.BDP   IFEQ   OP.BDP,OP.NO 
          LISTSEC  SA2AN
          TITLE  SA2AN - SUBSCRIPTED AN TO NON-SUBSCRIPTED AN PROCESSOR 
*      BEGIN PROCESSING SUBSCRIPTED SOURCE FIELD TO EITHER SUBSCRIPTED
*      OR UNSUBSCRIPTED RECEIVING FIELD.
  
 SA2AN    EGO    1
          IFZ    (RECSUBS,NE,0),SA2SA 
  
*      IF SPECIAL CASE CODE CAN BE GENERATED- GO DO IT
  
          IFZ    ((SUBSCOF,MOVEREGA),NE,0),SA2AN300 
          MOVEZ  (GSCODEOF,MOVEREGA),T1 
          IFZ    ((RFLCPTYP,T1),NE,0),SA2AN800
  
************************************************************************
*                                                                      *
*      I  SA2AN  * SUBSCRIPTED SOURCE TO UNSUBSCRIPTED RECEIVING       *
*                                                                      *
************************************************************************
  
          IFZ    (SIZEDIFF,GT,0),SA2AN160 
          IFZ    (SIZEDIFF,LT,0),SA2AN130 
  
************************************************************************
*      GENERATE CODE FOR SUBSCRIPTED SOURCE FIELD TO UNSUBSCRIPTED     *
*      RECEIVING FIELD HAVING THE SAME SIZE.                           *
************************************************************************
  
 SA2AN120 LABEL 
          NOTE   SA2AN120 
          GEN    SBBPK,(VREGOF,VREGA),,SRCADDR
          MOVEZ  SENDSUBS,P1
          CALLZ  SUBLOAD
          GEN    SHR,P1,30
          MOVEZ  P1,VREGU 
          MOVEZ  SENDBCP,P1 
          CALLZ  SETBXPK
          GEN    SBBPK,(VREGOF,VREGC),,RECADDR
          MOVEZ  RECBCP,P1
          CALLZ  SETBREG
          MOVEZ  VREGX,VREGD
          MOVEZ  SENDSIZE,P1
          CALLZ  SETBREG
          MOVEZ  SIZEDIFF,P1
          CALLZ  SETXREG
          GENOBJ N=C.MOVN,I=(VREGC,VREGD,VREGA,VREGU,VREGX,VREGW) 
          RETURN
          SPACE  4
*      BEGIN PROCESSING SUBSCRIPTED SOURCE FIELD TO UNSUBSCRIPTED 
*      RECEIVING FIELD.  SIZE OF SOURCE FIELD IS LESS THAN SIZE OF
*      RECEIVING FIELD. 
  
 SA2AN130 LABEL 
          NOTE   SA2AN130 
          IFZ    (JUSTFLG,EQ,0),SA2AN120
  
*      JUSTIFIED RECEIVING FIELD, MAKE SIZEDIFF POSITIVE FOR C.MOVE 
  
          SUBZ   0,SIZEDIFF,SIZEDIFF
          BRANCH SA2AN120 
          SPACE  4
*      PROCESS SUBSCRIPTED SOURCE FIELD TO UNSUBSCRIPTED RECEIVING
*      FIELD.  SIZE OF SOURCE FIELD IS GREATER THAN SIZE OF RECEIVING 
*      FIELD. 
  
 SA2AN160 LABEL 
          MOVEZ  RECSIZE,SENDSIZE 
          IFZ    (JUSTFLG,NE,0),SA2AN170
  
*      NO JUSTIFICATION 
  
          NOTE   SA2AN160 
          MOVEZ  0,SIZEDIFF 
          BRANCH SA2AN120 
  
*      JUSTIFIED RECEIVING FIELD, 
  
 SA2AN170 LABEL 
          NOTE   SA2AN170 
          ADDZ   SENDBCP,SIZEDIFF,T1
          REMZ   T1,10,SENDBCP
          QUOTZ  T1,10,ADOFSET
          MOVEZ  0,SIZEDIFF 
          BRANCH SA2AN120 
          EJECT 
*      BEGIN PROCESSING SPECIAL CASE MOVES
  
 SA2AN300 LABEL 
          MOVEZ  MOVEREGA,P1
          IFZ    (RECECP,GT,20),SA2AN700
          IFZ    (RECECP,GT,10),SA2AN500
  
          MOVEZ  1,P3        ZERO FILL
  
          IFZ    (SIZEDIFF,GT,0),SA2AN400 
          IFZ    (SIZEDIFF,LT,0),SA2AN360 
  
*      SIZE OF SOURCE FIELD = SIZE OF RECEIVING FIELD 
  
          IFZ    (RECBCP,NE,0),SA2AN340 
 SA2AN320 LABEL 
          NOTE   SA2AN320 
          MOVEZ  0,P2        LEFT JUSTIFY 
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          MOVEZ  RECBCP,P3
          MOVEZ  RECSIZE,P4 
          CALLZ  STORIT1   KR,BR,SR,VREGA;VREGC 
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD = SIZE OF RECEIVING FIELD.  BCP OF RECEIVING
*      FIELD NE 0 
  
 SA2AN340 LABEL 
          NOTE   SA2AN340 
          MOVEZ  1,P2        RIGHT JUSTIFY
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          IFTHEN (RECECP,NE,10) 
            GEN    SHL,VREGA,(ARITH7,RECECP)
          ENDIFZ
          MOVEZ  RECBCP,P3
          MOVEZ  RECSIZE,P4 
          CALLZ  STORIT1   KR,BR,SR,VREGA;VREGC 
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD LESS THAN SIZE OF RECEIVING FIELD 
  
 SA2AN360 LABEL 
          SUBZ   0,SIZEDIFF,SIZEDIFF
  
          MOVEZ  SIZEDIFF,P5
  
          IFZ    (JUSTFLG,NE,0),SA2AN380
  
*      SIZE OF SOURCE FIELD LESS THAN SIZE OF RECEIVING FIELD.
*      RECEIVING FIELD NOT JUSTIFIED. 
  
          NOTE   SA2AN360 
          MOVEZ  0,P2        LEFT JUSTIFY 
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          IFTHEN (RECBCP,NE,0)
            GEN    SHL,VREGA,(ARITH7,RECBCP)
          ENDIFZ
          ADDZ   RECBCP,SENDSIZE,P6 
          CALLZ  ADDSPCS   SR-SS,BR+SS,VREGA;VREGA
          MOVEZ  RECBCP,P3
          MOVEZ  RECSIZE,P4 
          CALLZ  STORIT1   KR,BR,SR,VREGA;VREGC 
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD LESS THAN SIZE OF JUSTIFIED RECEIVING FIELD.
  
 SA2AN380 LABEL 
          NOTE   SA2AN380 
          MOVEZ  1,P2        RIGHT JUSTIFY
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          IFTHEN (RECECP,NE,10) 
            GEN    SHL,VREGA,(ARITH7,RECECP)
          ENDIFZ
          MOVEZ  RECBCP,P6
          CALLZ  ADDSPCS   SR-SS,BR,VREGA;VREGA 
          MOVEZ  RECBCP,P3
          MOVEZ  RECSIZE,P4 
          CALLZ  STORIT1   KR,BR,SR,VREGA;VREGC 
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD GREATER THAN SIZE OF RECEIVING FIELD. 
  
 SA2AN400 LABEL 
          IFZ    (JUSTFLG,NE,0),SA2AN420
  
*      SIZE OF SOURCE FIELD GREATER THAN SIZE OF UNJUSTIFIED RECEIVING
*      FIELD. 
  
          NOTE   SA2AN400 
          MOVEZ  0,P2        LEFT JUSTIFY 
          CALLZ  SCLOAD 
          GEN    MASK,(VREGOF,VREGB),(ARITH8,RECSIZE) 
          GEN    LAND,(VREGOF,VREGA),VREGB,P4 
          IFTHEN (RECBCP,NE,0)
            GEN    SHL,VREGA,(ARITH7,RECBCP)
          ENDIFZ
          MOVEZ  RECBCP,P3
          MOVEZ  RECSIZE,P4 
          CALLZ  STORIT1   KR,BR,SR,VREGA;VREGC 
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD GREATER THAN SIZE OF JUSTIFIED RECEIVING
*      FIELD
  
 SA2AN420 LABEL 
          NOTE   SA2AN420 
          MOVEZ  1,P2        RIGHT JUSTIFY
          MOVEZ  0,P3        NO FILL
          CALLZ  SCLOAD 
          GEN    MASK,(VREGOF,VREGB),(ARITH7,RECSIZE) 
          GEN    LIMP,(VREGOF,VREGA),P4,VREGB 
          IFTHEN (RECECP,NE,10) 
            GEN    SHL,VREGA,(ARITH7,RECECP)
          ENDIFZ
          MOVEZ  RECBCP,P3
          MOVEZ  RECSIZE,P4 
          CALLZ  STORIT1   KR,BR,SR,VREGA;VREGC 
          RETURN
          SPACE  4
*      DOUBLE PRECISION RECEIVING FIELDS
  
 SA2AN500 LABEL 
          IFZ    (SIZEDIFF,GT,0),SA2AN680 
          IFZ    (SIZEDIFF,LT,0),SA2AN520 
  
*      SIZE OF SOURCE FIELD = SIZE OF RECEIVING FIELD 
  
 SA2AN510 LABEL 
          NOTE   SA2AN510 
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  1,P3        NO FILL
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          SUBZ   10,RECBCP,P4 
          REMZ   RECECP,10,P6 
          GENM   SPLITIT
            REGP   VREGA,(VREGOF,VREGA),(VREGOF,VREGD)
            CONP   (ARITH8,RECBCP),(ARITH8,P4),(ARITH8,P6)
          ENDG
          MOVEZ  RECBCP,P3
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          MOVEZ  VREGD,VREGA
          CALLZ  STORIT2   VREGC,(BR+SR)MOD 10,VREGA;VREGC
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS LESS THAN SIZE OF DP RECEIVING FIELD 
 SA2AN520 LABEL 
          SUBZ   0,SIZEDIFF,SIZEDIFF
          IFZ    (JUSTFLG,NE,0),SA2AN600
          IFZ    (RECBCP,NE,0),SA2AN540 
  
*      SIZE OF SOURCE FIELD IS LESS THAN SIZE OF RECEIVING FIELD. 
*      BCP OF RECEIVING FIELD = 0.  NO JUSTIFICATION. 
  
          NOTE   SA2AN520 
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  1,P3        ZERO FILL
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          SUBZ   10,SENDSIZE,P5 
          MOVEZ  SENDSIZE,P6
          CALLZ  ADDSPCS   10-SS,SS,VREGA;VREGA 
          MOVEZ  RECBCP,P3
          MOVEZ  10,P4
          CALLZ  STORIT1   KR,BR,10,VREGA;VREGC 
          SUBZ   (ARITH22,RECECP),2,P5
          MOVEZ  (ARITH21,RECECP),P6
          CALLZ  SPCFLRT
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS LESS THAN SIZE OF UNJUSTIFIED DP 
*      RECEIVING FIELD.  BCP OF RECEIVING FIELD IS NOT 0. 
  
 SA2AN540 LABEL 
          ADDZ   RECBCP,SENDSIZE,T1 
          IFZ    (T1,GT,10),SA2AN580
  
          MOVEZ  1,P2        RIGHT JUSTIFY
          MOVEZ  1,P3        ZERO FILL
  
          IFZ    (T1,LT,10),SA2AN560
  
*      SIZE OF SOURCE FIELD LESS THAN SIZE OF UNJUSTIFIED RECEIVING 
*      FIELD.  BCP OF RECEIVING FIELD NE 0. SIZE OF SOURCE FIELD = PART 
*      OF RECEIVING FIELD LYING IN FIRST WORD 
  
          NOTE   SA2AN540 
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          MOVEZ  RECBCP,P3
          SUBZ   10,RECBCP,P4 
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   (ARITH22,RECECP),2,P5
          MOVEZ  (ARITH21,RECECP),P6
          CALLZ  SPCFLRT
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS LESS THAN SIZE OF UNJUSTIFIED RECEIVING
*      FIELD.  BCP OF SOURCE FIELD IS NOT 0.  SIZE OF SOURCE FIELD IS 
*      LESS THAN PART OF RECEIVING FIELD LYING IN FIRST WORD. 
  
 SA2AN560 LABEL 
          NOTE   SA2AN560 
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          ADDZ   RECBCP,SENDSIZE,P6 
          GEN    SHL,VREGA,(ARITH7,P6)
          SUBZ   10,P6,P5 
          CALLZ  ADDSPCS   10-(BR+SS),(BR+SS),VREGA;VREGA 
          MOVEZ  RECBCP,P3
          SUBZ   10,RECBCP,P4 
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   (ARITH22,RECECP),2,P5
          MOVEZ  (ARITH21,RECECP),P6
          CALLZ  SPCFLRT
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS LESS THAN SIZE OF UNJUSTIFIED RECEIVING
*      FIELD.  BCP OF SOURCE FIELD IS NOT 0.  SIZE OF SOURCE FIELD IS 
*      GREATER THAN PART OF RECEIVING FIELD LYING IN FIRST WORD.
  
 SA2AN580 LABEL 
          NOTE   SA2AN580 
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  0,P3        NO FILL
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          SUBZ   10,RECBCP,P4 
          ADDZ   RECBCP,SENDSIZE,P6 
          SUBZ   P6,10,P6 
          GENM   SPLITIT
            REGP   VREGA,(VREGOF,VREGA),(VREGOF,VREGD)
            CONP   (ARITH8,RECBCP),(ARITH8,P4),(ARITH8,P6)
          ENDG
          MOVEZ  RECBCP,P3
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          MOVEZ  VREGD,VREGA
          MOVEZ  SIZEDIFF,P5
          CALLZ  ADDSPCS   SR-SS,(BR+SS)-10,VREGA;VREGA 
          SUBZ   RECECP,10,P6 
          CALLZ  STORIT2   VREGC,(BR+SR)-10,VREGA;VREGC 
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS LESS THAN SIZE OF JUSTIFIED RECEIVING
*      FIELD
  
 SA2AN600 LABEL 
          MOVEZ  (ARITH21,RECECP),T1
          IFZ    (T1,LT,SENDSIZE),SA2AN660
  
          MOVEZ  RECBCP,P3
          SUBZ   10,RECBCP,P4 
          MOVEZ  P4,P5
          MOVEZ  RECBCP,P6
  
          IFZ    (T1,GT,SENDSIZE),SA2AN620
  
**     SIZE OF SOURCE FIELD IS LESS THAN SIZE OF JUSTIFIED RECEIVING
**     FIELD.  SIZE OF SOURCE FIELD = PART OF RECEIVING FIELD LYING IN
*      LAST WORD. 
  
          NOTE   SA2AN600 
          CALLZ  GETSPCS   10-BR,BR;VREGA 
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   (ARITH22,RECECP),2,P5
          CALLZ  STRBLNK
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  1,P3        ZERO FILL
          PUSH   VREGC
          CALLZ  SCLOAD 
          POP    VREGC
          MOVEZ  P4,VREGA 
          MOVEZ  (ARITH21,RECECP),P6
          CALLZ  STORIT2   VREGC,[(BR+SR-1)MOD 10]+1,VREGA;VREGC
          RETURN
          SPACE  4
 SA2AN620 LABEL 
          IFZ    (T1,NE,10),SA2AN640
  
*      SIZE OF SOURCE FIELD LESS THAN SIZE OF JUSTIFIED RECEIVING FIELD.
*      SIZE OF SOURCE FIELD LESS THAN 10 CHARS.  LAST WORD OF RECEIVING 
*      FIELD CONTAINS 10 CHARS. 
  
          NOTE   SA2AN620 
          CALLZ  GETSPCS   10-BR,BR;VREGA 
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   (ARITH22,RECECP),2,P5
          CALLZ  STRBLNK
          MOVEZ  1,P2        RIGHT JUSTIFY
          MOVEZ  1,P3        ZERO FILL
          PUSH   VREGC
          CALLZ  SCLOAD 
          POP    VREGC
          MOVEZ  P4,VREGA 
          SUBZ   10,SENDSIZE,P5 
          MOVEZ  0,P6 
          CALLZ  ADDSPCS   10-SS,0,VREGA;VREGA
          MOVEZ  10,P6
          CALLZ  STORIT2   VREGC,10,VREGA;VREGC 
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD LESS THAN SIZE OF JUSTIFIED RECEIVING FIELD.
*      SIZE OF SOURCE FIELD LESS THAN PART OF RECEIVING FIELD LYING IN
*      LAST WORD.  LAST WORD OF RECEIVING FIELD CONTAINS LESS THAN 10 
*      CHARS. 
  
 SA2AN640 LABEL 
          NOTE   SA2AN640 
          CALLZ  GETSPCS   10-BR,BR;VREGA 
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   (ARITH22,RECECP),2,P5
          CALLZ  STRBLNK
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  1,P3        ZERO FILL
          PUSH   VREGC
          CALLZ  SCLOAD 
          POP    VREGC
          MOVEZ  P4,VREGA 
          ADDZ   RECBCP,SIZEDIFF,P5 
          REMZ   P5,10,P5 
          GEN    SHL,VREGA,(ARITH7,P5)
          MOVEZ  0,P6 
          CALLZ  ADDSPCS   [BR+(SR-SS)]MOD 10,0,VREGA;VREGA 
          REMZ   RECECP,10,P6 
          CALLZ  STORIT2   VREGC,(BR+SR)MOD 10,VREGA;VREGC
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD LESS THAN SIZE OF JUSTIFIED RECEIVING FIELD.
*      SIZE OF SOURCE FIELD GREATER THAN PART OF RECEIVING FIELD LYING
*      IN SECOND WORD.
  
 SA2AN660 LABEL 
          NOTE   SA2AN660 
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  0,P3        NO FILL
          CALLZ  SCLOAD 
          ADDZ   RECBCP,SIZEDIFF,MASK1
          MOVEZ  (ARITH7,MASK1),SHIFTCT 
          MOVEZ  (ARITH18,RECECP),MASK2 
          GENM   SPLITIT
            REGP   P4,(VREGOF,VREGA),(VREGOF,VREGD) 
            CONP   (ARITH8,MASK1),SHIFTCT,MASK2 
          ENDG
          MOVEZ  SIZEDIFF,P5
          MOVEZ  RECBCP,P6
          CALLZ  ADDSPCS   SR-SS,BR,VREGA;VREGA 
          MOVEZ  RECBCP,P3
          SUBZ   10,RECBCP,P4 
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          MOVEZ  VREGD,VREGA
          REMZ   RECECP,10,P6 
          CALLZ  STORIT2   VREGC,(BR+SR)MOD 10,VREGA;VREGC
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD GREATER THAN SIZE OF RECEIVING FIELD
  
 SA2AN680 LABEL 
          NOTE   SA2AN680 
          IFZ    (JUSTFLG,EQ,0),SA2AN510
  
          MOVEZ  1,P2        RIGHT JUSTIFY
          MOVEZ  0,P3        NO FILL
          CALLZ  SCLOAD 
          SUBZ   20,RECECP,SHIFTCT
          SUBZ   RECECP,10,P6 
          GENM   SPLITIT
            REGP   P4,(VREGOF,VREGA),(VREGOF,VREGD) 
            CONP   (ARITH8,RECBCP),(ARITH8,SHIFTCT),(ARITH8,P6) 
          ENDG
          MOVEZ  RECBCP,P3
          SUBZ   10,RECBCP,P4 
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          MOVEZ  VREGD,VREGA
          CALLZ  STORIT2   VREGC,(BR+SR)-10,VREGA;VREGC 
          RETURN
          EJECT 
*      BEGIN PROCESSING SPECIAL CASE MOVES TO TP OR EP RECEIVING FIELDS 
  
 SA2AN700 LABEL 
          SUBZ   0,SIZEDIFF,SIZEDIFF
          IFZ    (JUSTFLG,NE,0),SA2AN780
          NOTE   SA2AN700 
          SUBZ   10,RECBCP,T1 
          IFZ    (T1,GE,SENDSIZE),SA2AN520
  
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  0,P3        NO FILL
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          MOVEZ  RECBCP,P3
          SUBZ   10,RECBCP,P4 
          ADDZ   RECBCP,SENDSIZE,P6 
          SUBZ   P6,10,P6 
          GENM   SPLITIT
            REGP   VREGA,(VREGOF,VREGA),(VREGOF,VREGD)
            CONP   (ARITH8,P3),(ARITH8,P4),(ARITH8,P6)
          ENDG
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          MOVEZ  VREGD,VREGA
          SUBZ   10,P6,P5 
          CALLZ  ADDSPCS   20-(BR+SS),(BR+SS)-10,VREGA;VREGA
          MOVEZ  10,P6
          CALLZ  STORIT2   VREGC,10,VREGA;VREGC 
          SUBZ   (ARITH22,RECECP),3,P5
          MOVEZ  (ARITH21,RECECP),P6
          CALLZ  SPCFLRT
          RETURN
          SPACE  4
*      JUSTIFIED RECEIVING FIELD
  
 SA2AN780 LABEL 
          NOTE   SA2AN780 
          IFZ    ((ARITH21,RECECP),GE,SENDSIZE),SA2AN600
          NOTE   SA2AN780 
          SUBZ   10,RECBCP,P5 
          MOVEZ  RECBCP,P6
          CALLZ  GETSPCS   10-BR,BR;VREGA 
          MOVEZ  RECBCP,P3
          SUBZ   10,RECBCP,P4 
          CALLZ  STORIT1   KR,BR,10-BR,VREGA;VREGC
          SUBZ   (ARITH22,RECECP),3,P5
          CALLZ  STRBLNK
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  0,P3        NO FILL
          PUSH   VREGC
          CALLZ  SCLOAD 
          POP    VREGC
          ADDZ   RECBCP,SIZEDIFF,P5 
          REMZ   P5,10,P5 
          REMZ   RECECP,10,MASK2
          SUBZ   SENDSIZE,MASK2,SHIFTCT 
          GENM   SPLITIT
            REGP   P4,(VREGOF,VREGA),(VREGOF,VREGD) 
            CONP   (ARITH8,P5),(ARITH8,SHIFTCT),(ARITH8,MASK2)
          ENDG
          MOVEZ  0,P6 
          CALLZ  ADDSPCS   [(BR+(SR-SS)]MOD 10,0,VREGA;VREGA
          MOVEZ  10,P6
          CALLZ  STORIT2   VREGC,10,VREGA;VREGC 
          MOVEZ  VREGD,VREGA
          REMZ   RECECP,10,P6 
          CALLZ  STORIT2   VREGC,(BR+SR)MOD 10,VREGA;VREGC
          RETURN
          SPACE  3
*      REFERENCE MODIFICATION 
 SA2AN800 LABEL 
          NOTE   SA2AN800 
          GEN    SBBPK,(VREGOF,VREGA),,SRCADDR
          GEN    SBBPK,(VREGOF,VREGB),,RECADDR
          GEN    SXBPK,(VREGOF,VREGC),,(JUSTOF,MOVEREGB)
          MOVEZ  MOVEREGA,P2
          CALLZ  SUBREF 
          GEN    SBXPB,(VREGOF,VREGD),P3
          MOVEZ  P4,VREGE 
          MOVEZ  RECBCP,P1
          CALLZ  SETBREG
          MOVEZ  VREGX,VREGF
          MOVEZ  (BYTLENOF,MOVEREGB),P1 
          CALLZ  SETXREG
          GENOBJ N=C.MOVRF,I=(VREGB,VREGF,VREGA,VREGD,VREGC,VREGE,VREGW)
          RETURN
          LISTSEC  SA2SA
          TITLE  SA2SA - SUBSCRIPTED AN TO SUBSCRIPTED AN MOVE PROCESSOR
************************************************************************
*                                                                      *
*      III  SA2SA  * SUBSCRIPTED SOURCE TO SUBSCRIPTED RECEIVING       *
*                                                                      *
************************************************************************
  
 SA2SA    LABEL 
  
*      IF SPECIAL CASE CODE CAN BE GENERATED- GO DO IT
  
          IFTHEN ((SUBSCOF,MOVEREGA),NE,0)
            ANDIF  ((SUBSCOF,MOVEREGB),NE,0)
              BRANCH SA2SA300 
          ENDIFZ
          MOVEZ  (GSCODEOF,MOVEREGA),T1 
          IFZ    ((RFLCPTYP,T1),NE,0),SA2SA500
          MOVEZ  (GSCODEOF,MOVEREGB),T1 
          IFZ    ((RFLCPTYP,T1),NE,0),SA2SA500
  
          IFZ    (SIZEDIFF,GT,0),SA2SA160 
          IFZ    (SIZEDIFF,LT,0),SA2SA130 
  
************************************************************************
*      GENERATE CODE FOR SUBSCRIPTED SOURCE FIELD TO SUBSCRIPTED       *
*      RECEIVING FIELD HAVING THE SAME SIZE.                           *
************************************************************************
  
 SA2SA120 LABEL 
          NOTE   SA2SA120 
          GEN    SBBPK,(VREGOF,VREGA),,SRCADDR
          MOVEZ  SENDSUBS,P1
          CALLZ  SUBLOAD
          GEN    SHR,P1,30
          MOVEZ  P1,VREGU 
          MOVEZ  SENDBCP,P1 
          CALLZ  SETBXPK
          MOVEZ  VREGU,VREGB
          GEN    SBBPK,(VREGOF,VREGC),,RECADDR
          MOVEZ  RECSUBS,P1 
          CALLZ  SUBLOAD
          GEN    SHR,P1,30
          MOVEZ  P1,VREGU 
          MOVEZ  RECBCP,P1
          CALLZ  SETBXPK
          MOVEZ  SENDSIZE,P1
          CALLZ  SETBREG
          MOVEZ  SIZEDIFF,P1
          CALLZ  SETXREG
          GENOBJ N=C.MOVN,I=(VREGC,VREGU,VREGA,VREGB,VREGX,VREGW) 
          RETURN
          SPACE  4
*      BEGIN PROCESSING SUBSCRIPTED SOURCE FIELD TO SUBSCRIPTED 
*      RECEIVING FIELD.  SIZE OF SOURCE FIELD IS LESS THAN SIZE OF
*      RECEIVING FIELD. 
  
 SA2SA130 LABEL 
          NOTE   SA2SA130 
          IFZ    (JUSTFLG,EQ,0),SA2SA120
  
*      JUSTIFIED RECEIVING FIELD, MAKE SIZEDIFF POSITIVE FOR C.MOVE 
  
          SUBZ   0,SIZEDIFF,SIZEDIFF
          BRANCH SA2SA120 
          SPACE  4
*      PROCESS SUBSCRIPTED SOURCE FIELD TO SUBSCRIPTED RECEIVING FIELD. 
*      SIZE OF SOURCE FIELD IS GREATER THAN SIZE OF RECEIVING FIELD.
  
 SA2SA160 LABEL 
          MOVEZ  RECSIZE,SENDSIZE 
          IFZ    (JUSTFLG,NE,0),SA2SA170
  
*      NO JUSTIFICATION 
  
          NOTE   SA2SA160 
          MOVEZ  0,SIZEDIFF 
          BRANCH SA2SA120 
  
*      JUSTIFIED RECEIVING FIELD
  
 SA2SA170 LABEL 
          NOTE   SA2SA170 
          ADDZ   SENDBCP,SIZEDIFF,T1
          REMZ   T1,10,SENDBCP
          QUOTZ  T1,10,ADOFSET
          MOVEZ  0,SIZEDIFF 
          BRANCH SA2SA120 
          EJECT 
*      SPECIAL CASE CODE BEGINS HERE
  
 SA2SA300 LABEL 
          MOVEZ  MOVEREGA,P1
          IFZ    (SIZEDIFF,GT,0),SA2SA400 
          IFZ    (SIZEDIFF,LT,0),SA2SA340 
  
 SA2SA320 LABEL 
          NOTE   SA2SA320 
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  0,P3        NO FILL
          CALLZ  SCLOAD 
          IFTHEN (SENDSIZE,EQ,10)      FULL WORD ITEM 
            GEN    XMIT,(VREGOF,P4),P4
          ENDIFZ
          MOVEZ  MOVEREGB,P1
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  0,P3        NO FILL
          CALLZ  SCSTORE
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS LESS THAN SIZE OF RECEIVING FIELD
  
 SA2SA340 LABEL 
          SUBZ   0,SIZEDIFF,SIZEDIFF
          MOVEZ  1,P3        ZERO FILL
          MOVEZ  SIZEDIFF,P5
          IFZ    (JUSTFLG,NE,0),SA2SA360
          NOTE   SA2SA340 
          MOVEZ  0,P2        LEFT JUSTIFY 
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          MOVEZ  SENDSIZE,P6
          CALLZ  ADDSPCS   SR-SS,SS,VREGA;VREGA 
          MOVEZ  MOVEREGB,P1
          MOVEZ  VREGA,P4 
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  1,P3        ZERO FILL
          CALLZ  SCSTORE
          RETURN
          SPACE  4
 SA2SA360 LABEL 
          NOTE   SA2SA360 
          MOVEZ  1,P2        RIGHT JUSTIFY
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          SUBZ   10,RECSIZE,P6
          CALLZ  ADDSPCS   SR-SS,10-SR,VREGA;VREGA
          MOVEZ  MOVEREGB,P1
          MOVEZ  VREGA,P4 
          MOVEZ  1,P2        RIGHT JUSTIFY
          MOVEZ  1,P3        ZERO FILL
          CALLZ  SCSTORE
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS GREATER THAN SIZE OF RECEIVING FIELD 
  
 SA2SA400 LABEL 
          NOTE   SA2SA400 
          IFZ    (JUSTFLG,EQ,0),SA2SA320
          MOVEZ  0,P3        NO FILL
          MOVEZ  1,P2        RIGHT JUSTIFY
          CALLZ  SCLOAD 
          MOVEZ  MOVEREGB,P1
          MOVEZ  1,P2        RIGHT JUSTIFY
          MOVEZ  0,P3        NO FILL
          CALLZ  SCSTORE
          RETURN
          SPACE  3
*      REFERENCE MODIFICATION 
 SA2SA500 LABEL 
          NOTE   SA2SA500 
          GEN    SBBPK,(VREGOF,VREGA),,SRCADDR
          GEN    SBBPK,(VREGOF,VREGB),,RECADDR
          MOVEZ  (JUSTOF,MOVEREGB),P1 
          CALLZ  SETXREG     OUTPUT VREGW 
          MOVEZ  MOVEREGA,P2
          CALLZ  SUBREF 
          GEN    SBXPB,(VREGOF,VREGD),P3
          MOVEZ  P4,VREGC 
          MOVEZ  MOVEREGB,P2
          CALLZ  SUBREF 
          GEN    SBXPB,(VREGOF,VREGE),P3
          GENOBJ N=C.MOVRF,I=(VREGB,VREGE,VREGA,VREGD,VREGW,VREGC,P4) 
          RETURN
 OP.BDP   ENDIF 
          LISTSEC  SA2RA
          TITLE  SA2RA - SUBSCRIPTED AN TO AN-REGISTER MOVE PROCESSOR 
************************************************************************
*                                                                      *
*      I  SA2RA  * SUBSCRIPTED AN SOURCE FIELD TO ALPHANUMERIC REGISTER*
*                                                                      *
************************************************************************
  
  
 SA2RA    EGO    2
  
*      IF SPECIAL CASE CODE CAN BE GENERATED- GO DO IT
  
          IFZ    ((SUBSCOF,MOVEREGA),NE,0),SA2RA800 
  
          IFZ    (SENDSIZE,GT,10),SA2RA600
  
************************************************************************
*      GENERATE CODE TO LOAD A SUBSCRIPTED ITEM HAVING LESS THAN 11    *
*      CHARS                                                           *
************************************************************************
  
 SA2RA300 LABEL 
          NOTE   SA2RA300 
  
          GEN    SBBPK,(VREGOF,VREGA),,SRCADDR              SB3  FWA
          MOVEZ MOVEREGA,P2 
          CALLZ  SUBREF 
          MOVEZ  P3,VREGV 
          GEN    SBXPB,(VREGOF,VREGX),P4         LENGTH 
          GENOBJ N=C.SLODL,I=(VREGV,VREGA,VREGX),O=((VREGOF,VREGA)) 
*      TELL CALLER WHICH VREG CONTAINS SOURCE FIELD 
  
          MOVEZ  VREGA,(TREGOF,MOVEREGB)
  
*      IF CALLER WANTS 2 REGS BACK- RETURN A REGISTER FULL OF BLANKS
  
          IFTHEN ((BYTLENOF,MOVEREGB),GT,10)
            GEN    SLRBPK,(VREGOF,VREGD),,BLANKS
          ENDIFZ
          RETURN
 I        SPACE  4
************************************************************************
*      GENERATE CODE TO LOAD A SUBSCRIPTED ITEM HAVING MORE THAN 10 BUT*
*      LESS THAN 21 CHARS.                                             *
************************************************************************
  
 SA2RA600 LABEL 
          NOTE   SA2RA600 
  
          GEN    SBBPK,(VREGOF,VREGA),,SRCADDR              SB3  FWA
          MOVEZ  MOVEREGA,P2
          CALLZ  SUBREF 
          MOVEZ  P3,VREGV 
          GEN    SBXPB,(VREGOF,VREGX),P4         LENGTH 
          GENOBJ N=C.DLODL,I=(VREGV,VREGA,VREGX),O=((VREGOF,VREGB),(VREG
,OF,VREGA)) 
          MOVEZ  VREGB,(TREGOF,MOVEREGB)
          RETURN
          EJECT 
*      PROCESS SPECIAL CASE LOADS HERE
  
 SA2RA800 LABEL 
          NOTE   SA2RA800 
          MOVEZ  MOVEREGA,P1
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  1,P3        ZERO FILL
          CALLZ  SCLOAD 
          MOVEZ  P4,VREGA 
          SUBZ   10,SENDSIZE,P5 
          MOVEZ  SENDSIZE,P6
          CALLZ  ADDSPCS   10-SS,SS,VREGA;VREGA 
          MOVEZ  VREGA,(TREGOF,MOVEREGB)
          IFTHEN ((BYTLENOF,MOVEREGB),GT,10)
            GEN    SLRBPK,(VREGOF,VREGD),,BLANKS
          ENDIFZ
          RETURN
          SPACE  4
          LISTSEC  *
          END 
