*DECK GMOVAN
          IDENT  GMOVAN 
          TITLE GMOVAN - GENERATE AN2XX MOVES 
  
          MACHINE  ANY,I
          SST 
          COMMENT  GENERATE AN2XX MOVES 
          SPACE  4
**        GMOVAN - GENERATE AN2XX MOVES 
* 
* AN2AE   LINK   CGAN2AE
* AN2RA   LINK   CGAN2RA
* AN2SA   LINK   CGAN2SA
* 
*         REGB = DNAT POINTER TO SOURCE.
*         REGC = DNAT POINTER TO DESTINATION
* 
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
  
*      COMDECKS 
  
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
  
*CALL CCT 
  
          EJECT 
 GMOVAN   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
  
                                                 AN2RA
 SHIFTCT  EQU    T4 
 MASK1    EQU    T7 
  
  
  
*      MISCELLANEOUS EQUATES
  
  
*      LINKAGE FROM CALLING ROUTINES IN OTHER MODULES 
  
 AN2AE    KNIL   CGAN2AE
 AN2RA    KNIL   CGAN2RA
 AN2C1    KNIL   CGAN2C1
 AN2C2    KNIL   CGAN2C2
 AN2C4    KNIL   CGAN2C4
 AN2ND    KNIL   CGAN2ND
 AN2NE    KNIL   CGAN2NE
 OP.BDP   IFEQ   OP.BDP,OP.NO 
 AN2SA    KNIL   CGAN2SA
 OP.BDP   ENDIF 
  
*      LINKAGE TO CALLED ROUTINES IN OTHER MODULES
  
 ADDSPCS  LINK   CGADSPC     * TO GMOVSUB 
 ADNAT    LINK   ADNAT       * TO CGSTART 
 ADPDNAT  LINK   ADPDNAT
 GTADBCP  LINK   CGGTABP
 LITPOOL  LINK   LITPOOL
 LOADC1C2 LINK   CGLOADC     * TO GMOVSUB 
 LOADIT1  LINK   CGLOAD1     * TO GMOVSUB 
 LOADIT2  LINK   CGLOAD2     * TO GMOVSUB 
 ND2C1    LINK   CGND2C1
 ND2C2    LINK   CGND2C2
ND2C4     LINK   ND2C4
 ND2ND    LINK   CGND2ND
 ND2NE    LINK   CGND2NE
 RN2AE    LINK   CGRN2AE     * TO GMOVRN
 RN2C1    LINK   CGRN2C1
 RN2C2    LINK   CGRN2C2
 RN2C4    LINK   CGRN2C4
 RN2ND    LINK   CGRN2ND
 RN2NE    LINK   CGRN2NE
 R12RN    LINK   CGR12RN     * TO GMOVR1
 SA2RA    LINK   CGSA2RA     * TO GMOVSA
 SCSTORE  LINK   SCSTORE     * TO GSUBSC
 SETBREG  LINK   CGSETB4     * TO GMOVSUB 
 SETBXPK  LINK   CGSBXPK     * TO GMOVSUB 
 SETXREG  LINK   CGSETXW
 SUBDNAT  LINK   SUBDNAT     * TO CGSTART 
 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
#0.1S20   CONSTANT  1S20/10+1 
          SPACE  4
          LISTSEC  AN2AE
          TITLE  AN2AE -  ALPHANUMERIC ITEM TO ALPHANUMERIC-EDITED ITEM 
**        AN2AE -  ALPHANUMERIC ITEM TO ALPHANUMERIC-EDITED ITEM
* 
*         REGB = DNAT POINTER TO SOURCE ITEM. 
*         FWASOURC = ADDRESS OF SOURCE FIELD. 
*         (BCPOF,REGB) = BEGINNING CHARACTER POSITION OF SOURCE.
*         (BYTLENOF,REGB) = NUMBER OF CHARACTERS IN SOURCE FIELD. 
*         REGC = DNAT POINTER TO DESTINATION ITEM.
*         FWARECV = ADDRESS OF DESCRIPTOR OF DESTINATION FIELD. 
* 
*         CALLZ  AN2AE
* 
*         GENERATES CODE TO PERFORM THE INDICATED MOVE. 
  
  
 AN2AE    EGO    2
  
*      CREATE DUMMY REGTABL/DNAT TO REFERENCE EDIT PATTERN
  
          MOVEZ  REGU1,REGT 
          CALLZ    ADPDNAT
  
*      ANALYZE AND POOL THE EDIT PATTERN
  
          MOVEZ  (BYTLENOF,REGB),P1              = (INTLENOF,REGB)
*         REGC = REGTABL INDEX TO DESTINATION ITEM
*         REGT = REGTABL INDEX FOR EDIT PATTERN 
          EXECUTE EDITPAT                        ((FWA$OF,REGT)) _ PATT.
  
*      DECIDE WHICH PROCESSING TO BE DONE 
  
          IFZ    (SENDSUBS,NE,0),AN2AE2          IF SOURCE SUBSCRIPTED
          IFZ    (RECSUBS,NE,0),AN2AE1           IF DEST. SUBSCRIPTED 
  
*      SOURCE NOT SUBSCRIPTED,  DESTINATION NOT SUBSCRIPTED 
  
          CALLZ  AN2AEA 
          RETURN
  
  
*      SOURCE NOT SUBSCRIPTED,  DESTINATION SUBSCRIPTED 
  
 AN2AE1   LABEL 
          NOTE   AN2AE1 
*      CONSTRUCT SOURCE DESCRIPTOR     3/SIGN  4/BCP  11/LENGTH 
          MOVEZ  (BCPOF,REGB),T2
          LSHIFT T2,11
          ADDZ   T2,(BYTLENOF,REGB),T2
          GEN    SXBPK,(VREGOF,VREG3),,T2 
          MOVEZ  RECSUBS,P1 
          MOVEZ  (BCPOF,REGC),P2
          GEN    SXBPK,(VREGOF,VREG4),,((FWA$OF,REGC))
          CALLZ  GTADBCP     SETS VREG4 = ADDR, VREG5 = BCP 
          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 
          GEN    SBBPK,(VREGOF,VREG1),,((FWA$OF,REGB))
          GENOBJ N=C.EDIT,I=(VREG1,VREG2,VREG3) 
          RETURN
  
  
*      SOURCE SUBSCRIPTED 
  
 AN2AE2   LABEL 
          IFZ    (RECSUBS,NE,0),AN2AE3           IF DEST. SUBSCRIPTED 
  
*      SOURCE SUBSCRIPTED,  DESTINATION NOT SUBSCRIPTED 
  
          CALLZ  AN2AEC 
          RETURN
  
  
*      SOURCE SUBSCRIPTED,  DESTINATION SUBSCRIPTED 
  
 AN2AE3   LABEL 
          NOTE   AN2AE3 
          MOVEZ  RECSUBS,P1 
          MOVEZ  (BCPOF,REGC),P2
          GEN    SXBPK,(VREGOF,VREG4),,((FWA$OF,REGC))
          CALLZ  GTADBCP     SETS VREG4 = ADDR, VREG5 = BCP 
          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 
          PUSH  VREG2 
          MOVEZ  REGB,P2
          CALLZ  SUBREF 
          GEN    SXBPK,(VREGOF,VREG4),,#0.1S20
          GEN    IMUL,(VREGOF,VREG4),P3,VREG4 
          GEN    SHR,VREG4,20 
          GEN    SBXPK,(VREGOF,VREG1),VREG4,((FWA$OF,REGB)) 
          GEN    IADD,(VREGOF,VREG5),VREG4,VREG4
          GEN    SHL,VREG4,3
          GEN    IADD,(VREGOF,VREG4),VREG4,VREG5
          GEN    ISUB,(VREGOF,VREG3),P3,VREG4 
          GEN    SHL,VREG3,11 
          GEN    IADD,(VREGOF,VREG4),P4,VREG3 
          POP    VREG2
          GENOBJ N=C.EDIT,I=(VREG1,VREG2,VREG4) 
          RETURN
AN2AEA    EJECT 
 AN2AEA   LABEL 
          NOTE   AN2AEA 
  
*      CONSTRUCT SOURCE DESCRIPTOR:  3/SIGN=000, 4/BCP, 11/LENGTH 
  
          MOVEZ  (BCPOF,REGB),T2                 3/SIGN=000, 4/BCP
          LSHIFT T2,11                           3/000,4/BCP, 11/0
          ADDZ   T2,(BYTLENOF,REGB),T2
  
*      NOW CALL C.EDIT
  
          GEN    SBBPK,(VREGOF,VREG1),,((FWA$OF,REGB))
          GEN    SBBPK,(VREGOF,VREG2),,((FWA$OF,REGU1)) 
          GEN    SXBPK,(VREGOF,VREG3),,T2 
          GENOBJ N=C.EDIT,I=(VREG1,VREG2,VREG3) 
  
          RETURN
C         EJECT 
**        AN2AEC -  ALPHANUMERIC ITEM TO ALPHANUMERIC-EDITED ITEM 
*                   SOURCE IS SUBSCRIPTED 
*                   DESTINATION IS NOT SUBSCRIPTED
* 
*         REGB = REGTABL INDEX TO SOURCE ITEM 
*         SENDSUBS = (GSCODEOF,REGB)
*         REGC = REGTABL INDEX TO DESTINATION ITEM
*         REGU1 = REGTABL INDEX TO EDIT PATTERN 
  
  
 AN2AEC   LABEL 
          NOTE   AN2AEC 
  
*      COMPUTE X-REGSITER VREG3 = SOURCE BCP   (0 @ BCP < 10) 
*             AX-REGISTER VREG1 = SOURCE FWA
  
          MOVEZ  REGB,P2
          CALLZ  SUBREF 
          MOVEZ  P3,VREG3 
          GEN    SXBPK,(VREGOF,VREG4),,#0.1S20             (1/10) * 2'20
          GEN    IMUL,(VREGOF,VREG4),VREG3,VREG4           (N/10) * 2'20
          GEN    SHR,VREG4,20                               N/10
          GEN    SBXPK,(VREGOF,VREG1),VREG4,((FWA$OF,REGB)) 
          GEN    IADD,(VREGOF,VREG5),VREG4,VREG4           (N/10)*2 
          GEN    SHL,VREG4,3                               (N/10)*8 
          GEN    IADD,(VREGOF,VREG4),VREG4,VREG5           (N/10)*10
          GEN    ISUB,(VREGOF,VREG3),VREG3,VREG4           0 @ BCP < 10 
  
*      CONSTRUCT SOURCE DESCRIPTOR:  3/SIGN=000, 4/BCP, 11/LENGTH 
  
          GEN    SHL,VREG3,11                    3/0, 4/BCP, 11/0 
          GEN    IADD,(VREGOF,VREG3),VREG3,P4 
  
*      NOW CALL C.EDIT
  
          GEN    SBBPK,(VREGOF,VREG2),,((FWA$OF,REGU1)) 
          GENOBJ N=C.EDIT,I=(VREG1,VREG2,VREG3) 
  
          RETURN
          TITLE  AN2C1 - ALPHANUMERIC TO COMP-1 
**        AN2C1  ALPHANUMERIC TO COMP-1 
 AN2C1    EGO    2
          MOVEZ  (GSCODEOF,REGB),T1 
          IFTHEN (T1,NE,0)
          ANDIF  ((RFLCPTYP,T1),NE,0) 
            CALLZ  LOADRM 
            CALLZ  RN2C1
          ELSEZ 
            CALLZ  ND2C1
          ENDIFZ
          RETURN
          TITLE  AN2C2 - ALPHANUMERIC TO COMP-2 
**        AN2C2  ALPHANUMERIC TO COMP-2 
 AN2C2    EGO    2
          MOVEZ  (GSCODEOF,REGB),T1 
          IFTHEN (T1,NE,0)
          ANDIF  ((RFLCPTYP,T1),NE,0) 
            CALLZ  LOADRM 
            CALLZ  RN2C2
          ELSEZ 
            CALLZ  ND2C2
          ENDIFZ
          RETURN
          TITLE  AN2C4 - ALPHANUMERIC TO COMP-4 
**        AN2C4  ALPHANUMERIC TO COMP-4 
 AN2C4    EGO    2
          MOVEZ  (GSCODEOF,REGB),T1 
          IFTHEN (T1,NE,0)
          ANDIF  ((RFLCPTYP,T1),NE,0) 
            CALLZ  LOADRM 
            CALLZ  RN2C4
          ELSEZ 
            CALLZ  ND2C4
          ENDIFZ
          RETURN
          TITLE  AN2ND - ALPHANUMERIC TO COMP 
**        AN2ND  ALPHANUMERIC TO COMP 
 AN2ND    EGO    2
          MOVEZ  (GSCODEOF,REGB),T1 
          IFTHEN (T1,NE,0)
          ANDIF  ((RFLCPTYP,T1),NE,0) 
            CALLZ  LOADRM 
            CALLZ  RN2ND
          ELSEZ 
            CALLZ  ND2ND
          ENDIFZ
          RETURN
          TITLE  AN2NE - ALPHANUMERIC TO NUMERIC EDITED 
**        AN2NE  ALPHANUMERIC TO NUMERIC EDITED 
 AN2NE    EGO    2
          MOVEZ  (GSCODEOF,REGB),T1 
          IFTHEN (T1,NE,0)
          ANDIF  ((RFLCPTYP,T1),NE,0) 
            CALLZ  LOADRM 
            CALLZ  RN2NE
          ELSEZ 
            CALLZ  ND2NE
          ENDIFZ
          RETURN
          SPACE  4
          LISTSEC  AN2RA
          TITLE  AN2RA - ALPHANUMERIC TO ALPHANUMERIC-REGISTER PROCESSOR
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *
*                                                                      *
** NAME- ALPHANUMERIC TO ALPHANUMERIC-REGISTER PROCESSOR               *
*                                                                      *
** PURPOSE-                                                            *
*      GENERATE CODE TO LOAD A SOURCE FIELD INTO SPECIFIED REGISTER(S).*
*      SOURCE FIELD MUST BE ONE OF THE FOLLOWING TYPES-                *
*         ALPHABETIC                                                   *
*         ALPHABETIC EDITED                                            *
*         ALPHANUMERIC                                                 *
*         ALPHANUMERIC EDITED                                          *
*         NUMERIC EDITED                                               *
*         GROUP                                                        *
*         VARIABLE LENGTH GROUP                                        *
*      BY DEFINITION ALPHANUMERIC REGISTERS ARE LEFT JUSTIFIED AND     *
*      BLANK FILLED                                                    *
*                                                                      *
** FIXED CELLS USED-                                                   *
*         ADOFSET-  AN OFFSET APPLIED TO THE WORD ADDRESS OF THE SOURCE*
*                   FIELD.  ADOFSET IS ALWAYS ZERO.  IT IS NOT         *
*                   NECESSARY FOR AN2RA MOVES BUT IS USED BY SUBROUTINE*
*                   LOADIT1 FOR AN2AN MOVES AND SO MUST BE INITIALIZED *
*         LITFLG-   SET IF THE SOURCE FIELD IS A LITERAL               *
*         P1, P2  ETC-                                                 *
*                   PARAMETERS TO CODE GENERATION SUBROUTINES          *
*                   P1 AND P2 ARE USED BY LOADIT1                      *
*                   P3 AND P4 ARE USED BY STORIT1                      *
*                   P5 AND P6 ARE USED BY THE OTHER SUBROUTINES        *
*                   P7 IS THE OUTPUT PARAMETER FROM ROUTINE  FILLTIX   *
*         RECSIZE-  SIZE IN CHARS OF THE RECEIVING FIELD               *
*         SENDBCP-  BCP OF THE SOURCE FIELD.                           *
*         SENDECP-  SENDBCP+SENDSIZE.  THIS IS TECHNICALLY A MISNOMER  *
*                   BUT I COULDN"T THINK OF A BETTER NAME (SORRY)      *
*         SENDSIZE- SIZE IN CHARS OF THE SOURCE FIELD.                 *
*         SENDSUBS- SET NON-ZERO AT BEGINNING OF GMOVE IF THE SOURCE   *
*                   FIELD IS SUBSCRIPTED.  SENDSUBS CONTAINS THE INFO  *
*                   NECESSARY FOR SUBROUTINE SUBLOAD TO LOAD THE       *
*                   SUBSCRIPT (= GSCODE FIELD OF MOVEREGA)             *
*         SHIFTCT-  A TEMPORARY COUNT (EITHER CHAR OF BIT) USED IN     *
*                   GENERATING SHIFTS                                  *
*                                                                      *
*      VIRTUAL REGISTER USAGE-                                         *
*                                                                      *
*         UNSUBSCRIPTED MOVES                                          *
*                                                                      *
*         VREGA-    VIRTUAL X-REGISTER CONTAINING THE (PART OF THE)    *
*                   SOURCE FIELD WHICH WILL BE PROCESSED NEXT (EITHER  *
*                   SHIFTED OR PADDED WITH BLANKS OR STORED).          *
*         VREGB-    VIRTUAL (LOAD) A-REGISTER CONTAINING THE ADDRESS   *
*                   OF THE LAST WORD LOADED.                           *
*         VREGC-    VIRTUAL (STORE) A-REGISTER CONTAINING THE ADDRESS  *
*                   OF THE LAST WORD STORED INTO.                      *
*         VREGC, VREGD, ... , VREGH-                                   *
*                   VIRTUAL X-REGISTERS CONTAINING SPLIT-OUT PARTS     *
*                   OF THE SOURCE FIELD WHICH WILL EVENTUALLY GET      *
*                   PROCESSED AND STORED.                              *
*                                                                      *
*      TABLE OF CONTENTS-                                              *
*                                                                      *
*         UNSUBSCRIPTED MOVES (AN2RA)                                  *
*                                                                      *
*                I    SINGLE PRECISION SOURCE FIELD                    *
*                II   DOUBLE PRECISION SOURCE FIELD                    *
*                II   TRIPLE PRECISION SOURCE FIELD                    *
*                                                                      *
*         SUBSCRIPTED MOVES (SA2RA)                                    *
*                                                                      *
*                I    ANY SUBSCRIPTED SOURCE FIELD                     *
*                                                                      *
*      NOTES-                                                          *
*                                                                      *
*         CALLS TO SUBROUTINES CONTAIN ON THEM THEIR PARAMETER LIST AS *
*         A COMMENT.  FOR EXAMPLE A CALL TO LOADIT1 MIGHT BE CODED AS- *
*         CALLZ  LOADIT1   KS,BS,SS;VREGA,VREGB                        *
*         INPUT PARAMETERS APPEAR FIRST AND ARE SEPARATED FROM OUTPUT  *
*         PARAMETERS BY A SEMICOLON.                                   *
*         THE ABBREVIATIONS USED AND THEIR FIXED CELL EQUIVALENTS ARE  *
*         AS FOLLOWS-                                                  *
*                BS= SENDBCP                                           *
*                SS= SENDSIZE                                          *
*                KS= SRCADDR                                           *
*         THESE SAME ABBREVIATIONS ARE USED IN OTHER COMMENTS          *
*         THROUGHOUT THE CODE.                                         *
*                                                                      *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *
  
 AN2RA    EGO    2
  
*      ADDRESS OFFSET IS ALWAYS ZERO FOR AN2RA MOVES
*      (ADOFSET IS USED IN SUBROUTINE LOADIT1.  IT IS NECESSARY FOR 
*      AN2AN MOVES WHICH ALSO USE THIS SUBROUTINE.) 
  
          MOVEZ  0,ADOFSET
  
*      EXTRACT PERTINENT INFORMATION ABOUT THE SOURCE FIELD 
  
          MOVEZ  (BCPOF,MOVEREGA),SENDBCP 
          MOVEZ  (BYTLENOF,MOVEREGA),SENDSIZE 
          MOVEZ  (BYTLENOF,MOVEREGB),RECSIZE
          ADDZ   SENDBCP,SENDSIZE,SENDECP 
          IFTHEN ((GCODEOF,MOVEREGA),EQ,GLITREF)
            MOVEZ  1,LITFLG 
          ELSEZ 
            MOVEZ  0,LITFLG 
          ENDIFZ
  
*      IF SOURCE FIELD IS SUBSCRIPTED- PROCESS IT ELSEWHERE 
*      NOTICE THAT THIS ROUTINE EXPECTS SENDSUBS TO CONTAIN THE GSCODE
*      FIELD OF MOVEREGA ON ENTRY 
  
          IFZ    (SENDSUBS,NE,0),SA2RA
  
*     COMMON PARAMETER SETUP FOR ALL CASES
  
          MOVEZ  SENDBCP,P1 
  
*      DETERMINE PRECISION OF SOURCE FIELD
  
          IFZ    (SENDECP,GT,20),AN2RA500 
          IFZ    (SENDECP,GT,10),AN2RA300 
 I        EJECT 
************************************************************************
*                                                                      *
*      I     SP TO RA  * SINGLE PRECISION TO ALPHANUMERIC-REGISTER     *
*                                                                      *
************************************************************************
  
*      COMMON PARAMETER SETUP FOR ALL CASES 
  
          MOVEZ  SENDSIZE,P2
          SUBZ   10,SENDSIZE,P5 
          MOVEZ  SENDSIZE,P6
  
          IFZ    (SENDBCP,NE,0),AN2RA250
  
************************************************************************
*      GENERATE CODE TO LOAD A SP ITEM WHICH BEGINS ON A WORD BOUNDARY.*
*      IF CALLER WANTS 2 REGISTERS- RETURN A REGISTER FULL OF BLANKS   *
*      AS SECOND ONE                                                   *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
*      P1=BS
*      P2=SS
*      P5=10-SS 
*      P6=SS
  
 AN2RA200 LABEL 
          NOTE   AN2RA200 
          CALLZ  LOADIT1   KS,BS,SS;VREGA,VREGB 
          CALLZ  ADDSPCS   10-SS,SS,VREGA;VREGA 
          MOVEZ  VREGA,(TREGOF,MOVEREGB)
          IFTHEN (RECSIZE,GT,10)
            GEN    SLRBPK,(VREGOF,VREGD),,BLANKS
          ENDIFZ
          RETURN
 I        SPACE  4
************************************************************************
*      GENERATE CODE TO LOAD A SP ITEM WHICH DOESNT BEGIN ON A WORD    *
*      BOUNDARY                                                        *
*      IF CALLER WANTS 2 REGISTERS- RETURN A REGISTER FULL OF          *
*      AS SECOND ONE                                                   *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*      P1=BS
*      P2=SS
*      P5=10-SS 
*      P6=SS
  
*                  ARITH8: 6*FIXED
 AN2RA250 LABEL 
          NOTE   AN2RA250 
          CALLZ  LOADIT1   KS,BS,SS;VREGA,VREGB 
          GEN    SHL,VREGA,(ARITH8,SENDBCP) 
          CALLZ  ADDSPCS   10-SS,SS,VREGA;VREGA 
          MOVEZ  VREGA,(TREGOF,MOVEREGB)
          IFTHEN (RECSIZE,GT,10)
            GEN    SLRBPK,(VREGOF,VREGD),,BLANKS
           ENDIFZ 
          RETURN
 II       EJECT 
************************************************************************
*                                                                      *
*      II    DP TO RA  * DOUBLE PRECISION TO ALPHANUMERIC-REGISTER(S)  *
*                                                                      *
************************************************************************
  
 AN2RA300 LABEL 
  
*      COMMON PARAMETER SETUP FOR ALL CASES:  
  
          SUBZ   10,SENDBCP,P2
  
          IFZ    (SENDBCP,NE,0),AN2RA350
  
************************************************************************
*      GENERATE CODE TO LOAD A DP ITEM WHICH BEGINS ON A WORD BOUNDARY *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*      P1=BS
*      P2=10-BS 
  
          NOTE   AN2RA300 
          CALLZ  LOADIT1   KS,BS,10-BS;VREGA,VREGB
          MOVEZ  VREGA,VREGC
          SUBZ   SENDSIZE,10,P6 
          CALLZ  LOADIT2   VREGB,SS-10;VREGA,VREGB
          SUBZ   20,SENDSIZE,P5 
          CALLZ  ADDSPCS   20-SS,SS-10,VREGA;VREGA
  
*      NOTICE THE ASSEMBLER WILL THROW OUT THE FOLLOWING TWO (USELESS)
*      INSTRUCTIONS.  THEY EXIST TO INSURE THAT THE 2 VREGS RETURNED
*      ARE CONSECUTIVE
  
          GEN    XMIT,(VREGOF,VREGD),VREGC
          GEN    XMIT,(VREGOF,VREGE),VREGA
          MOVEZ  VREGD,(TREGOF,MOVEREGB)
          RETURN
 II       SPACE  4
*      PROCESS DP SOURCE FIELD NOT BEGINNING ON A WORD BOUNDARY 
  
 AN2RA350 LABEL 
  
*      COMMON PARAMETER SETUP FOR BS .NE. 0 CASES 
  
          MULTZ  6,SENDBCP,SHIFTCT
  
          IFZ    (SENDSIZE,GT,10),AN2RA380
  
************************************************************************
*      GENERATE CODE TO LOAD A DP ITEM OF LESS THAN 11 CHARS WHICH     *
*      DOESN"T BEGIN ON A WORD BOUNDARY                                *
*      IF CALLER WANTS 2 REGS BACK- RETURN A REGISTER FULL OF BLANKS   *
*      AS SECOND ONE                                                   *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*      P1=BS
*      P2=10-BS 
*      SHIFTCT=6*BS 
  
*                  ARITH18: 6*(FIXED)MOD 10 
          NOTE   AN2RA350 
          CALLZ  LOADIT1   KS,BS,10-BS;VREGA,VREGB
          GEN    SHL,VREGA,SHIFTCT
          GENM   LDSPLT2
            REGP   VREGB,VREGA,(VREGOF,VREGA) 
            CONP   (ARITH18,SENDECP),SHIFTCT
          ENDG
          SUBZ   10,SENDSIZE,P5 
          MOVEZ  SENDSIZE,P6
          CALLZ  ADDSPCS   10-SS,SS,VREGA;VREGA 
          MOVEZ  VREGA,(TREGOF,MOVEREGB)
          IFTHEN (RECSIZE,GT,10)
            GEN    SLRBPK,(VREGOF,VREGD),,BLANKS
          ENDIFZ
          RETURN
 II       SPACE  4
************************************************************************
*      GENERATE CODE TO LOAD A DP ITEM OF MORE THAN 10 CHARS WHICH     *
*      DOESN"T BEGIN ON A WORD BOUNDARY                                *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*      P1=BS
*      P2=10-BS 
*      SHIFTCT=6*BS 
  
*                  ARITH7: 60-6*(FIXED) 
*                  ARITH8: 6*FIXED
*                  ARITH17: (FIXED)MOD 10 
  
 AN2RA380 LABEL 
          NOTE   AN2RA380 
          CALLZ  LOADIT1   KS,BS,10-BS;VREGA,VREGB
          GEN    SHL,VREGA,SHIFTCT
          SUBZ   SENDSIZE,10,P6 
          GENM   LD2LFSPL 
            REGP   VREGB,(VREGOF,VREGB),(VREGOF,VREGC),(VREGOF,VREGD) 
            CONP   SHIFTCT,(ARITH7,SENDBCP),(ARITH8,P6) 
          ENDG
          GEN    LOR,(VREGOF,VREGE),VREGA,VREGC 
          MOVEZ  VREGD,VREGA
          SUBZ   20,SENDSIZE,P5 
          CALLZ  ADDSPCS   20-SS,SS-10,VREGA;VREGA
  
*      NOTICE THE ASSEMBLER WILL THROW OUT THE FOLLOWING TWO (USELESS)
*      INSTRUCTIONS.  THEY EXIST TO INSURE THAT THE 2 VREGS RETURNED
*      ARE CONSECUTIVE
  
          GEN    XMIT,(VREGOF,VREGF),VREGE
          GEN    XMIT,(VREGOF,VREGG),VREGA
          MOVEZ  VREGF,(TREGOF,MOVEREGB)
          RETURN
 III      EJECT 
************************************************************************
*                                                                      *
*      III   TP TO RA  * TRIPLE PRECISION TO ALPHANUMERIC REGISTERS    *
*                                                                      *
************************************************************************
  
*      PRIOR PARAMETER SETUP HAS PRODUCED:  
  
*      P1=BS
*                  ARITH18: 6*(FIXED)MOD 10 
 AN2RA500 LABEL 
          NOTE   AN2RA500 
          SUBZ   10,SENDBCP,P2
          CALLZ  LOADIT1   KS,BS,10-BS;VREGA,VREGB
          MULTZ  6,SENDBCP,SHIFTCT
          GEN    SHL,VREGA,SHIFTCT
          SUBZ   60,SHIFTCT,MASK1 
          GENM   LD2LFSPL 
            REGP   VREGB,(VREGOF,VREGB),(VREGOF,VREGC),(VREGOF,VREGD) 
            CONP   SHIFTCT,MASK1,MASK1
          ENDG
          GEN    LOR,(VREGOF,VREGE),VREGA,VREGC 
          GENM   LDSPLT2
            REGP   VREGB,VREGD,(VREGOF,VREGA) 
            CONP   (ARITH18,SENDECP),SHIFTCT
          ENDG
          SUBZ   20,SENDSIZE,P5 
          SUBZ   SENDSIZE,10,P6 
          CALLZ  ADDSPCS   20-SS,SS-10,VREGA;VREGA
  
*      NOTICE THE ASSEMBLER WILL THROW OUT THE FOLLOWING TWO (USELESS)
*      INSTRUCTIONS.  THEY EXIST TO INSURE THAT THE 2 VREGS RETURNED
*      ARE CONSECUTIVE
  
          GEN    XMIT,(VREGOF,VREGG),VREGE
          GEN    XMIT,(VREGOF,VREGH),VREGA
          MOVEZ  VREGG,(TREGOF,MOVEREGB)
          RETURN
          SPACE  4
 OP.BDP   IFEQ   OP.BDP,OP.NO 
          LISTSEC  AN2SA
          TITLE  AN2SA - NON-SUBSCRIPTED AN TO SUBSCRIPTED AN PROCESSOR 
************************************************************************
*                                                                      *
*      II AN2SA * UNSUBSCRIPTED SOURCE TO SUBSCRIPTED RECEIVING        *
*                                                                      *
************************************************************************
  
 AN2SA    EGO    1
  
*      IF SPECIAL CASE CODE CAN BE GENERATED- GO DO IT
  
          IFZ    ((SUBSCOF,MOVEREGB),NE,0),AN2SA300 
          MOVEZ  (GSCODEOF,MOVEREGB),T1 
          IFZ    ((RFLCPTYP,T1),NE,0),AN2SA800
  
          IFZ    (SIZEDIFF,GT,0),AN2SA160 
          IFZ    (SIZEDIFF,LT,0),AN2SA130 
  
************************************************************************
*      GENERATE CODE FOR UNSCRIPTED SOURCE FIELD TO SUBSCRIPTED        *
*      RECEIVING FIELD HAVING THE SAME SIZE.                           *
************************************************************************
  
 AN2SA120 LABEL 
          NOTE   AN2SA120 
          GEN    SBBPK,(VREGOF,VREGC),,RECADDR
          MOVEZ  RECSUBS,P1 
          CALLZ  SUBLOAD
          GEN    SHR,P1,30
          MOVEZ  P1,VREGU 
          MOVEZ  RECBCP,P1
          CALLZ  SETBXPK
          GEN    SBBPK,(VREGOF,VREGA),,SRCADDR
          MOVEZ  SENDBCP,P1 
          CALLZ  SETBREG
          MOVEZ  VREGX,VREGB
          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 UNSUBSCRIPTED SOURCE FIELD TO SUBSCRIPTED 
*      RECEIVING FIELD.  SIZE OF SOURCE FIELD IS LESS THAN SIZE OF
*      RECEIVING FIELD. 
  
 AN2SA130 LABEL 
          NOTE   AN2SA130 
          IFZ    (JUSTFLG,EQ,0),AN2SA120
  
*      JUSTIFIED RECEIVING FIELD, MAKE SIZEDIFF POSITIVE FOR C.MOVE 
  
          SUBZ   0,SIZEDIFF,SIZEDIFF
          BRANCH AN2SA120 
          SPACE  4
*      PROCESS UNSUBSCRIPTED SOURCE FIELD TO SUBSCRIPTED RECEIVING
*      FIELD.  SIZE OF SOURCE FIELD IS GREATER THAN SIZE OF RECEIVING 
*      FIELD. 
  
 AN2SA160 LABEL 
          MOVEZ  RECSIZE,SENDSIZE 
          IFZ    (JUSTFLG,NE,0),AN2SA170
  
*      NO JUSTIFICATION 
  
          NOTE   AN2SA160 
          MOVEZ  0,SIZEDIFF 
          BRANCH AN2SA120 
  
*      JUSTIFIED RECEIVING FIELD
  
  
 AN2SA170 LABEL 
          NOTE   AN2SA170 
          ADDZ   SENDBCP,SIZEDIFF,T1
          REMZ   T1,10,SENDBCP
          QUOTZ  T1,10,ADOFSET
          MOVEZ  0,SIZEDIFF 
          BRANCH AN2SA120 
          EJECT 
*      BEGIN PROCESSING SPECIAL CASE MOVES
  
 AN2SA300 LABEL 
          IFZ    (SENDECP,GT,20),AN2SA700 
          IFZ    (SENDECP,GT,10),AN2SA500 
  
*      SINGLE PRECESION SOURCE FIELD
  
          IFZ    (SIZEDIFF,GT,0),AN2SA460 
          IFZ    (SIZEDIFF,LT,0),AN2SA380 
  
*      SIZE OF SOURCE FIELD = SIZE OF RECEIVING FIELD 
  
          IFZ    (SENDBCP,NE,0),AN2SA340
  
 AN2SA320 LABEL 
          NOTE   AN2SA320 
          GEN    SLRBPK,(VREGOF,VREGA),,SRCADDR 
          MOVEZ  MOVEREGB,P1
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  0,P3        NO FILL
          MOVEZ  VREGA,P4 
          CALLZ  SCSTORE
          RETURN
          SPACE  4
 AN2SA340 LABEL 
          ADDZ   SENDBCP,RECSIZE,T1 
          IFZ    (T1,NE,10),AN2SA360
  
 AN2SA350 LABEL 
          NOTE   AN2SA350 
          GEN    SLRBPK,(VREGOF,VREGA),,SRCADDR 
          MOVEZ  MOVEREGB,P1
          MOVEZ  1,P2        RIGHT JUSTIFY
          MOVEZ  0,P3        NO FILL
          MOVEZ  VREGA,P4 
          CALLZ  SCSTORE
          RETURN
          SPACE  4
 AN2SA360 LABEL 
          NOTE   AN2SA360 
          GEN    SLRBPK,(VREGOF,VREGA),,SRCADDR 
          GEN    SHL,VREGA,(ARITH8,SENDBCP) 
          MOVEZ  MOVEREGB,P1
          MOVEZ  0,P2        LEFT JUSTIFY 
          MOVEZ  0,P3        NO FILL
          MOVEZ  VREGA,P4 
          CALLZ  SCSTORE
          RETURN
          SPACE  4
*      SIZE OF SOURCE IS LESS THAN SIZE OF RECEIVING
  
 AN2SA380 LABEL 
          SUBZ   0,SIZEDIFF,SIZEDIFF
  
          MOVEZ  SENDBCP,P1 
          MOVEZ  SENDSIZE,P2
          MOVEZ  1,P3 
          MOVEZ  SIZEDIFF,P5
  
          IFZ    (JUSTFLG,NE,0),AN2SA420
  
          NOTE   AN2SA380 
          CALLZ  LOADIT1   KS,BS,SS;VREGA;VREGB 
          IFTHEN (SENDBCP,NE,0) 
            GEN    SHL,VREGA,(ARITH8,SENDBCP) 
          ENDIFZ
          MOVEZ  SENDSIZE,P6
          CALLZ  ADDSPCS   SR-SS,SS,VREGA;VREGA 
          MOVEZ  MOVEREGB,P1
          MOVEZ  0,P2 
          MOVEZ  VREGA,P4 
          CALLZ  SCSTORE
          RETURN
          SPACE  4
 AN2SA420 LABEL 
          NOTE   AN2SA420 
          CALLZ  LOADIT1   KS,BS,SS;VREGA,VREGB 
          IFTHEN (SENDECP,NE,10)
            GEN    SHL,VREGA,(ARITH8,SENDECP) 
          ENDIFZ
          SUBZ   10,RECSIZE,P6
          CALLZ  ADDSPCS   SR-SS,10-SR,VREGA;VREGA
          MOVEZ  MOVEREGB,P1
          MOVEZ  1,P2 
          MOVEZ  VREGA,P4 
          CALLZ  SCSTORE
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS GREATER THAN SIZE OF RECEIVING FIELD 
  
 AN2SA460 LABEL 
          IFZ    (JUSTFLG,NE,0),AN2SA480
  
          NOTE   AN2SA460 
          IFZ    (SENDBCP,EQ,0),AN2SA320
          BRANCH AN2SA360 
          SPACE  4
*      SIZE OF SOURCE FIELD IS GREATER THAN SIZE OF JUSTIFIED RECEIVING 
*      FIELD. 
 AN2SA480 LABEL 
          NOTE   AN2SA480 
          IFZ    (SENDECP,EQ,10),AN2SA350 
  
*      SIZE OF SOURCE FIELD IS GREATER THAN SIZE OF JUSTIFIED RECEIVING 
*      FIELD.  SOURCE FIELD DOES NOT END ON A WORD BOUNDARY.
  
          MOVEZ  MOVEREGB,P1
          GEN    SLRBPK,(VREGOF,VREGA),,SRCADDR 
          GEN    SHL,VREGA,(ARITH18,SENDECP)
          MOVEZ  1,P2        RIGHT JUSTIFIED
          MOVEZ  0,P3        NO FILL
          MOVEZ  VREGA,P4 
          CALLZ  SCSTORE
          RETURN
          EJECT 
*      BEGIN PROCESSING SPECIAL CASE MOVES FROM DP SOURCE FIELDS
  
 AN2SA500 LABEL 
          IFZ    (SIZEDIFF,GT,0),AN2SA580 
          IFZ    (SIZEDIFF,LT,0),AN2SA540 
  
*      SIZE OF DP SOURCE FIELD = SIZE OF RECEIVING FIELD
  
 AN2SA520 LABEL 
          NOTE   AN2SA520 
          MOVEZ  SENDBCP,P1 
          SUBZ   10,SENDBCP,P2
          CALLZ  LOADIT1   KS,BS,10-BS;VREGA,VREGB
          GEN    SHL,VREGA,(ARITH8,SENDBCP) 
          ADDZ   SENDBCP,RECSIZE,MASK1
          GENM   LDSPLT2
            REGP   VREGB,VREGA,(VREGOF,P4)
            CONP   (ARITH18,MASK1),(ARITH8,SENDBCP) 
          ENDG
          MOVEZ  MOVEREGB,P1
          MOVEZ  0,P2        LEFT JUSTIFIED 
          MOVEZ  1,P3        ZERO FILLED
          CALLZ  SCSTORE
          RETURN
          SPACE  4
*      SIZE OF SORUCE FIELD LESS THAN SIZE OF RECEIVING FIELD 
  
AN2SA540  LABEL 
          SUBZ   0,SIZEDIFF,SIZEDIFF
          MOVEZ  SENDBCP,P1 
          SUBZ   10,SENDBCP,P2
          MOVEZ  SIZEDIFF,P5
  
          IFZ    (JUSTFLG,NE,0),AN2SA560
  
*      SIZE OF DP SOURCE FIELD IS LESS THAN SIZE OF UNJUSTIFIED 
*      RECEIVING FIELD
  
          CALLZ  LOADIT1   KS,BS,10-BS;VREGA,VREGB
          GEN    SHL,VREGA,(ARITH8,SENDBCP) 
          GENM   LDSPLT2
            REGP   VREGB,VREGA,(VREGOF,VREGA) 
            CONP   (ARITH18,SENDECP),(ARITH8,SENDBCP) 
          ENDG
          MOVEZ  SENDSIZE,P6
          CALLZ  ADDSPCS   SR-SS,SS,VREGA;VREGA 
          MOVEZ  MOVEREGB,P1
          MOVEZ  0,P2        LEFT JUSTIFIED 
          MOVEZ  1,P3        ZERO FILLED
          MOVEZ  VREGA,P4 
          CALLZ  SCSTORE
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS LESS THAN SIZE OF JUSTIFIED RECEIVING
*      FIELD
  
 AN2SA560 LABEL 
          NOTE   AN2SA560 
          CALLZ LOADIT1   KS,BS,10-BS;VREGA,VREGB 
          MOVEZ  (ARITH18,SENDECP),SHIFTCT
          GEN    SHL,VREGA,SHIFTCT
          GENM   LDSPLT2
            REGP   VREGB,VREGA,(VREGOF,VREGA) 
            CONP   SHIFTCT,SHIFTCT
          ENDG
          SUBZ   10,RECSIZE,P6
          CALLZ  ADDSPCS   SR-SS,10-SB,VREGA;VREGA
          MOVEZ  MOVEREGB,P1
          MOVEZ  1,P2        RIGHT JUSTIFIED
          MOVEZ  1,P3        ZERO FILLED
          MOVEZ  VREGA,P4 
          CALLZ  SCSTORE
          RETURN
          SPACE  4
*      SIZE OF SOURCE FIELD IS GREATER THAN SIZE OF RECEIVING FIELD 
  
 AN2SA580 LABEL 
          IFZ    (JUSTFLG,NE,0),AN2SA600
          NOTE   AN2SA580 
          ADDZ   SENDBCP,RECSIZE,T1 
          IFZ    (T1,LE,10),AN2SA340
          BRANCH AN2SA520 
  
*      SIZE OF SOURCE FIELD IS GREATER THAN SIZE OF JUSTIFIED RECEIVING 
*      FIELD
  
 AN2SA600 LABEL 
          ADDZ   SENDBCP,SIZEDIFF,T1
          REMZ   T1,10,SENDBCP
          QUOTZ  T1,10,ADOFSET
          REMZ   SENDECP,10,T1
          IFZ    (T1,EQ,RECSIZE),AN2SA320 
          IFZ    (T1,GT,RECSIZE),AN2SA360 
          BRANCH AN2SA520 
          EJECT 
*      BEGIN PROCESSING SPECIAL CASE MOVES FROM TP OR EP SOURCE FIELDS
  
 AN2SA700 LABEL 
          NOTE   AN2SA700 
          BRANCH AN2SA580 
          SPACE  3
*      REFERENCE MODIFICATION 
 AN2SA800 LABEL 
          NOTE   AN2SA800 
          IFTHEN (POOLFLG,EQ,0) 
            ANDIF  (LITFLG,EQ,1)
            MOVEZ  REGU1,REGT 
            CALLZ  ADPDNAT
            MOVEZ  0,(BCPOF,REGT) 
            MOVEZ  10,(BYTLENOF,REGT) 
            MOVEZ  0,P1 
            MOVEZ  (SHOLITOF,MOVEREGA),P2 
            EXECUTE LITPOOL 
            GEN    SBBPK,(VREGOF,VREGA),,((FWA$OF,REGT))
          ELSEZ 
            GEN    SBBPK,(VREGOF,VREGA),,SRCADDR
          ENDIFZ
          GEN    SBBPK,(VREGOF,VREGB),,RECADDR
          GEN    MASK,(VREGOF,VREGC),0           NOT JUSTIFIED
          MOVEZ  MOVEREGB,P2
          CALLZ  SUBREF 
          GEN    SBXPB,(VREGOF,VREGD),P3
          MOVEZ  P4,VREGE 
          MOVEZ  SENDBCP,P1 
          CALLZ  SETBREG     OUTPUT IN VREGX
          MOVEZ  SENDSIZE,P1
          CALLZ  SETXREG     OUTPUT IN VREGW
          GENOBJ N=C.MOVRF,I=(VREGB,VREGD,VREGA,VREGX,VREGC,VREGW,VREGE)
          RETURN
 OP.BDP   ENDIF 
          LISTSEC  *
          TITLE  LOADRM - LOAD REFERENCE MODIFIED ITEM
**        LOADRM LOAD REFERENCE MODIFIED ITEM AS NUMERIC
 LOADRM   EGO    3
          MOVEZ  REGB,P2
          CALLZ  SUBREF 
          GEN    XMIT,(VREGOF,VREG1),P4 
          GEN    SXXPK,(VREGOF,VREG2),VREG1,-18 
          MOVEZ  (LOCLAB,T1),T1 
          GEN    HOLDR,VREG1
          GEN    NG$,VREG2,,((LOCAL$OF,T1)) 
          GEN    SXBPK,VREG1,,18
          GEN    LABEL$,((LOCAL$OF,T1)) 
          GEN    RFREE,VREG1
          GEN    SXBPB,(VREGOF,VREG3),,VREGB1 
          GEN    SHL,VREG3,17 
          GEN    LOR,(VREGOF,VREG1),VREG1,VREG3 
          GEN    SBBPK,(VREGOF,VREG2),,((FWA$OF,REGB))
          GENOBJ N=C.ND2RN,I=(VREG1,P3,VREG2),O=((VREGOF,VREG1),(VREGOF,
,VREG2))
          MOVEZ  REGU4,REGT 
          CALLZ  ADNAT
          MOVEZ  18,(NUMLENOF,REGT) 
          MOVEZ  0,(SIGNOF,REGT)
          MOVEZ  0,(POINTOF,REGT) 
          MOVEZ  VREG1,(TREGOF,REGT)
          MOVEZ  REGT,REGB
          RETURN
          END 
