*DECK             DPOSIT
USETEXT   TSOURCE 
USETEXT   TCEXECQ 
USETEXT   TSYMCNS 
USETEXT   TCOM37Q 
USETEXT   TCOM39Q 
USETEXT   TCOM78Q 
USETEXT   TCEXEC
USETEXT   TC7DECS 
PROC DPOSIT;
                                        #GENERATES INSTRUCTION TO DEPO-#
                                        # SIT A FIXED-FIELD VALUE,     #
                                        # SIGNED OR UNSIGNED, INTO A   #
                                        # FIXED FIELD OF AN X-REGISTER,#
                                        # RIGHT-ADJUSTED.              #
                                        #    SINK: XX, EBT, MBT, K     # JANDRE 
                                        #  SOURCE: RR, FBT, NBT, L     # JANDRE 
BEGIN #SINK MUST BE LS 60 BITS LONG#
  
  
  
  
*CALL COMEX 
  
  
  
  
    ITEM I1,I2,I3,I4,O1,O2,O3,C1,CX,J,K,L,W,M1; 
    XDEF PROC CDPOSIT;                                                   JANDRE 
    XREF PROC ICFGNR; 
    XREF PROC ICFGEN; 
    XREF PROC FIND; 
    XREF FUNC MSKGEN; 
    XREF PROC MSKGNC;                                                    JANDRE 
    XREF FUNC PSICON; 
    XREF PROC PSICONS;                                                   JANDRE 
         $BEGIN                                                          JANDRE 
           XREF PROC DMPTRD;                                             JANDRE 
           DMPTRD(OBJX);                                                 JANDRE 
           DMPTRD(RR);                                                   JANDRE 
         $END                                                            JANDRE 
    # GENERATE MASK TO CLEAN SINK #                                      JANDRE 
    W=1;                                                                 JANDRE 
    MSKGNC(EBT,MBT,M1,W);         # M1=MASK #                            JANDRE 
    FIND(M1,O1); O1=CONS[O1];                                            JANDRE 
    #CHECK FOR CONSTANT SOURCE# 
    IF KFLG[RR] THEN
        BEGIN 
        O3=0; 
        IF ADJF[RR] THEN B<EBT,MBT>O3=B<0,MBT>KONS[RR]; 
        ELSE #RIGHT-ADJUSTED CONSTANT# B<EBT,MBT>O3=KONS[RR]; 
        IF O3 EQ 0 THEN 
            BEGIN #NEED ONLY CLEAR SINK#
            ICFGEN(NDINS[W],M1,XX); 
            RETURN;                                                      JANDRE 
            END 
        IF O3 EQ O1 THEN
            BEGIN #NEED ONLY OR IN ALL 1"S# 
            ICFGEN(ORINS[W],M1,XX); 
            RETURN;                                                      JANDRE 
            END 
         ICFGEN(NDINS[W],M1,XX);  #CLEAN SINK#                           JANDRE 
        L=ICFPTR;                                                        JANDRE 
        #CHOOSE BEST CONSTANT REPRESENTATION# 
        I3=1;                                                            JANDRE 
        PSICONS(O3,EBT,MBT,I3,I4);                                       JANDRE 
        ICFGEN(ADINS[1-I3],I4,L);                                        JANDRE 
        RETURN;                                                          JANDRE 
        END 
    #CLEAR THE SINK#
    ICFGEN(NDINS[W],M1,XX); 
    K=ICFPTR; #SAVE CLEARED-SINK PTR# 
    L=MEMR[RR]; #INITIALIZE SOURCE PTR# 
    IF NBT GQ MBT THEN
        BEGIN #NO SIGN EXTENSION# 
POSS:   #CALCULATE SOURCE POSITIONING#
        J=FBT+NBT-(EBT+MBT);
        IF J NQ 0 THEN
            BEGIN #POSITION SOURCE# 
            IF J LS 0 THEN J=J+60;
            ICFGEN(QICFOP"LSHC",L,J); 
            L=ICFPTR; 
            END 
ANDS:    #TRUNCATE SOURCE TO FIT SINK#
        ICFGEN(NDINS[1-W],M1,L);
        L=ICFPTR; 
        #OR SOURCE AND SINK#
        ICFGEN(QICFOP"LOR",L,K);
        RETURN;                                                          JANDRE 
        END 
    IF SYG THEN 
        BEGIN #MUST SIGN-EXTEND SOURCE# 
          IF FBT EQ 42 AND NBT EQ 18 AND EBT NQ 0 THEN                   JANDRE 
            BEGIN #RIGHT-MOST 18 BITS#
            ICFGEN(QICFOP"BXND",L,0); 
            L=ICFPTR; #UPDATE SOURCE ICF PTR# 
            GOTO POSS;
            END 
        IF FBT NQ 0 THEN
            BEGIN #POSITION TO SIGN BIT#
            ICFGEN(QICFOP"LSHC",L,FBT); 
            L=ICFPTR; #UPDATE SOURCE ICF PTR# 
            END 
        #EXTEND SIGN# 
        ICFGEN(QICFOP"RSHC",L,EBT+MBT-NBT); 
        L=ICFPTR; #UPDATE SOURCE ICF PTR# 
        GOTO ANDS;
        END 
    # GENERATE 2ND MASK WHEN UNSIGNED SOURCE #                           JANDRE 
    W=1;                                                                 JANDRE 
    MSKGNC(EBT+(MBT-NBT),NBT,M1,W);                                      JANDRE 
    GOTO POSS;
CONTROL EJECT;                                                           JANDRE 
PROC CDPOSIT;                                                            JANDRE 
               # GENERATE INSTRUCTIONS TO DEPOSIT CHARACTER VALUE      # JANDRE 
               # INTO FIXED FIELD OF AN X-REGISTER, WITH BLANK PADDING # JANDRE 
               # SINK = SOURCE                                         # JANDRE 
               # SINK:  XX,EBT,MBT,K                                   # JANDRE 
               # SOURCE:RR,FBT,NBT,L                                   # JANDRE 
BEGIN                                                                    JANDRE 
   $BEGIN                                                                JANDRE 
    DMPTRD(OBJX);                                                        JANDRE 
    DMPTRD(RR);                                                          JANDRE 
   $END                                                                  JANDRE 
   #GENERATE MASK M1 TO CLEAN SOURCE #                                   JANDRE 
   W=1;                                                                  JANDRE 
   MSKGNC(EBT,MBT,M1,W);                                                 JANDRE 
   FIND(M1,O1); O1=CONS[O1];                                             JANDRE 
   # CHECK IF SOURCE IS CONSTANT #                                       JANDRE 
   IF KFLG[RR] THEN                                                      JANDRE 
         BEGIN                                                           JANDRE 
         O3=0;                                                           JANDRE 
         IF ADJF[RR]                                                     JANDRE 
            THEN # LEFT JUSTIFIED CONSTANT, BLANK PADDED #               JANDRE 
                 B<EBT,MBT>O3=B<0,MBT>KONS[RR];                          JANDRE 
            ELSE # NOT JUSTIFIED, NOT PADDED #                           JANDRE 
                 IF MBT LQ NBT                                           JANDRE 
                     THEN # NO PADDING ASKED #                           JANDRE 
                         B<EBT,MBT>O3=B<FBT,NBT>KONS[RR];                JANDRE 
                    ELSE # ADD BLANKS #                                  JANDRE 
                         BEGIN                                           JANDRE 
                         B<EBT,NBT>O3=B<FBT,NBT>KONS[RR];                JANDRE 
                         B<EBT+NBT,MBT+NBT>O3="          ";              JANDRE 
                         END                                             JANDRE 
         IF O3  EQ 0 THEN                                                JANDRE 
              BEGIN # CLEAR SINK ONLY#                                   JANDRE 
              ICFGEN(NDINS[W],M1,XX);                                    JANDRE 
              RETURN;                                                    JANDRE 
              END                                                        JANDRE 
         IF O3 EQ O1 THEN                                                JANDRE 
              BEGIN # ALL 1 #                                            JANDRE 
              ICFGEN(ORINS[W],M1,XX);                                    JANDRE 
              RETURN;                                                    JANDRE 
              END                                                        JANDRE 
         ICFGEN(NDINS[W],M1,XX); # CLEAR SINK #                          JANDRE 
         L=ICFPTR;                                                       JANDRE 
         I3=1;                                                           JANDRE 
         PSICONS(O3,EBT,MBT,I3,I4);                                      JANDRE 
         ICFGEN(ADINS[1-I3],I4,L);                                       JANDRE 
         RETURN;                                                         JANDRE 
         END # CONSTANT SOURCE#                                          JANDRE 
                                                                         JANDRE 
    # SOURCE IS NOT CONSTANT #                                           JANDRE 
    ICFGEN(NDINS[W],M1,XX);  # CLEAR SINK #                              JANDRE 
    K=ICFPTR;                # SINK   PTR #                              JANDRE 
    L=MEMR[RR];              # SOURCE PTR #                              JANDRE 
    IF MBT LQ NBT THEN                                                   JANDRE 
         BEGIN # SOURCE FIELD > SINK FIELD=>NO PADDING #                 JANDRE 
         J=FBT-EBT;                                                      JANDRE 
         IF J NQ 0 THEN                                                  JANDRE 
              BEGIN # POSITION SOURCE #                                  JANDRE 
              IF J LS 0 THEN J=J+60;                                     JANDRE 
              ICFGEN(QICFOP"LSHC",L,J);                                  JANDRE 
              L=ICFPTR;                                                  JANDRE 
              END                                                        JANDRE 
         ICFGEN(NDINS[1-W],M1,L); # MASK USEFULL FIELD #                 JANDRE 
         L=ICFPTR;                                                       JANDRE 
         # OR SINK(K) AND SOURCE(L)#                                     JANDRE 
         ICFGEN(QICFOP"LOR",L,K);                                        JANDRE 
         RETURN;                                                         JANDRE 
         END                                                             JANDRE 
                                                                         JANDRE 
    # PADDING IS ASKED #                                                 JANDRE 
    I1 =0;
    IF EBT EQ 0 THEN                                                     JANDRE 
         BEGIN # SINK IS LEFT JUSTIFIED #                                JANDRE 
         IF FBT NQ 0 THEN                                                JANDRE 
              BEGIN # SOURCE POSITIONING#                                JANDRE 
              ICFGEN(QICFOP"LSHC",L,FBT);                                JANDRE 
              L=ICFPTR;                                                  JANDRE 
              END                                                        JANDRE 
         ICFGEN(QICFOP"LAND",L,MSKGEN(NBT)); #ISOLATE SOURCE#            JANDRE 
          J = NBT - (NBT/6) *6  ;                                        L414 
          IF J NQ 0 THEN                                                 L414 
          BEGIN                                                          L414 
          L = ICFPTR;                                                    L414 
          ICFGEN ( QICFOP"LSHC" , L , 54+J);                             L414 
          NBT = NBT + 6 -J;                                              L414 
          END                                                            L414 
         END                                                             JANDRE 
    ELSE                                                                 JANDRE 
         BEGIN # EBT " 0 #                                               JANDRE 
         IF FBT EQ 0 THEN ICFGEN(QICFOP"LAND",L,MSKGEN(NBT));            JANDRE 
                     ELSE BEGIN # ISOLATE C<FBT,NBT>SOURCE#              JANDRE 
                          W=1;                                           JANDRE 
                          MSKGNC(FBT,NBT,M1,W);                          JANDRE 
                          ICFGEN(NDINS[1-W],M1,L);                       JANDRE 
                          END                                            JANDRE 
         #POSITION CLEARED SOURCE #                                      JANDRE 
         J=FBT-EBT;                                                      JANDRE 
         I1 = NBT - (NBT/6)*6;     # IF NOT MULT OF 6 BITS MAY BE 
                                    ADJUSTED TOO MUCH # 
         IF I1 NQ 0 THEN
           J = J - 6 + I1 ; 
         IF J LS 0 THEN J=J+60;                                          JANDRE 
         ICFGEN(QICFOP"LSHC",ICFPTR,J);                                  JANDRE 
         END                                                             JANDRE 
    ICFGEN(QICFOP"LOR",ICFPTR,K);                                        JANDRE 
    L=ICFPTR;                                                            JANDRE 
    # GENERATE BLANKS#                                                   JANDRE 
    O3=0;                                                                JANDRE 
    I3=1;                                                                JANDRE 
    IF I1 NQ 0 THEN 
         # ADJUST SHIFT TO MULT OF 6  # 
      NBT = NBT -I1 + 6 ; 
    EBT=EBT+NBT; MBT=MBT-NBT;                                            JANDRE 
    IF MBT EQ 0 THEN RETURN;
    B<EBT,MBT>O3="          ";                                           JANDRE 
    PSICONS(O3,EBT,MBT,I3,I4);                                           JANDRE 
    ICFGEN(ADINS[1-I3],I4,L);                                            JANDRE 
    RETURN;                                                              JANDRE 
END #CDPOSIT#                                                            JANDRE 
END 
TERM
