home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istvc / ISTVC.MAC.f
Encoding:
Text File  |  1989-03-04  |  38.3 KB  |  1,391 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 1.1
  3. C---------------------------------------------------------
  4. C
  5. C  ISTVC  - 5 DEC 83
  6. C           VERSION CONTROL TOOL
  7. C
  8. C           ORIGINAL AUTHOR:      WEBB MILLER, UNIVERSITY OF ARIZONA
  9. C           TOOLPACK CONFORMANCE: BOB ILES, NAG CENTRAL OFFICE
  10. C           MODIFICATIONS:        BOB ILES, NAG CENTRAL OFFICE
  11. C                                 MALCOM COHEN, NAG CENTRAL OFFICE
  12. C
  13. C  TNAME - AN ARRAY HOLDING THE NAME OF THE TEMPORARY FILE 'TMPVER'
  14. C
  15.       PROGRAM ISTVC
  16.  
  17. C---------------------------------------------------------
  18. C    TOOLPACK/1    Release: 1.1
  19. C---------------------------------------------------------
  20.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  21.      +                TNAME, TFIRST, ICNT, DCNT
  22.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  23.      +        TNAME(81)
  24.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  25.       SAVE
  26.  
  27.       CALL ZINIT
  28.  
  29.       CALL VERSIN
  30.       CALL REMOVE(TNAME(TFIRST))
  31.  
  32.       CALL ZQUIT(-2)
  33.  
  34.       END
  35. C---------------------------------------------------------------------
  36. C     Added routine INITV to initialise COMMON block variables.
  37. C     (Program was assuming that they were initialised to zero
  38. C      ugh, shudder).  This will (a) mean we init TNAME at compile time
  39. C                                (b) fix funny numbers bug
  40. C
  41.       BLOCK DATA INITV
  42.  
  43. C---------------------------------------------------------
  44. C    TOOLPACK/1    Release: 1.1
  45. C---------------------------------------------------------
  46.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  47.      +                TNAME, TFIRST, ICNT, DCNT
  48.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  49.      +        TNAME(81)
  50.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  51.       SAVE
  52.  
  53.       DATA LENGTH/0/, TFIRST/1/
  54.       DATA (TNAME(I),I=1,8)/35,116,109,112,118,101,114,129/
  55.       DATA DCNT/0/, ICNT/0/
  56.  
  57.       END
  58. C-----------------------------------------------------------------------
  59. C
  60. C  FILE COPY UTILITY, COPY FILE "NAME1" TO FILE "NAME2" THE TRANSFER
  61. C  ENDS WHEN AN "e1" LINE IS FOUND. AN END-OF-FILE IS AN ERROR AS IT
  62. C  MEANS THAT NO "e1" LINE EXISTED.
  63. C
  64.       SUBROUTINE AMOVE(NAME1, NAME2)
  65.  
  66.       INTEGER NAME1(*), NAME2(*), BUF(134)
  67.       INTEGER OPEN, GETLIN, FD1, FD2
  68.  
  69.       FD1 = OPEN(NAME1, 0)
  70.       FD2 = OPEN(NAME2, 1)
  71.       IF((FD2 .EQ. -1) .OR. (FD1 .EQ. -1)) CALL
  72.      +    VCERR('VC: AMOVE - UNABLE TO OPEN FILE.')
  73.  
  74.    10 CONTINUE
  75.         IF(GETLIN(BUF, FD1) .LT. 0) THEN
  76.           CALL VCERR('VC: AMOVE - TRANSFER ERROR.')
  77.         ELSE
  78.           CALL PUTLIN(BUF, FD2)
  79.           IF((BUF(1).EQ.101) .AND. (BUF(2).EQ.49) .AND.
  80.      +       (BUF(3).EQ.10)) RETURN
  81.         ENDIF
  82.       GOTO 10
  83.  
  84.       END
  85. C-------------------------------------------------------------------------
  86. C
  87.       INTEGER FUNCTION CHANGE(M,N)
  88.  
  89.       INTEGER M, N
  90.       INTEGER BUFFER(5), ITOC, JUNK
  91. C---------------------------------------------------------
  92. C    TOOLPACK/1    Release: 1.1
  93. C---------------------------------------------------------
  94.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  95.      +                TNAME, TFIRST, ICNT, DCNT
  96.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  97.      +        TNAME(81)
  98.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  99.       SAVE
  100.  
  101.       JUNK = ITOC(VERSIO,BUFFER,5)
  102.       IF (N .GT. 0) THEN
  103.         CALL FPRNTF(97, BUFFER)
  104.         CALL SEND(2,N)
  105.         CALL FPRNTF(101, BUFFER)
  106.         ICNT = ICNT + N
  107.       END IF
  108.       IF (M .GT. 0) THEN
  109.         CALL FPRNTF(100, BUFFER)
  110.         CALL SEND(1,M)
  111.         CALL FPRNTF(101, BUFFER)
  112.         DCNT = DCNT + M
  113.       END IF
  114.       CHANGE = 1 + 1
  115.  
  116.       END
  117. C---------------------------------------------------------------------
  118. C
  119.       INTEGER FUNCTION CMPTIM(TIME)
  120.  
  121.       INTEGER TIME(6), T(6)
  122.       INTEGER I, J
  123.       INTEGER INDEXX
  124. C---------------------------------------------------------
  125. C    TOOLPACK/1    Release: 1.1
  126. C---------------------------------------------------------
  127.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  128.       INTEGER VP
  129.       INTEGER TYP
  130.       INTEGER LINE(134),   OPTVAL(134)
  131.       INTEGER VFNAME(81), FILNAM(81)
  132.       SAVE
  133.  
  134.       J = INDEXX(LINE, 32)
  135.       CALL CONVTI(LINE(J+1), T)
  136.  
  137.       DO 10 I = 1, 6
  138.         IF (TIME(I) .NE. T(I)) THEN
  139.           CMPTIM = TIME(I) - T(I)
  140.           RETURN
  141.         END IF
  142.    10 CONTINUE
  143.  
  144.       CMPTIM = 0
  145.  
  146.       END
  147. C----------------------------------------------------------------------
  148. C
  149. C  LIST VERSION FILE CONTENTS
  150. C
  151.       SUBROUTINE CONTEN(VERSIO)
  152.  
  153.       INTEGER VERSIO, INLINE, VERS, VNBR
  154. C---------------------------------------------------------
  155. C    TOOLPACK/1    Release: 1.1
  156. C---------------------------------------------------------
  157.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  158.       INTEGER VP
  159.       INTEGER TYP
  160.       INTEGER LINE(134),   OPTVAL(134)
  161.       INTEGER VFNAME(81), FILNAM(81)
  162.       SAVE
  163.  
  164.    10 CONTINUE
  165.         IF(INLINE() .EQ. -100) RETURN
  166.         IF(TYP .NE. 118 .AND. TYP .NE. 99) RETURN
  167.  
  168.         IF (TYP .EQ. 118) THEN
  169.           VERS = VNBR()
  170.           IF (VERS .LT. VERSIO) RETURN
  171.         END IF
  172.  
  173.         IF (VERSIO .EQ. 0 .OR. VERSIO .EQ. VERS) THEN
  174.           IF (TYP .EQ. 118) THEN
  175.             CALL SKIP(1)
  176.             CALL ZCHOUT('version .', 1)
  177.           END IF
  178.           CALL PUTLIN(LINE,1)
  179.         END IF
  180.       GOTO 10
  181.  
  182.       END
  183. C---------------------------------------------------------------------
  184. C
  185.       SUBROUTINE CONVTI(A,T)
  186.  
  187.       INTEGER P
  188.       INTEGER A(*), T(*)
  189.       INTEGER CTOI
  190.  
  191. C  CONVERT THE YEAR (WHICH STARTS IN POSITION 19)
  192.       P = 19
  193.       T(1) = CTOI(A,P)
  194. C  CONVERT THE MONTH
  195.       IF(A(1) .EQ. 106) THEN
  196.         IF(A(2) .EQ. 97) THEN
  197.           T(2) = 1
  198.         ELSE
  199.           IF(A(3) .EQ. 108) THEN
  200.             T(2) = 7
  201.           ELSE
  202.             T(2) = 6
  203.           ENDIF
  204.         ENDIF
  205.       ELSE IF(A(1) .EQ. 102) THEN
  206.         T(2) = 2
  207.       ELSE IF(A(1) .EQ. 109) THEN
  208.         IF(A(3) .EQ. 114) THEN
  209.           T(2) = 3
  210.         ELSE
  211.           T(2) = 5
  212.         ENDIF
  213.       ELSE IF(A(1) .EQ. 97) THEN
  214.         IF(A(2) .EQ. 112) THEN
  215.           T(2) = 4
  216.         ELSE
  217.           T(2) = 8
  218.         ENDIF
  219.       ELSE IF(A(1) .EQ. 115) THEN
  220.         T(2) = 9
  221.       ELSE IF(A(1) .EQ. 111) THEN
  222.         T(2) = 10
  223.       ELSE IF(A(1) .EQ. 110) THEN
  224.         T(2) = 11
  225.       ELSE IF(A(1) .EQ. 100) THEN
  226.         T(2) = 12
  227.       ELSE
  228.         CALL VCERR('illegal month.')
  229.       END IF
  230. C CONVERT THE DAY
  231.       P = 5
  232.       T(3) = CTOI(A,P)
  233. C  CONVERT THE HOUR
  234.       P = 8
  235.       T(4) = CTOI(A,P)
  236. C  CONVERT THE MINUTE
  237.       P = 11
  238.       T(5) = CTOI(A,P)
  239. C  CONVERT THE SECOND
  240.       P = 14
  241.       T(6) = CTOI(A,P)
  242.  
  243.       END
  244. C------------------------------------------------------------------------
  245. C
  246.       SUBROUTINE CUTOFF(ARGC, I, VAL)
  247.  
  248.       INTEGER ARGC, I, VAL
  249.       INTEGER TIME(6)
  250.       INTEGER JUNK, J, K, TYPE, VERSIO, VNBR, CMPTIM
  251.       INTEGER OUTP, FIXEND, NEXTLN, INLINE
  252. C---------------------------------------------------------
  253. C    TOOLPACK/1    Release: 1.1
  254. C---------------------------------------------------------
  255.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  256.       INTEGER VP
  257.       INTEGER TYP
  258.       INTEGER LINE(134),   OPTVAL(134)
  259.       INTEGER VFNAME(81), FILNAM(81)
  260.       SAVE
  261.  
  262.       J = 3
  263.       K = 1
  264.    10 IF(K .LE. 6) THEN
  265.         IF (TYPE(OPTVAL(J)) .NE. 2) THEN
  266.           TIME(K) = 0
  267.         ELSE
  268.           TIME(K) = OPTVAL(J) - 48
  269.           J = J + 1
  270.           IF (TYPE(OPTVAL(J)) .EQ. 2) THEN
  271.             TIME(K) = 10*TIME(K) + OPTVAL(J) - 48
  272.           END IF
  273.           J = J + 1
  274.           IF (TYPE(OPTVAL(J)) .NE. 2 .AND. OPTVAL(J) .NE. 129) THEN
  275.             J = J + 1
  276.           END IF
  277.         END IF
  278.         K = K + 1
  279.         GO TO 10
  280.       ENDIF
  281.  
  282.    20 IF(INLINE() .NE. -100) THEN
  283.         IF (TYP .EQ. 118) THEN
  284.           VERSIO = VNBR()
  285.           IF (CMPTIM(TIME) .GE. 0) GO TO 30
  286.         ELSE IF (VERSIO .EQ. 1) THEN
  287.           CALL VCERR('VC: file did 126 exist at specified time.')
  288.         END IF
  289.         GO TO 20
  290.       ENDIF
  291.  
  292.    30 CONTINUE
  293.       OUTP = FIXEND(ARGC,I,1)
  294.  
  295.    40 IF(NEXTLN(VERSIO, -1) .NE. -100) THEN
  296.         CALL PUTOUT(VERSIO,LINE,OUTP)
  297.         GO TO 40
  298.       ENDIF
  299.  
  300.       END
  301. C----------------------------------------------------------------
  302. C
  303. C  LIST DIFFERENCES BETWEEN VERSIONS IN THE VERSION FILE
  304. C
  305.       SUBROUTINE DIFFER(VERSIO)
  306.  
  307.       INTEGER JUNK, VERSIO, VERSNB
  308.       INTEGER OPEN, INLINE, VNBR
  309. C---------------------------------------------------------
  310. C    TOOLPACK/1    Release: 1.1
  311. C---------------------------------------------------------
  312.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  313.       INTEGER VP
  314.       INTEGER TYP
  315.       INTEGER LINE(134),   OPTVAL(134)
  316.       INTEGER VFNAME(81), FILNAM(81)
  317.       SAVE
  318.  
  319.       IF (VERSIO .NE. 0) THEN
  320.         CALL VERSDI(VERSIO)
  321.  
  322.       ELSE
  323.         JUNK = INLINE()
  324.         VERSNB = VNBR()
  325.  
  326.    10   CONTINUE
  327.         CALL VERSDI(VERSNB)
  328.         VERSNB = VERSNB - 1
  329.         IF (VERSNB .NE. 0) THEN
  330.           CALL CLOSE(VP)
  331.           VP = OPEN(VFNAME, 0)
  332.           CALL SKIP(2)
  333.           GO TO 10
  334.         ENDIF
  335.       END IF
  336.  
  337.       END
  338. C-------------------------------------------------------------------------
  339. C
  340.       INTEGER FUNCTION EQUIV(S, T)
  341.  
  342.       INTEGER S, T
  343.       INTEGER I, J, TYPE, ZLOWER
  344. C---------------------------------------------------------
  345. C    TOOLPACK/1    Release: 1.1
  346. C---------------------------------------------------------
  347.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  348.      +                TNAME, TFIRST, ICNT, DCNT
  349.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  350.      +        TNAME(81)
  351.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  352.       SAVE
  353.  
  354.       EQUIV = -3
  355.       IF (S .EQ. -100 .OR. T .EQ. -100) RETURN
  356.  
  357.       I = S
  358.       J = T
  359.    10 CONTINUE
  360.       IF (BUF(I,1) .NE. 10 .AND. BUF(J,2) .NE. 10) THEN
  361.         IF (BUF(I,1) .EQ. BUF(J,2)) THEN
  362.           I = I + 1
  363.           J = J + 1
  364.         ELSE IF((ZLOWER(BUF(I,1)) .EQ. 118)  .AND.
  365.      +          (BUF(I+1,1)       .EQ. 35) .AND.
  366.      +          (TYPE(BUF(J,2))   .EQ. 2)) THEN
  367.    20     IF(TYPE(BUF(J,2)) .EQ. 2) THEN
  368.             J = J + 1
  369.             GO TO 20
  370.           ENDIF
  371.           IF (BUF(J,2) .EQ. 32) THEN
  372.             I = I + 2
  373.             J = J + 1
  374.           ELSE
  375.             GO TO 100
  376.           END IF
  377.         ELSE
  378.           GO TO 100
  379.         END IF
  380.         GO TO 10
  381.       ENDIF
  382.  
  383. 100   CONTINUE
  384.       IF (BUF(I,1) .EQ. 10 .AND. BUF(J,2) .EQ. 10) EQUIV = -2
  385.  
  386.       END
  387. C------------------------------------------------------------------------
  388. C
  389.       INTEGER FUNCTION FIXEND(ARGC, I, MODE)
  390.  
  391.       INTEGER ARGC, I, MODE
  392.       INTEGER JUNK, J, OPEN, CREATE
  393. C---------------------------------------------------------
  394. C    TOOLPACK/1    Release: 1.1
  395. C---------------------------------------------------------
  396.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  397.       INTEGER VP
  398.       INTEGER TYP
  399.       INTEGER LINE(134),   OPTVAL(134)
  400.       INTEGER VFNAME(81), FILNAM(81)
  401.       SAVE
  402.  
  403.       IF (MODE .EQ. 1) THEN
  404.         FIXEND = CREATE(FILNAM, 1)
  405.       ELSE
  406.         FIXEND = OPEN  (FILNAM, 0)
  407.       ENDIF
  408.  
  409.       IF (FIXEND .EQ. -1) THEN
  410.         CALL CANT(FILNAM)
  411.         IF(MODE .EQ. 0) CALL ZQUIT(-1)
  412.         FIXEND = 1
  413.       END IF
  414.  
  415.       END
  416. C---------------------------------------------------------------------
  417. C
  418.       SUBROUTINE FLUSHH
  419.  
  420.       INTEGER READIN, NUMBER, DIGITS(5), ITOC, JUNK
  421. C---------------------------------------------------------
  422. C    TOOLPACK/1    Release: 1.1
  423. C---------------------------------------------------------
  424.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  425.      +                TNAME, TFIRST, ICNT, DCNT
  426.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  427.      +        TNAME(81)
  428.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  429.       SAVE
  430.  
  431.       NUMBER = NLINES(1)
  432.       DCNT   = DCNT + NLINES(1)
  433.       ICNT   = ICNT + NLINES(2)
  434.  
  435.    10 IF(READIN(1, 250) .NE. -100) THEN
  436.         IF (BUF(TEXT(1, 250), 1) .EQ. 46) THEN
  437.           LENGTH = LENGTH + 1
  438.           DCNT = DCNT + 1
  439.           NUMBER = NUMBER + 1
  440.         END IF
  441.         GO TO 10
  442.       ENDIF
  443.  
  444.    20 IF(READIN(2, 250) .NE. -100) THEN
  445.         ICNT = ICNT + 1
  446.         GO TO 20
  447.       ENDIF
  448.  
  449.       JUNK = ITOC(VERSIO, DIGITS, 5)
  450.       IF (NLINES(2) .GT. 0) THEN
  451.         CALL FPRNTF(97, DIGITS)
  452.         BUF(P(2),2) = 129
  453.         CALL PUTLIN(BUF(1,2),TP)
  454.         CALL FPRNTF(101, DIGITS)
  455.       END IF
  456.       IF (P(1) .NE. 1) THEN
  457.         IF (NUMBER .GT. 0) CALL FPRNTF(100, DIGITS)
  458.         BUF(P(1), 1) = 129
  459.         CALL PUTLIN(BUF(1,1),TP)
  460.         IF (NUMBER .GT. 0) CALL FPRNTF(101, DIGITS)
  461.       END IF
  462.  
  463.       END
  464. C-------------------------------------------------------------------------
  465. C
  466.       SUBROUTINE FPRNTF(LETTER, DIGITS)
  467.  
  468.       INTEGER LETTER, DIGITS(*)
  469. C---------------------------------------------------------
  470. C    TOOLPACK/1    Release: 1.1
  471. C---------------------------------------------------------
  472.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  473.      +                TNAME, TFIRST, ICNT, DCNT
  474.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  475.      +        TNAME(81)
  476.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  477.       SAVE
  478.  
  479.       CALL PUTCH (LETTER,  TP)
  480.       CALL ZPTMES(DIGITS,  TP)
  481.  
  482.       END
  483. C------------------------------------------------------------------------
  484. C
  485.       INTEGER FUNCTION GETL(FILE, N)
  486.  
  487.       INTEGER FILE, N
  488.       INTEGER READIN, POINT, CTOI, VERSN, SAVEP
  489. C---------------------------------------------------------
  490. C    TOOLPACK/1    Release: 1.1
  491. C---------------------------------------------------------
  492.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  493.      +                TNAME, TFIRST, ICNT, DCNT
  494.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  495.      +        TNAME(81)
  496.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  497.       SAVE
  498.  
  499.       IF (N .GT. NLINES(FILE)) THEN
  500.    30   CONTINUE
  501.         IF (READIN(FILE,N) .EQ. -100) THEN
  502.           GETL = -100
  503.           RETURN
  504.  
  505.         ELSE IF (FILE .EQ. 2) THEN
  506.           NLINES(FILE) = N
  507.           GO TO 10
  508.  
  509.         ELSE IF (BUF(TEXT(FILE,N),1) .EQ. 100) THEN
  510.           POINT = TEXT(FILE,N) + 1
  511.           VERSN = CTOI(BUF, POINT)
  512.           IF (VERSN .LT. VERSIO) THEN
  513.    20       CONTINUE
  514.               SAVEP = P(FILE)
  515.               IF (READIN(FILE,N) .EQ. -100) THEN
  516.                 GETL = -100
  517.                 RETURN
  518.               END IF
  519.               POINT = TEXT(FILE,N) + 1
  520.               IF(BUF(SAVEP,1).EQ.101.AND.CTOI(BUF,POINT).EQ.VERSN)THEN
  521.                 POINT = 2
  522.               ELSE
  523.                 GO TO 20
  524.               END IF
  525.           END IF
  526.         ELSE IF (BUF(TEXT(FILE,N),1) .EQ. 46) THEN
  527.           LENGTH = LENGTH + 1
  528.         ELSE
  529.           GO TO 30
  530.         END IF
  531.         NLINES(FILE) = N
  532.       END IF
  533.  
  534.    10 CONTINUE
  535.       GETL = TEXT(FILE,N)
  536.  
  537.       END
  538. C-------------------------------------------------------------------------
  539. C
  540.       SUBROUTINE GETTIM(FP)
  541.  
  542.       INTEGER FP
  543.       INTEGER YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, MILLI
  544.       INTEGER ITOC, JUNK
  545.       INTEGER BUFFER(6)
  546.  
  547.       CALL ZTIME(YEAR,MONTH,DAY,HOUR,MINUTE,SECOND,MILLI)
  548.       CALL PUTCH(32, FP)
  549.       IF (MONTH .EQ. 1) THEN
  550.         CALL ZCHOUT('jan .',FP)
  551.       ELSE IF (MONTH .EQ. 2) THEN
  552.         CALL ZCHOUT('feb .',FP)
  553.       ELSE IF (MONTH .EQ. 3) THEN
  554.         CALL ZCHOUT('mar .',FP)
  555.       ELSE IF (MONTH .EQ. 4) THEN
  556.         CALL ZCHOUT('apr .',FP)
  557.       ELSE IF (MONTH .EQ. 5) THEN
  558.         CALL ZCHOUT('may .',FP)
  559.       ELSE IF (MONTH .EQ. 6) THEN
  560.         CALL ZCHOUT('jun .',FP)
  561.       ELSE IF (MONTH .EQ. 7) THEN
  562.         CALL ZCHOUT('jul .',FP)
  563.       ELSE IF (MONTH .EQ. 8) THEN
  564.         CALL ZCHOUT('aug .',FP)
  565.       ELSE IF (MONTH .EQ. 9) THEN
  566.         CALL ZCHOUT('sep .',FP)
  567.       ELSE IF (MONTH .EQ. 10) THEN
  568.         CALL ZCHOUT('oct .',FP)
  569.       ELSE IF (MONTH .EQ. 11) THEN
  570.         CALL ZCHOUT('nov .',FP)
  571.       ELSE IF (MONTH .EQ. 12) THEN
  572.         CALL ZCHOUT('dec .',FP)
  573.       END IF
  574.       CALL ZITOCP(DAY, BUFFER, 2, 48)
  575.       CALL PUTLIN(BUFFER,FP)
  576.  
  577.       CALL PUTCH(32, FP)
  578.       CALL ZITOCP(HOUR, BUFFER, 2, 48)
  579.       CALL PUTLIN(BUFFER,FP)
  580.       CALL PUTCH(58, FP)
  581.       CALL ZITOCP(MINUTE, BUFFER, 2, 48)
  582.       CALL PUTLIN(BUFFER,FP)
  583.  
  584.       CALL PUTCH(58, FP)
  585.       CALL ZITOCP(SECOND, BUFFER, 2, 48)
  586.       CALL PUTLIN(BUFFER,FP)
  587.  
  588.       CALL PUTCH(32, FP)
  589.       JUNK = ITOC(YEAR, BUFFER, 6)
  590.       CALL ZPTMES(BUFFER,FP)
  591.  
  592.       END
  593. C------------------------------------------------------------------------
  594. C
  595.       SUBROUTINE GETVER(ARGC, I, VERSIO)
  596.  
  597.       INTEGER ARGC, I, VERSIO
  598.       INTEGER LAST, LASTVE, OUTP, FIXEND, NEXTLN, JUNK, ITOC
  599. C---------------------------------------------------------
  600. C    TOOLPACK/1    Release: 1.1
  601. C---------------------------------------------------------
  602.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  603.       INTEGER VP
  604.       INTEGER TYP
  605.       INTEGER LINE(134),   OPTVAL(134)
  606.       INTEGER VFNAME(81), FILNAM(81)
  607.       SAVE
  608.  
  609.       LAST = LASTVE()
  610.       IF (VERSIO .LT. 0 .OR. VERSIO .GT. LAST) THEN
  611.         CALL ZCHOUT('VC: VERSION .', 2)
  612.         CALL ZPTINT(VERSIO, 1, 2)
  613.         CALL ZCHOUT(' OF .', 2)
  614.         CALL PUTLIN(VFNAME, 2)
  615.         CALL ZMESS(' DOES NOT EXIST.', 2)
  616.         CALL ZQUIT(-1)
  617.       END IF
  618.       IF (VERSIO .EQ. 0) THEN
  619.         VERSIO = LAST
  620.       END IF
  621.  
  622.       OUTP = FIXEND(ARGC, I, 1)
  623.  
  624.    10 CONTINUE
  625.         IF(NEXTLN(VERSIO, -1) .EQ. -100) RETURN
  626.         CALL PUTOUT(VERSIO, LINE, OUTP)
  627.       GO TO 10
  628.  
  629.       END
  630. C---------------------------------------------------------------------
  631. C
  632.       SUBROUTINE HELP
  633.  
  634.       CALL ZMESS('VC: VERSION CONTROL PROGRAM.', 1)
  635.       CALL ZMESS('    USAGE: VC,-<option>,VERSION-FILE [,FILE].', 1)
  636.       CALL ZMESS('    OPTIONS (* : FILE NAME REQUIRED):.', 1)
  637.       CALL ZMESS('      C[<n>]  DETAIL CONTENTS.', 1)
  638.       CALL ZMESS('      D[<n>]  VERSION DIFFERENCES.', 1)
  639.       CALL ZMESS('     *T<time> PRODUCE VERSION AS AT TIME.', 1)
  640.       CALL ZMESS('     *U       UPDATE THE VERSION FILE.', 1)
  641.       CALL ZMESS('     *V[<n>]  REPRODUCE VERSION N.', 1)
  642.       CALL ZQUIT(-1)
  643.  
  644.       END
  645. C-------------------------------------------------------------------------
  646. C
  647.       SUBROUTINE INITVE(VNAME, FP)
  648.  
  649.       INTEGER VNAME(*),FP
  650.       INTEGER BUFFER(134)
  651.       INTEGER CREATE, GETLIN
  652. C---------------------------------------------------------
  653. C    TOOLPACK/1    Release: 1.1
  654. C---------------------------------------------------------
  655.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  656.       INTEGER VP
  657.       INTEGER TYP
  658.       INTEGER LINE(134),   OPTVAL(134)
  659.       INTEGER VFNAME(81), FILNAM(81)
  660.       SAVE
  661.  
  662.       CALL ZCHOUT('Initialise version file ".', 1)
  663.       CALL PUTLIN(VNAME, 1)
  664.       CALL ZMESS('".', 1)
  665.  
  666.       VP = CREATE(VNAME, 1)
  667.       IF(VP .EQ. -1) THEN
  668.         CALL CANT(VNAME)
  669.         CALL ZQUIT(-1)
  670.       END IF
  671.       CALL PUTTOP(VP, 1)
  672.       CALL ZMESS('a1.', VP)
  673.    10 CONTINUE
  674.         IF(GETLIN(BUFFER, FP) .EQ. -100) GO TO 20
  675.         CALL PUTCH(46,VP)
  676.         CALL PUTLIN(BUFFER,VP)
  677.       GO TO 10
  678.  
  679.    20 CONTINUE
  680.       CALL ZMESS('e1.', VP)
  681.  
  682.       END
  683. C-----------------------------------------------------------------------
  684. C
  685. C  READ IN A LINE AND CHECK THAT IT IS VALID, VALID LINES START
  686. C  WITH A, C, D, E, V OR A PERIOD CHARACTER. NOTE THAT THE
  687. C  PERIOD IS USED IN PLACE OF A BLANK FOR NORMAL LINES SO THAT
  688. C  FORTRAN BLANK COMMENT LINES CAN BE DEALT WITH PROPERLY (TIE
  689. C  DELETES TRAILING BLANKS DURING I/O).
  690. C
  691.       INTEGER FUNCTION INLINE()
  692.  
  693.       INTEGER I
  694.       INTEGER GETLIN, INDEXX
  695.       INTEGER OPTS(7)
  696. C---------------------------------------------------------
  697. C    TOOLPACK/1    Release: 1.1
  698. C---------------------------------------------------------
  699.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  700.       INTEGER VP
  701.       INTEGER TYP
  702.       INTEGER LINE(134),   OPTVAL(134)
  703.       INTEGER VFNAME(81), FILNAM(81)
  704.       SAVE
  705.  
  706.       DATA (OPTS(I), I = 1, 7)/97,99,100,101,118,46,129/
  707.  
  708.       INLINE = GETLIN(LINE, VP)
  709.  
  710.       TYP = LINE(1)
  711.       CALL SCOPY(LINE, 2, LINE, 1)
  712.       IF (INLINE .EQ. -100) RETURN
  713.  
  714.       IF (INDEXX(OPTS, TYP) .EQ. 0) CALL VCERR('CORRUPT VERSION FILE.')
  715.  
  716.       END
  717. C------------------------------------------------------------------------
  718. C
  719.       INTEGER FUNCTION LASTVE()
  720.  
  721.       INTEGER INLINE, POS, CTOI
  722. C---------------------------------------------------------
  723. C    TOOLPACK/1    Release: 1.1
  724. C---------------------------------------------------------
  725.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  726.       INTEGER VP
  727.       INTEGER TYP
  728.       INTEGER LINE(134),   OPTVAL(134)
  729.       INTEGER VFNAME(81), FILNAM(81)
  730.       SAVE
  731.  
  732.       LASTVE = 0
  733.       IF (INLINE() .EQ. -100) RETURN
  734.  
  735.       IF (TYP .NE. 118) CALL VCERR('CORRUPT VERSION FILE.')
  736.  
  737.       POS = 1
  738.       LASTVE = CTOI(LINE,POS)
  739.  
  740.       END
  741. C---------------------------------------------------------------------
  742. C
  743.       INTEGER FUNCTION MATCH(I,J)
  744.  
  745.       INTEGER I, J
  746.       INTEGER S1, S2, T1, T2, GETL, EQUIV
  747.  
  748.       S1 = GETL(1,I+1)
  749.       S2 = GETL(1,I+2)
  750.       T1 = GETL(2,J+1)
  751.       T2 = GETL(2,J+2)
  752.       IF (S1.EQ.-100 .OR. S2.EQ.-100 .OR. T1.EQ.-100 .OR. T2 .EQ. -100)
  753.      *THEN
  754.         MATCH = -2
  755.       ELSE IF (EQUIV(S1,T1) .EQ. -2 .AND. EQUIV(S2,T2) .EQ. -2) THEN
  756.         MATCH = -2
  757.       ELSE
  758.         MATCH = -3
  759.       END IF
  760.  
  761.       END
  762. C-------------------------------------------------------------------------
  763. C
  764.       SUBROUTINE NEWVER
  765.  
  766.       INTEGER S1, S2
  767.       INTEGER GETL, EQUIV, RESYNC
  768.  
  769.       CALL STARTT
  770.  
  771.    10 CONTINUE
  772.         S1 = GETL(1, 1)
  773.         S2 = GETL(2, 1)
  774.         IF ((S1 .EQ. -100) .OR. (S2 .EQ. -100)) GO TO 20
  775.         IF (EQUIV(S1, S2) .EQ. -3) THEN
  776.           IF (RESYNC() .EQ. 1) GO TO 20
  777.         END IF
  778.         CALL SEND (1, 1)
  779.         CALL PURGE(2, 1)
  780.       GOTO 10
  781.  
  782.    20 CONTINUE
  783.       CALL FLUSHH
  784.  
  785.       END
  786. C--------------------------------------------------------------------
  787. C
  788. C  GET THE NEXT LINE OUT OF THE FILE
  789. C
  790.       INTEGER FUNCTION NEXTLN(VERSIO, FP)
  791.  
  792.       INTEGER VERSIO, FP
  793.       INTEGER INLINE, N, VNBR
  794. C---------------------------------------------------------
  795. C    TOOLPACK/1    Release: 1.1
  796. C---------------------------------------------------------
  797.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  798.       INTEGER VP
  799.       INTEGER TYP
  800.       INTEGER LINE(134),   OPTVAL(134)
  801.       INTEGER VFNAME(81), FILNAM(81)
  802.       SAVE
  803.  
  804.    10 CONTINUE
  805.         IF(INLINE() .EQ. -100) GO TO 20
  806.         IF (TYP .EQ. 46) THEN
  807.           NEXTLN = -2
  808.           RETURN
  809.         END IF
  810.         IF (FP .NE. -1) THEN
  811.           CALL PUTCH(TYP,   FP)
  812.           CALL PUTLIN(LINE, FP)
  813.         END IF
  814.         N = VNBR()
  815.         IF ((TYP .EQ. 97 .AND. N .GT. VERSIO) .OR.
  816.      +      (TYP .EQ. 100 .AND. N .LE. VERSIO)) THEN
  817.           CALL SKIPEN(N, FP)
  818.         END IF
  819.       GO TO 10
  820.  
  821.    20 CONTINUE
  822.       NEXTLN = -100
  823.  
  824.       END
  825. C--------------------------------------------------------------------------
  826. C
  827.       SUBROUTINE PURGE(FILE,J)
  828.  
  829.       INTEGER FILE, J
  830.       INTEGER I, SHIFT
  831. C---------------------------------------------------------
  832. C    TOOLPACK/1    Release: 1.1
  833. C---------------------------------------------------------
  834.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  835.      +                TNAME, TFIRST, ICNT, DCNT
  836.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  837.      +        TNAME(81)
  838.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  839.       SAVE
  840.  
  841.       IF (J .EQ. NLINES(FILE)) THEN
  842.         NLINES(FILE) = 0
  843.         P(FILE) = 1
  844.       ELSE
  845.         SHIFT = TEXT(FILE,J+1) - 1
  846.         I = TEXT(FILE,J+1)
  847.    10   IF (I .LT. P(FILE)) THEN
  848.           BUF(I-SHIFT,FILE) = BUF(I,FILE)
  849.           I = I + 1
  850.           GO TO 10
  851.         ENDIF
  852.         NLINES(FILE) = NLINES(FILE) - J
  853.         I = 1
  854.    20   IF(I .LE. NLINES(FILE)) THEN
  855.           TEXT(FILE,I) = TEXT(FILE,I+J) - SHIFT
  856.           I = I + 1
  857.           GO TO 20
  858.         ENDIF
  859.         P (FILE) = P(FILE) - SHIFT
  860.       END IF
  861.  
  862.       END
  863. C--------------------------------------------------------------------
  864. C
  865. C  OUTPUT A LINE, CHECK FOR THE CHARACTER PAIR 'V#' AND REPLACE IT
  866. C  WITH THE VERSION NUMBER
  867. C
  868.       SUBROUTINE PUTOUT(VERSIO,S,FD)
  869.  
  870.       INTEGER VERSIO, FD, I, JUNK
  871.       INTEGER S(*), VERNBR(6)
  872.       INTEGER ITOC, ZLOWER
  873.  
  874.       I = 1
  875.    10 IF(S(I) .NE. 129) THEN
  876.         IF((ZLOWER(S(I)) .EQ. 118) .AND. (S(I+1) .EQ. 35)) THEN
  877.           JUNK = ITOC(VERSIO, VERNBR, 6)
  878.           CALL PUTLIN(VERNBR, FD)
  879.           CALL PUTCH(46, FD)
  880.           I = I + 1
  881.         ELSE
  882.           CALL PUTCH(S(I),FD)
  883.         END IF
  884.         I = I + 1
  885.         GO TO 10
  886.       ENDIF
  887.  
  888.       END
  889. C---------------------------------------------------------------------------
  890. C
  891.       SUBROUTINE PUTTOP(FP, VNBR)
  892.  
  893.       INTEGER FP, VNBR
  894.       INTEGER JUNK, ZGTCMD
  895.       INTEGER BUFFER(134)
  896.  
  897.       CALL PUTCH(118, FP)
  898.       CALL ZPTINT(VNBR, 1, FP)
  899.  
  900.       CALL GETTIM(FP)
  901.       CALL ZMESS('Enter Comment Describing the Changes Made:.', 1)
  902.       CALL ZMESS('(End with a Blank Line o'//'r Single Period).', 1)
  903.  
  904.    10 CONTINUE
  905.         IF(ZGTCMD(BUFFER, 0) .LE. 0) RETURN
  906.         IF((BUFFER(1) .EQ. 46) .AND. (BUFFER(2) .EQ. 129)) RETURN
  907.         CALL PUTCH(99, FP)
  908.         CALL ZPTMES(BUFFER, FP)
  909.       GO TO 10
  910.  
  911.       END
  912. C--------------------------------------------------------------------------
  913. C
  914.       INTEGER FUNCTION READIN(FILE, N)
  915.  
  916.       INTEGER FILE, N, LEN
  917.       INTEGER GETLIN
  918. C---------------------------------------------------------
  919. C    TOOLPACK/1    Release: 1.1
  920. C---------------------------------------------------------
  921.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  922.      +                TNAME, TFIRST, ICNT, DCNT
  923.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  924.      +        TNAME(81)
  925.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  926.       SAVE
  927.  
  928.       TEXT(FILE,N) = P(FILE)
  929.       IF (FILE .EQ. 2) THEN
  930.         BUF(P(2), 2) = 46
  931.         P(2) = P(2) + 1
  932.       END IF
  933.       IF (P(FILE) .GT. 10000 - 132) CALL VCERR
  934.      +              ('VC: difference is too complex.')
  935.       LEN = GETLIN(BUF(P(FILE),FILE), FP(FILE))
  936.  
  937.       IF (LEN .NE. -100) THEN
  938.         P(FILE) = P(FILE) + LEN
  939.       ELSE IF (FILE .EQ. 2) THEN
  940.         P(2) = P(2) - 1
  941.       END IF
  942.  
  943.       READIN = LEN
  944.  
  945.       END
  946. C---------------------------------------------------------------------------
  947. C
  948.       INTEGER FUNCTION RESYNC()
  949.  
  950.       INTEGER I, J, S1, S2, GETL, EQUIV, MATCH, CHANGE
  951.  
  952.       DO 100 I = 2, 250
  953.         S1 = GETL(1,I)
  954.         IF (S1 .NE. -100) THEN
  955.           DO 10 J = 1, I - 1
  956.             IF (EQUIV(S1,GETL(2,J)) .EQ. -2) THEN
  957.               IF (MATCH(I,J) .EQ. -2) THEN
  958.                 RESYNC = CHANGE(I-1,J-1)
  959.                 RETURN
  960.               END IF
  961.             END IF
  962.    10     CONTINUE
  963.         END IF
  964.  
  965.         S2 = GETL(2,I)
  966.         IF (S2 .NE. -100) THEN
  967.           DO 20 J = 1, I
  968.             IF (EQUIV(GETL(1,J),S2) .EQ. -2) THEN
  969.               IF (MATCH(J,I) .EQ. -2) THEN
  970.                 RESYNC = CHANGE(J-1,I-1)
  971.                 RETURN
  972.               END IF
  973.             END IF
  974.    20     CONTINUE
  975.         END IF
  976.         IF (S1 .EQ. -100 .AND. S2 .EQ. -100) THEN
  977.           RESYNC = 1
  978.           RETURN
  979.         END IF
  980.   100 CONTINUE
  981.  
  982.       CALL VCERR('VC: difference is too complicated.')
  983.  
  984.       END
  985. C--------------------------------------------------------------------------
  986. C
  987.       SUBROUTINE SEND(FILE,J)
  988.  
  989.       INTEGER FILE, J
  990.       INTEGER LIM, I
  991. C---------------------------------------------------------
  992. C    TOOLPACK/1    Release: 1.1
  993. C---------------------------------------------------------
  994.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  995.      +                TNAME, TFIRST, ICNT, DCNT
  996.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  997.      +        TNAME(81)
  998.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  999.       SAVE
  1000.  
  1001.       IF (J .EQ. NLINES(FILE)) THEN
  1002.         LIM = P(FILE)
  1003.       ELSE
  1004.         LIM = TEXT(FILE,J+1)
  1005.       END IF
  1006.  
  1007.       DO 10 I = 1, LIM-1
  1008.         CALL PUTCH(BUF(I, FILE), TP)
  1009.    10 CONTINUE
  1010.  
  1011.       CALL PURGE(FILE,J)
  1012.  
  1013.       END
  1014. C-----------------------------------------------------------------------
  1015. C
  1016.       SUBROUTINE SKIPEN(VERSIO, FP)
  1017.  
  1018.       INTEGER VERSIO, FP
  1019.       INTEGER INLINE, VNBR
  1020. C---------------------------------------------------------
  1021. C    TOOLPACK/1    Release: 1.1
  1022. C---------------------------------------------------------
  1023.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  1024.       INTEGER VP
  1025.       INTEGER TYP
  1026.       INTEGER LINE(134),   OPTVAL(134)
  1027.       INTEGER VFNAME(81), FILNAM(81)
  1028.       SAVE
  1029.  
  1030.    10 CONTINUE
  1031.         IF (INLINE() .EQ. -100) CALL VCERR('CORRUPT VERSION FILE.')
  1032.         IF (FP .NE. -1) THEN
  1033.           CALL PUTCH (TYP,  FP)
  1034.           CALL PUTLIN(LINE, FP)
  1035.         END IF
  1036.         IF ((TYP .EQ. 101) .AND. (VNBR() .EQ. VERSIO)) RETURN
  1037.       GO TO 10
  1038.  
  1039.       END
  1040. C--------------------------------------------------------------------------
  1041. C
  1042.       SUBROUTINE STARTT
  1043.  
  1044.       INTEGER INLINE, NEXTLN, VNBR, BUFFER(5), JUNK, ITOC, I
  1045. C---------------------------------------------------------
  1046. C    TOOLPACK/1    Release: 1.1
  1047. C---------------------------------------------------------
  1048.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  1049.      +                TNAME, TFIRST, ICNT, DCNT
  1050.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  1051.      +        TNAME(81)
  1052.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  1053. C---------------------------------------------------------
  1054. C    TOOLPACK/1    Release: 1.1
  1055. C---------------------------------------------------------
  1056.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  1057.       INTEGER VP
  1058.       INTEGER TYP
  1059.       INTEGER LINE(134),   OPTVAL(134)
  1060.       INTEGER VFNAME(81), FILNAM(81)
  1061.       SAVE
  1062.  
  1063.       IF (INLINE() .EQ. -100) CALL VCERR('CORRUPT VERSION FILE.')
  1064.       IF (TYP .NE. 118)     CALL VCERR('CORRUPT VERSION FILE.')
  1065.  
  1066.       VERSIO = VNBR() + 1
  1067.       CALL ZCHOUT('Version .', 1)
  1068.       CALL PUTDEC(VERSIO, 1)
  1069.       CALL ZMESS(':.', 1)
  1070.  
  1071.       CALL PUTTOP(TP, VERSIO)
  1072.       CALL PUTCH(TYP,TP)
  1073.       CALL PUTLIN(LINE,TP)
  1074.       IF (NEXTLN(VERSIO-1, TP) .EQ. -100) CALL VCERR
  1075.      +                              ('CORRUPT VERSION FILE.')
  1076.       BUF(1,1) = TYP
  1077.  
  1078.       I = 1
  1079.    20 CONTINUE
  1080.         IF(LINE(I) .EQ. 129) GO TO 10
  1081.         BUF(I+1, 1) = LINE(I)
  1082.         I = I + 1
  1083.       GO TO 20
  1084.  
  1085.    10 CONTINUE
  1086.       P(1)      = I + 1
  1087.       TEXT(1,1) = 1
  1088.       NLINES(1) = 1
  1089.       LENGTH    = 1
  1090.       P(2)      = 1
  1091.       NLINES(2) = 0
  1092.  
  1093.       END
  1094. C--------------------------------------------------------------------------
  1095. C
  1096.       SUBROUTINE UPDATE(ARGC, I)
  1097.  
  1098.       INTEGER ARGC, I, STATUS, C
  1099.       INTEGER FIXEND, CREATE, GETLIN, ZLOWER
  1100.       INTEGER MESS8(5), JUNK(134)
  1101. C---------------------------------------------------------
  1102. C    TOOLPACK/1    Release: 1.1
  1103. C---------------------------------------------------------
  1104.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  1105.       INTEGER VP
  1106.       INTEGER TYP
  1107.       INTEGER LINE(134),   OPTVAL(134)
  1108.       INTEGER VFNAME(81), FILNAM(81)
  1109. C---------------------------------------------------------
  1110. C    TOOLPACK/1    Release: 1.1
  1111. C---------------------------------------------------------
  1112.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  1113.      +                TNAME, TFIRST, ICNT, DCNT
  1114.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  1115.      +        TNAME(81)
  1116.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  1117.       SAVE
  1118.  
  1119.       DATA (MESS8(C), C=1, 5)/79, 75, 63, 32, 129/
  1120.  
  1121.       FP(2) = FIXEND(ARGC, I, 0)
  1122.       IF (VP .EQ. -1) THEN
  1123.         CALL INITVE(VFNAME, FP(2))
  1124.         RETURN
  1125.       END IF
  1126.  
  1127.       FP(1) = VP
  1128.       TP = CREATE(TNAME(TFIRST), 2)
  1129.       IF (TP .EQ. -1) CALL VCERR('VC: cannot create scratch file.')
  1130.  
  1131.       CALL NEWVER
  1132.       CALL CLOSE(VP)
  1133.       CALL CLOSE(TP)
  1134. C
  1135. C  TELL THE USER THE EFFECTS OF THE CHANGES
  1136. C
  1137.       CALL ZCHOUT('Version .', 1)
  1138.       CALL PUTDEC(VERSIO, 1)
  1139.       CALL ZCHOUT(' of ".', 1)
  1140.       CALL PUTLIN(VFNAME, 1)
  1141.       CALL ZMESS('":.', 1)
  1142.       CALL PUTDEC(ICNT-1, 1)
  1143.       CALL ZMESS(' LINES INSERTED.', 1)
  1144.       CALL PUTDEC(DCNT, 1)
  1145.       CALL ZMESS(' LINES DELETED.', 1)
  1146.       CALL PUTDEC(LENGTH-DCNT, 1)
  1147.       CALL ZMESS(' LINES UNCHANGED.', 1)
  1148. C
  1149. C  ASK THE USER IF IT'S ALRIGHT TO UPDATE THE MASTER
  1150. C
  1151.       CALL ZPRMPT(MESS8)
  1152.       STATUS = GETLIN(JUNK, 0)
  1153.       C = ZLOWER(JUNK(1))
  1154.  
  1155.       IF (C .EQ. 121 .OR. STATUS .LT. 0) THEN
  1156.         CALL AMOVE(TNAME(TFIRST), VFNAME)
  1157.       ELSE
  1158.         CALL PUTLIN(VFNAME, 1)
  1159.         CALL ZMESS(' NOT UPDATED.', 1)
  1160.       END IF
  1161.  
  1162.       END
  1163. C---------------------------------------------------------------------
  1164. C
  1165.       SUBROUTINE VCERR(STRING)
  1166.  
  1167.       CHARACTER*(*) STRING
  1168. C---------------------------------------------------------
  1169. C    TOOLPACK/1    Release: 1.1
  1170. C---------------------------------------------------------
  1171.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  1172.      +                TNAME, TFIRST, ICNT, DCNT
  1173.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  1174.      +        TNAME(81)
  1175.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  1176.       SAVE
  1177.  
  1178.       CALL REMOVE(TNAME(TFIRST))
  1179.       CALL ERROR(STRING)
  1180.       END
  1181. C-----------------------------------------------------------------------
  1182. C
  1183.       SUBROUTINE VERSDI(VERSIO)
  1184.  
  1185.       INTEGER VERSIO, N, PRINTS, LINENB, PREV, JUNK
  1186.       INTEGER INLINE, VNBR, ITOC
  1187.       INTEGER NUMBER(81)
  1188. C---------------------------------------------------------
  1189. C    TOOLPACK/1    Release: 1.1
  1190. C---------------------------------------------------------
  1191.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  1192.       INTEGER VP
  1193.       INTEGER TYP
  1194.       INTEGER LINE(134),   OPTVAL(134)
  1195.       INTEGER VFNAME(81), FILNAM(81)
  1196.       SAVE
  1197.  
  1198.       PRINTS = 0
  1199.       LINENB = 0
  1200.       PREV = 0
  1201.  
  1202.       CALL ZOBLNK(12, 1)
  1203.       CALL ZCHOUT('CHANGES INTRODUCED AT VERSION .', 1)
  1204.       CALL PUTDEC(VERSIO, 1)
  1205.       CALL SKIP(1)
  1206.  
  1207.    10 IF(INLINE() .NE. -100) THEN
  1208.         IF (TYP .EQ. 46) THEN
  1209.           IF (PREV .EQ. 1) THEN
  1210.             LINENB = LINENB + 1
  1211.           END IF
  1212.           IF (PRINTS .EQ. 1) THEN
  1213.             CALL PUTLIN(LINE,1)
  1214.           END IF
  1215.         ELSE IF (TYP .EQ. 97) THEN
  1216.           N = VNBR()
  1217.           IF (N .LT. VERSIO) THEN
  1218.             PREV = 1
  1219.           ELSE IF (N .EQ. VERSIO) THEN
  1220.             CALL SKIP(1)
  1221.             CALL ZCHOUT('appended after line .', 1)
  1222.             CALL PUTDEC(LINENB, 1)
  1223.             CALL SKIP(1)
  1224.             PREV = 0
  1225.             PRINTS = 1
  1226.           ELSE
  1227.             CALL SKIPEN(N, -1)
  1228.           END IF
  1229.         ELSE IF (TYP .EQ. 100) THEN
  1230.           N = VNBR()
  1231.           IF (N .LT. VERSIO) THEN
  1232.             PREV = 0
  1233.           ELSE IF (N .EQ. VERSIO) THEN
  1234.             CALL SKIP(1)
  1235.             CALL ZCHOUT('deleted at line .', 1)
  1236.             CALL PUTDEC(LINENB+1, 1)
  1237.             CALL SKIP(1)
  1238.             PREV = 1
  1239.             PRINTS = 1
  1240.           END IF
  1241.         ELSE IF (TYP .EQ. 101) THEN
  1242.           N = VNBR()
  1243.           IF (N .LT. VERSIO) THEN
  1244.             PREV = 1
  1245.           ELSE IF (N .EQ. VERSIO) THEN
  1246.             PREV = 1
  1247.             PRINTS = 0
  1248.           END IF
  1249.         END IF
  1250.  
  1251.         GO TO 10
  1252.       ENDIF
  1253.  
  1254.       END
  1255. C---------------------------------------------------------------------
  1256. C
  1257. C  MAIN ROUTINE - RECOVER AND CHECK ARGUMENTS, NO PROMPTING FOR
  1258. C                 MISSING ARGUMENTS IS PERFORMED AND THE OPTION
  1259. C                 BE THE FIRST SPECIFIED ARGUMENT.
  1260. C                 OPTION 'S' REMOVED FROM OPTION LIST.
  1261. C
  1262.       SUBROUTINE VERSIN
  1263.  
  1264.       INTEGER I, VAL, ARGC, POS, C, OPTION, JUNK
  1265.       INTEGER OPTS(6)
  1266.       INTEGER OPEN, GETARG, CTOI, INDEXX, ZGTCMD, ZLOWER
  1267. C---------------------------------------------------------
  1268. C    TOOLPACK/1    Release: 1.1
  1269. C---------------------------------------------------------
  1270.       COMMON /CUPDAT/ FP, TP, BUF, TEXT, P, NLINES, VERSIO, LENGTH,
  1271.      +                TNAME, TFIRST, ICNT, DCNT
  1272.       INTEGER FP(2), BUF(10000,2), TEXT(2,250), P(2), NLINES(2),
  1273.      +        TNAME(81)
  1274.       INTEGER VERSIO, TP, ICNT, DCNT, LENGTH, TFIRST
  1275. C---------------------------------------------------------
  1276. C    TOOLPACK/1    Release: 1.1
  1277. C---------------------------------------------------------
  1278.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  1279.       INTEGER VP
  1280.       INTEGER TYP
  1281.       INTEGER LINE(134),   OPTVAL(134)
  1282.       INTEGER VFNAME(81), FILNAM(81)
  1283.       SAVE
  1284.  
  1285.       DATA (OPTS(I), I = 1, 6)/99, 100, 116, 117, 118, 129/
  1286.  
  1287.       OPTION = 32
  1288. C
  1289. C  RECOVER THE OPTION ARGUMENT
  1290. C
  1291.       IF(GETARG(1, OPTVAL, 134) .EQ. -100) THEN
  1292.         CALL ZMESS
  1293.      +    ('Enter Option (-c[n], -d[n], -t[time], -u, -v[n]):.', 1)
  1294.         JUNK = ZGTCMD(OPTVAL, 0)
  1295.       END IF
  1296.  
  1297.       IF(OPTVAL(1) .EQ. 129) CALL HELP
  1298.  
  1299.       POS = 1
  1300.       CALL SKIPBL(OPTVAL, POS)
  1301.       IF(OPTVAL(1) .EQ. 45) POS = POS + 1
  1302.       OPTION = ZLOWER(OPTVAL(POS))
  1303.  
  1304.       IF(INDEXX(OPTS, OPTION) .EQ. 0) THEN
  1305.         CALL PUTLIN(OPTVAL, 1)
  1306.         CALL ZMESS(': illegal flag.', 1)
  1307.         CALL HELP
  1308.       END IF
  1309.  
  1310.       IF (OPTION .EQ. 116) THEN
  1311.         VAL = 1
  1312.       ELSE
  1313.         VAL = CTOI(OPTVAL, POS)
  1314.       END IF
  1315. C
  1316. C  RECOVER THE VERSION FILE NAME ARGUMENT
  1317. C
  1318.       ARGC = 2
  1319.       IF (GETARG(2, VFNAME, 81) .EQ. -100) THEN
  1320.         CALL ZMESS('Enter version file name:.', 1)
  1321.         IF(ZGTCMD(VFNAME, 0) .LE. 0) CALL HELP
  1322.       END IF
  1323. C
  1324. C  RECOVER THE SOURCE/DESTINATION FILE NAME IF REQUIRED
  1325. C
  1326.       IF((OPTION .EQ. 116) .OR. (OPTION .EQ. 117) .OR.
  1327.      +   (OPTION .EQ. 118)) THEN
  1328.         ARGC = 3
  1329.         IF (GETARG(3, FILNAM, 81) .EQ. -100) THEN
  1330.           IF(OPTION .EQ. 117) THEN
  1331.             CALL ZMESS('Enter source file name:.', 1)
  1332.           ELSE
  1333.             CALL ZMESS('Enter destination file name:.', 1)
  1334.           ENDIF
  1335.           IF(ZGTCMD(FILNAM, 0) .LE. 0) CALL HELP
  1336.         END IF
  1337.       ENDIF
  1338. C
  1339. C  ENSURE THAT THE VERSION FILE IS AVAIABLE, OR IF IT IS NOT THEN
  1340. C  CHECK THAT THIS IS AN UPDATE OPERATION (IE: CREATE A NEW VERSION FILE)
  1341. C
  1342.       VP = OPEN(VFNAME, 0)
  1343.       IF (VP .EQ. -1 .AND. OPTION .NE. 117) THEN
  1344.         CALL CANT(VFNAME)
  1345.         CALL ZQUIT(-1)
  1346.       END IF
  1347.       IF(VFNAME(1) .NE. 35) TFIRST = 2
  1348. C
  1349. C  PERFORM THE REQUESTED OPERATION OR GIVE HELP INFORMATION
  1350. C
  1351.       IF (OPTION .EQ. 99) THEN
  1352.         CALL CONTEN(VAL)
  1353.  
  1354.       ELSE IF (OPTION .EQ. 100) THEN
  1355.         CALL DIFFER(VAL)
  1356.  
  1357.       ELSE IF (OPTION .EQ. 116) THEN
  1358.         CALL CUTOFF(ARGC, 1, VAL)
  1359.  
  1360.       ELSE IF (OPTION .EQ. 117) THEN
  1361.         CALL UPDATE(ARGC, 1)
  1362.  
  1363.       ELSE IF (OPTION .EQ. 118) THEN
  1364.         CALL GETVER(ARGC, 1, VAL)
  1365.  
  1366.       ELSE
  1367.         CALL HELP
  1368.  
  1369.       END IF
  1370.  
  1371.       END
  1372. C------------------------------------------------------------------------
  1373. C
  1374.       INTEGER FUNCTION VNBR()
  1375.  
  1376.       INTEGER POS, CTOI
  1377. C---------------------------------------------------------
  1378. C    TOOLPACK/1    Release: 1.1
  1379. C---------------------------------------------------------
  1380.       COMMON /CLINE/ VP, TYP, LINE, OPTVAL, VFNAME, FILNAM
  1381.       INTEGER VP
  1382.       INTEGER TYP
  1383.       INTEGER LINE(134),   OPTVAL(134)
  1384.       INTEGER VFNAME(81), FILNAM(81)
  1385.       SAVE
  1386.  
  1387.       POS = 1
  1388.       VNBR = CTOI(LINE, POS)
  1389.  
  1390.       END
  1391.