333 lines
		
	
	
	
		
			10 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
			
		
		
	
	
			333 lines
		
	
	
	
		
			10 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
(*  COPYRIGHT 1979 YAVUZ ONDER, UNIVERSITY OF MANCHESTER  *)
 | 
						|
(*$G-*) 
 | 
						|
 | 
						|
PROGRAM TAILOR ( INPUT, INFILE, error, output );
 | 
						|
(*         HOW TO USE 'TAILOR'
 | 
						|
 *  -ANY VERSION IN TEXT IS OPENED BY (*SNN() AND 
 | 
						|
                            CLOSED BY ()SNN*) (*
 | 
						|
 *        WHERE S IS '+' OR '-' (NO DEFAULT), 
 | 
						|
 *             NN IS AN UNSIGNED TWO DIGIT INTEGER (NO ZERO SUPRESSION) 
 | 
						|
 *        IN SOME CASES output WILL CONTAIN '+)' INSTEAD OF
 | 
						|
 *             'ASTERISK)' AS COMMENT CLOSER. 
 | 
						|
 *  -THE NAME OF THE FILE TO BE TAILORED IS THE FIRST ARGUMENT. 
 | 
						|
 *  -THERE ARE THREE BASIC OPERATIONS :  
 | 
						|
 *        'INCLUDE'  :  (I) REMOVES VERSION ENTRY AND CLOSING
 | 
						|
 *                          SYMBOLS AND CHANGES '+)'S TO 'ASTERISK )'S
 | 
						|
 *                          WITHIN THE VERSION ;
 | 
						|
 *                     (II) CHANGES ALL 'ASTERISK )'S TO '+)'S
 | 
						|
 *                          WITHIN THE COMPLEMENTED VERSION, EXCEPT IN 
 | 
						|
 *                          VERSION CLOSER. 
 | 
						|
 *        'SKIP'     :  (I) REMOVES ALL VERSION INCLUDING ENTRY AND
 | 
						|
 *                          CLOSING SYMBOLS ; 
 | 
						|
 *                     (II) PERFORMS 'INCLUDE' (I) ON COMPLEMENTED VERSION
 | 
						|
 *       'LEAVE ALONE':      IF NO COMMAND EXISTS FOR ANY ONE OF THE VERSIONS 
 | 
						|
 *                          IN THE TEXT 'INCLUDE' IS PERFORMED ON 
 | 
						|
 *                          -(ABS(VERSION-NOT-IN-TEXT)).
 | 
						|
 *  -COMMANDS ARE INPUT WHEN REQUIRED BY 'TAILOR'.
 | 
						|
 *  -TO 'INCLUDE' ANY VERSION GIVE ITS NUMBER ('+'S NEED NOT BE GIVEN.).
 | 
						|
 *  -TO 'SKIP' ANY VERSION ENTER ABS(ITS-NUMBER)+100 SIGNED AS IN TEXT... 
 | 
						|
 *
 | 
						|
 *        ... E.G.  COMMAND SEQUENCE ' 1 -102 103 -20 200 ' MEANS
 | 
						|
 *              (PERFORM 'INCLUDE' ON 1,2,-3 AND -20 ) AND
 | 
						|
 *              (PERFORM 'SKIP'    ON -2 AND 3 )     AND
 | 
						|
 *              (PERFORM 'LEAVE ALONE' ON ALL OTHER VERSIONS IN TEXT.). 
 | 
						|
 *  -TO TERMINATE COMMAND SEQUENCE BEFORE THIRTY-SECOND ENTER ANY COMMAND>=300
 | 
						|
 *         THIRTYTWO OR MORE COMMANDS START THE EXECUTION OF THE TAILOR 
 | 
						|
 *         AND ONLY FIRST THIRTYTWO (NOW APPROX 50) ARE ACCEPTED.
 | 
						|
 *  -IF ANY VERSION OR ITS COMPLEMENT TAKES PLACE IN MORE THAN ONE
 | 
						|
 *         COMMAND THE LAST ONE IS OBEYED.
 | 
						|
 *  -ZERO CANNOT BE USED AS VERSION NUMBER OR IN COMMANDS.
 | 
						|
 *  -TO REMOVE ALL TAILORING BRACKETS (USEFUL PRIOR TO XREF) INPUT 1000 ONLY.
 | 
						|
 *  -LINE NUMBER ARE REMOVED FROM FILES, EXCEPT WITH THE 1000 COMMAND.
 | 
						|
 *  -THE TAILORED PROGRAM APPEARS ON THE STANDARD OPUTPUT.
 | 
						|
 *  -ERROR MESSAGES APPEAR ON THE FILE GIVEN BY THE SECOND ARGUMENT.
 | 
						|
 ************* END OF HOW TO USE ************************************)
 | 
						|
 | 
						|
CONST verslimit=50;
 | 
						|
VAR   VERLIST : ARRAY[1..verslimit]OF INTEGER;
 | 
						|
      INFILE : TEXT;
 | 
						|
      error : TEXT;
 | 
						|
      (* INPUT AND OUTPUT FILES *)
 | 
						|
      NOOFVER         : INTEGER; 
 | 
						|
      (* NUMBER OF COMMANDS (MAX. verslimit) *)
 | 
						|
      INLFLAG, INIFLAG : INTEGER;
 | 
						|
      (* FLAGS SHOWING WHETHER IN A 'LEAVE ALONE' OR
 | 
						|
                 'INCLUDE' RESPECTIVELY *)
 | 
						|
      LINBUF           : ARRAY[1..200]OF CHAR; 
 | 
						|
      (* TEMPORARY STORAGE FOR MANIPULATION OF
 | 
						|
                 THE CURRENT LINE *)
 | 
						|
      FIRSTNONBLANK    : INTEGER; (* KEEPS THE POSITION OF FIRST 
 | 
						|
         NONBLANK 
 | 
						|
                                 CHAR IN LINBUF *)
 | 
						|
      INCLUDEALL       : BOOLEAN;
 | 
						|
      (*******************************************************) 
 | 
						|
 | 
						|
PROCEDURE INITIALISE ( VAR NOOFVER : INTEGER );
 | 
						|
  (* READS COMMANDS AND INITIALISES THE GLOBALS *)
 | 
						|
 | 
						|
  LABEL 9;
 | 
						|
 | 
						|
  VAR   VERNO, I : INTEGER;
 | 
						|
BEGIN 
 | 
						|
INCLUDEALL := FALSE; 
 | 
						|
I := 0;
 | 
						|
REPEAT
 | 
						|
  IF I < verslimit THEN
 | 
						|
    BEGIN 
 | 
						|
    I := I+1;
 | 
						|
    READ ( VERNO ); 
 | 
						|
    IF VERNO < 300 THEN 
 | 
						|
      VERLIST[I]:= VERNO 
 | 
						|
    ELSE
 | 
						|
      BEGIN 
 | 
						|
      I := I-1;
 | 
						|
      IF ( VERNO=1000 ) AND ( I=0 ) THEN
 | 
						|
        INCLUDEALL := TRUE;
 | 
						|
      GOTO 9
 | 
						|
      END;
 | 
						|
    END 
 | 
						|
  ELSE
 | 
						|
    GOTO 9
 | 
						|
UNTIL 1=0;
 | 
						|
9: NOOFVER := I;
 | 
						|
INLFLAG := 0;
 | 
						|
INIFLAG := 0;
 | 
						|
FOR I := 1 TO 120 DO 
 | 
						|
  LINBUF[I]:= ' '; 
 | 
						|
FIRSTNONBLANK := 1(*0*);
 | 
						|
RESET ( INFILE ); 
 | 
						|
REWRITE ( output );
 | 
						|
REWRITE ( error );
 | 
						|
END;
 | 
						|
(*******************************************************) 
 | 
						|
 | 
						|
PROCEDURE SEARCHVER;
 | 
						|
  (* SEARCHES FOLLOWING VERSION IN THE TEXT 
 | 
						|
    WHEN FOUND CALLS PROC SCANLIST          *)
 | 
						|
 | 
						|
  LABEL 99; 
 | 
						|
 | 
						|
  VAR   CH    : CHAR;
 | 
						|
        I, II : INTEGER;
 | 
						|
 | 
						|
  PROCEDURE SCANLIST; 
 | 
						|
    FORWARD;
 | 
						|
  (****************************)
 | 
						|
 | 
						|
  PROCEDURE FINDEND ( VER : INTEGER ); 
 | 
						|
    (*  SEARCHES END OF THE VERSION GIVEN IN PARAMETER
 | 
						|
      IF ENCOUNTERS ANOTHER VERSION ENTRY IN THE MEANTIME 
 | 
						|
      CALLS PROC SCANLIST ( AND ITSELF INDIRECTLY )       *)
 | 
						|
 | 
						|
    LABEL 999, 888, 9999;
 | 
						|
 | 
						|
    VAR   II, FIXI, ABVER, CLSVER : INTEGER; 
 | 
						|
          OP                      : CHAR;
 | 
						|
  BEGIN 
 | 
						|
  FIXI := I; 
 | 
						|
  ABVER := ABS ( VER );
 | 
						|
  IF ABVER < 100 THEN 
 | 
						|
    OP := 'I'
 | 
						|
  ELSE
 | 
						|
    BEGIN 
 | 
						|
    IF ABVER < 200 THEN 
 | 
						|
      OP := 'S'
 | 
						|
    ELSE
 | 
						|
      OP := 'L'; 
 | 
						|
    VER := ( ABVER MOD 100 )*VER DIV ABVER;
 | 
						|
    END;
 | 
						|
  REPEAT
 | 
						|
    while EOLN ( INFILE ) (* END-OF-LINE ACTION *) 
 | 
						|
    do
 | 
						|
      BEGIN 
 | 
						|
      IF NOT ( OP='S' ) THEN
 | 
						|
        IF FIRSTNONBLANK <> 0 THEN
 | 
						|
          BEGIN 
 | 
						|
          FOR II := 1 TO I DO
 | 
						|
            WRITE ( output, LINBUF[II]); 
 | 
						|
          WRITELN ( output ) 
 | 
						|
          END 
 | 
						|
        ELSE (*NOTHING*)
 | 
						|
      ELSE
 | 
						|
        IF  (FIXI>=FIRSTNONBLANK) AND (FIRSTNONBLANK <> 0) THEN 
 | 
						|
          BEGIN 
 | 
						|
          FOR II := 1 TO FIXI-1 DO 
 | 
						|
            WRITE ( output, LINBUF[II]); 
 | 
						|
          WRITELN ( output ) 
 | 
						|
          END
 | 
						|
      ELSE writeln(output) (*to keep line nos in step*);
 | 
						|
      READLN ( INFILE );
 | 
						|
      IF EOF ( INFILE ) THEN
 | 
						|
        GOTO 888;
 | 
						|
      if (infile^ in ['0'..'9']) AND NOT INCLUDEALL then
 | 
						|
        for ii := 1 to 6 do get(infile); (*ignore line numbers*) 
 | 
						|
      I := 0;
 | 
						|
      fixi := 0;
 | 
						|
      FIRSTNONBLANK := 1(*0*) 
 | 
						|
      END;
 | 
						|
    READ ( INFILE, CH );
 | 
						|
    (* ACTION FOR EVERY CHARACTER *)
 | 
						|
    I := I+1;
 | 
						|
    LINBUF[I]:= CH;
 | 
						|
    IF ( FIRSTNONBLANK=0 ) THEN 
 | 
						|
      IF CH<>' ' THEN 
 | 
						|
        BEGIN 
 | 
						|
        FIRSTNONBLANK := I;
 | 
						|
        FIXI := I-1
 | 
						|
        END;
 | 
						|
    IF ( CH=')' ) AND ( I > 6 ) (* A VERSIN CLOSER ? *) 
 | 
						|
    THEN
 | 
						|
      IF LINBUF[I-6]='(' THEN 
 | 
						|
        IF LINBUF[I-5]=')' THEN 
 | 
						|
          IF ( LINBUF[I-1]='*' ) OR ( LINBUF[I-1]='+' ) THEN
 | 
						|
            IF ( LINBUF[I-2]IN['0'..'9']) AND ( LINBUF[I-3]IN['0'..'9']) AND ( LINBUF[I-4]IN['+', '-']) THEN
 | 
						|
              BEGIN 
 | 
						|
              CLSVER := ORD ( LINBUF[I-2])-ORD ( '0' )+( ORD ( LINBUF[I-3])-ORD ( '0' ) )*10;
 | 
						|
              IF LINBUF[I-4]='-' THEN 
 | 
						|
                CLSVER :=-CLSVER;
 | 
						|
              IF ( VER=CLSVER ) OR INCLUDEALL THEN
 | 
						|
                BEGIN 
 | 
						|
                IF ( OP='I' ) OR INCLUDEALL THEN
 | 
						|
                  IF FIRSTNONBLANK=I-6 THEN 
 | 
						|
                    BEGIN 
 | 
						|
                    FOR II := I DOWNTO I-6 DO
 | 
						|
                      LINBUF[II]:= ' ';
 | 
						|
                    FIRSTNONBLANK := 1(*0*) 
 | 
						|
                    END 
 | 
						|
                  ELSE
 | 
						|
                    I := I-7;
 | 
						|
                IF OP='S' THEN
 | 
						|
                  BEGIN 
 | 
						|
                  I := FIXI; 
 | 
						|
                  IF FIRSTNONBLANK >= FIXI THEN 
 | 
						|
                    FIRSTNONBLANK := 1(*0*) 
 | 
						|
                  END;
 | 
						|
                GOTO 9999;
 | 
						|
                END;
 | 
						|
              END;
 | 
						|
    IF OP='S' THEN
 | 
						|
      GOTO 999; 
 | 
						|
    IF ( CH=')' ) AND ( I > 6 ) (* A NEW VERSION ENTRY ? *) 
 | 
						|
    THEN
 | 
						|
      IF LINBUF[I-6]='(' THEN 
 | 
						|
        IF LINBUF[I-1]='(' THEN 
 | 
						|
          IF LINBUF[I-5]='*' THEN 
 | 
						|
            IF ( LINBUF[I-2]IN['0'..'9']) AND ( LINBUF[I-3]IN['0'..'9']) AND ( LINBUF[I-4]IN['+', '-']) THEN
 | 
						|
              SCANLIST; 
 | 
						|
    IF I>1 THEN 
 | 
						|
      IF LINBUF[I]=')' (* CORRECTIONS ON COMMENT CLOSERS
 | 
						|
         *) 
 | 
						|
      THEN
 | 
						|
      BEGIN 
 | 
						|
      IF ( INLFLAG > 0 ) AND ( LINBUF[I-1]='*' ) THEN 
 | 
						|
        LINBUF[I-1]:= '+'; 
 | 
						|
      IF ( INIFLAG > 0 ) AND ( INLFLAG=0 ) AND ( LINBUF[I-1]='+' ) THEN 
 | 
						|
        LINBUF[I-1]:= '*'; 
 | 
						|
      END;
 | 
						|
999:
 | 
						|
  UNTIL EOF ( INFILE ); 
 | 
						|
888:
 | 
						|
  WRITELN ( error, 'VERSION ', VER : 2, ' NOT CLOSED AT EOF.' );
 | 
						|
9999:  
 | 
						|
  END;
 | 
						|
  (******************************)
 | 
						|
 | 
						|
  PROCEDURE SCANLIST; 
 | 
						|
 | 
						|
    VAR   II, III, VERSN, COMMAND, ABSVER : INTEGER; 
 | 
						|
  BEGIN 
 | 
						|
  (* COMPUTES VERSION NUMBER FROM TEXT *) 
 | 
						|
  VERSN := ORD ( LINBUF[I-2])-ORD ( '0' )+( ORD ( LINBUF[I-3])-ORD ( '0' ) )*10; 
 | 
						|
  IF LINBUF[I-4]='-' THEN 
 | 
						|
    VERSN :=-VERSN;
 | 
						|
  ABSVER := ABS ( VERSN ); 
 | 
						|
  COMMAND :=-ABS ( VERSN );
 | 
						|
  (* FINDS COMMAND RELATED TO CURRENT VERSION, IF ANY *)
 | 
						|
  FOR II := 1 TO NOOFVER DO
 | 
						|
    IF ( ABSVER=ABS ( VERLIST[II]) ) OR ( ABSVER=ABS ( VERLIST[II])-100 ) or (absver=abs(verlist[ii])-200) THEN
 | 
						|
      COMMAND := VERLIST[II];
 | 
						|
  IF ( COMMAND=VERSN ) OR ( ABS ( COMMAND+VERSN )=100 ) OR INCLUDEALL (*
 | 
						|
         CHECK & ACTION FOR 'INCLUDE' CONDITION 
 | 
						|
         *) 
 | 
						|
  THEN
 | 
						|
    BEGIN 
 | 
						|
    FOR III := I DOWNTO I-6 DO 
 | 
						|
      LINBUF[III]:= ' '; 
 | 
						|
    IF FIRSTNONBLANK=I-6 THEN 
 | 
						|
      FIRSTNONBLANK := 1(*0*) 
 | 
						|
    ELSE
 | 
						|
      I := I-7;
 | 
						|
    INIFLAG := INIFLAG+1;
 | 
						|
    FINDEND ( VERSN );
 | 
						|
    INIFLAG := INIFLAG-1;
 | 
						|
    END 
 | 
						|
  ELSE
 | 
						|
    IF COMMAND+VERSN=0 (* CHECK & ACTION FOR 'LEAVE ALONE 
 | 
						|
            ' CONDITION *)
 | 
						|
    THEN
 | 
						|
      BEGIN 
 | 
						|
      INLFLAG := INLFLAG+1;
 | 
						|
      FINDEND ( ( ABSVER+200 )*VERSN DIV ABSVER );
 | 
						|
      INLFLAG := INLFLAG-1;
 | 
						|
      END 
 | 
						|
    ELSE
 | 
						|
      BEGIN 
 | 
						|
      (* ACTION FOR 'SKIP' CONDITION *) 
 | 
						|
      I := I-7;
 | 
						|
      IF FIRSTNONBLANK=I-6 THEN 
 | 
						|
        FIRSTNONBLANK := 1(*0*);
 | 
						|
      FINDEND ( ( ABSVER+100 )*VERSN DIV ABSVER );
 | 
						|
      END;
 | 
						|
  END;
 | 
						|
  (*******************************) 
 | 
						|
BEGIN (* BODY OF SEARCHVER *) 
 | 
						|
if (infile^ in ['0'..'9']) AND NOT INCLUDEALL then
 | 
						|
  for ii := 1 to 6 do get(infile); (*ignore line numbers*)
 | 
						|
I := 0;
 | 
						|
REPEAT
 | 
						|
  while EOLN ( INFILE ) do
 | 
						|
    begin 
 | 
						|
    (* ACTION FOR EOLN S OUT OF ANY VERSION *)
 | 
						|
    IF FIRSTNONBLANK <> 0 THEN
 | 
						|
      BEGIN 
 | 
						|
      FOR II := 1 TO I DO
 | 
						|
        WRITE ( output, LINBUF[II]); 
 | 
						|
      WRITELN ( output );
 | 
						|
      READLN ( INFILE );
 | 
						|
      IF EOF ( INFILE ) THEN
 | 
						|
        GOTO 99;
 | 
						|
      FIRSTNONBLANK := 1(*0*);
 | 
						|
      END 
 | 
						|
    ELSE
 | 
						|
      BEGIN 
 | 
						|
      if eof(infile) then goto 99;
 | 
						|
      READLN ( INFILE );
 | 
						|
      IF EOF ( INFILE ) THEN
 | 
						|
        GOTO 99 
 | 
						|
      END;
 | 
						|
    if (infile^ in ['0'..'9']) AND NOT INCLUDEALL then
 | 
						|
      for ii := 1 to 6 do get(infile); (*ignore line numbers*)
 | 
						|
    I := 0;
 | 
						|
    end;
 | 
						|
  READ ( INFILE, CH );
 | 
						|
  I := I+1;
 | 
						|
  LINBUF[I]:= CH;
 | 
						|
  IF FIRSTNONBLANK=0 THEN 
 | 
						|
    IF CH<>' ' THEN 
 | 
						|
      FIRSTNONBLANK := I;
 | 
						|
  IF ( CH=')' ) AND ( I > 5 ) (* A VERSION ENTRY ? *) 
 | 
						|
  THEN
 | 
						|
    IF LINBUF[I-1]='(' THEN 
 | 
						|
      IF LINBUF[I-5]='*' THEN 
 | 
						|
        IF LINBUF[I-6]='(' THEN 
 | 
						|
          IF ( LINBUF[I-2]IN['0'..'9']) AND ( LINBUF[I-3]IN['0'..'9']) AND ( LINBUF[I-4]IN['+', '-']) THEN
 | 
						|
            SCANLIST; 
 | 
						|
UNTIL EOF ( INFILE );
 | 
						|
99:
 | 
						|
END;
 | 
						|
(***************************************************************) 
 | 
						|
 | 
						|
BEGIN 
 | 
						|
INITIALISE ( NOOFVER ); 
 | 
						|
SEARCHVER;
 | 
						|
END.
 |