*DECK,DCNLFL
      PROC DC$NLFL(TCLASS,TSIZE,TGIBBP,TGIFWA,TRGPIC);
      BEGIN 
 #
  *    DC$NLFL                                   PAGE 1 
  *   NULLFILL PRIMITIVE
  *   J.W.PERRY                                  DATE  04/09/74 
  DC  PURPOSE 
      FILL TARGET ITEM WITH NULL-VALUE APPROPRIATE
      FOR THE DATA DESCRIPTION. 
  DC  ENTRY CONDITIONS
        FORMAL PARAMETERS 
      TCLASS CONTAINS TARGET ITEM DATA CLASS CODE (UNSIGNED INTEGER). 
      TSIZE CONTAINS TARGET ITEM SIZE, IN BITS (UNSIGNED INTEGER).
      TGIBBP CONTAINS BEGINNING BIT POSITION OF TARGET ITEM.
      TGIFWA CONTAINS FWA OF TARGET ITEM. 
      TRGPIC (ARRAY) CONTAINS PIC WORD (TARGET ITEM PICTURE INFO).
  DC  EXIT CONDITIONS 
      TARGET ITEM NULL-FILLED.
      ENTRY CELLS UNCHANGED.
  DC  CALLED ROUTINES 
      DC$XFER -- TRANSFER PRIMITIVE 
      DC$MWD -- MOVE-WORDS PRIMITIVE
      EMBEDDED PROC FILCHARACTER
  DC  CALLING ROUTINES
      ITEMMAPPING ROUTINE 
  DC  NON-LOCAL VARIABLES 
      NONE
  DC  DESCRIPTION 
        CURRENT IMPLEMENTATION SUPPORTS THE FOLLOWING DATA CLASSES
      ALPHANUMERIC  RECEIVES DISPLAY CODE BLANKS. 
      ALPHABETIC    RECEIVES DISPLAY CODE BLANKS. 
      DCNUMERIC     RECEIVES DISPLAY CODE ZEROES. 
      DCFIXED       RECEIVES DISPLAY CODE ZEROES PLUS OPTIONAL DECIMAL. 
      INTEGER       RECEIVES BINARY ZERO. 
      FIXED         RECEIVES FLOATING POINT ZERO. 
      FLOATUNNORM   RECEIVES FLOATING POINT ZERO. 
      FLOATNORM     RECEIVES FLOATING POINT ZERO. 
      DOUBLE        RECEIVES FLOATING POINT ZEROES (IN DOUBLE PREC).
      COMPLEX       RECEIVES FLOATING POINT ZEROES. 
      LOGICAL       RECEIVES BINARY ZERO. 
        RESULTS FOR OTHER CLASSES IS UNDETERMINED -- NO ERROR CONDITION 
      IS INDICATED. 
  
        FOR DISPLAY CODE CLASSES, BLANKS OR D.C. ZEROES ARE MOVED FROM
      LOCAL CELL TO TARGET ITEM (UP TO) 60 BITS AT A TIME UNTIL 
      TARGET SIZE IS REACHED. 
      EXPLICIT DECIMAL, SIGN, OR EXPONENT INDICATOR ARE SUPPLIED
      IF REQUIRED BY TARGET PICTURE INFO. 
      EXIT. 
        REMAINING CLASSES RECEIVE FULL WORD OF BINARY ZERO OR 
      FLOATING ZERO (SECOND WORD ALSO FOR DOUBLE, COMPLEX). 
  
 #
# 
      DEFINE UPDATE SYMBOL DNLFL TO TURN ON TRACE (USING SNATCH). 
      DEFINE UPDATE SYMBOL DNLFL2 TO DUMP PARAMETERS. 
# 
      CONTROL EJECT;
# DDL DATA-CLASS CODES                                                 #
  
        DEF ALPHANUMERIC #0#;          #ALPHANUMERIC DISPLAY CODE # 
        DEF ALPHABETIC   #1#;          #ALPHABETIC DISPLAY CODE # 
        DEF DATABASEKEY  #2#; 
        DEF DCNUMERIC    #3#;          #NUMERIC DISPLAY CODE, SIGN OVPN#
        DEF DCFIXED      #4#;          #NUM DC, WITH DECIMAL PT # 
        DEF DCFLOAT      #5#;          #NUM DC, WITH EXPONENT # 
        DEF DCDOUBLE     #6#;          #DISPLAY CODE DOUBLE PRECISION#
        DEF DCCOMPLEX    #7#;          #DISPLAY CODE COMPLEX #
        DEF DCLOGICAL    #8#;          #DISPLAY CODE LOGICAL #
        DEF BITSTRING    #9#; 
        DEF INTEGER      #10#;         #BINARY INTEGER #
        DEF FIXED        #11#;         #FLOATING POINT, UNNORMALIZED #
        DEF FLOATUNNORM  #12#;         #FLOATING POINT, UNNORMALIZED #
        DEF FLOATNORM    #13#;         #FLOATING POINT, NORMALIZED #
        DEF DOUBLE       #14#;         #FLOATING POINT, DOUBLE PREC. #
        DEF COMPLEX      #15#;         #FLOATING POINT, COMPLEX # 
        DEF LOGICAL      #16#;         #LOGICAL (BINARY 0 OR 1)#
  
  
      #DEFS FOR READABILITY                                            #
        DEF CALL     # #;    #CALL CAN BE USED WHEN CALLING PROCEDURES #
        DEF XCALL    # #;    #XCALL CAN BE USED WHEN CALLING PROCEDURES#
        DEF THRU     #STEP 1 UNTIL#; #SHORTHAND FOR FOR-LOOP USE       #
  
      XREF
        BEGIN 
        PROC DC$XFER; 
        PROC DC$MWD;
        END 
  
# NULL VALUES, READ-ONLY CONSTANTS. # 
  
      ITEM BLANKS C(10) = "          ";      #FOR ALPHA-NUMERIC DATA.  #
      ITEM DCZERO C(10) = "0000000000";      #FOR DISPLAY NUMERIC DATA.#
      ITEM BINZERO U = 0;                    #FOR BINARY INTEGER DATA. #
      ITEM FLTZERO U = O"20000000000000000000";  #FOR FLOAT PT DATA.   #
      ITEM DBLZERO U = O"17170000000000000000";  #FOR DOUBLE PREC DATA.#
      ITEM DECIMAL C(10) = ".         ";      #EXPLICIT DECIMAL.       #
      ITEM PLUSSIGN C(10) = "+         ";     #EXPLICIT PLUS SIGN.     #
      ITEM EXPONENT C(10) = "E         ";     #EXPLICIT EXPONENT.      #
  
# FORMAL PARAMETERS. #
  
      ITEM TCLASS U;               #PARAM 1 - ITEM DATA CLASS CODE.#
      ITEM TSIZE U;                #PARAM 2 - ITEM SIZE (BITS).#
      ITEM TGIBBP U;               #PARAM 3 - ITEM BEGIN BIT POS.#
      ITEM TGIFWA U;               #PARAM 4 - ITEM BEGIN WORD POS.# 
      ARRAY TRGPIC;                #PARAM 5 - ITEM PICTURE INFO. #
        BEGIN 
          ITEM TSNLOC U(0,0,5);    #SIGN LOC, NBR DIGITS FROM RIGHT.   #
          ITEM TSEPSG B(0,5,1);    #TRUE - SEP SIGN, FALSE - OVERPUNCH #
          ITEM TSIGNF B(0,6,1);    #TRUE - SIGN IS SPECIFIED.          #
          ITEM TPTLOC U(0,7,5);    #DECIMAL PT DISPLACEMENT,NBR DIGITS #
          ITEM TACTLP B(0,12,1);   #TRUE-ACTUAL DECIMAL PT,FALSE-ASSUM #
          ITEM TLEFTP B(0,13,1);   #TRUE-PT IS TO LEFT, FALSE-TO RIGHT #
          ITEM TSYNC B(0,28,1);    #TRUE - SYNCHRONIZATION SPECIFIED   #
          ITEM TSYLFT B(0,29,1);   #TRUE- SYNC LEFT (IF SYNC IS SPEC)  #
          ITEM TJUST B(0,30,1);    #TRUE - JUSTIFIED RIGHT.            #
        END #TRGPIC#
  
# LOCAL VARIABLES. #
  
      ITEM DATACLASS U;      #DATA CLASS-CODE.                         #
      ITEM I U;              #SCRATCH. #
      ITEM SIZE U;           #LOCAL CELL FOR TRANSFER SIZE (BITS).     #
      ITEM SIZELEFT I;       #BITS LEFT TO MOVE.                       #
      ITEM SOURCFWA U;       #SOURCE VALUE FWA.                        #
      ITEM TARGTFWA U;       #TARGET VALUE FWA.                        #
      ITEM TARGTBBP U;       #TARGET VALUE BEGINNING BIT POSITION.     #
      CONTROL EJECT;
*IF DEF,DNLFL,4 
      XREF PROC SNATCHC;                         #IN IF DEF DNLFL # 
      BASED ARRAY DUMARRAY;                      #IN IF DEF,DNLFL # 
        ITEM DUMITEM C(0,0,10);                  #IN IF DEF,DNLFL # 
      SNATCHC("ENTER NLFL",SIZE,0);              #IN IF DEF DNLFL # 
*IF DEF,DNLFL2,5
      XREF PROC SNATCHD;                         #IN IF DEF DNLFL2 #
      SNATCHD("DATACLASS",TCLASS); #IN IF DEF DNLFL2 #
      SNATCHD("SIZE",TSIZE);       #IN IF DEF DNLFL2 #
      SNATCHD("TARGBBP",TGIBBP);                 #IN IF DEF DNLFL2 #
      SNATCHD("TARGFWA",TGIFWA);                 #IN IF DEF DNLFL2 #
      DATACLASS = TCLASS;    #DATA CLASS CODE OF ITEM TO BE FILLED.    #
  
      IF #1# DATACLASS LQ DCLOGICAL THEN    #DISPLAY CODE DATA. # 
        BEGIN 
        IF #2# DATACLASS LQ ALPHABETIC THEN 
          SOURCFWA = LOC(BLANKS);      #NULL-VALUE IS D.C. BLANKS. #
        ELSE #2#
          SOURCFWA = LOC(DCZERO);      #NULL-VALUE IS D.C. ZEROES. #
  
        SIZELEFT = TSIZE;    #TOTAL BITS OF TARGET TO FILL. # 
        TARGTFWA = TGIFWA;             #INITIAL TARGET LOCATION.       #
        TARGTBBP = TGIBBP;
  
# LOOP, TRANSFERRING UP TO 60 BITS OF NULL-VALUE PER PASS.             #
  
        FOR #3# I = 1 WHILE SIZELEFT GR 0 DO
          BEGIN 
          IF #4# SIZELEFT GR 60 THEN
            SIZE = 60;
          ELSE #4#           #SIZE = MIN(60,SIZELEFT). #
            SIZE = SIZELEFT;
  
          XCALL DC$XFER(SOURCFWA,0,TARGTFWA,TARGTBBP,SIZE); 
  
          SIZELEFT = SIZELEFT - SIZE; 
          TARGTBBP = TARGTBBP + SIZE; 
          IF #5# TARGTBBP GQ 60 THEN   #ADJUST BBP,FWA SO BBP LT 60. #
            BEGIN 
            TARGTBBP = TARGTBBP - 60; 
            TARGTFWA = TARGTFWA + 1;
            END #OF IF 5 #
          END #OF FOR 3#
        IF #6# DATACLASS GR ALPHABETIC THEN 
          BEGIN 
  
# SUPPLY EXPLICIT DECIMAL, SIGN, EXPONENT INDICATOR, IF REQUIRED.      #
  
          SIZE = 6; 
          TARGTBBP = TGIBBP + TSIZE;   #TARGET ENDING BIT POS.# 
  
          IF #7# TSIGNF[0] AND TSEPSG[0] THEN    #SUPPLY  PLUS SIGN. #
            BEGIN 
            TARGTBBP = TARGTBBP - 6 * TSNLOC[0]; #BACK UP SNLOC DIGITS.#
            SOURCFWA = LOC(PLUSSIGN);  #POINT TO + SIGN. #
  
            CALL FILCHARACTER;         #FILL IN PLUS SIGN. #
  
            END #OF IF 7# 
  
          IF #8# TACTLP[0] AND TLEFTP[0] THEN    #SUPPLY DECIMAL POINT.#
            BEGIN 
            TARGTBBP = TARGTBBP - 6 * TPTLOC[0]; #BACK UP PTLOC DIGITS.#
            SOURCFWA = LOC(DECIMAL);   #POINT TO DECIMAL POINT. # 
  
            CALL FILCHARACTER;         #FILL IN DECIMAL POINT. #
  
            END #OF IF 8# 
  
# ADD CODE HERE FOR EXPONENT INDICATOR AND EXPONENT SIGN.              #
          END #OF IF 6# 
  
*IF,DEF,DNLFL,1 
      SNATCHC("EXIT NLFL",SIZE,0);               #IN IF DEF,DNLFL # 
        RETURN; 
  
        END #OF IF 1# 
  
      ELSE #1#               #DATACLASS GQ BITSTRING. # 
  
# DATA IS FULL-WORD(S) VALUE.                                          #
  
        BEGIN 
        IF #11# DATACLASS LQ INTEGER OR DATACLASS EQ LOGICAL THEN 
          SOURCFWA = LOC(BINZERO);     #NULL-VALUE IS BINARY ZERO. #
        ELSE #11# 
          SOURCFWA = LOC(FLTZERO);     #NULL-VALUE IS FLOATING ZERO. #
  
        XCALL DC$MWD(SOURCFWA,TGIFWA,1); #NULL-FILL FULL WORD.# 
  
        IF #12# DATACLASS NQ DOUBLE AND DATACLASS NQ COMPLEX THEN 
*IF,DEF,DNLFL,1 
      SNATCHC("EXIT NLFL",SIZE,0);               #IN IF DEF,DNLFL # 
          RETURN; 
  
        IF #13# DATACLASS EQ DOUBLE THEN
          SOURCFWA = LOC(DBLZERO);
        ELSE #13# 
          SOURCFWA = SOURCFWA + 1;
        TARGTFWA = TGIFWA + 1;
  
        XCALL DC$MWD(SOURCFWA,TARGTFWA,1);  #FILL 2ND WORD.#
  
*IF DEF,DNLFL,1 
      SNATCHC("EXIT NLFL",SIZE,0);               #IN IF DEF NLFL #
        RETURN; 
  
        END #OF ELSE 1# 
      CONTROL EJECT;
      PROC FILCHARACTER;
      BEGIN 
 #
  *   FILCHARACTER ROUTINE                       PAGE 1 
  *   J.W.PERRY 
  DC  PURPOSE 
      FILL SINGLE CHARACTER IN TARGET ITEM. 
  DC  ENTRY CONDITIONS
      TARGTBBP CONTAINS BEGINNING BIT POSITION OF CHARACTER TO BE 
        FILLED (NOT NECESSARILY LESS THAN 60).
      SOURCFWA CONTAINS FWA OF SOURCE CHARACTER, LEFT-JUST IN A WORD. 
      TGIFWA (DC$RMCM) CONTAINS FWA OF ENTIRE TARGET FIELD. 
      SIZE CONTAINS NUMBER OF BITS TO FILL. 
  DC  EXIT CONDITIONS 
      CHARACTER MOVED FROM SOURCE TO TARGET FIELD.
  DC  CALLED ROUTINES 
      DC$XFER -- TRANSFER PRIMITIVE 
  DC  CALLING ROUTINES
      DC$NLFL -- NULL-FILL PRIMITIVE
  DC  NON-LOCAL VARIABLES 
      TARGTFWA
  DC  DESCRIPTION 
        CHARACTER OF LENGTH -SIZE- BITS IS INSERTED INTO TARGET FIELD 
      AT BIT POSITION -TARGTBBP-. 
        FIRST OBTAIN BIT POSITION MODULO 60 (ROUNDING UP FWA -TARGTFWA- 
      BY WORDS), THEN CALL DC$XFER TO TRANSFER FROM SOURCE, LEFT-JUST 
      AT SOURCFWA.
 #
      CONTROL EJECT;
*IF DEF,DNLFL,2 
      P<DUMARRAY> = SOURCFWA;                    #IN IF DEF,DNLFL # 
      SNATCHC("ENTER FILC",DUMITEM[0],10);       #IN IF DEF,DNLFL # 
      TARGTFWA = TARGTBBP / 60; 
      TARGTBBP = TARGTBBP - 60*TARGTFWA;    #GET BBP MODULO 60. # 
      TARGTFWA = TGIFWA + TARGTFWA;    #ROUND TARGET FWA UP.  # 
  
      XCALL DC$XFER(SOURCFWA,0,TARGTFWA,TARGTBBP,SIZE); 
  
*IF DEF,DNLFL,1 
      SNATCHC("EXIT FILC",SIZE,0);               #IN IF DEF,DNLFL # 
      RETURN; 
  
      END #OF PROC FILCHARACTER#
  
      END #OF PROC DC$NLFL# 
      TERM; 
