From: ceriel Date: Tue, 4 Oct 1988 10:33:39 +0000 (+0000) Subject: Initial revision X-Git-Tag: release-5-5~2812 X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=23a7e7b427432d1de56e501e62edcc403e6be206;p=ack.git Initial revision --- diff --git a/lang/a68s/.distr b/lang/a68s/.distr new file mode 100644 index 000000000..2e474efe9 --- /dev/null +++ b/lang/a68s/.distr @@ -0,0 +1,8 @@ +COPYRIGHT +README +a68s.1 +aem +cpem +liba68s +test +util diff --git a/lang/a68s/COPYRIGHT b/lang/a68s/COPYRIGHT new file mode 100644 index 000000000..06477343a --- /dev/null +++ b/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 diff --git a/lang/a68s/README b/lang/a68s/README new file mode 100644 index 000000000..84987da90 --- /dev/null +++ b/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. + diff --git a/lang/a68s/a68s.1 b/lang/a68s/a68s.1 new file mode 100644 index 000000000..833f914f5 --- /dev/null +++ b/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. diff --git a/lang/a68s/util/.distr b/lang/a68s/util/.distr new file mode 100644 index 000000000..0d6c1b50c --- /dev/null +++ b/lang/a68s/util/.distr @@ -0,0 +1,6 @@ +Makefile +checkseq.p +indent.p +reseq.p +tailor.p +xref.c diff --git a/lang/a68s/util/Makefile b/lang/a68s/util/Makefile new file mode 100644 index 000000000..5628454c1 --- /dev/null +++ b/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 diff --git a/lang/a68s/util/checkseq.p b/lang/a68s/util/checkseq.p new file mode 100644 index 000000000..c40a9eb74 --- /dev/null +++ b/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. diff --git a/lang/a68s/util/indent.p b/lang/a68s/util/indent.p new file mode 100644 index 000000000..a3e8f10c8 --- /dev/null +++ b/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 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 CHSTRING 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. diff --git a/lang/a68s/util/reseq.p b/lang/a68s/util/reseq.p new file mode 100644 index 000000000..cb5877b03 --- /dev/null +++ b/lang/a68s/util/reseq.p @@ -0,0 +1,80 @@ +(* reseq.p *) +(* ******* *) + +(* A program to renumber a text file. To use this utility type : + reseq 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 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. diff --git a/lang/a68s/util/tailor.p b/lang/a68s/util/tailor.p new file mode 100644 index 000000000..aed7e2504 --- /dev/null +++ b/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. diff --git a/lang/a68s/util/xref.c b/lang/a68s/util/xref.c new file mode 100644 index 000000000..4f7beb16e --- /dev/null +++ b/lang/a68s/util/xref.c @@ -0,0 +1,775 @@ +/* + * xref makes cross references. + * November 1977 Johan Stevenson + */ + +#include +#include +#include + +/* 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; inext; + 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); +}