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