Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0141/dafill.for
There are 2 other files named dafill.for in the archive. Click here to see a list.
      SUBROUTINE DAFILL(INITAL,INTRVL,IBEGIN,IFINAL,MAXBFR,
     1IBUFFR,MAXPRT,MAXUSD)
C     RENBR(/EXPAND TABS TO SPACES WITHOUT EXTRA BUFFER)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THE TAB CHARACTER IS A  NONPRINTING  CHARACTER  WHICH
C     CAUSES  THE FOLLOWING CHARACTER TO APPEAR IN THE NEXT
C     COLUMN BEYOND THE NEXT MULTIPLE OF THE TAB STOP.
C
C     INITAL = LESS THAN ZERO,  PROVIDING  THAT  INTRVL  IS
C              GREATER  THAN  ZERO,  THE  NUMBER  OF  EXTRA
C              SPACES INDICATED BY THE  ABSOLUTE  VALUE  OF
C              INITAL  ARE  TO  BE INSERTED AT THE START OF
C              THE BUFFER SHIFTING  THE REST OF THE TEXT TO
C              THE RIGHT.   THE FIRST  TAB STOP  WILL BE OF
C              THE WIDTH INDICATED BY INTRVL.  IF INTRVL IS
C              LESS THAN OR EQUAL TO ZERO, THEN NO  LEADING
C              SPACES WILL APPEAR AT START OF THE PROCESSED
C              TEXT, WHETHER  REQUESTED  BY  INITAL  OR  BY
C              LEADING SPACES OR TABS IN THE IBUFFR ARRAY.
C            = EQUAL TO OR GREATER THAN ZERO, INITAL IS THE
C              NUMBER  OF SPACES TO THE FIRST TAB STOP.  IF
C              INITAL  IS ZERO,  THEN  THE  DISTANCE TO THE
C              FIRST  TAB STOP  IS  TAKEN  AS THE  ABSOLUTE
C              VALUE OF INTRVL.   IF THE FIRST CHARACTER IN
C              INPUT BUFFER IS A TAB,  IT WILL BE  EXPANDED
C              TO THIS NUMBER  OF SPACES.  INITAL CAN EQUAL
C              EITHER ZERO OR VALUE  OF INTRVL IF FIRST TAB
C              STOP IS TO BE  OF SAME WIDTH  AS THOSE WHICH
C              FOLLOW IT.
C     INTRVL = THE ABSOLUTE VALUE OF INTRVL IS THE TAB STOP
C              INTERVAL.   A  TAB  CHARACTER  IN  THE INPUT
C              BUFFER CAUSES THE FOLLOWING CHARACTER TO  GO
C              INTO THE NEXT POSITION BEYOND THE SUM OF THE
C              ABSOLUTE VALUE OF INITAL AND  NEXT  MULTIPLE
C              OF THE ABSOLUTE VALUE OF INTRVL.
C            = LESS THAN ZERO, NO LEADING SPACES ARE TO  BE
C              INSERTED   INTO THE  PROCESSED  TEXT WHETHER
C              REQUESTED BY A NEGATIVE VALUE OF  INITAL  OR
C              BY  LEADING  SPACES  OR  TABS  IN THE IBUFFR
C              ARRAY.  ONCE A PRINTING CHARACTER  HAS  BEEN
C              ENCOUNTERED  IN THE  TEXT  BEING  PROCESSED,
C              THEN ALL REMAINING SPACES WILL BE COPIED AND
C              REMAINING TABS WILL BE EXPANDED TO SPACES.
C            = ZERO, NO SPACES ARE TO BE INSERTED INTO  THE
C              PROCESSED  TEXT.   TABS IN THE  INPUT BUFFER
C              ARE IGNORED, AND SPACES ARE NOT COPIED.
C            = GREATER  THAN  ZERO,  ALL   SPACES   WHETHER
C              REQUESTED  BY  A NEGATIVE VALUE OF INITAL OR
C              BY SPACES  OR TABS  IN THE INPUT  BUFFER ARE
C              INSERTED INTO THE PROCESSED TEXT.
C     IBEGIN = SUBSCRIPT OF THE IBUFFR ARRAY AT WHICH IS TO
C              BE FOUND THE FIRST  CHARACTER OF THE TEXT TO
C              BE PROCESSSED.   FOLLOWING CONVERSION OF TAB
C              CHARACTERS TO PROPER NUMBER  OF SPACES,  THE
C              TEXT  IS PLACED  BACK INTO THE  IBUFFR ARRAY
C              STARTING AT SUBSCRIPT IBEGIN.
C     IFINAL = SUBSCRIPT OF THE IBUFFR ARRAY AT WHICH IS TO
C              BE FOUND THE FINAL  CHARACTER OF THE TEXT TO
C              BE PROCESSED.
C     MAXBFR = MAXIMUM  SUBSCRIPT  OF THE  IBUFFR  ARRAY AT
C              WHICH THE  FINAL CHARACTER  OF THE PROCESSED
C              TEXT CAN BE PLACED.  MAXBFR MUST BE EQUAL TO
C              OR BE GREATER THAN IFINAL.
C     IBUFFR = ARRAY USED FOR  INPUT OF THE TEXT CONTAINING
C              TAB CHARACTERS TO BE  EXPANDED TO THE PROPER
C              NUMBER OF SPACES, AND USED FOR OUTPUT OF THE
C              TEXT AFTER THE EXPANSION HAS BEEN PERFORMED.
C              IBUFFR  CONTAINS  CHARACTERS  READ   BY   A1
C              FORMAT.
C     MAXPRT = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C              LOCATION  IN THE OUTPUT  CONTENTS OF  IBUFFR
C              WHICH CONTAINS A PRINTING CHARACTER.
C     MAXUSD = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C              LOCATION IN  THE IBUFFR  ARRAY  CONTAINING A
C              CHARACTER OF THE TEXT  AFTER PROCESSING.  IF
C              INTRVL IS LESS  THAN OR EQUAL  TO ZERO,  AND
C              TEXT  CONTAINS  ONLY SPACES  AND TABS,  THEN
C              MAXUSD  IS RETURNED  SET EQUAL  TO IBEGIN-1.
C              THE MAXIMUM VALUE OF MAXUSD IS MAXBFR.
C
C
      DIMENSION IBUFFR(MAXBFR)
C
C     ISPACE = THE SPACE CHARACTER
C     ITAB   = THE TAB CHARACTER
      DATA ISPACE,ITAB/1H ,1H	/
C
C     ****************************************************
C     *                                                  *
C     *  COPY CHARACTERS GOING TO LEFT OR STAYING FIXED  *
C     *                                                  *
C     ****************************************************
C
C     INITIAL POINTERS
      JBEGIN=IBEGIN-1
      JUSED=JBEGIN
      JPRINT=JUSED
      NEED=INITAL
      KPYEND=MAXBFR
      LOKEND=IFINAL
C
C     INSERT EXTRA SPACES AT START IF INITAL.LT.0
      IF(INTRVL.LE.0)GO TO 1
      JNTRVL=INTRVL
      IF(NEED.LT.0)GO TO 9
      NONSPC=1
      GO TO 2
    1 JNTRVL=-INTRVL
      NONSPC=0
C
C     TEST IF AT END OF TEXT MOVING LEFT OR KEPT IN PLACE
    2 IF(JBEGIN.GE.LOKEND)GO TO 21
      JBEGIN=JBEGIN+1
C
C     SET DISTANCE TO NEXT TAB STOP OF JUST BEYOND LAST
      IF(NEED.LE.0)NEED=JNTRVL
C
C     TEST IF NEW CHARACTER IS A SPACE OR A TAB
      IF(IBUFFR(JBEGIN).EQ.ISPACE)GO TO 5
      IF(IBUFFR(JBEGIN).NE.ITAB)GO TO 6
C
C     IF FIND A TAB, COPY IN THE SPACES TO NEXT TAB STOP
      IF(NONSPC.EQ.0)GO TO 4
    3 JUSED=JUSED+1
      IBUFFR(JUSED)=ISPACE
      NEED=NEED-1
      IF(NEED.LE.0)GO TO 2
      IF(JUSED.LT.JBEGIN)GO TO 3
      GO TO 10
    4 NEED=0
      GO TO 2
C
C     IF FIND CHARACTER OTHER THAN A TAB, JUST COPY IT
    5 IF(NONSPC.NE.0)GO TO 7
      GO TO 8
    6 JPRINT=JUSED+1
      NONSPC=JNTRVL
    7 JUSED=JUSED+1
      IBUFFR(JUSED)=IBUFFR(JBEGIN)
    8 NEED=NEED-1
      GO TO 2
C
C     *****************************************************
C     *                                                   *
C     *  MOVE RIGHTMOST AS YET UNMOVED GROUP OF TABS OR   *
C     *  GROUP OF NON-TABS TO ITS FINAL DESTINATION       *
C     *                                                   *
C     *****************************************************
C
C     INITIAL POINTERS
    9 NEED=-NEED
   10 IF(KPYEND.LE.JBEGIN)GO TO 21
      LOOK=JBEGIN
      KOPY=JBEGIN
      LIMIT=NEED
      GO TO 13
C
C     TEST IF HAVE SCANNED TO RIGHT END OF UNPROCESSED TEXT
   11 IF(KOPY.GE.KPYEND)GO TO 17
   12 IF(LOOK.GE.LOKEND)GO TO 17
      LOOK=LOOK+1
C
C     SET DISTANCE TO NEXT TAB STOP OF JUST BEYOND LAST
      IF(LIMIT.LE.0)LIMIT=JNTRVL
C
C     TEST IF NEW CHARACTER IS A SPACE OR A TAB
      IF(IBUFFR(LOOK).EQ.ISPACE)GO TO 16
      IF(IBUFFR(LOOK).NE.ITAB)GO TO 15
C
C     IF FIND A TAB, RECORD NUMBER OF SPACES TO NEXT STOP
      IF(KIND.GT.0)GO TO 14
   13 LOCATN=KOPY
      KIND=1
   14 KOPY=KOPY+LIMIT
      LIMIT=0
      IF(KOPY.LT.KPYEND)GO TO 12
      KOPY=KPYEND
      GO TO 17
C
C     IF FIND CHARACTER OTHER THAN A TAB, RECORD LOCATION
   15 IF(KOPY.GE.JPRINT)JPRINT=KOPY+1
   16 LIMIT=LIMIT-1
      IF(KIND.GT.0)LOCATN=KOPY
      KOPY=KOPY+1
      KIND=0
      GO TO 11
C
C     COPY RIGHTMOST GROUP OF CHARACTERS
   17 IF(JUSED.LT.KOPY)JUSED=KOPY
      IF(KIND.GT.0)GO TO 19
   18 IBUFFR(KOPY)=IBUFFR(LOOK)
      KOPY=KOPY-1
      LOOK=LOOK-1
      IF(KOPY.GT.LOCATN)GO TO 18
      GO TO 20
   19 IBUFFR(KOPY)=ISPACE
      KOPY=KOPY-1
      IF(KOPY.GT.LOCATN)GO TO 19
      LOOK=LOOK-1
C
C     SHRINK THE UNPROCESSED REGION AND GO BACK TO DO AGAIN
   20 LOKEND=LOOK
      KPYEND=KOPY
      GO TO 10
C
C     RETURN TO CALLING PROGRAM
   21 MAXUSD=JUSED
      MAXPRT=JPRINT
      RETURN
C404242973694
      END