Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/dacopy.for
There are 2 other files named dacopy.for in the archive. Click here to see a list.
SUBROUTINE DACOPY(INITAL,INTRVL,IBUFFR,IBEGIN,IFINAL,
1JFINAL,JUSED,JBUFFR,NXTINI,NXTBGN,MAXPRT)
C RENBR(/COPY BUFFER EXPANDING TABS TO SPACES)
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 JBUFFR ARRAY BEFORE THE CONTENTS OF THE
C IBUFFR ARRAY IS COPIED INTO THE JBUFFR
C ARRAY. THE FIRST TAB STOP WILL BE OF THE
C WIDTH INDICATED BY INTRVL. IF INTRVL IS
C LESS THAN OR EQUAL TO ZERO, THEN NO LEADING
C SPACES WILL BE INSERTED INTO THE JBUFFR
C ARRAY 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 COPYING HAS ALREADY
C PASSED BEYOND THE FIRST TAB STOP AND THE
C DISTANCE TO THE NEXT TAB STOP IS TAKEN AS
C THE ABSOLUTE VALUE OF INTRVL. IF THE FIRST
C CHARACTER IN THE INPUT BUFFER IS A TAB, IT
C WILL BE EXPANDED TO THIS NUMBER OF SPACES.
C INITAL CAN EQUAL EITHER ZERO OR THE VALUE OF
C INTRVL IF THE FIRST TAB STOP IS TO BE OF THE
C SAME WIDTH AS THOSE WHICH 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 JBUFFR ARRAY 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 COPIED INTO THE JBUFFR ARRAY, HOWEVER, THEN
C ALL REMAINING SPACES WILL BE COPIED AND ALL
C REMAINING TABS WILL BE EXPANDED TO SPACES.
C = ZERO, NO SPACES ARE TO BE INSERTED INTO THE
C JBUFFR ARRAY. TABS IN THE IBUFFR ARRAY ARE
C 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 IBUFFR ARRAY ARE
C INSERTED INTO THE JBUFFR ARRAY.
C IBUFFR = THE INPUT BUFFER WHICH IS TO BE COPIED INTO
C THE OUTPUT BUFFER EXPANDING ANY TABS FOUND.
C IBUFFR CONTAINS CHARACTERS READ BY A1
C FORMAT.
C IBEGIN = SUBSCRIPT IN IBUFFR ARRAY AT WHICH IS TO BE
C FOUND THE FIRST CHARACTER TO BE COPIED.
C IFINAL = SUBSCRIPT IN IBUFFR ARRAY AT WHICH IS TO BE
C FOUND THE FINAL CHARACTER TO BE COPIED.
C JFINAL = THE DIMENSION OF JBUFFR ARRAY.
C JUSED = SUBSCRIPT OF THE LOWEST LOCATION IN JBUFFR
C ARRAY WHICH IS CURRENTLY IN USE AND WHICH
C CONTAINS DATA WHICH MUST BE MAINTAINED.
C JUSED IS RETURNED CONTAINING THE SUBSCRIPT
C OF THE HIGHEST LOCATION INTO WHICH DACOPY
C HAS PLACED A CHARACTER.
C JBUFFR = ARRAY INTO WHICH THE CONTENTS OF IBUFFR ARE
C TO BE COPIED EXPANDING TABS TO SPACES.
C NXTINI = RETURNED CONTAINING VALUE NEXT TO BE GIVEN
C TO INITAL IF THE CURRENT CALL COULD NOT
C COMPLETELY REPESENT THE CONTENTS OF THE
C IBUFFR ARRAY DUE TO THE ROOM AVAILABLE IN
C JBUFFR BEING TOO SMALL. IF A TAB WAS
C ENCOUNTERED IN IBUFFR BUT COULD NOT BE
C COMPLETELY REPRESENTED, THEN NXTINI WILL BE
C NEGATIVE. IF THE LAST CHARACTER ENCOUNTERED
C IN THE IBUFFR ARRAY WAS NOT A TAB, THEN
C NXTINI WILL BE RETURNED WITH THE REMAINING
C DISTANCE TO THE NEXT TAB STOP.
C NXTBGN = RETURNED CONTAINING THE SUBSCRIPT WITHIN THE
C IBUFFR ARRAY OF THE FIRST LETTER WHICH COULD
C NOT BE REPRESENTED IN THE OUTPUT BUFFER. IF
C ALL LETTERS COULD BE REPRESENTED, THEN
C NXTBGN WILL BE RETURNED CONTAINING IFINAL+1.
C NOTE THAT IF A TAB IS REPRESENTED EVEN BY
C SINGLE SPACE, THEN NXTBGN IS PASSED BEYOND
C THIS TAB ALTHOUGH THERE MIGHT NOT BE ENOUGH
C ROOM IN THE OUTPUT BUFFER TO FILL COMPLETELY
C TO THE NEXT TAB STOP.
C MAXPRT = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C LOCATION IN JBUFFR ARRAY INTO WHICH DACOPY
C HAS PLACED A PRINTING CHARACTER.
C
DIMENSION IBUFFR(IFINAL),JBUFFR(JFINAL)
C
C ISPACE = THE SPACE CHARACTER
C ITAB = THE TAB CHARACTER
DATA ISPACE,ITAB/1H ,1H /
C
C INITIAL POINTERS
INDEX=IBEGIN-1
IPRINT=JUSED
LIMIT=INITAL
C
C INSERT EXTRA SPACES AT START IF INITAL.LT.0
IF(INTRVL.LE.0)GO TO 2
JNTRVL=INTRVL
NONSPC=1
1 IF(LIMIT.GE.0)GO TO 4
LIMIT=-LIMIT
GO TO 6
2 JNTRVL=-INTRVL
NONSPC=0
GO TO 4
C
C TEST IF ARE AT END OF EITHER INPUT OR OUTPUT BUFFERS
3 LIMIT=0
4 INDEX=INDEX+1
IF(JUSED.GE.JFINAL)GO TO 11
IF(INDEX.GT.IFINAL)GO TO 11
C
C ADJUST NUMBER OF COLUMNS LEFT UNTIL NEXT TAB STOP
IF(LIMIT.LE.0)LIMIT=JNTRVL
LIMIT=LIMIT-1
C
C TEST IF NEW CHARACTER IS A SPACE OR A TAB
IF(IBUFFR(INDEX).EQ.ISPACE)GO TO 7
IF(IBUFFR(INDEX).NE.ITAB)GO TO 8
C
C IF FIND A TAB, COPY IN THE SPACES TO NEXT TAB STOP
IF(NONSPC.EQ.0)GO TO 3
5 JUSED=JUSED+1
JBUFFR(JUSED)=ISPACE
IF(LIMIT.LE.0)GO TO 4
6 IF(JUSED.GE.JFINAL)GO TO 10
LIMIT=LIMIT-1
GO TO 5
C
C IF FIND CHARACTER OTHER THAN A TAB, JUST COPY IT
7 IF(NONSPC.EQ.0)GO TO 4
GO TO 9
8 IPRINT=JUSED+1
NONSPC=JNTRVL
9 JUSED=JUSED+1
JBUFFR(JUSED)=IBUFFR(INDEX)
GO TO 4
C
C NOT ENOUGH ROOM FOR ALL SPACES IN TAB EXPANSION
10 LIMIT=-LIMIT
INDEX=INDEX+1
C
C RETURN TO CALLING PROGRAM
11 NXTINI=LIMIT
NXTBGN=INDEX
MAXPRT=IPRINT
RETURN
C243897269317
END