Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume7/occam.yacc

Text File | 1989-08-11 | 38.0 KB | 2,041 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Brandon S. Allbery - comp.sources.misc)
Subject: v07i125: OCCAM - yacc specification with lexer
Keywords: occam yacc lex
Organization: GEC Hirst Research Centre, Wembley, England. (uk.co.gec-rl-hrc)
Reply-To: [e-mail] (Peter Polkinghorne)

Posting-number: Volume 7, Issue 125
Submitted-by: [e-mail] (Peter Polkinghorne)
Archive-name: occam.yacc

[Which leaves me only one question:  what is OCCAM?  It looks like some kind of
realtime control language (for MIDI?).  ++bsa]

Here is a simple OCCAM yacc specification with lexer. OCCAM & OCCAM2 are
handled. Hope this is the right newsgroup. [It is.  ++bsa]  It is not perfect!

---- Cut Here and unpack ----
#!/bin/sh
# shar:    Shell Archiver  (v1.22)
#
#    Run the following text with /bin/sh to create:
#      README
#      Makefile
#      occam.y
#      occamlex.c
#      occam2.y
#      occam2lex.c
#      test1
#      test2
#      test3
#      test4
#
if test -f README; then echo "File README exists"; else
echo "x - extracting README (Text)"
sed 's/^X//' << 'SHAR_EOF' > README &&
X
XThese are two Occam recognisers, defined with yacc & handcrafted lexers.
XThe Occam recogniser was developed as a lex & yacc learning exercise.
XThe one for Occam is unambiguous. The one for Occam2 is ambiguous and requires
Xwork to tidy up the syntax. This is mainly because the Occam2 definition is a
Xrather unsuited for yacc, as defined by the Occam2 Language definition by David
XMay.
X
XThe most original part of this is the lex routines which deal with Occam's
Xindentation features. These recognisers are offered because periodically
XI see people on the net asking for an Occam lex & yacc definition.
X
XTo build a compiler from this requires a LOT more work. I hope someone
Xfinds this useful, however I do not intend to maintain it. Hence I am
Xplacing this in the public domain.
X
XFiles supplied:
X
XREADME        - this file!
XMakefile    - simple UNIX makefile
X
Xoccam.y        - Occam yacc specification
Xoccamlex.c    - Occam lexer
X
Xoccam2.y    - Occam2 yacc specification
Xoccam2lex.c    - Occam2 lexer
X
Xtest1        )
Xtest2        )- set of Occam test files for occam.
Xtest3        )
Xtest4        )
X
XHave fun!
X
XPeter Polkinghorne ( [e-mail]-rl-hrc or ...!mcvax!ukc!hrc63!pjmp )
XGEC Hirst Research Centre, East Lane, Wembley, Middlesex, UK
X
SHAR_EOF
chmod 0666 README || echo "restore of README fails"
set `wc -c README`;Sum=$1
if test "$Sum" != "1197"
then echo original size 1197, current size $Sum;fi
fi
if test -f Makefile; then echo "File Makefile exists"; else
echo "x - extracting Makefile (Text)"
sed 's/^X//' << 'SHAR_EOF' > Makefile &&
X#
X#    Makefile for occam recogniser - pjmp @ hrc 22/7/86
X#
X
X#
X# This work is in the public domain.
X# It was written by Peter Polkinghorne in 1986 & 1989 at
X# GEC Hirst Research Centre, Wembley, England.
X# No liability is accepted or warranty given by the Author,
X# still less my employers.
X#
X
X# sys V like flags
X#CFLAGS=-g -O
X#YFLAGS=-vdt
X
X# BSD like flags
XCFLAGS=-O
XYFLAGS=-dv
X
Xall:        occam occam2
X
Xoccam:        occam.o occamlex.o
X        cc $(CFLAGS) occam.o occamlex.o -o occam
X
Xoccam.c:        occam.y
X        yacc $(YFLAGS) occam.y
X        mv y.tab.h lex.h
X        mv y.tab.c occam.c
X
Xoccam2:        occam2.o occam2lex.o
X        cc $(CFLAGS) occam2.o occam2lex.o -o occam2
X
Xoccam2.c:       occam2.y
X        yacc $(YFLAGS) occam2.y
X        mv y.tab.h lex2.h
X        mv y.tab.c occam2.c
X
Xclean:
X    rm -f *.o occam2.c occam.c lex2.h lex.h y.output
X
Xshar:        README Makefile occam.y occamlex.c occam2.y occam2lex.c test1 test2 test3 test4
X        shar2 -v -s -x -c README Makefile occam.y occamlex.c occam2.y occam2lex.c test1 test2 test3 test4 > shar
SHAR_EOF
chmod 0666 Makefile || echo "restore of Makefile fails"
set `wc -c Makefile`;Sum=$1
if test "$Sum" != "981"
then echo original size 981, current size $Sum;fi
fi
if test -f occam.y; then echo "File occam.y exists"; else
echo "x - extracting occam.y (Text)"
sed 's/^X//' << 'SHAR_EOF' > occam.y &&
X/*
X *
X *        OCCAM yacc specification
X *
X *        Peter Polkinghorne - GEC Research
X *
X */
X
X/*
X * This work is in the public domain.
X * It was written by Peter Polkinghorne in 1986 & 1989 at
X * GEC Hirst Research Centre, Wembley, England.
X * No liability is accepted or warranty given by the Author,
X * still less my employers.
X */
X
X/* revision history
X    0.0    initial attempt                pjmp    22/7/86
X    0.1    add in COMMA so that yylex can cope with
X        comma differentiation for PROC decls    pjmp    4/8/86
X    0.2    add in main - since BSD does not have -ly
X                            pjmp    8/3/89
X
Xend revisions */
X
X%token        VAR    CHAN    ANY    WAIT    SKIP    ID    EOL
X%token        VALUE    BYTE    DEF    PROC    NOT    NUMBER    BOOL
X%token        NOW    TABLE    BOOLOP    SHIFTOP    COMPOP    CHCON    STR
X%token        LOGOP    SEQ    ALT    IF    PAR    WHILE    FOR
X%token        BEG    END    COMMA
X
X%start        program
X
X%%
X
Xprogram        :    sep process
X        |    process
X        ;
X
Xprocess        :    primitive sep
X        |    ID sep
X        |    ID '(' explist ')' sep
X        |    construct
X        |    declaration ':' sep process
X        |    error sep
X            {
X                yyerrok;
X            }
X        ;
X
Xprimitive    :    assignment
X        |    input
X        |    output
X        |    wait
X        |    skip
X        ;
X
X
Xconstruct    :    SEQ sep BEG proclist END
X        |    SEQ replic sep BEG process END
X        |    SEQ sep
X        |    PAR sep BEG proclist END
X        |    PAR replic sep BEG process END
X        |    PAR sep
X        |    IF sep BEG condlist END
X        |    IF replic sep BEG cond END
X        |    IF sep
X        |    ALT sep BEG guardplist END
X        |    ALT replic sep BEG guardp END
X        |    ALT sep
X        |    WHILE expr sep BEG process END
X        ;
X
Xsep        :    EOL
X        |    sep EOL
X        ;
X
Xproclist    :    process
X        |    proclist process
X        ;
X
Xcondlist    :    cond
X        |    condlist cond
X        ;
X
Xguardplist    :    guardp
X        |    guardplist guardp
X        ;
X
X
Xreplic        :    ID '=' '[' expr FOR expr ']'
X        ;
X
Xcond        :    expr sep BEG process END
X        |    IF sep
X        |    IF sep BEG condlist END
X        |    IF replic sep BEG cond END
X        ;
X
Xguardp        :    guard sep BEG process END
X        |    ALT sep
X        |    ALT sep BEG guardplist END
X        |    ALT replic sep BEG guardp END
X        ;
X
Xguard        :    expr '&' input
X        |    input
X        |    expr '&' wait
X        |    wait
X        |    expr '&' SKIP
X        |    SKIP
X        ;
X
Xdeclaration    :    VAR varlist
X        |    CHAN chanlist
X        |    DEF deflist
X        |    PROC ID '=' sep BEG process END
X        |    PROC ID formparms '=' sep BEG process END
X        ;
X
Xassignment    :    var ':' '=' expr
X        ;
X
Xinput        :    chan '?' inlist
X        |    chan '?' ANY
X        ;
X
Xoutput        :    chan '!' outlist
X        |    chan '!' ANY
X        ;
X
Xwait        :    WAIT expr
X        ;
X
Xskip        :    SKIP
X        ;
X
Xinlist        :    var
X        |    inlist ';' var
X        ;
X
Xoutlist        :    expr
X        |    outlist ';' expr
X        ;
X
Xexplist        :    expr
X        |    explist ',' expr
X        ;
X
Xvarlist        :    var
X        |    varlist ',' var
X        ;
X
Xchanlist    :    chan
X        |    chanlist ',' chan
X        ;
X
Xdeflist        :    def
X        |    deflist ',' def
X        ;
X
Xformparms    :    '(' fparmlist ')'
X        ;
X
Xfparmlist    :    fparm
X        |    fparmlist COMMA fparm
X        ;
X
Xvar        :    ID
X        |    ID subscript
X        ;
X
Xchan        :    ID
X        |    ID '[' expr ']'
X        ;
X
Xdef        :    ID '=' expr
X        |    ID '=' veccon
X        ;
X
Xsubscript    :    '[' expr ']'
X        |    '[' BYTE expr ']'
X        ;
X
X
Xfparm        :    VAR plist
X        |    CHAN plist
X        |    VALUE plist
X        ;
X
Xplist        :    parm
X        |    plist ',' parm
X        ;
X
Xparm        :    ID
X        |    ID '[' ']'
X        ;
X
Xexpr        :    monop element
X        |    element op element
X        |    ellist
X        ;
X
Xellist        :    element
X        |    ellist assop element
X        ;
X
Xmonop        :    '-'
X        |    NOT
X        ;
X
Xelement        :    NUMBER
X        |    BOOL
X        |    NOW
X        |    CHCON
X        |    '(' expr ')'
X        |    item
X        ;
X
Xop        :    arop
X        |    COMPOP
X        |    '='
X        |    SHIFTOP
X        ;
X
Xassop        :    '+'
X        |    '*'
X        |    LOGOP
X        |    BOOLOP
X        ;
X
Xarop        :    '-'
X        |    '/'
X        |    '\\'
X        ;
X
Xitem        :    ID
X        |    ID subscript
X        |    veccon subscript
X        ;
X
Xveccon        :    str
X        |    TABLE '[' BYTE tlist ']'
X        |    TABLE '[' tlist ']'
X        ;
X
X
Xstr        :    STR
X        |    str sep STR
X        ;
X
Xtlist        :    expr
X        |    tlist ',' expr
X        ;
X
X%%
X
X#include <stdio.h>
X
Xvoid main()
X{
X
X    exit( yyparse() );
X
X}/*main*/
X
Xyyerror( str )
Xchar     *str;
X/* our slightly more informative error routine */
X{
X
Xextern int    yylineno;
Xextern char    yytext[];
X
X    fprintf( stderr, "ERROR <%s> near <%s> on line %d\n",
X            str, yytext, yylineno );
X
X}/*yyerror*/
X
X/*end occam.y*/
SHAR_EOF
chmod 0666 occam.y || echo "restore of occam.y fails"
set `wc -c occam.y`;Sum=$1
if test "$Sum" != "3693"
then echo original size 3693, current size $Sum;fi
fi
if test -f occamlex.c; then echo "File occamlex.c exists"; else
echo "x - extracting occamlex.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > occamlex.c &&
X/*
X *    OCCAM lexical analysis routine
X *
X *    pjmp    HRC    31/7/86
X *
X */
X
X/*
X * This work is in the public domain.
X * It was written by Peter Polkinghorne in 1986 & 1989 at
X * GEC Hirst Research Centre, Wembley, England.
X * No liability is accepted or warranty given by the Author,
X * still less my employers.
X */
X
X/* revision history
X
X    0.0    first release                    pjmp    31/7/86
X    0.1    make yylex more rational - common exit        pjmp    1/8/86
X    0.2    add in comma differentiation - for proc decl    pjmp    4/8/86
X
Xend revisions */
X
X#include <stdio.h>
X#include <ctype.h>
X#include "lex.h"
X
X#define    MAXLINE    256
X
X#define    TRUE    1
X#define    FALSE    0
X
X/************************************************************************/
X/* reserved word list - ordered for binary chomp */
X
Xstatic struct reserv { char * word; int tok, len; } rlist[] = {
X        "AFTER",    COMPOP,    5,
X        "ALT",        ALT,    3,
X        "AND",        BOOLOP,    3,
X        "ANY",        ANY,    3,
X        "BYTE",        BYTE,    4,
X        "CHAN",        CHAN,    4,
X        "DEF",        DEF,    3,
X        "FALSE",    BOOL,    5,
X        "FOR",        FOR,    3,
X        "IF",        IF,    2,
X        "NOT",        NOT,    3,
X        "NOW",        NOW,    3,
X        "OR",        BOOLOP,    2,
X        "PAR",        PAR,    3,
X        "PROC",        PROC,    4,
X        "SEQ",        SEQ,    3,
X        "SKIP",        SKIP,    4,
X        "TABLE",    TABLE,    5,
X        "TRUE",        BOOL,    5,
X        "VALUE",    VALUE,    5,
X        "VAR",        VAR,    3,
X        "WAIT",        WAIT,    4,
X        "WHILE",    WHILE,    5,
X        0,        0,    0
X
X    };
X
X/************************************************************************/
X
Xstatic    char    line[MAXLINE];    /* where we store the input, line as a time */
X
Xchar    yytext[MAXLINE];    /* where we store text associated with token */
X
Xint    yylineno=1,        /* line number of input */
X    yylen;            /* amount of text stored */
X
Xstatic    int    llen,        /* how much in line */
X        curind,        /* current indentation */
X        indent=0;    /* this lines indent */
X        ldebug = TRUE,    /* set to TRUE for debug */
X        index;        /* where we are in the line */
X
X/* state we are in: either start - get new input, decide what next
X            ind - processing indentation
X            rest - processing some occam stmt
X            eof - tidy up processing
X*/
X
Xstatic    enum    lexstate { Start, Ind, Rest, Eof } state = Start;
X
X/************************************************************************/
X
Xyylex()
X/* this function returns the next token (defined by lex.h), a character
Xvalue or 0 for end of input. The tokens are defined by standard input
X*/
X{
X    int    tok = -1,    /* token to return - init to impossible value */
X        sind = index;    /* start of input being processed */
X
X/* go round and round until token to return */
X    while ( tok < 0  ) {
X
X/* decide by state */
X    switch (state) {
X
X        case Start: {
X/*grab some more line */
X            if ( fgets( line, MAXLINE-1, stdin ) == NULL ) {
X                state = Eof;
X                break;
X
X            } else if ( (llen=strlen(line)) >= MAXLINE-1 ) {
X                fprintf( stderr,
X                    "line <%s> longer than %d\n",
X                    line, MAXLINE-1 );
X                exit( 1 );
X            }/*if*/
X
X            index = 0;
X            sind = 0;
X            indent = 0;
X
X
X/* if blank line OR has just comment skip, otherwise got to appropriate state */
X
X            if ( m_nulline() ) {
X                /* do nowt */
X
X            } else if ( line[0]==' ' && line[1]==' ' ) {
X                state = Ind;
X
X            } else {
X                state = Rest;
X
X            }/*if*/
X
X        break;}/*Start*/
X
X        case Ind: {
X/* work out indentation */
X            if ( line[index]==' ' && line[index+1]==' ' ) {
X                indent++;
X                index+=2;
X                sind+=2;
X            } else {
X                state = Rest;
X
X            }/*if*/
X
X        break;}/*Ind*/
X
X        case Rest: {
X/* do we have some indentation to adjust for ... */
X            if ( curind > indent ) {
X                curind--;
X                tok = END;
X                break;
X
X            } else if ( curind < indent ) {
X                curind++;
X                tok = BEG;
X                break;
X
X            }/*if*/
X
X/* process ch as appropriate */
X            switch ( line[index] ) {
X
X/* space ignored */
X                case ' ': {
X                    sind++;
X                    index++;
X                break;}
X
X/* eol change state again */
X                case '\n': {
X                    yylineno++;
X                    index++;
X                    state = Start;
X                    tok = EOL;
X                break;}
X
X/* - a comment perhaps OR just itself */
X                case '-': {
X                    if ( line[index+1] == '-' ) {
X                        index = llen+1;
X                        state = Start;
X                        tok = EOL;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X                break;}
X
X                case '<': {
X                    if ( line[index+1] == '<' ) {
X                        index+=2;
X                        tok = SHIFTOP;
X
X                    } else {
X                        if ( line[index+1] == '=' ||
X                            line[index+1] == '>' ) {
X                            index++;
X                        }/*if*/
X                        index++;
X                        tok = COMPOP;
X                    }/*if*/
X                break;}
X
X                case '>': {
X                    if ( line[index+1] == '>' ) {
X                        index+=2;
X                        tok = SHIFTOP;
X
X                    } else if ( line[index+1] == '<' ) {
X                        index+=2;
X                        tok = LOGOP;
X
X                    } else {
X                        if ( line[index+1] == '=' ) {
X                            index++;
X                        }/*if*/
X                        index++;
X                        tok = COMPOP;
X                    }/*if*/
X
X                break;}
X
X                case '/': {
X                    if ( line[index+1] == '\\' ) {
X                        index+=2;
X                        tok = LOGOP;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X                break;}
X
X                case '\\': {
X                    if ( line[index+1] == '/' ) {
X                        index+=2;
X                        tok = LOGOP;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X                break;}
X
X                case '#': {
X                    if ( isxdigit( line[index+1] ) ) {
X/* gobble up hex digits */
X                        index++;
X                        while ( isxdigit(line[index]) ){
X                            index++;
X                        }/*while*/
X
X                        tok = NUMBER;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X
X                break;}
X
X                case '\'': {
X                    if ( line[index+1] != '*'
X                         && line[index+2] == '\'' ) {
X
X                        index+=3;
X                        tok = CHCON;
X
X                    } else if ( line[index+1] == '*'
X                         && line[index+2] != '#'
X                         && line[index+3] == '\'' ) {
X
X                        index+=4;
X                        tok = CHCON;
X
X                    } else if ( line[index+1] == '*'
X                         && line[index+2] == '#'
X                         && isxdigit( line[index+3] )
X                         && isxdigit( line[index+4] )
X                         && line[index+5] == '\'' ) {
X
X                        index+=6;
X                        tok = CHCON;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X
X                break;}
X
X
X                case '"': {
X                    int    lindex=index+1;
X
X                    while ( line[lindex] != '"'
X                         && lindex <= llen ) {
X                        lindex++;
X                    }/*while*/
X
X                    if ( line[lindex] == '"' ) {
X                        index = lindex+1;
X                        tok = STR;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X
X                break;}
X
X/* do extra look ahead that yacc can not do for CHAN | VAR | VALUE */
X                case ',': {
X                    int    lindex=index+1;
X
X                    while ( line[lindex] == ' ' ) {
X                        lindex++;
X                    }/*while*/
X
X                    if ( strncmp(&line[lindex], "CHAN", 4)
X                         == 0
X                       || strncmp(&line[lindex], "VAR", 3)
X                         == 0
X                       || strncmp(&line[lindex], "VALUE", 5)
X                         == 0 ) {
X
X                        index++;
X                        tok = COMMA;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X
X                break;}
X
X/* oh well pass back to yacc & let it cope  - if not digit or alpha */
X                default: {
X                    if ( isdigit( line[index] ) ) {
X/* gobble up digits */
X                        index++;
X                        while ( isdigit(line[index]) ){
X                            index++;
X                        }/*while*/
X
X                        tok = NUMBER;
X                        break;
X
X                    } else if ( isalpha( line[index] ) ) {
X                        int    i, wlen = 1;
X                        index++;
X/* gobble up associated chs */
X                        while ( isalpha( line[index] )
X                            || isdigit( line[index])
X                            || line[index] == '.' ){
X                            wlen++;
X                            index++;
X                        }/*while*/
X
X/* now check against reserved word list */
X                        for ( i=0;
X                             rlist[i].word != NULL;
X                            i++ ) {
X
X                            if ( rlist[i].len
X                                != wlen ) {
X                                continue;
X                            }/*if*/
X
X                            if ( strncmp(
X                              &line[index-wlen],
X                              rlist[i].word,
X                              wlen ) == 0 ) {
X
X                             tok = rlist[i].tok;
X                             break;
X                            }/*if*/
X                        }/*for*/
X
X/* not a reserved word */
X                        if ( tok < 0 ) {
X                            tok = ID;
X                        }/*if*/
X                        break;
X
X                    }/*if*/
X
X                    tok = line[index++];
X
X                break;}/*default*/
X
X            }/*switch*/
X
X        break;}/*Rest*/
X
X        case Eof: {
X/* do we have some indentation to adjust for ... */
X            if ( curind > 0 ) {
X                curind--;
X                tok = END;
X            } else {
X                tok = 0;
X            }/*if*/
X
X
X        break;}/*Eof*/
X
X
X    }/*switch*/
X
X    }/*while*/
X
X/* return whats required after setting yytext etc */
X    if ( index > sind ) {
X        int    i;
X        yylen = index - sind;
X
X        for ( i = 0; i < yylen; i++ ) {
X            yytext[i] = line[sind+i];
X        }/*for*/
X
X        yytext[yylen] = '\0';
X
X    } else {
X        yylen = 0;
X        yytext[0] = '\0';
X
X    }/*if*/
X
X/* debug report */
X    if ( ldebug ) {
X        fprintf( stderr, "yylex: token %d <%s>\n", tok, yytext );
X    }/*if*/
X
X    return( tok );
X
X}/*yylex*/
X
X/*************************************************************************/
X
Xm_nulline()
X/* return true if a null line */
X{
X
X    int    lindex=index;    /* local index */
X
X/* tramp thru spaces */
X    while ( line[lindex] == ' ' ) {
X        lindex++;
X    }/*while*/
X
X/* any comment ? */
X    if ( line[lindex] == '-' && line[lindex+1] == '-' ) {
X        yylineno++;
X        return( TRUE );
X
X/* or we got to the end of the line */
X    } else if ( line[lindex]== '\n' ) {
X        yylineno++;
X        return( TRUE );
X
X    }/*if*/
X
X    return( FALSE );
X
X}/*m_nulline*/
X
X/* end occamlex.c */
SHAR_EOF
chmod 0666 occamlex.c || echo "restore of occamlex.c fails"
set `wc -c occamlex.c`;Sum=$1
if test "$Sum" != "8622"
then echo original size 8622, current size $Sum;fi
fi
if test -f occam2.y; then echo "File occam2.y exists"; else
echo "x - extracting occam2.y (Text)"
sed 's/^X//' << 'SHAR_EOF' > occam2.y &&
X/*
X *
X *        OCCAM2 yacc specification
X *
X *        Peter Polkinghorne - GEC Research
X *
X */
X
X/*
X * This work is in the public domain.
X * It was written by Peter Polkinghorne in 1986 & 1989 at
X * GEC Hirst Research Centre, Wembley, England.
X * No liability is accepted or warranty given by the Author,
X * still less my employers.
X */
X
X/* revision history
X    0.0    initial attempt                pjmp    9/3/89
X
Xend revisions */
X
X%token        VAR    CHAN    ANY    SKIP    ID    EOL
X%token        VALUE    BYTE    DEF    PROC    NOT    NUMBER    BOOL
X%token        NOW    TABLE    BOOLOP    SHIFTOP    COMPOP    CHCON    STR
X%token        LOGOP    SEQ    ALT    IF    PAR    WHILE    FOR
X%token        OF    SIZE    TRUNC    ROUND    MOSTNEG    MOSTPOS    RNUMBER
X%token        STOP    CASE    ELSE    IS    VAL    FROM    PROTOCOL
X%token        INT    INT16    INT32    INT64    REAL    REAL32    REAL64
X%token        PLACE    AT    PLACED    PROCESSOR    FUNCTION
X%token        AFTER    RETYPES    VALOF    RESULT    PORT    PRI
X%token        BEG    END    TO    TIMER
X
X%start        program
X
X%%
X
Xprogram        :    sep process
X        |    process
X        ;
X
Xprocess        :    action sep
X        |    SKIP sep
X        |    STOP sep
X        |    CASE selector sep
X        |    CASE selector sep BEG selectlist END
X        |    construct
X        |    instance
X        |    specification sep process
X        |    caseinput
X        |    allocation sep process
X        |    error sep
X            {
X                yyerrok;
X            }
X        ;
X
Xaction        :    assignment
X        |    input
X        |    output
X        ;
X
Xallocation    :    PLACE ID AT expr ':'
X        ;
X
Xselectlist    :    select
X        |    selectlist select
X        ;
X
Xselect        :    expr sep BEG process END
X        |    ELSE sep BEG process END
X        ;
X
Xselector    :    expr
X        ;
X
Xconstruct    :    sequence
X        |    parallel
X        |    conditional
X        |    alternation
X        |    loop
X        ;
X
Xinstance    :    ID '(' actualist ')' sep
X        |    ID '(' ')' sep
X        ;
X
Xactualist    :    actual
X        |    actualist comma actual
X        ;
X
Xactual        :    element
X        |    expr
X        ;
X
Xsequence    :    SEQ sep BEG proclist END
X        |    SEQ replic sep BEG process END
X        |    SEQ sep
X        ;
X
Xparallel    :    PAR sep BEG proclist END
X        |    PAR replic sep BEG process END
X        |    PAR sep
X        |    PRI PAR sep BEG proclist END
X        |    PRI PAR replic sep BEG process END
X        |    PRI PAR sep
X        |    PLACED PAR sep BEG placelist END
X        |    PLACED PAR replic sep BEG placement END
X        |    PLACED PAR sep
X        ;
X
Xconditional    :    IF sep BEG choicelist END
X        |    IF replic sep BEG choice END
X        |    IF sep
X        ;
X
Xalternation    :    ALT sep BEG alternativelist END
X        |    ALT replic sep BEG alternative END
X        |    ALT sep
X        |    PRI ALT sep BEG alternativelist END
X        |    PRI ALT replic sep BEG alternative END
X        |    PRI ALT sep
X        ;
X
Xloop        :    WHILE expr sep BEG process END
X        ;
X
Xsep        :    EOL
X        |    sep EOL
X        ;
X
Xcomma        :    ',' EOL
X        |    ','
X        ;
X
Xsemicolon    :    ';' EOL
X        |    ';'
X        ;
X
Xproclist    :    process
X        |    proclist process
X        ;
X
Xchoicelist    :    choice
X        |    choicelist choice
X        ;
X
Xplacelist    :    placement
X        |    placelist placement
X        ;
X
Xalternativelist    :    alternative
X        |    alternativelist alternative
X        ;
X
X
Xreplic        :    ID '=' base FOR count
X        ;
X
Xbase        :    expr
X        ;
X
Xcount        :    expr
X        ;
X
Xchoice        :    boolean sep BEG process END
X        |    specification sep choice
X        |    conditional
X        ;
X
Xplacement    :    PROCESSOR expr sep BEG process END
X        ;
X
Xalternative    :    guard sep BEG process END
X        |    specification sep alternative
X        |    alternation
X        ;
X
Xguard        :    boolean '&' input
X        |    input
X        |    boolean '&' SKIP
X        ;
X
Xspecification    :    declaration
X        |    abbreviation
X        |    definition
X        ;
X
Xdeclaration    :    type namelist ':'
X        ;
X
Xnamelist    :    ID
X        |    namelist comma ID
X        ;
X
Xabbreviation    :    specifier ID IS element ':'
X        |    VAL specifier ID IS element ':'
X        |    ID IS element ':'
X        |    VAL ID IS element ':'
X        ;
X
Xspecifier    :    primtype
X        |    '['']' specifier
X        |    '[' expr ']' specifier
X        ;
X
Xdefinition    :    PROTOCOL ID IS simpleproto ':'
X        |    PROTOCOL ID IS seqproto ':'
X        |    PROTOCOL ID sep BEG CASE sep END ':'
X        |    PROTOCOL ID sep BEG CASE sep BEG tagprotolist END END ':'
X        |    PROC ID '(' fparmlist ')' sep BEG process END ':'
X        |    PROC ID '(' ')' sep BEG process END ':'
X        |    typelist FUNCTION ID '(' fparmlist ')' sep BEG valof END ':'
X        |    typelist FUNCTION ID '(' ')' sep BEG valof END ':'
X        |    typelist FUNCTION ID '(' fparmlist ')' IS explist ':'
X        |    typelist FUNCTION ID '(' ')' IS explist ':'
X        |    specifier ID RETYPES element ':'
X        |    VAL specifier ID RETYPES expr ':'
X        ;
X
Xsimpleproto    :    type
X        |    type ':' ':' '[' ']' type
X        ;
X
Xseqproto    :    simpleproto
X        |    seqproto semicolon simpleproto
X        ;
X
Xtagprotolist    :    tagproto
X        |    tagprotolist sep tagproto
X        ;
X
Xtagproto    :    tag
X        |    tag semicolon protocol
X        ;
X
Xtag        :    ID
X        ;
X
Xprotocol    :    ANY
X        |    ID
X        |    simpleproto
X        ;
X
Xassignment    :    varlist ':' '=' explist
X        ;
X
Xinput        :    chan '?' inlist
X        |    chan '?' CASE taggedlist
X        |    port '?' var
X        |    timer '?' var
X        |    timer '?' AFTER expr
X        ;
X
Xcaseinput    :    chan '?' CASE sep
X        |    chan '?' CASE sep BEG variantlist END
X        ;
X
Xtaggedlist    :    tag
X        |    tag semicolon inlist
X        ;
X
Xvariantlist    :    variant
X        |    variantlist sep variant
X        ;
X
Xvariant        :    taggedlist sep BEG process END
X        |    specification sep variant
X        ;
X
Xoutput        :    chan '!' outlist
X        |    chan '!' tag
X        |    chan '!' tag semicolon outlist
X        |    port '!' element
X        |    port '!' expr
X        ;
X
Xinlist        :    var
X        |    var ':' ':' var
X        |    inlist semicolon var
X        ;
X
Xoutlist        :    expr
X        |    expr ':' ':' expr
X        |    outlist semicolon expr
X        ;
X
Xexplist        :    expr
X        |    explist comma expr
X        |    '(' valof sep ')'
X        |    ID '(' explist ')'
X        |    ID '(' ')'
X        ;
X
Xvarlist        :    var
X        |    varlist comma var
X        ;
X
Xtypelist    :    type
X        |    typelist comma type
X        ;
X
Xfparmlist    :    fparm
X        |    fparmlist comma fparm
X        ;
X
Xfparm        :    specifier ID
X        |    VAL specifier ID
X        ;
X
Xvar        :    element
X        ;
X
Xtimer        :    element
X        ;
X
Xchan        :    element
X        ;
X
Xport        :    element
X        ;
X
Xelement        :    ID
X        |    element '[' subscript ']'
X        |    '[' element FROM subscript TO subscript ']'
X        ;
X
Xsubscript    :    expr
X        ;
X
Xexpr        :    monop operand
X        |    operand dyop operand
X        |    monop sep operand
X        |    operand dyop sep operand
X        |    operand
X        |    conversion
X        |    MOSTPOS type
X        |    MOSTNEG type
X        ;
X
Xoperand        :    element
X        |    literal
X        |    '(' expr ')'
X        |    '[' explist ']'
X        |    '(' valof sep ')'
X        |    ID '(' explist ')'
X        |    ID '(' ')'
X        ;
X
Xconversion    :    type operand
X        |    type ROUND operand
X        |    type TRUNC operand
X        ;
X
Xmonop        :    '-'
X        |    NOT
X        |    SIZE
X        |    '~'
X        ;
X
Xliteral        :    NUMBER
X        |    BOOL
X        |    RNUMBER
X        |    CHCON
X        |    STR
X        |    NUMBER '(' type ')'
X        |    RNUMBER '(' type ')'
X        |    CHCON '(' type ')'
X        ;
X
Xdyop        :    COMPOP
X        |    '='
X        |    SHIFTOP
X        |    '+'
X        |    '*'
X        |    LOGOP
X        |    BOOLOP
X        |    '-'
X        |    '/'
X        |    '\\'
X        ;
X
Xvalof        :    VALOF sep BEG process RESULT explist sep END
X        |    specification sep valof
X        ;
X
Xtype        :    primtype
X        |    arrtype
X        ;
X
Xprimtype    :    CHAN OF protocol
X        |    PORT OF type
X        |    TIMER
X        |    BOOL
X        |    BYTE
X        |    INT
X        |    INT16
X        |    INT32
X        |    INT64
X        |    REAL32
X        |    REAL64
X        ;
X
Xarrtype        :    '[' expr ']' type
X        ;
X
Xboolean        :    expr
X        ;
X
X%%
X
X#include <stdio.h>
X
Xvoid main()
X{
X
X    exit( yyparse() );
X
X}/*main*/
X
Xyyerror( str )
Xchar     *str;
X/* our slightly more informative error routine */
X{
X
Xextern int    yylineno;
Xextern char    yytext[];
X
X    fprintf( stderr, "ERROR <%s> near <%s> on line %d\n",
X            str, yytext, yylineno );
X
X}/*yyerror*/
X
X/*end occam.y*/
SHAR_EOF
chmod 0666 occam2.y || echo "restore of occam2.y fails"
set `wc -c occam2.y`;Sum=$1
if test "$Sum" != "6613"
then echo original size 6613, current size $Sum;fi
fi
if test -f occam2lex.c; then echo "File occam2lex.c exists"; else
echo "x - extracting occam2lex.c (Text)"
sed 's/^X//' << 'SHAR_EOF' > occam2lex.c &&
X/*
X *    OCCAM2 lexical analysis routine
X *
X *    pjmp    HRC    9/3/89
X *
X */
X
X/*
X * This work is in the public domain.
X * It was written by Peter Polkinghorne in 1986 & 1989 at
X * GEC Hirst Research Centre, Wembley, England.
X * No liability is accepted or warranty given by the Author,
X * still less my employers.
X */
X
X/* revision history
X
X    0.0    first release                    pjmp    9/3/89
X
Xend revisions */
X
X#include <stdio.h>
X#include <ctype.h>
X#include "lex2.h"
X
X#define    MAXLINE    256
X
X#define    TRUE    1
X#define    FALSE    0
X
X/************************************************************************/
X/* reserved word list - ordered for binary chomp */
X
Xstatic struct reserv { char * word; int tok, len; } rlist[] = {
X        "AFTER",    AFTER,    5,
X        "ALT",        ALT,    3,
X        "AND",        BOOLOP,    3,
X        "ANY",        ANY,    3,
X        "AT",        AT,    2,
X        "BYTE",        BYTE,    4,
X        "CASE",        CASE,    4,
X        "CHAN",        CHAN,    4,
X        "DEF",        DEF,    3,
X        "ELSE",        ELSE,    4,
X        "FALSE",    BOOL,    5,
X        "FOR",        FOR,    3,
X        "FROM",        FROM,    4,
X        "FUNCTION",    FUNCTION,    8,
X        "IF",        IF,    2,
X        "INT",        INT,    3,
X        "INT16",    INT16,    5,
X        "INT32",    INT32,    5,
X        "INT64",    INT64,    5,
X        "IS",        IS,    2,
X        "MOSTNEG",    MOSTNEG,7,
X        "MOSTPOS",    MOSTPOS,7,
X        "NOT",        NOT,    3,
X        "NOW",        NOW,    3,
X        "OR",        BOOLOP,    2,
X        "OF",        OF,    2,
X        "PAR",        PAR,    3,
X        "PLACE",    PLACE,    5,
X        "PLACED",    PLACED,    6,
X        "PORT",        PORT,    4,
X        "PRI",        PRI,    3,
X        "PROC",        PROC,    4,
X        "PROCESSOR",    PROCESSOR,    9,
X        "PROTOCOL",    PROTOCOL,    8,
X        "ROUND",    ROUND,    5,
X        "REAL",        REAL,    4,
X        "REAL32",    REAL32,    6,
X        "REAL64",    REAL64,    6,
X        "RESULT",    RESULT,    6,
X        "RETYPES",    RETYPES,    7,
X        "SEQ",        SEQ,    3,
X        "SIZE",        SIZE,    4,
X        "SKIP",        SKIP,    4,
X        "STOP",        STOP,    4,
X        "TABLE",    TABLE,    5,
X        "TIMER",    TIMER,    5,
X        "TO",        TO,    2,
X        "TRUE",        BOOL,    4,
X        "TRUNC",    TRUNC,    5,
X        "VALUE",    VALUE,    5,
X        "VAL",        VAL,    3,
X        "VALOF",    VALOF,    5,
X        "VAR",        VAR,    3,
X        "WHILE",    WHILE,    5,
X        0,        0,    0
X
X    };
X
X/************************************************************************/
X
Xstatic    char    line[MAXLINE];    /* where we store the input, line as a time */
X
Xchar    yytext[MAXLINE];    /* where we store text associated with token */
X
Xint    yylineno=1,        /* line number of input */
X    yylen;            /* amount of text stored */
X
Xstatic    int    llen,        /* how much in line */
X        curind,        /* current indentation */
X        indent=0;    /* this lines indent */
X        ldebug = TRUE,    /* set to TRUE for debug */
X        index;        /* where we are in the line */
X
X/* state we are in: either start - get new input, decide what next
X            ind - processing indentation
X            rest - processing some occam stmt
X            eof - tidy up processing
X*/
X
Xstatic    enum    lexstate { Start, Ind, Rest, Eof } state = Start;
X
X/************************************************************************/
X
Xyylex()
X/* this function returns the next token (defined by lex.h), a character
Xvalue or 0 for end of input. The tokens are defined by standard input
X*/
X{
X    int    tok = -1,    /* token to return - init to impossible value */
X        sind = index;    /* start of input being processed */
X
X/* go round and round until token to return */
X    while ( tok < 0  ) {
X
X/* decide by state */
X    switch (state) {
X
X        case Start: {
X/*grab some more line */
X            if ( fgets( line, MAXLINE-1, stdin ) == NULL ) {
X                state = Eof;
X                break;
X
X            } else if ( (llen=strlen(line)) >= MAXLINE-1 ) {
X                fprintf( stderr,
X                    "line <%s> longer than %d\n",
X                    line, MAXLINE-1 );
X                exit( 1 );
X            }/*if*/
X
X            index = 0;
X            sind = 0;
X            indent = 0;
X
X
X/* if blank line OR has just comment skip, otherwise got to appropriate state */
X
X            if ( m_nulline() ) {
X                /* do nowt */
X
X            } else if ( line[0]==' ' && line[1]==' ' ) {
X                state = Ind;
X
X            } else {
X                state = Rest;
X
X            }/*if*/
X
X        break;}/*Start*/
X
X        case Ind: {
X/* work out indentation */
X            if ( line[index]==' ' && line[index+1]==' ' ) {
X                indent++;
X                index+=2;
X                sind+=2;
X            } else {
X                state = Rest;
X
X            }/*if*/
X
X        break;}/*Ind*/
X
X        case Rest: {
X/* do we have some indentation to adjust for ... */
X            if ( curind > indent ) {
X                curind--;
X                tok = END;
X                break;
X
X            } else if ( curind < indent ) {
X                curind++;
X                tok = BEG;
X                break;
X
X            }/*if*/
X
X/* process ch as appropriate */
X            switch ( line[index] ) {
X
X/* space ignored */
X                case ' ': {
X                    sind++;
X                    index++;
X                break;}
X
X/* eol change state again */
X                case '\n': {
X                    yylineno++;
X                    index++;
X                    state = Start;
X                    tok = EOL;
X                break;}
X
X/* - a comment perhaps OR just itself */
X                case '-': {
X                    if ( line[index+1] == '-' ) {
X                        index = llen+1;
X                        state = Start;
X                        tok = EOL;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X                break;}
X
X                case '<': {
X                    if ( line[index+1] == '<' ) {
X                        index+=2;
X                        tok = SHIFTOP;
X
X                    } else {
X                        if ( line[index+1] == '=' ||
X                            line[index+1] == '>' ) {
X                            index++;
X                        }/*if*/
X                        index++;
X                        tok = COMPOP;
X                    }/*if*/
X                break;}
X
X                case '>': {
X                    if ( line[index+1] == '>' ) {
X                        index+=2;
X                        tok = SHIFTOP;
X
X                    } else if ( line[index+1] == '<' ) {
X                        index+=2;
X                        tok = LOGOP;
X
X                    } else {
X                        if ( line[index+1] == '=' ) {
X                            index++;
X                        }/*if*/
X                        index++;
X                        tok = COMPOP;
X                    }/*if*/
X
X                break;}
X
X                case '/': {
X                    if ( line[index+1] == '\\' ) {
X                        index+=2;
X                        tok = LOGOP;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X                break;}
X
X                case '\\': {
X                    if ( line[index+1] == '/' ) {
X                        index+=2;
X                        tok = LOGOP;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X                break;}
X
X                case '#': {
X                    if ( isxdigit( line[index+1] ) ) {
X/* gobble up hex digits */
X                        index++;
X                        while ( isxdigit(line[index]) ){
X                            index++;
X                        }/*while*/
X
X                        tok = NUMBER;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X
X                break;}
X
X                case '\'': {
X                    if ( line[index+1] != '*'
X                         && line[index+2] == '\'' ) {
X
X                        index+=3;
X                        tok = CHCON;
X
X                    } else if ( line[index+1] == '*'
X                         && line[index+2] != '#'
X                         && line[index+3] == '\'' ) {
X
X                        index+=4;
X                        tok = CHCON;
X
X                    } else if ( line[index+1] == '*'
X                         && line[index+2] == '#'
X                         && isxdigit( line[index+3] )
X                         && isxdigit( line[index+4] )
X                         && line[index+5] == '\'' ) {
X
X                        index+=6;
X                        tok = CHCON;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X
X                break;}
X
X
X                case '"': {
X                    int    lindex=index+1;
X
X                    while ( line[lindex] != '"'
X                         && lindex <= llen ) {
X                        lindex++;
X                    }/*while*/
X
X                    if ( line[lindex] == '"' ) {
X                        index = lindex+1;
X                        tok = STR;
X
X                    } else {
X                        tok = line[index++];
X
X                    }/*if*/
X
X                break;}
X
X/* oh well pass back to yacc & let it cope  - if not digit or alpha */
X                default: {
X                    if ( isdigit( line[index] ) ) {
X/* gobble up digits */
X                        index++;
X                        while ( isdigit(line[index]) ){
X                            index++;
X                        }/*while*/
X
X                        tok = NUMBER;
X                        break;
X
X                    } else if ( isalpha( line[index] ) ) {
X                        int    i, wlen = 1;
X                        index++;
X/* gobble up associated chs */
X                        while ( isalpha( line[index] )
X                            || isdigit( line[index])
X                            || line[index] == '.' ){
X                            wlen++;
X                            index++;
X                        }/*while*/
X
X/* now check against reserved word list */
X                        for ( i=0;
X                             rlist[i].word != NULL;
X                            i++ ) {
X
X                            if ( rlist[i].len
X                                != wlen ) {
X                                continue;
X                            }/*if*/
X
X                            if ( strncmp(
X                              &line[index-wlen],
X                              rlist[i].word,
X                              wlen ) == 0 ) {
X
X                             tok = rlist[i].tok;
X                             break;
X                            }/*if*/
X                        }/*for*/
X
X/* not a reserved word */
X                        if ( tok < 0 ) {
X                            tok = ID;
X                        }/*if*/
X                        break;
X
X                    }/*if*/
X
X                    tok = line[index++];
X
X                break;}/*default*/
X
X            }/*switch*/
X
X        break;}/*Rest*/
X
X        case Eof: {
X/* do we have some indentation to adjust for ... */
X            if ( curind > 0 ) {
X                curind--;
X                tok = END;
X            } else {
X                tok = 0;
X            }/*if*/
X
X
X        break;}/*Eof*/
X
X
X    }/*switch*/
X
X    }/*while*/
X
X/* return whats required after setting yytext etc */
X    if ( index > sind ) {
X        int    i;
X        yylen = index - sind;
X
X        for ( i = 0; i < yylen; i++ ) {
X            yytext[i] = line[sind+i];
X        }/*for*/
X
X        yytext[yylen] = '\0';
X
X    } else {
X        yylen = 0;
X        yytext[0] = '\0';
X
X    }/*if*/
X
X/* debug report */
X    if ( ldebug ) {
X        fprintf( stderr, "yylex: token %d <%s>\n", tok, yytext );
X    }/*if*/
X
X    return( tok );
X
X}/*yylex*/
X
X/*************************************************************************/
X
Xm_nulline()
X/* return true if a null line */
X{
X
X    int    lindex=index;    /* local index */
X
X/* tramp thru spaces */
X    while ( line[lindex] == ' ' ) {
X        lindex++;
X    }/*while*/
X
X/* any comment ? */
X    if ( line[lindex] == '-' && line[lindex+1] == '-' ) {
X        yylineno++;
X        return( TRUE );
X
X/* or we got to the end of the line */
X    } else if ( line[lindex]== '\n' ) {
X        yylineno++;
X        return( TRUE );
X
X    }/*if*/
X
X    return( FALSE );
X
X}/*m_nulline*/
X
X/* end occam2lex.c */
SHAR_EOF
chmod 0666 occam2lex.c || echo "restore of occam2lex.c fails"
set `wc -c occam2lex.c`;Sum=$1
if test "$Sum" != "8696"
then echo original size 8696, current size $Sum;fi
fi
if test -f test1; then echo "File test1 exists"; else
echo "x - extracting test1 (Text)"
sed 's/^X//' << 'SHAR_EOF' > test1 &&
XSEQ
X  fred:=0
SHAR_EOF
chmod 0666 test1 || echo "restore of test1 fails"
set `wc -c test1`;Sum=$1
if test "$Sum" != "14"
then echo original size 14, current size $Sum;fi
fi
if test -f test2; then echo "File test2 exists"; else
echo "x - extracting test2 (Text)"
sed 's/^X//' << 'SHAR_EOF' > test2 &&
XVAR volume:
XSEQ
X  volume:=0
X  WHILE TRUE
X    ALT
X      louder?ANY
X         SEQ
X           volume:=volume+1
X           amplifier!volume
X      softer?ANY
X         SEQ
X           volume:=volume-1
X           amplifier!volume
SHAR_EOF
chmod 0666 test2 || echo "restore of test2 fails"
set `wc -c test2`;Sum=$1
if test "$Sum" != "221"
then echo original size 221, current size $Sum;fi
fi
if test -f test3; then echo "File test3 exists"; else
echo "x - extracting test3 (Text)"
sed 's/^X//' << 'SHAR_EOF' > test3 &&
X  -- this is a comprehensive exercise of occam syntax
X        -- pjmp @ hrc 31/7/86
XVAR fred, joe[BYTE - #fAf], bill[ (20>>2)/\#0F]:
XVAR heinz:
XCHAN mary,jane[TRUE]:
XCHAN sue:
XDEF one =1, alphabet="abcdefghijklmnopq"
X"rstuvwxyz":
XDEF Tablet   = TABLE [ BYTE 0 ]:
X
XPROC time =
X  mary!NOW
X:
X
XPROC relay ( CHAN from, to, VAR via ) =
X  SEQ
X    from?via
X    to!via
X:
X
XPROC zilch ( VALUE t[] ) =
X  SKIP
X:
X
XWHILE NOT FALSE
X
X  SEQ
X    time
X    bill[0]   := TABLE [ 2, 3, 5, 7, 11, 13, 17, 19, 23] [fred]
X    WAIT NOW AFTER bill[joe[BYTE 0]]
X
X    VAR cats, dogs:
X    CHAN raining[ one ]:
X    PAR WHICH = [ 0 FOR one ]
X      relay( raining[ cats AND dogs], jane[WHICH], alphabet[WHICH] )
X
X    zilch( "abc"[2] )
X
X    SEQ
X
X    mary!ANY
X
X    CHAN jane:
X    jane?ANY
X
X    PAR
X
X    VAR john,tarzan:
X    CHAN janet,jane:
X    PAR
X      janet?john;john
X      jane!tarzan; tarzan
X
X    IF
X      'a' << #2
X        IF
X
X      IF
X        '**' >> ( 1 OR 2 )
X          IF fred = [ 0 FOR '*#FF' ]
X            fred <> ( alphabet[ fred >< bill[ fred /\ bill [ fred \/ fred ]]] )
X              joe := (fred>0) AND (fred<100) AND (fred>='a') AND (fred<='-')
X
X    VAR then:
X    ALT fred = [ 1+1+1 FOR 2*2*(2-1)+(4\2)*(2/2) ]
X      ALT
X        ALT
X        SKIP
X          SKIP
X        fred = 3 & SKIP
X          SKIP
X        fred >3 & WAIT NOW
X          SKIP
X        WAIT NOW AFTER then
X          SKIP
X        fred < 20 & mary?ANY
X          then := NOW
X        jane[fred]?then
X          then := then + 4
SHAR_EOF
chmod 0666 test3 || echo "restore of test3 fails"
set `wc -c test3`;Sum=$1
if test "$Sum" != "1469"
then echo original size 1469, current size $Sum;fi
fi
if test -f test4; then echo "File test4 exists"; else
echo "x - extracting test4 (Text)"
sed 's/^X//' << 'SHAR_EOF' > test4 &&
X
X  -- this is another comprehensive exercise of occam syntax
X        -- pjmp @ hrc 31/7/86
XVAR fred, joe[BYTE - #fAf], bill[ (20>>2)/\#0F]:
XVAR heinz:
XCHAN mary,jane[TRUE]:
XCHAN sue:
XDEF one =1, alphabet="abcdefghijklmnopq"
X"rstuvwxyz":
XDEF Tablet   = TABLE [ BYTE 0 ]:
X
XPROC time =
X  mary!NOW
X:
X
XPROC relay ( CHAN from, to, VAR via ) =
X  SEQ
X    from?via
X    to!via
X:
X
XPROC zilch ( VALUE t[] ) =
X  SKIP
X:
X
XWHILE NOT FALSE
X
X  SEQ
X    time
X    bill[0]   := TABLE [ 2, 3, 5, 7, 11, 13, 17, 19, 23] [fred]
X    WAIT NOW AFTER bill[joe[BYTE 0]]
X
X    VAR cats, dogs:
X    CHAN raining[ one ]:
X    PAR WHICH = [ 0 FOR one ]
X      relay( raining[ cats AND dogs], jane[WHICH], alphabet[WHICH] )
X
X    zilch( "abc"[2] )
X
X    SEQ fred = [ 0 FOR 3 ]
X
X    mary!ANY
X
X    CHAN jane:
X    jane?ANY
X
X    PAR
X
X    VAR john,tarzan:
X    CHAN janet,jane:
X    PAR
X      janet?john;john
X      jane!tarzan; tarzan
X
X    IF
X      'a' << #2
X        IF
X
X      IF
X        '**' >> ( 1 OR 2 )
X          IF fred = [ 0 FOR '*#FF' ]
X            fred <> ( alphabet[ fred >< bill[ fred /\ bill [ fred \/ fred ]]] )
X              joe := (fred>0) AND (fred<100) AND (fred>='a') AND (fred<='-')
X
X    VAR then:
X    ALT fred = [ 1+1+1 FOR 2*2*(2-1)+(4\2)*(2/2) ]
X      ALT
X        ALT
X        SKIP
X          SKIP
X        fred = 3 & SKIP
X          SKIP
X        fred >3 & WAIT NOW
X          SKIP
X        WAIT NOW AFTER then
X          SKIP
X        fred < 20 & mary?ANY
X          then := NOW
X        jane[fred]?then
X          then := then + 4
SHAR_EOF
chmod 0666 test4 || echo "restore of test4 fails"
set `wc -c test4`;Sum=$1
if test "$Sum" != "1495"
then echo original size 1495, current size $Sum;fi
fi
exit 0