godzil/ack
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial revision

Browse Source
This commit is contained in:
ceriel
1988-10-04 10:33:39 +00:00
parent 17e980aa15
commit 23a7e7b427
11 changed files with 2195 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
lang/a68s/util/.distr Normal file
View File

@@ -0,0 +1,6 @@
Makefile
checkseq.p
indent.p
reseq.p
tailor.p
xref.c

36
lang/a68s/util/Makefile Normal file
View File

@@ -0,0 +1,36 @@
EM=../../..
h=$EM/h
APC=apc
ACC=acc
all: tailor xref checkseq reseq indent68
install: all
cp indent68 $(EM)/bin/indent68
cmp: all
tailor: tailor.p
$(APC) -o tailor tailor.p
indent68: indent.p
$(APC) -o indent68 indent.p
xref: xref.c
cc -o xref xref.c
checkseq: checkseq.p
$(APC) -o checkseq checkseq.p
reseq: reseq.p
$(APC) -o reseq reseq.p
clean:
-rm -f *.o indent68
pr:
@pr tailor.p xref.c checkseq.p reseq.p indent.p
opr:
make pr ^ opr

34
lang/a68s/util/checkseq.p Normal file
View File

@@ -0,0 +1,34 @@
program checkseq(output);
(* Rewritten to allow a list of files to be passed in on the command line *)
(* This version : 24 August 1987 by Jon Abbott *)
type buf = packed array [1..20] of char;
string = ^buf;
var
this, last, nargs: integer;
s: string;
inf: text;
function argc: integer; extern;
function argv(i: integer): string; extern;
procedure popen(var f: text; s: string); extern;
begin
nargs := argc;
while nargs>1 do
begin
nargs := nargs-1;
s := argv(nargs);
popen(inf,s);
writeln('checkseq: ',s^);
this := 0;
while not eof(inf) do
begin
last := this;
readln(inf,this);
if this <= last then writeln(last, this)
end
end
end.

428
lang/a68s/util/indent.p Normal file
View File

@@ -0,0 +1,428 @@
(*$R-,L-*)
PROGRAM INDENT(SOURCE, INPUT, OUTPUT);
CONST
SMALLINDENT=2; MIDINDENT=2; LARGEINDENT=4;
TYPE
STATETYPE =
(OPENER, MIDDLER, CLOSER, PRAGMENT, DOER, QUOTE, COLON, GO, STROP, OTHER);
CLAUSETYPE =
(BRIEF, CONDCL, CASECL, CLOSEDCL, LOOPCL, INDEXER, ROUTINE, JUMP,
EXIT, SEMICOMMA, STRING, HASH, CO, COMMENT, PR, PRAGMAT, UPPER, POINT, ANY);
TREEP=^TREE;
TREE=RECORD
(*TREE TO HOLD RESERVED WORD DICTIONARY*)
C: CHAR;
LEFT, RIGHT, NEXT: TREEP;
TIP: BOOLEAN;
ST: STATETYPE; CL: CLAUSETYPE;
END;
STACKP=^STACK;
STACK=PACKED RECORD
C: CLAUSETYPE; G: BOOLEAN;
NEXT: STACKP
END;
ALFA=PACKED ARRAY [1..10] OF CHAR;
VAR
SOURCE: TEXT;
ROOT: TREEP;
TOS: STACKP;
VETTEDCHARACTER: RECORD
WORD: PACKED ARRAY [1..80] OF CHAR; (*THE LONGEST CONCEIVABLE BOLDWORD!*)
INDEX: 0..80;
END;
STARTOFLINE,
LINENUMBERS: BOOLEAN; (*TRUE IFF THE SOURCE TEXT INCLUDES LINE NUMBERS*)
I: INTEGER;
INDENT, (*EXPECTED INDENT FOR SUBSEQUENT LINES*)
TEMPINDENT: INTEGER; (*INDENT FOR CURRENT LINE*)
INSTRAGMENT: BOOLEAN;
STROPSTATE: (INPOINT, INUPPER, INPRAGP, INPRAGUP);
GONEON: BOOLEAN; (*TRUE IFF THE LAST TOKEN WAS AN OPENER OR A MIDDLER*)
(**)
(**)
(**)
PROCEDURE SETUPTREE;
(*TO CREATE THE DICTIONARY*)
PROCEDURE INSERT(WORD: ALFA; S: STATETYPE; B: CLAUSETYPE);
VAR TREEPTR: TREEP; INDEX: INTEGER; FOUND: BOOLEAN;
BEGIN TREEPTR := ROOT; INDEX := 1;
WHILE WORD[INDEX]<>' ' DO
BEGIN
WITH TREEPTR^ DO
BEGIN
IF TREEPTR^.NEXT=NIL THEN
BEGIN NEW(NEXT); WITH NEXT^ DO
BEGIN C := WORD[INDEX];
LEFT := NIL; RIGHT := NIL; TIP := FALSE; NEXT := NIL
END
END;
TREEPTR := NEXT
END;
FOUND := FALSE;
WHILE NOT FOUND DO WITH TREEPTR^ DO
IF WORD[INDEX]<C THEN
BEGIN
IF LEFT=NIL THEN
BEGIN NEW(LEFT); WITH LEFT^ DO
BEGIN C := WORD[INDEX];
LEFT := NIL; RIGHT := NIL; TIP := FALSE; NEXT := NIL
END;
FOUND := TRUE
END;
TREEPTR := LEFT
END
ELSE IF WORD[INDEX]>C THEN
BEGIN
IF RIGHT=NIL THEN
BEGIN NEW(RIGHT); WITH RIGHT^ DO
BEGIN C := WORD[INDEX];
LEFT := NIL; RIGHT := NIL; TIP := FALSE; NEXT := NIL
END;
FOUND := TRUE
END;
TREEPTR := RIGHT
END
ELSE FOUND := TRUE;
INDEX := INDEX+1
END;
WITH TREEPTR^ DO
BEGIN TIP := TRUE; ST := S; CL := B END
END (*INSERT*);
(**)
BEGIN (*SETUPTREE*)
NEW(ROOT); ROOT^.NEXT := NIL;
INSERT('( ', OPENER , BRIEF );
INSERT('IF ', OPENER , CONDCL );
INSERT('if ', OPENER , CONDCL );
INSERT('CASE ', OPENER , CASECL );
INSERT('case ', OPENER , CASECL );
INSERT('BEGIN ', OPENER , CLOSEDCL );
INSERT('begin ', OPENER , CLOSEDCL );
INSERT('[ ', OPENER , INDEXER );
INSERT('! ', MIDDLER , BRIEF );
INSERT('THEN ', MIDDLER , CONDCL );
INSERT('then ', MIDDLER , CONDCL );
INSERT('IN ', MIDDLER , CASECL );
INSERT('in ', MIDDLER , CASECL );
INSERT('ELIF ', MIDDLER , CONDCL );
INSERT('elif ', MIDDLER , CONDCL );
INSERT('ELSE ', MIDDLER , CONDCL );
INSERT('else ', MIDDLER , CONDCL );
INSERT('OUSE ', MIDDLER , CASECL );
INSERT('ouse ', MIDDLER , CASECL );
INSERT('OUT ', MIDDLER , CASECL );
INSERT('out ', MIDDLER , CASECL );
INSERT('EXIT ', MIDDLER , EXIT );
INSERT('exit ', MIDDLER , EXIT );
INSERT('; ', MIDDLER , SEMICOMMA);
INSERT(', ', MIDDLER , SEMICOMMA);
INSERT(') ', CLOSER , BRIEF );
INSERT('FI ', CLOSER , CONDCL );
INSERT('fi ', CLOSER , CONDCL );
INSERT('ESAC ', CLOSER , CASECL );
INSERT('esac ', CLOSER , CASECL );
INSERT('END ', CLOSER , CLOSEDCL );
INSERT('end ', CLOSER , CLOSEDCL );
INSERT('] ', CLOSER , INDEXER );
INSERT('# ', PRAGMENT, HASH );
INSERT('CO ', PRAGMENT, CO );
INSERT('co ', PRAGMENT, CO );
INSERT('COMMENT ', PRAGMENT, COMMENT );
INSERT('comment ', PRAGMENT, COMMENT );
INSERT('PR ', PRAGMENT, PR );
INSERT('pr ', PRAGMENT, PR );
INSERT('PRAGMAT ', PRAGMENT, PRAGMAT );
INSERT('pragmat ', PRAGMENT, PRAGMAT );
INSERT('FOR ', DOER , LOOPCL );
INSERT('for ', DOER , LOOPCL );
INSERT('FROM ', DOER , LOOPCL );
INSERT('from ', DOER , LOOPCL );
INSERT('BY ', DOER , LOOPCL );
INSERT('by ', DOER , LOOPCL );
INSERT('TO ', DOER , LOOPCL );
INSERT('to ', DOER , LOOPCL );
INSERT('WHILE ', DOER , LOOPCL );
INSERT('while ', DOER , LOOPCL );
INSERT('DO ', DOER , LOOPCL );
INSERT('do ', DOER , LOOPCL );
INSERT('OD ', CLOSER , LOOPCL );
INSERT('od ', CLOSER , LOOPCL );
INSERT('GO ', GO , JUMP );
INSERT('go ', GO , JUMP );
INSERT('" ', QUOTE , STRING );
INSERT('UPPER ', STROP , UPPER );
INSERT('upper ', STROP , UPPER );
INSERT('POINT ', STROP , POINT );
INSERT('point ', STROP , POINT );
(*':' AFTER BOLD , COLON , ROUTINE ); *)
END;
(**)
(**)
PROCEDURE PUSH(CL: CLAUSETYPE);
VAR TEMP: STACKP;
BEGIN TEMP := TOS; NEW(TOS); WITH TOS^ DO
BEGIN C := CL; G := GONEON; NEXT := TEMP END
END;
(**)
(**)
PROCEDURE POP;
VAR TEMP: STACKP;
BEGIN
IF NOT GONEON AND NOT INSTRAGMENT THEN INDENT := INDENT-MIDINDENT;
TEMP := TOS; GONEON := TOS^.G; TOS := TOS^.NEXT; DISPOSE(TEMP)
END;
(**)
(**)
PROCEDURE VET(VAR SOURCE: TEXT);
(*MOVES NEXT INTERESTING TOKEN TO VETTED CHARACTER,
AND SETS INDENT AND TEMPINDENT ACCORDINGLY*)
VAR TREEPTR: TREEP;
CH: CHAR;
STATE: STATETYPE;
CLAUSE: CLAUSETYPE;
BOLD, FOUND: BOOLEAN;
(**)
PROCEDURE GAP(VAR SOURCE: TEXT);
(*ENSURE THAT AT LEAST (SMALLINDENT-1) BLANKS ARE PRESENT IN OUTPUT*)
VAR I: INTEGER;
BEGIN
I := SMALLINDENT-1;
WHILE NOT EOLN(SOURCE) AND (SOURCE^=' ') AND (I>0) DO
BEGIN GET(SOURCE); I := I-1 END;
IF NOT EOLN(SOURCE) THEN
FOR I := 2 TO SMALLINDENT DO WITH VETTEDCHARACTER DO
BEGIN WORD[I] := ' '; INDEX := I END
END;
(**)
PROCEDURE CHECK(CLAUSE: CLAUSETYPE);
BEGIN WITH TOS^ DO
IF C<>CLAUSE THEN (*ATTEMPT TO FIX BRACKETS MISMATCH*)
IF NEXT^.C=CLAUSE THEN (*ASSUME CLOSER WAS OMITTED*)
BEGIN
IF C IN [BRIEF, INDEXER] THEN INDENT := INDENT-SMALLINDENT
ELSE INDENT := INDENT-LARGEINDENT;
POP;
IF GONEON THEN
BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END
END
ELSE (*ASSUME OPENER WAS OMITTED*)
BEGIN
IF CLAUSE IN [BRIEF, INDEXER] THEN INDENT := INDENT+SMALLINDENT
ELSE INDENT := INDENT+LARGEINDENT;
IF NOT GONEON THEN
BEGIN GONEON := TRUE; INDENT := INDENT-MIDINDENT END;
PUSH(CLAUSE)
END
END;
(**)
BEGIN (*VET*)
(*ASSERT: (SOURCE^ IN [(!)[],.#";]) OR (UPPER & SOURCE^ IN [A..Z]) OR INPRAGMAT*)
CH := SOURCE^;
TEMPINDENT := INDENT;
VETTEDCHARACTER.INDEX := 0;
CASE STROPSTATE OF
INPOINT: BOLD := CH='.';
INUPPER: BOLD := CH IN ['.','A'..'Z'];
INPRAGUP,INPRAGP: BOLD := CH IN ['.','A'..'Z','a'..'z'];
END;
IF CH='.' THEN WITH VETTEDCHARACTER DO
BEGIN INDEX := 1; WORD[1] := '.'; GET(SOURCE); CH := SOURCE^ END;
TREEPTR := ROOT^.NEXT; FOUND := FALSE;
WHILE (TREEPTR<>NIL) AND NOT FOUND DO WITH TREEPTR^ DO
IF C=CH THEN WITH VETTEDCHARACTER DO
BEGIN
INDEX := INDEX+1; WORD[INDEX] := CH;
GET(SOURCE); CH := SOURCE^;
IF BOLD THEN
CASE STROPSTATE OF
INPRAGUP,INPRAGP,INPOINT: FOUND := NOT(CH IN ['A'..'Z', 'a'..'z']) AND TIP;
INUPPER: FOUND := NOT(CH IN ['A'..'Z']) AND TIP;
END
ELSE FOUND := TIP;
IF NOT FOUND THEN TREEPTR := NEXT
END
ELSE IF CH<C THEN TREEPTR := LEFT
ELSE TREEPTR := RIGHT;
IF FOUND THEN WITH TREEPTR^ DO
BEGIN STATE := ST; CLAUSE := CL END
ELSE WITH VETTEDCHARACTER DO
BEGIN
IF BOLD THEN
WHILE (CH IN ['A'..'Z', 'a'..'z']) DO
(*ABSORB REMAINDER OF UNRECOGNIZED BOLDWORD*)
BEGIN INDEX := INDEX+1; WORD[INDEX] := CH; GET(SOURCE); CH := SOURCE^ END
ELSE
BEGIN INDEX := INDEX+1; WORD[INDEX] := CH; GET(SOURCE); CH := SOURCE^ END;
IF (CH=':') AND NOT INSTRAGMENT THEN WITH VETTEDCHARACTER DO
(*START OF ROUTINE-TEXT*)
BEGIN STATE := COLON; CLAUSE := ROUTINE;
INDEX := INDEX+1; WORD[INDEX] := CH; GET(SOURCE)
END
ELSE BEGIN STATE := OTHER; CLAUSE := ANY END
END;
(**)
IF INSTRAGMENT THEN
IF (CLAUSE=TOS^.C) THEN
(*MATCHING CLOSE-STRAGMENT-TOKEN FOUND*)
BEGIN
IF STROPSTATE IN [INPRAGUP,INPRAGP] THEN
STROPSTATE := PRED(PRED(STROPSTATE));
POP;
INSTRAGMENT := FALSE;
IF CLAUSE=HASH THEN INDENT := INDENT-SMALLINDENT
ELSE IF CLAUSE<>STRING THEN INDENT := INDENT-LARGEINDENT;
TEMPINDENT := INDENT
END
ELSE IF (STROPSTATE IN [INPRAGUP,INPRAGP]) AND (STATE=STROP) THEN
IF CLAUSE=UPPER THEN STROPSTATE := INPRAGUP ELSE STROPSTATE := INPRAGP
ELSE (*NO ACTION*)
ELSE (*NOT INSTRAGMENT*)
BEGIN
IF STATE IN [MIDDLER, CLOSER] THEN (*MAYBE END OF ROUTINE-TEXT*)
WHILE TOS^.C=ROUTINE DO
BEGIN
POP; INDENT := INDENT-SMALLINDENT;
IF GONEON THEN
BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END
END;
(**)
IF STATE=GO THEN (*.GO OF .GO .TO*)
BEGIN PUSH(JUMP); STATE := OTHER END
ELSE IF STATE=DOER THEN (*CHANGE IT TO MIDDLER OR OPENER*)
IF TOS^.C=JUMP THEN (*.TO OF .GO .TO*)
BEGIN POP; STATE := OTHER END
ELSE IF (TOS^.C=LOOPCL) AND NOT GONEON THEN STATE := MIDDLER
ELSE STATE := OPENER;
(**)
IF STATE=COLON THEN (*START OF ROUTINE-TEXT*)
BEGIN
IF NOT GONEON THEN
BEGIN GONEON := TRUE; INDENT := INDENT-MIDINDENT END;
PUSH(CLAUSE);
INDENT := INDENT+SMALLINDENT
END
ELSE IF STATE=OPENER THEN (*START OF A NEW INDENT*)
BEGIN
PUSH(CLAUSE);
IF CLAUSE IN [BRIEF, INDEXER] THEN
BEGIN INDENT := INDENT+SMALLINDENT; IF STARTOFLINE THEN GAP(SOURCE) END
ELSE INDENT := INDENT+LARGEINDENT;
GONEON := TRUE
END
ELSE IF STATE=MIDDLER THEN
BEGIN
IF NOT (CLAUSE IN [EXIT, SEMICOMMA]) THEN CHECK(CLAUSE);
IF NOT GONEON THEN
BEGIN GONEON := TRUE; INDENT := INDENT-MIDINDENT END;
IF CLAUSE=SEMICOMMA THEN
BEGIN TEMPINDENT := INDENT-SMALLINDENT; GAP(SOURCE) END
ELSE IF TOS^.C=BRIEF THEN
(* ! OR !: OR .EXIT AFTER ( *)
BEGIN TEMPINDENT := INDENT-SMALLINDENT;
IF STARTOFLINE AND (SOURCE^<>':') AND (CLAUSE<>EXIT) THEN GAP(SOURCE)
END
ELSE TEMPINDENT := INDENT-LARGEINDENT
END
ELSE IF STATE=CLOSER THEN (*END OF INDENT*)
BEGIN
CHECK(CLAUSE); POP;
IF CLAUSE IN [BRIEF, INDEXER] THEN INDENT := INDENT-SMALLINDENT
ELSE INDENT := INDENT-LARGEINDENT;
TEMPINDENT := INDENT;
IF GONEON THEN
BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END
END
ELSE IF STATE=PRAGMENT THEN
BEGIN
TEMPINDENT := INDENT;
PUSH(CLAUSE);
INSTRAGMENT := TRUE;
IF CLAUSE IN [PR,PRAGMAT] THEN
STROPSTATE := SUCC(SUCC(STROPSTATE));
IF CLAUSE=HASH THEN
BEGIN INDENT := INDENT+SMALLINDENT; IF STARTOFLINE THEN GAP(SOURCE) END
ELSE INDENT := INDENT+LARGEINDENT
END
ELSE IF STATE=QUOTE THEN
BEGIN
IF GONEON THEN
BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END;
PUSH(STRING);
INSTRAGMENT := TRUE
END
ELSE (*STATE=OTHER*)
IF GONEON THEN
BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END
END
END (*OF VET*);
(**)
(**)
PROCEDURE MAIN(VAR SOURCE: TEXT);
VAR I: INTEGER;
BEGIN
INDENT := 0; INSTRAGMENT := FALSE;
STROPSTATE := INUPPER; (*THE DEFAULT is UPPER*)
GONEON := TRUE;
SETUPTREE;
LINENUMBERS := SOURCE^ IN ['0'..'9'];
TOS := NIL; PUSH(ANY); PUSH(ANY);
WHILE NOT EOF(SOURCE) DO
BEGIN
WHILE EOLN(SOURCE) DO BEGIN GET(SOURCE); WRITELN(OUTPUT) END;
BEGIN
STARTOFLINE := TRUE;
IF LINENUMBERS THEN
BEGIN
WHILE SOURCE^ IN ['0'..'9'] DO
BEGIN WRITE(OUTPUT, SOURCE^); GET(SOURCE) END;
IF NOT EOLN(SOURCE) AND (SOURCE^=' ') THEN (*FIRST BLANK AFTER LINE NUMBER IS OBLIGATORY*)
BEGIN WRITE(OUTPUT, ' '); GET(SOURCE) END
END;
IF TOS^.C=STRING THEN
(*DO NOT TINKER WITH BLANKS INSIDE STRING-DENOTATIONS*)
BEGIN
WHILE NOT EOLN(SOURCE) AND (SOURCE^=' ') DO
BEGIN WRITE(OUTPUT, ' '); GET(SOURCE) END;
STARTOFLINE := FALSE
END
ELSE WHILE NOT EOLN(SOURCE) AND (SOURCE^=' ') DO
GET(SOURCE); (*GET RID OF EXISTING INDENTATION*)
WHILE NOT EOLN(SOURCE) DO
BEGIN
IF (SOURCE^ IN ['(','!',')','[',']',',','.','#','"',';']) OR
((STROPSTATE<>INPOINT) AND (SOURCE^ IN ['A'..'Z'])) OR
(STROPSTATE IN [INPRAGUP,INPRAGP]) THEN
(*CHARACTER WHICH MIGHT AFFECT INDENTATION*)
BEGIN
VET(SOURCE);
IF STARTOFLINE THEN FOR I := 1 TO TEMPINDENT DO WRITE(OUTPUT, ' ');
WITH VETTEDCHARACTER DO
FOR I := 1 TO INDEX DO WRITE(OUTPUT, WORD[I])
END
ELSE
BEGIN
IF STARTOFLINE THEN FOR I := 1 TO INDENT DO WRITE(OUTPUT, ' ');
IF (SOURCE^<>' ') AND NOT INSTRAGMENT AND GONEON THEN
(*PREPARE TO INDENT ANY CONTINUATION LINE*)
BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END;
WRITE(OUTPUT, SOURCE^); GET(SOURCE);
END;
STARTOFLINE := FALSE
END;
GET(SOURCE); WRITELN(OUTPUT)
END;
END;
END;
(**)
FUNCTION ARGC: INTEGER; EXTERN;
(**)
BEGIN (*INDENT*)
IF ARGC=1 THEN
MAIN(INPUT)
ELSE
BEGIN
RESET(SOURCE);
MAIN(SOURCE);
END;
(*$G-*)
END.

80
lang/a68s/util/reseq.p Normal file
View File

@@ -0,0 +1,80 @@
(* reseq.p *)
(* ******* *)
(* A program to renumber a text file. To use this utility type :
reseq <file1 >file2 start step
to create file2 as a renumbered version of file1, starting
with line number start, with increments of step.
NOTE : file1 and file2 had better be different !!! *)
(* Version 1.1 written Friday 31 July 1987 by Jon Abbott. *)
program reseq(input,output);
type buf = packed array [1..10] of char;
string = ^ buf;
var c : char;
start,step,i : integer;
numbered : boolean;
function argc: integer; extern;
function argv(i: integer): string; extern;
procedure number;
begin
if i<10 then write('0000',i:1)
else if i<100 then write('000',i:2)
else if i<1000 then write('00',i:3)
else if i<10000 then write('0',i:4)
else write(i:5);
if not numbered then write(' ');
if not eoln then write(c);
while not eoln do
begin
read(c);
write(c)
end;
readln;
writeln;
i:=i+step
end;
function getarg(n:integer) : integer;
var s : string;
i,g :integer;
begin
s := argv(n);
i:=1;
while (not (s^[i] in ['0'..'9'])) and (i<10) do i:=i+1;
g := 0;
if not (s^[i] in ['0'..'9']) then g := 100
else
while (i<11) and (s^[i] in ['0'..'9']) do begin
g := g*10+ord(s^[i])-ord('0');
i := i+1
end;
getarg := g
end;
begin
start := 100;
step := 10;
if argc>1 then start := getarg(1);
if argc>2 then step := getarg(2);
if argc>3 then
writeln('Syntax : reseq <file1 >file2 start step : subsequent args ignored');
read(c);
numbered := (c in ['0'..'9']);
i := start;
while not eof do
begin
if numbered then
while c in ['0'..'9'] do
read(c);
number;
if not eof then
if not eoln then read(c)
end
end.

333
lang/a68s/util/tailor.p Normal file
View File

@@ -0,0 +1,333 @@
(* 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.

775
lang/a68s/util/xref.c Normal file
View File

@@ -0,0 +1,775 @@
/*
* xref makes cross references.
* November 1977 Johan Stevenson
*/
#include <stdio.h>
#include <signal.h>
#include <setjmp.h>
/* type of flags() calls */
#define HEAD 0
#define TAIL 1
FILE *input;
FILE *output;
FILE *hashin;
jmp_buf env; /* used by setjmp and longjmp */
int scanout[2]; /* descriptor of output of scan */
int postin[2]; /* descriptor of input of post */
int ch; /*last char*/
int chsy; /*type of last char*/
char id[80]; /*last identifier*/
char fl[80]; /*last filename (see post) */
char buf[80]; /*work space*/
int proc = 0; /*process id of sort*/
int nflag; /*line number flag*/
int nfiles;
int argc;
char **argv;
char *procname;
char *file; /*points to current file*/
int pass1 = 1;
int pass2 = 1;
int only = 0; /* 1 if only selected words needed */
int useroif = 0; /* 1 if user supplied ignore/only file*/
char *oifile = "/usr/lib/xrefign.\0";
int oifsuf = 0; /* index in oifile of last char */
int linecount;
int width = 72; /*line width*/
int type; /* which scanner must be used */
int forced = 0; /* scanner type chosen by user */
stop()
{
if (proc!=0)
kill(proc,9);
exit(-1);
}
main(narg,args) char **args;
int narg;
{
argc=narg;
argv = args;
argc--;
argv++;
if (signal(SIGHUP,stop) != SIG_DFL)
signal(SIGHUP,SIG_IGN);
if (signal(SIGINT,stop) != SIG_DFL)
signal(SIGINT,SIG_IGN);
while (argc && argv[0][0]=='-' && argv[0][1]!='\0')
{
argc--;
flags(*argv++,HEAD);
}
if (argc==0) {
argc++;
*--argv = "-";
}
if (pass1 && pass2) {
if (pipe(scanout)<0 || pipe(postin)<0)
fatal("pipe failed");
if ((proc=fork()) == 0) {
close(0);
close(1);
dup(scanout[0]);
dup(postin[1]);
close(scanout[0]);
close(scanout[1]);
close(postin[0]);
close(postin[1]);
execl("/bin/sort","xref","+1","-3","+0n",0);
execl("/usr/bin/sort","xref","+1","-3","+0n",0);
fatal("sort not found");
}
if (proc == -1) fatal("fork failed");
close(scanout[0]);
close(postin[1]);
}
else if (pass1)
scanout[1] = dup(1);
else if (pass2)
postin[0] = dup(0);
if (pass1) {
if (useroif) {
if ((hashin = fopen(oifile, "r")) == NULL)
fatal("bad ignore/only file: %s",oifile);
buildhash();
fclose(hashin);
}
input = stdin;
output = fdopen(scanout[1], "w");
nfiles = argc;
setjmp(env);
while (argc--)
if (argv[0][0] == '-' && argv[0][1] != '\0')
flags(*argv++,TAIL);
else
scan(*argv++);
fclose(input);
fclose(output);
}
if (pass2) {
input = fdopen(postin[0], "r");
output = stdout;
post();
}
exit(0);
}
flags(s,ftype) register char *s;
{
register c;
s++; /* skip - */
switch (c = *s++) {
case 'p':
case '8':
case 'c':
case 's':
case 'x':
forced++;
type = c;
break;
case '1':
if (ftype == TAIL)
fatal("-1 must precede file arguments");
pass2=0;
pass1++;
break;
case '2':
if (ftype == TAIL)
fatal("-2 must precede file arguments");
pass1=0;
pass2++;
break;
case 'i':
case 'o':
only = (c == 'o');
useroif++;
if (*s == '\0')
fatal("more args expected");
oifile = s;
return;
case 'w':
if (*s == '\0')
fatal("more args expected");
width=atoi(s);
return;
default:
fatal("possible flags: cpsxio12w");
}
if (*s != '\0')
fatal("flags should be given as separate arguments");
}
char *tail(s)
register char *s;
{
register char *t;
t = s;
while (*s)
if (*s++ == '/')
t = s;
return(t);
}
scan(s) char *s;
{
register lastc;
linecount = 0;
nflag = 0;
chsy = 0;
if (nfiles==1)
file = "";
else
file = tail(s);
if (forced==0) {
lastc = suffix(s);
if (lastc=='h')
lastc = 'c';
if (lastc=='c' || lastc=='p' || lastc=='s' || lastc=='8')
type=lastc;
else
type='x';
} else
lastc = type;
if (useroif==0) {
if (oifsuf == 0)
while (oifile[oifsuf] != '\0')
oifsuf++;
if (lastc != oifile[oifsuf] ) {
oifile[oifsuf] = lastc;
if ((hashin = fopen(oifile, "r")) == NULL) {
oifile[oifsuf] = 'x';
if ((hashin = fopen(oifile, "r")) == NULL)
fatal("cannot open %s",oifile);
}
buildhash();
fclose(hashin);
}
}
if (s[0]=='-' && s[1]=='\0')
input = stdin;
else
if ((input = fopen(s, "r")) == NULL)
fatal("cannot open %s",s);
switch (type) {
case 'x':
x_scan();
break;
case 'p':
p_scan();
break;
case '8':
a_scan();
break;
case 'c':
c_scan();
break;
case 's':
s_scan();
break;
}
/*this place is never reached*/
}
suffix(s)
register char *s;
{
while (*s) s++;
if (*(s-2) == '.')
return(*--s);
return('x');
}
fatal(s) char *s;
{
fprintf(stderr, "xref: %s",s);
fprintf(stderr, "\n");
stop();
}
/*============================================*/
#define HSIZE 79
struct {
int integ;
};
struct link {
struct link *next;
char word[];
}
*hashtab[HSIZE];
buildhash()
{
register struct link *p,*q;
register char *s;
int i;
for (i=0; i<HSIZE; i++)
{
p = hashtab[i];
hashtab[i] = 0;
while (q = p)
{
p = q->next;
free(q);
}
}
ch = getc(hashin);
while (ch != EOF) {
s = id;
do {
*s++ = ch;
ch = getc(hashin);
} while (ch>' ');
*s++ = '\0';
h_add(id,s-id);
while (ch!='\n' && ch!=EOF)
ch = getc(hashin);
ch = getc(hashin);
}
}
h_add(s,l) char *s;
int l;
{
register struct link *q,**p;
char temp[80];
char *s2;
if (h_in(s)) return;
s2 = temp;
strcpy(s2,s);
if (strlen(s2)<=2)
strcat(s2,"zz\0");
p = &hashtab[ s2->integ % HSIZE ];
l += 4+((4-(l & 3) & 3));
if ((q = malloc(l)) == 0)
fatal("out of space");
q->next = *p;
*p = q;
strcpy(q->word, s);
}
h_in(s) char *s;
{
register struct link *p;
char temp[80];
char *s2;
s2 = temp;
strcpy(s2,s);
if (strlen(s)<= 2)
strcat(s2,"zz\0");
p = hashtab[ s2->integ % HSIZE ];
while (p) {
if (strcmp(s, p->word) == 0)
return(1);
p = p->next;
}
return(0);
}
/*=====================================*/
#define NL -1
#define ERROR 0
#define LETTER 1
#define DIGIT 2
#define QUOTE 3
#define LPAR 4
#define LBRACE 5
#define DQUOTE 6
#define SLASH 7
#define POINT 9
#define LESS 10
#define USCORE 11
#define OTHER 12
#define HASH 13
char cs[128] = {
/*NUL*/ ERROR, OTHER, OTHER, OTHER, OTHER, OTHER, OTHER, OTHER,
/*010*/ OTHER, OTHER, NL, OTHER, OTHER, OTHER, OTHER, OTHER,
/*020*/ OTHER, OTHER, OTHER, OTHER, OTHER, OTHER, OTHER, OTHER,
/*030*/ OTHER, OTHER, OTHER, OTHER, OTHER, OTHER, OTHER, OTHER,
/*' '*/ OTHER, OTHER, DQUOTE, HASH, OTHER, OTHER, OTHER, QUOTE,
/*'('*/ LPAR, OTHER, OTHER, OTHER, OTHER, OTHER, POINT, SLASH,
/*'0'*/ DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT,
/*'8'*/ DIGIT, DIGIT, OTHER, OTHER, LESS, OTHER, OTHER, OTHER,
/*'@'*/ OTHER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
/*'H'*/ LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
/*'P'*/ LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
/*'X'*/ LETTER, LETTER, LETTER, OTHER, OTHER, OTHER, OTHER, USCORE,
/*'`'*/ OTHER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
/*'h'*/ LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
/*'p'*/ LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
/*'x'*/ LETTER, LETTER, LETTER, LBRACE, OTHER, OTHER, OTHER, OTHER
};
nextch()
{
if (linecount == 0) {
if ((ch=getc(input))==EOF) {
fclose(input);
longjmp(env,0);
}
else {
chsy = cs[ch];
if (chsy != DIGIT)
linecount++;
else {
nflag = 1;
linecount = ch-'0';
chsy = cs[(ch=getc(input))];
while (chsy == DIGIT) {
linecount = linecount*10+ch-'0';
chsy = cs[(ch=getc(input))];
}
}
}
}
else {
if ((ch=getc(input))==EOF) {
fclose(input);
longjmp(env,0);
}
if (chsy < 0) {
if (nflag == 0)
linecount++;
else {
linecount = ch-'0';
chsy = cs[(ch=getc(input))];
while (chsy == DIGIT) {
linecount = linecount*10+ch-'0';
chsy = cs[(ch=getc(input))];
}
}
}
if (ch >= 128)
fatal("bad chars on file %s",*--argv);
chsy = cs[ch];
}
}
out(p)
char *p;
{
fprintf(output, "%d %s %s\n",linecount,p,file);
}
scannumber()
{
do nextch(); while (chsy == DIGIT);
if (ch == '.') {
nextch();
if (chsy!=DIGIT) return;
do nextch(); while (chsy == DIGIT);
}
if (ch == 'e') {
nextch();
if (ch == '+' || ch == '-')
nextch();
while (chsy == DIGIT)
nextch();
}
}
scansymbol(ok1,ok2) {
register char *p;
p = id;
do {
*p++ = ch;
nextch();
} while (chsy==LETTER || chsy==DIGIT || ch==ok1 || ch==ok2);
*p = '\0';
if (h_in(id) == only)
out(id);
}
scanusymbol(ok1,ok2) {
register char *p;
p = id;
do {
if (ch >= 'a' && ch <= 'z')
ch += 'A'-'a';
*p++ = ch;
nextch();
} while (chsy==LETTER || chsy==DIGIT || ch==ok1 || ch==ok2);
*p = '\0';
if (h_in(id) == only)
out(id);
}
escaped() {
if (ch=='\\') nextch();
nextch();
}
comment(lastch) {
nextch();
if (ch=='*') {
nextch();
do {
while(ch!='*') nextch();
nextch();
} while (ch!=lastch);
nextch();
}
}
acmnt1() {
/* handle a .COMMENT ..... .COMMENT */
register char *p;
register int cont;
p = id;
nextch();
if (chsy==DIGIT) scannumber();
else {
do {
*p++ = ch;
nextch();
} while (chsy==LETTER);
/* see if the word is COMMENT */
*p = '\0';
p = id;
if (strcmp("COMMENT",p)) { /* skip to next .COMMENT */
cont = 1;
while (cont) {
while (chsy != POINT) nextch();
nextch();
p = id;
do {
*p++ = ch;
nextch();
} while (chsy==LETTER);
*p = '\0';
p = id;
cont = strcmp("COMMENT",p);
}
}
else { /* do hash lookup - could be pragmat (ignore) or record field */
if (h_in(id)==only)
out(id);
}
}
}
acmnt2() {
register char *p;
int cont;
/* handle a CO ..... CO comment */
p = id;
*p++ = 'C';
nextch();
if (ch!='O') { /* do a scansymbol */
do {
*p++ =ch;
nextch();
} while (chsy==LETTER || chsy==DIGIT || chsy==USCORE);
if (h_in(id)==only)
out(id);
}
else { /* found a CO .... CO */
cont = 1;
while (cont) {
while (ch!='C') nextch();
nextch();
cont = (ch!='O');
}
nextch();
}
}
p_scan() {
nextch();
for(;;) switch (chsy) {
case LETTER:
case USCORE:
scanusymbol('_','\0');
break;
case DIGIT:
scannumber();
break;
case QUOTE:
do nextch(); while (ch!='\'');
nextch();
break;
case DQUOTE:
do nextch(); while (ch!='"');
nextch();
break;
case LPAR:
comment(')');
break;
case LBRACE:
do nextch(); while (ch!='}');
default:
nextch();
}
}
a_scan() {
nextch();
for(;;) switch (chsy) {
case LETTER:
if (ch=='C') acmnt2();
else
scanusymbol('_','\0');
break;
case DIGIT:
scannumber();
break;
case QUOTE:
do nextch(); while (ch!='\'');
nextch();
break;
case DQUOTE:
do nextch(); while (ch!='"');
nextch();
break;
case HASH:
nextch();
while (ch!='#') nextch();
nextch();
break;
case POINT:
acmnt1();
break;
default:
nextch();
}
}
c_scan()
{
nextch();
for (;;) switch (chsy) {
case LETTER:
case USCORE:
scansymbol('_','\0');
break;
case DIGIT:
scannumber();
break;
case SLASH:
comment('/');
break;
case QUOTE:
do escaped(); while (ch!='\'');
nextch();
break;
case DQUOTE:
do escaped(); while (ch!='"');
default:
nextch();
}
}
s_scan()
{
nextch();
for(;;) switch(chsy) {
case LETTER:
case POINT:
scansymbol('_','.');
break;
case DIGIT:
do nextch(); while (chsy==DIGIT);
if (ch=='.' || ch=='f' || ch=='b') nextch();
break;
case DQUOTE:
nextch();
case QUOTE:
escaped();
escaped();
break;
case SLASH:
do nextch(); while (ch!='\n');
break;
case LESS:
nextch();
do escaped(); while (ch!='>');
break;
default:
nextch();
}
}
x_scan()
{
register char *p;
nextch();
for (;;) switch (chsy) {
case LETTER:
p=id;
do {
if (ch<'A' || ch>'Z') *p++ = ch;
else *p++ = ch - 'A' + 'a';
nextch();
if (ch=='-') {
nextch();
if (ch=='\n')
do nextch(); while (chsy!=LETTER);
else *p++ = '-';
}
} while (chsy==LETTER || chsy==DIGIT);
*p = '\0';
if (h_in(id) == only) out(id);
break;
default:
nextch();
}
}
/*=========================================*/
int N;
post()
{
register n,l,i;
int first,newid,newfl,withfile;
first = 1;
id[0] = '\0';
ch = getc(input);
while (ch != EOF) {
l = getfld('\t');
if ((i=atoi(buf)) == 0)
fatal("line number expected");
l = getfld('\t');
newid = strcmp(id,buf);
if (newid) {
strcpy(id,buf);
if (first == 0)
putc('\n',output);
fprintf(output,"%s",id);
if (l > 7)
putc('\n',output);
putc('\t',output);
fl[0] = '\0';
}
l = getfld('\n');
newfl = strcmp(fl,buf);
if (newfl) {
strcpy(fl,buf);
if (newid == 0)
fprintf(output,"\n\t");
fprintf(output,"%s",fl);
if (l > 7)
fprintf(output,"\n\t");
putc('\t',output);
}
if (first) {
first = 0;
withfile = newfl;
N = width - 12;
if (withfile) N -= 8;
if (N<0) fatal("line width too small");
N = (N/5) + 1;
}
if (newid || newfl)
n = N;
else if (n==0) {
fprintf(output,"\n\t");
if (withfile)
putc('\t',output);
n = N;
}
else
putc(' ',output);
n--;
fprintf(output,"%4d",i);
}
putc('\n',output);
}
getfld(stopch) {
register char *p;
p = buf;
while (ch!=EOF && ch!=stopch) {
*p++ = ch;
ch = getc(input);
}
*p = '\0';
ch = getc(input);
return(p-buf);
}