Kaynağa Gözat

Initial revision

ceriel 36 yıl önce
ebeveyn
işleme
3ce78f0ae5

+ 8 - 0
lang/a68s/.distr

@@ -0,0 +1,8 @@
+COPYRIGHT
+README
+a68s.1
+aem
+cpem
+liba68s
+test
+util

+ 10 - 0
lang/a68s/COPYRIGHT

@@ -0,0 +1,10 @@
+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

+ 67 - 0
lang/a68s/README

@@ -0,0 +1,67 @@
+			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.
+

+ 418 - 0
lang/a68s/a68s.1

@@ -0,0 +1,418 @@
+.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.

+ 6 - 0
lang/a68s/util/.distr

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

+ 36 - 0
lang/a68s/util/Makefile

@@ -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 - 0
lang/a68s/util/checkseq.p

@@ -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 - 0
lang/a68s/util/indent.p

@@ -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 - 0
lang/a68s/util/reseq.p

@@ -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 - 0
lang/a68s/util/tailor.p

@@ -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 - 0
lang/a68s/util/xref.c

@@ -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);
+}