*DECK DB$CFIL 
      FUNC DB$CFIL(STRING,(LENGTH),(FILLER)) C(30); 
  
 #
  
  *   DB$CFIL - BLANK/BINARY 0 CHARACTER FILL    PAGE  1
  *   BOB MCALLESTER (PERFORMANCE IMPROVEMENTS)  DATE  05/26/81 
  
  DC  PURPOSE 
  
      BLANK FILL OR BINARY ZERO FILL CHARACTERS OF A STRING OF UP TO
      30 CHARACTERS IN LENGTH, STARTING WITH THE RIGHT CHARACTERS.
  
  DC  ENTRY CONDITIONS
  
      THE FOLLOWING THREE PARAMETERS MUST BE PASSED:  
        STRING - THE STRING TO BE USED, UP TO 30 CHARACTERS IN LENGTH 
        LENGTH - THE LENGTH IN CHARACTERS OF THE STRING (UP TO 30)
        FILLER - THE CHARACTER TO BE USED AS THE FILLER (BLANK OR 0)
  
  DC  EXIT CONDITIONS 
  
      A THIRTY CHARACTER STRING IS RETURNED.
      ALL CHARACTERS BEYOND THE LEFT-MOST 'LENGTH' ARE SET TO FILLER. 
      WITHIN THE 'LENGTH' ALL CHARACTERS TO THE RIGHT OF THE RIGHT-MOST 
      CHARACTER WHICH IS NEITHER BLANK OR BINARY ZERO ARE SET TO FILLER.
  
  DC  CALLING ROUTINES
  
      IT IS A GENERAL UTILITY PROCEDURE THAT IS CALLED BY MANY. 
  
  DC  CALLED ROUTINES 
  
      NO ROUTINES ARE CALLED BY DB$CFIL.
  
  DC  NON-LOCAL VARIABLES 
  
      NONE
  
  DC  DESCRIPTION 
  
      INITIALIZE THE TARGET STRING AND DETERMINE CHARACTER TO REMOVE. 
      REPLACE CHARACTERS AFTER FIRST LENGTH BY THE FILLER CHARACTER.
      REPLACE FILLER/REMOVE CHARACTERS ON RIGHT OF LENGTH BY FILLER.
      ASSIGN THE NEW LITERAL VALUE TO DB$CFIL.  RETURN FROM DB$CFIL.
  
 #
  
  
  
        BEGIN                # DB$CFIL #
  
# THE FOLLOWING ARE FORMAL PARAMETERS # 
  
        ITEM STRING C(30);   # THE STRING TO BE USED, UP TO 30 CHARS.#
        ITEM LENGTH;         # THE LENGTH IN CHARACTERS OF THE STRING#
        ITEM FILLER C(1);    # THE CHARACTER TO BE USED AS THE FILLER#
  
# THE FOLLOWING ITEMS ARE LOCAL TO THIS PROC #
  
        ITEM NEWFIL I;       # NEW FILL CHARACTER                      #
        ITEM OLDFIL I;       # OLD FILL CHARACTER                      #
        ITEM WORK I;         # A TEMPORARY WORK WORD                   #
        ITEM XA I;           # INDUCTION VARIABLE                      #
        ITEM XB I;           # INDUCTION VARIABLE                      #
  
        ARRAY TARG [0:2] S(1);
          BEGIN 
          ITEM TARGTC C(00,00,30);  # THE FULL TARGET STRING           #
          ITEM TARGET I(00,00,60);  # INDIVIDUAL TARGET WORDS          #
          END 
  
  
  
#     B E G I N   D B $ C F I L   E X E C U T A B L E   C O D E .      #
  
  
      IF LENGTH LS 0
      THEN
        BEGIN 
        LENGTH = 0;          # LENGTH MUST BE AT LEAST ZERO            #
        END 
      IF LENGTH GR 30 
      THEN
        BEGIN 
        LENGTH = 30;         # THE MAXIMUM LENGTH IS 30                #
        END 
# 
*     FILL THE TARGET STRING WITH FILLER CHARACTERS.
*     IF THE FILLER CHARACTER IS NOT BLANK, IT IS ASSUMED TO BE 
*     BINARY ZERO.
*     NEWFIL IS AN INTEGER VALUE OF FILLER. 
*     OLDFIL IS THE ALTERNATE CHARACTER (BLANK OR BINARY ZERO). 
# 
      IF FILLER EQ " "
      THEN
        BEGIN 
        OLDFIL = 0; 
        NEWFIL = O"55"; 
        TARGET[0] = O"55555555555555555555";
        TARGET[1] = O"55555555555555555555";
        TARGET[2] = O"55555555555555555555";
        END 
      ELSE
        BEGIN 
        OLDFIL = O"55"; 
        NEWFIL = 0; 
        TARGET[0] = 0;
        TARGET[1] = 0;
        TARGET[2] = 0;
        END 
  
# 
*     MOVE 'LENGTH' CHARACTERS INTO THE TARGET STRING.
# 
      C<0,LENGTH>TARGTC[0] = STRING;
# 
*     SCAN THE 'LENGTH' CHARACTERS RIGHT TO LEFT. 
*     SKIP NEWFIL CHARACTERS. 
*     REPLACE OLDFIL CHARACTERS WITH NEWFIL CHARACTERS. 
*     TERMINATE THE SCAN IF THE CHARACTER IS NEITHER OLDFIL OR NEWFIL.
# 
      FOR XA = (LENGTH -1) /10 STEP -1 UNTIL 0
      DO
        BEGIN 
        WORK = TARGET[XA];   # WORK ON ONE WORD AT A TIME              #
  
        FOR XB = 54 STEP -6 UNTIL 0 
        DO
          BEGIN              # SCAN CHARACTER BY CHARACTER WITHIN WORK #
          IF B<XB,6>WORK EQ NEWFIL
          THEN
            BEGIN 
            TEST XB;         # SKIP CHARACTER OF NEW FILLER            #
            END 
  
          IF B<XB,6>WORK EQ OLDFIL
          THEN
            BEGIN 
            B<XB,6>WORK = NEWFIL;  # REPLACE OLD FILLER WITH NEW       #
            END 
          ELSE               # FOUND THE FIRST NON-FILLER CHARACTER    #
            BEGIN 
            TARGET[XA] = WORK;  # REPLACE THE TARGET WORD              #
            XA = 0; 
            TEST XA;         # TERMINATE THE SCAN                      #
            END 
          END 
  
        TARGET[XA] = WORK;   # REPLACE THIS TARGET WORD                #
        END 
  
      DB$CFIL = TARGTC[0];   # RETURN WITH THE FILLED STRING           #
      RETURN; 
  
      END 
  
      TERM
