--- /dev/null
+COPYRIGHT
+README
+a68s.1
+aem
+cpem
+liba68s
+test
+util
--- /dev/null
+The material in this directory (with the exception of util.xref) is
+copyright 1988 by
+ Dr C. H. Lindsey
+ Dept. of Computer Science
+ University of Manchester
+ MANCHESTER M13 9PL
+ United Kingdom.
+
+tel. 061-275 6120
+uucp chl@ux.cs.man.ac.uk
--- /dev/null
+ The ALGOL 68S System
+ ********************
+
+1. See a68s.1 in -man format for the goodies on offer.
+
+2. This system is presently exceeding slow (but correct). The reason is that
+it calls run-time routines to do absolutely everything. It is known that
+significant improvement can easily be made in this state of affairs, but not
+in this release.
+
+3. Other developments expected for the future are facilities for separate and
+mixed-language compilation (a student will tackle this next year), and a
+non-checking run time option which will run faster (but with less security)
+(but no student available for this yet).
+
+4. The system should run on any 44 or 24 system, but not on a 22 system as yet
+(that is another development in the waiting). It has actually been tested on
+sun3, moon3 and vax4.
+
+5. The system was originally delevoped for CDC machines, and then for PERQs
+running under PNX. Thus its method of compilation is not particularly suited
+to the ACK way of thinking (a compiler designed with ACK in mind from the
+start would have been very different). The CDC origin explains why all the
+sources are in upper case, and with numbered lines (however, I like numbered
+lines, so I have kept them, and a68s will even accept them still).
+
+6. Version control is by a program /util/tailor, which selectively exposes or
+hides commented out sections of the sources according to a recipe. See the
+start of aem/a68sdec.p for what all the tailoring parameters mean. Every
+source text is passed through tailor before being compiled.
+
+7. The system is written in a bastardized version of PASCAL called cpem (see
+README in the directory of that name). {This also provides an "improved" method
+of separate compilation which might be of benefit in pem.}
+
+8. The directories aem and liba68s have their own private versions of 'make'
+(therefore, '.' must precede '/bin' in your PATH). These prepare the tailoring
+recipes according to the system given in ack_sys (set environment variable
+MACH to override this). Unlike pem, separate versions of the compiler must
+exist to generate 44 and 24 (and eventually 22) code. To avoid keeping too
+many .o files around, the Makefile will do a clean before changing from a 44
+system to a 24 one, etc.
+
+9. Although a runtime library can be made using 'make' in liba68s, this is
+really intended for debugging libraries. A more usual system would be to use
+the 'compmodule' system in the liba68s directory of the appropriate mach.
+However, it is recommended that this be not included automatically in the
+'action' of each mach, because compiling an ALGOL 68S library takes over a
+hour on a microvax, and to do it for all of the 'mach's provided would use up
+a lot of time.
+
+10. To build the complete system requires
+ make install in util
+ make all in cpem
+ make install in aem
+ make install in EM/mach/???/liba68s
+
+11. The programs test/test.8 and test/tp8.8 are the main confidence-checkers.
+test.8 produces lots of numbers, with clear error messages interspersed if
+anything goes wrong. Its last few lines should contain 5 '.'s, followed by
+4'.'s and so on down to 0. There is one test needs commenting out if floating
+point is not available. tp8.8 is the transput test. It should print out a long
+string in vertical columns spread over two pages. After that, if it says "FYLA
+read back OK" it should be all right. tp9.8 is the same thing for systems
+without floating point. The other programs in the test directory are just
+interesting examples, which should work.
+
--- /dev/null
+.TH A68S 1 "Version 2.2a Jul 15 1987"
+.SH NAME
+a68s, indent68 \- ALGOL 68S compiler
+.SH SYNOPSIS
+.B a68s
+.IR arguments
+.PP
+.BR ack (etc)
+.IR arguments
+.PP
+.B indent68
+.IR filename
+.SH DESCRIPTION
+ALGOL68S source files should have the extension `.8'.
+.LP
+.I a68s
+accepts the same flags and conventions as
+.I ack
+(q.v.). Thus 'a68s -o
+.I prog
+.IR prog .8'
+will compile the source in file
+.IR prog .8,
+producing executable binary in
+.IR prog
+and a program listing in
+.IR prog .8.lst.
+.IP
+WARNING. Although the
+.I ack
+system will have produced the usual intermediate files with suffices .k, .m and .o
+(and you may even stop the compilation at these intermediate stages if you wish),
+do not try to include other files (whether ending in .8 or in .anything else)
+as the present compiler has no facilities for separate or
+mixed-language compilation. Hopefully, this will be rectified some day.
+.IP
+If the source file starts with a digit, it will be assumed that every line
+starts with a line number (but the sequencing is not checked). These line
+numbers will then appear on the .lst file,
+and will be used in diagnostic messages.
+.LP
+`indent68'
+will read the given
+.IR filename
+which is expected to be an ALGOL 68 program.
+A correctly indented form of the same program is sent to the standard output.
+Note that, unlike more elaborate prettyprinters, it confines itself to
+inserting or removing blanks at the beginnings of lines (although it does
+insist upon a space after each
+.BR go-on-symbol
+.RI ( ; )
+and after a starting
+.BR brief-comment-symbol
+.RI ( # ).
+It is particularly intended for indenting programs that place their
+.BR go-on-symbols
+at the start of the line (i.e. before the next
+.BR statement
+rather than after the last one), but it will produce an acceptable
+indentation of any program.
+.SH LANGUAGE
+The language implemented is the official sublanguage of ALGOL 68 (usually
+known as ALGOL 68S), as defined in [1] (see also Appendix 4 of [2]). The only
+features of ALGOL 68S not implemented are binary transput and
+.IR "stand back channel" .
+On the other hand, in addition to the official features of ALGOL 68S, the
+.B heap-generator
+(but not the
+.BR sample-heap-generator )
+is implemented. WARNING. The garbage collector is of the "access count"
+variety, and it will therefore not collect circular lists which may become
+inaccessible (however, circular lists constructed from
+.BR local-generators
+are collected correctly on range exit).
+.PP
+The hardware representation is the official one ([3]), except for the absence
+of reserved-word stropping.
+.PP
+The principal limitations with respect to full ALGOL 68 are therefore as
+follows.
+.TP
+1.
+All defining occurences must precede their applied occurrences (except for
+.BR labels ).
+.TP
+2.
+No
+.IR UNION s
+or
+.BR conformity-clauses
+or
+.IR EMPTY .
+.TP
+3.
+No
+.IR FLEX
+(but
+.IR STRING
+is OK) and no
+.BR vacuums .
+.TP
+4.
+Structures may not contain arrays, and
+.B 'row-of-row-of'
+modes are not permitted (as opposed to
+.B 'row-row-of'
+modes which are OK).
+.TP
+5.
+No
+.BR parallel-clauses
+or
+.BR void-collateral-clauses
+(but
+.BR displays
+are OK).
+.TP
+6.
+No formatted transput.
+.TP
+7.
+.IR GOTO
+(or
+.IR GO
+.IR TO )
+may not be omitted in a
+.BR jump .
+.TP
+8.
+No procedured jumps.
+.TP
+9.
+Existing
+.BR operators
+(notably the
+.BR standard-prelude
+ones) may not be redefined (nor may their priorities be altered).
+.TP
+10.
+Restricted
+.BR standard-prelude .
+The following is a complete list of the standard
+.BR indicators
+available.
+.IP
+.IR "maxint, maxreal, smallreal, pi, maxabschar"
+.br
+.IR "sqrt, exp, ln, nextrandom, random"
+.br
+.IR "cos, arccos, sin, arcsin, tan, arctan"
+.br
+.IR "bitspack, bytespack"
+.br
+.IR "standin channel, standout channel, "
+.IR "standin, standout"
+.br
+.IR "open, establish, associate, close"
+.br
+.IR "put, print, write, get, read"
+.br
+.IR "space, newline, newpage, set, reset"
+.br
+.IR "on logical file end, "
+.IR "on physical file end, on page end"
+.br
+.IR "on line end, maketerm"
+.br
+.IR "chan, char number, line number, page number"
+.br
+.IR "whole, fixed, float"
+.br
+.IR "stop"
+.br
+.IR "REPR, BIN, ENTIER, ROUND, ODD, SIGN, ABS, "
+.IR "LWB, UPB"
+.br
+.IR "RE, IM, ARG, CONJ"
+.br
+.IR "NOT, AND, OR, OVER, MOD, SHL, SHR, I"
+.br
+.IR "+ , - , * , / , % , %* , ^ , ** , +*"
+.br
+.IR "EQ, NE, GE, GT, LE, LT"
+.br
+.IR "= , /= , >= , > , <= , <"
+.br
+.IR "PLUSAB, MINUSAB, TIMESAB, DIVAB, OVERAB, "
+.IR "MODAB, PLUSTO"
+.br
+.IR "+:= , -:= , *:= , /:= , %:= , %*:= , +=:"
+.PP
+.SH PRAGMATS
+The following
+.BR pragmats
+are provided:
+.PD 0
+.IP
+.TP 17
+.IR "PR UPPER PR"
+(enable upper-case stropping)
+.TP
+.IR "PR POINT PR"
+(disable upper-case stropping)
+.br
+Note that point stropping always works (with either case of word).
+The essential difference with upper-case stropping is that upper-case words are
+assumed to be stropped whether a point is present or not. Thus it is always
+possible to write
+.IR ".PR UPPER .PR" ,
+which will be recognised whatever the previous stropping regime.
+.TP
+.IR "PR LIST PR"
+(turn listing on)
+.TP
+.IR "PR NOLIST PR"
+(turn listing off)
+.br
+listings are sent to the .lst file.
+.TP
+.IR "PR PAGE PR"
+(start a new page on the .lst file)
+.TP
+.IR "PR WARN PR"
+(include compile-time warning messages)
+.TP
+.IR "PR NOWARN PR"
+(omit compile-time warning messages)
+.PD
+.PP
+The words within a
+.BR pragmat
+may be in either upper or lower case, and one
+.BR pragmat
+may contain several such words, separated by commas, as in the following
+example which shows the default states.
+.IP
+.IR "PR UPPER, LIST, WARN PR"
+.SH DIAGNOSTICS
+The compile-time error messages are self-explanatory.
+They can be divided into 3 categories:
+.RS
+.br
+Lexcical errors (the offending lexeme is simply ignored)
+.br
+Syntactic errors (text up to the next
+.RI ' ; '
+or
+.RI ' ) ',
+etc. is ignored)
+.br
+Semantic errors.
+.RE
+.br
+After the first syntactic error, further checking for semantic errors is
+inhibited.
+.LP
+On the .lst file,
+a row of "=" indicates parts of the text that have been ignored.
+A "1" under a particular symbol indicates the point where an error was detected
+(a "2" indicates that 2 errors were found there). An "S" ("C", "P") is printed
+in the margin wherever a new line of source text starts within a
+.BR string-denotation
+.RB ( comment ,
+.BR pragmat ).
+Thus mismatched delimiters for these things will readily stand out.
+.LP
+A run-time error message is followed by a print out of the stack, giving the
+line number in each active procedure. For each procedure, the active
+.BR ranges
+are printed, starting from the innermost and finishing with the outermost.
+Within each range, the values ascribed to all identifiers and operators
+(apart from some manifest values) are listed in the order in which they were
+declared in the
+.BR range .
+Names are printed as a "#" followed by a number. Not much significance should
+be attached to these numbers except to note that the same name will always be
+printed as the same number. At the end of each range, the value of any active
+loop counter
+.RI ( .FOR )
+together with its increment and target
+.RI ( .BY
+and
+.IR .TO )
+will be printed.
+.SH ENVIRONMENT ENQUIRIES
+The following figures apply primarily to machines with a wordsize of 32 bits.
+Figures for 16-bit machines are given in parentheses where appropriate.
+.DS
+.IP
+.IR "max int"
+= 2147483647 (32767)
+.br
+.IR "max real"
+= 1.701411733192600E+38 (on the VAX)
+.br
+.IR "small real"
+= 3.469446951953614E-18 (on the VAX)
+.br
+.IR "bits width"
+= 32 (16)
+.br
+.IR "bytes width"
+= 4 (2)
+.br
+.IR "max abs char"
+= 127
+.br
+.IR "null character"
+= NULL
+.RI ( REPR(0) )
+.br
+.IR "int lengths" ,
+.IR "int shorths" ,
+.IR "real lengths" ,
+.IR "real shorths" ,
+.br
+.IR "bits lengths" ,
+.IR "bits shorths" ,
+.br
+.IR "bytes lengths" ,
+.IR "bytes shorths"
+.br
+ all = 1
+.br
+.IR "int width"
+= 10 (5)
+.br
+.IR "real width"
+= 16
+.br
+.IR "exp width"
+= 3
+.br
+.IR "error character"
+= *
+.br
+.IR "flip"
+= T
+.br
+.IR "flop"
+= F
+.br
+On
+.IR "stand in channel" :
+.RS
+.br
+.RS
+.IR "get possible" ,
+.IR "reset possible"
+.RE
+.br
+On
+.IR "stand out channel" :
+.br
+.RS
+.IR "put possible" ,
+.IR "reset possible" ,
+.IR "compressible" ,
+.br
+.IR "estab possible"
+.RE
+.br
+On associated files:
+.br
+.RS
+.IR "get possible" ,
+.IR "put possiblle" ,
+.IR "set possible" ,
+.br
+.IR "reset possible"
+.DE
+.SH FILES
+.ta \w'/EMDISTR/lib/a68/a68s.out 'u
+.PD 0
+~em/bin/a68s
+.br
+~em/bin/indent68
+.br
+~em/lib/em_a68s?? - the compiler
+.br
+~em/lib/em_a68s_init?? - compiler initialization
+.br
+~em/mach/lib/MACH/tail_a68s - runtime library
+.br
+~em/lang/a68s/a68s.1 - this manual
+.SH BUGS
+There is no
+.IR REAL
+arithmetic on the SUNs.
+.LP
+Excessive static nesting (especially with
+.IR ELIF s
+or
+.IR CASE s
+with many alternatives) can exceed certain stack spaces in the compiler.
+.LP
+Dimensions of arrays are limited to 8.
+.LP
+.SH SEE ALSO
+.TP
+ack(I)
+.SH REFERENCES
+.TP
+[1]
+P. G. Hibbard,
+.IR "A Sublanguage of ALGOL 68" ,
+SIGPLAN Notices Vol. 12, No. 5, May 1977.
+.TP
+[2]
+C. H. Lindsey and S. G. van der Meulen,
+.IR "Informal Introduction to ALGOL 68" ,
+North Holland.
+.TP
+[3]
+Wilfred J. Hansen and Hendrik Boom,
+.IR "The Report on the Standard Hardware"
+.IR "Representation for ALGOL 68" ,
+SIGPLAN Notices Vol. 12, No. 5, May 1977.
--- /dev/null
+Makefile
+checkseq.p
+indent.p
+reseq.p
+tailor.p
+xref.c
--- /dev/null
+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
--- /dev/null
+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.
--- /dev/null
+(*$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.
--- /dev/null
+(* 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.
--- /dev/null
+(* 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.
--- /dev/null
+/*
+ * 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);
+}