334 lines
10 KiB
OpenEdge ABL
334 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.
|