IVY - a new little-language (part 1 of 2)

[Joseph H Allen]

Archive-name: ivy1/part1
Submitted-by: jha...@world.std.com

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.50)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 09/28/1993 06:26 UTC by jhallen@world
# Source directory /home/foyer/jhallen/ivy
#
# existing files will NOT be overwritten unless -c is specified
#
# This is part 1 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 13692 -rw------- README
# 1098 -rw------- TODO
# 18500 -rw------- codegen.c
# 945 -rw------- codegen.h
# 20831 -rw------- compile.c
# 3545 -rw------- compile.h
# 1549 -rw------- main.c
# 111 -rw------- makefile
# 2053 -rw------- rtlib.c
# 20174 -rw------- run.c
# 4994 -rw------- run.h
# 381 -rw------- sort.i
#
if test -r _shar_seq_.tmp; then
echo 'Must unpack archives in sequence!'
echo Please unpack part `cat _shar_seq_.tmp` next
exit 1
fi
# ============= README ==============
if test -f 'README' -a X"$1" != X"-c"; then
echo 'x - skipping README (File already exists)'
rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting README (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'README' &&
X Ivy
X Preliminary Manual
X
INTRODUCTION
X
X Ivy is an embeddable byte-code compiled/interpreted language which
is useful as both an extension and a command language. Its syntax is
designed to be easy to learn and to be fairly good looking. Ivy currently
supports four data types: integers, strings, functions and objects. Objects
are late-binding storage devices which take the role of arrays, structures
and simple look-up tables. Floating point or arbitrary length floating
point numbers will be available in a future implementation. Ivy comes
packaged as an interactive language like BASIC and LISP. You can either
execute language statements immediately from the keyboard or run a program
stored in a file. Ivy is also easy to embed into another program. Calls
are provided to execute Ivy code and to add C function extensions to Ivy's
interpreter.
X
X
COMMAND FORMAT
X
X ivy [-u] [-t] [filenames...]
X
X If no filenames are given, ivy takes input from the keyboard
X
X -t is a debugging aid which displays the parse tree as
X commands are entered
X
X -u is a debugging aid which unassembles the byte-code as
X it's made
X
PROGRAM STRUCTURE
X
X Whenever a command or expression is encounted outside of a block, it
is executed immediately. A command is a function or statement name followed
by expressions.
X
X command-name expr expr expr ...
X
X print "Hello world"
X
X The expressions get evaluated and their results are passed to the
command as arguments. Multiple expressions or multiple expressions followed
by a command may be placed on a line:
X
X expr expr expr ...
X expr expr expr ... command-name expr expr expr ...
X
X a="Hello" b="World" print a b
X
X Multiple commands may also be placed on a line, but they must be
separated by semicolons:
X
X command ; command ; ...
X
X print "Hello" ; print "World"
X
X A command is really a function call and may be placed in an
expression as one:
X
X command-name[expr expr expr ...]
X
X print["Hello" "World"]
X
X Some statements also require a block of commands to follow them
('if' for example). Such statements can still be formulated as function
calls, but they may not be used inside of an expression unless they enclosed
within parenthesis.
X
X print (if[1==1] print "One equals one" else print "One equals two")
X
X Commas may be used to separate the expressions, but they are not
needed. Ambiguities between operators which take multiple roles are
resolved by measuring how close they are to their operands. For example:
X
X a + b - c # Two expressions, a+b and -c
X a + b - c # One expression, a+b-c
X
X In other words, the code is parsed how it looks.
X
X Expressions may also cross lines if it is necessary to do so for
them to complete:
X
X a + b # Two expressions, a+b and -c
X - c
X
X a + b - # One expression, a+b-c
X c
X
X When a statement requires a block of commands to follow it, two
options are available. The block may be composed of a single command on the
same line as the statement:
X
X if 1==1 print "One equals one"
X
X Or the block may be composed of multiple commands beginning on the
X
X if 1==1
X print "One equals one"
X print "It certainly doesn't equal 2"
X
X Blocks end when there is no more input (in interactive mode, hit ^D
to end the current block) or, in keeping with the philosophy of having the
code parsed the way it looks, when the "indentation level" (the number of
columns at the beginning of the line) returns to that of the line containing
the command requiring the block. For example:
X
X if x==1
X print "X equals 1, not two"
X print "or three or anything else"
X if x==2
X print "X equals 2"
X
X Else associates with the if with the same indentation level, not, as
is usual, with the latest if. Thus the following code works as it is
printed:
X
X if x!=1
X if x==2
X print "X equals two"
X else
X print "X equals one"
X
CONSTANTS
X
X Integers may be entered in a variety of bases:
X
X x=0128 # Decimal
X x=$80 # Hexadecimal
X x=@200 # Octal
X x=%10000000 # Binary
X
X Also the ASCII value of a character may be taken as an integer:
X
X x='A # The value 65
X x='C' # The value 67 (the second ' is optional)
X x='' # The ASCII value for '
X x=''' # The ASCII value for '
X
X The following "escape sequences" may also be used in place of a
character:
X
X x='\n # New-line
X x='\r # Return
X x='\b # Backspace
X x='\t # Tab
X x='\a # Alert (bell)
X x='\e # ESC
X x='\f # Form-feed
X x='\^A # Ctrl-A (works for ^@ to ^_ and ^?)
X x='\010 # Octal for 8
X x='\xFF # Hexadecimal for 255
X x='\X # Any other character is returned as itself
X
X String constants are enclosed in double-quotes:
X
X
X x="Hello there"
X
X Escape sequences may also be used inside of strings.
X
EXPRESSIONS
X
X An expression is a single or dual operand operator, a constant, a
variable, a lambda function, commands enclosed within parenthesis, a
function call, or an object. Examples of each of these cases follow:
X
X ~expr Single operand
X
X expr+expr Dual operand
X
X 25 Constant
X
X (command ; ...) Commands or expressions inside of
X parenthesis (evaluates to the last
X expression or command)
X
X expr[expr ...] Function call
X
X {1, 2, 3, 4} An array object
X
X {`next=item `value=1} A structure object
X
X (::x,y x*y)[3, 5] Calling a lambda function
X
OPERATORS
X
X Ivy uses a superset of operators from C but with the precedence
fixed. Here are the operators grouped from highest precedence to lowest:
X
X ` # Named argument
X
X . # Member selection
X
X [ ] # Function call
X
X - ~ ! ++ -- # Single operand
X
X << >> # Shift group
X
X * / & % # Multiply group
X
X + - | ^ # Add group
X
X == > < >= <= != # Comparison group
X
X && # Logical and
X
X || # Logical or
X
X = <<= >>= *= /= %= += -= |= ^= .= # Pre-assignments
X : <<: >>: *: /: %: +: -: |: ^: .: # Post-assignments
X
X \ # Sequential evaluation
X
X , # Sequential evaluation or argument
X # separation
X
X
X A detailed description of each operator follows:
X
X ` Named argument
X
X This operator can be used to explicitly state the argument
or member name in a command, function call or object. For example:
X
X open `name="joe.c", `mode="r"
X square[`x=5, `y=6]
X {`1=5 `0=7} # Array object
X {`x=10 `y=10} # Structure object
X
X . Member selection
X
X This operator is used to select a named member from an
object. For example:
X
X o={`x=5, `y=10} # Create an object
X print o.x # Print member x
X print o["x"] # Equivalent to above
X
X [ ] Function call
X
X This operator calls the function resulting from the
expression on the left with the argument inside of the brackets. This
operator can also be used for object member selection and for string
character and substring operations. Examples of each of these follow:
X
X x.y[5] # Call function y in object x
X
X z[0]=1, z[1]=2 # Set numbered members of an object
X
X z["foo"]=3, z["bar"]=4 # Set named member of an object
X
X print "Hello"[0] # Prints 65
X
X print "Hello"[1,3] # Prints "el"
X
X a="Hello"
X a[0]='G
X a[5]=" there"
X print a # Prints "Gello there"
X
X - Negate
X
X ~ Bit-wise one's complement
X
X ! Logical not
X
X ++ Pre or post increment depending on whether it precedes or follows
X a variable
X
X -- Pre or post decrement
X
X << Bit-wise shift left
X
X >> Bit-wise shift right
X
X * Multiply
X
X / Divide
X
X & Bit-wise AND
X
X % Modulus (Remainder)
X
X + Add or concatenate
X
X In addition to adding integers, this operand concatenates
X strings if strings are passed to it. For example:
X
X print "Hello"+" There" # Prints "Hello There"
X
X Add also adds a single item onto the end of an array. For
X example:
X
X a={1 2 3}
X a+=4 # a now is { 1 2 3 4 }
X
X - Subtract
X
X | Bit-wise OR
X
X If objects are given as arguments to OR, OR unions the
X objects together into a single object. If the objects have
X numerically referenced members, OR will append the array on the
X right to the array on the left. For example:
X
X a={1 2 3}
X b={4 5 6}
X a|=b # a now is {1 2 3 4 5 6}
X
X ^ Bit-wise Exclusive OR
X
X == Returns 1 (true) if arguments are equal or 0 (false) if arguments
X are not equal. Can be used for strings and numbers.
X
X > Greater than
X >= Greater than or equal to
X < Less than
X <= Less than or equal to
X != Not equal to
X
X && Logical and
X
X The right argument is only evaluated if the left argument is
X true (non-zero).
X
X || Logical or
X
X The right argument is evaluated only if the left argument is
X false (zero).
X
X \ Sequential evaluation
X
X The left and then the right argument are evaluated and the
X result of the right argument is returned.
X
X , Sequential evaluation or argument separator
X
X When this is used inside of [ ] or { } it is an argument
X separator. In those cases, \ should be used for sequential
X evaluation.
X
X = Pre assignment
X
X The right side is evaluated and the result is stored in the
X variable specified on the left side. The right sides result is
X also returned.
X
X : Post assignment
X
X The right side is evaluated and the result is stored in the
X variable specified on the left side. The left side's original value
X is returned.
X
X X= Pre-assignment group
X
X These translate directly into: "left = left X right"
X
X X: Post-assignment group
X
X These translate directly into: "left : left X right"
X
X Notes on assignment groups:
X
X .= translates into "left = left . right" and is
X useful for traversing linked lists. For example:
X
X for list=0\ x=0, x!=10, ++x # Build list
X list={`next=list, `value=x}
X
X for a=list, a, a.=next # Print list
X print a.value
X
X x+:1 Is the same as x++
X x+=1 Is the same as ++x
X
X a:b:c:5
X ':' is useful for shifting the value of variables
X around. In this example, a gets b, b gets c, and
X c gets 5.
X
X a:b:a
X ':' is also useful for swapping the values of
X variables. In this example, a gets swapped with
X b.
X
X
STATEMENTS
X
Function declaration:
X
X :name expr expr expr ... ; body
X
X :name expr expr expr ...
X body
X
X These declare functions. Here are some examples:
X
X :square x ; x*x
X
X :square[x] x*x
X
X :square x
X x*x
X
X square=(::x x*x)
X
X The last form uses "Lambda" (nameless) functions. You can
X also use lambda functions without assigning them:
X
X x=(::x x*x)[6] # x gets assigned 36
X
X
If statement
X
X if expr block
X else if expr block
X else block
X
X Note that 'else' does not work unless it is in a block.
X
Loop statement
X
X loop block
X
X The block gets repeatedly executed until a 'break' or
X 'until' statement within the block terminates the loop.
X
While statement
X
X while expr block
X
X The block is repeatedly executed if the expression is true.
X
For statement
X
X for expr1, expr2, expr3 block
X
X This is a shorthand for the follow while statement:
X
X expr1 while expr2
X block
X expr3
X
X Thus,
X expr1 is usually used as an index variable initializer
X expr2 is the loop test
X expr3 is the index variable incrementer
X
Return statement
X
X return
X
X return expr
X
X This exits the function it is executed in with the given
X return value or with the value of the last expression
X preceeding the return.
X
Break statement
X
X break
X
X break n
X
X This aborts the innermost or nth innermost loop
X
Continue statement
X
X continue
X
X continue n
X
X This jumps the beginning of the innermost or nth loop.
X
Until statement
X
X until expr
X
X This exits the loop it's in if the expression is true.
X
Local statement
X
X local a, b, c,... block
X
X This declares variables which are local to the block
X
With statement
X
X with x block
X
X The members of the object x look like local variables inside
X of the block.
X
X
FUNCTIONS
X
X When the block inside of a function gets control a special
variable becomes visible:
X
X argv Contains an object containing numbered members
X which are each set the arguments passed to the
X function.
X
X So for example, if the function:
X
X :x
X for a=0, a!=len[argv], ++a
X print argv[a]
X
X gets called as follows:
X
X x[1 2 3]
X
X The following gets printed:
X
X 1
X 2
X 3
X
X Default values may be specified for missing arguments in function
calls. For example if this function:
X
X :func x=5, y=6
X x*y
X
X Is called as follows:
X
X print func[1] # '6' is printed
X print func[] # '30' is printed
X print func[`y=7] # '35' is printed
X
X
X Functions may be assigned to variables and passed to functions. For
example you can define a function 'apply' which applies a function to an
argument:
X
X :apply x y
X return x[y]
X
X :square x
X return x*x
X
X print apply[square,5] # Prints 25
X
X
VARIABLES
X
X Variables set outside of functions are global variables. They will
be visible in any block unless 'local' is used to make local variables.
X
X If a variable is set inside of a function and there is no global
variable of the same name, that variable will be local to the block it was
assigned in.
X
X
OBJECTS
X
X Objects can be created either member by member:
X
X o.a=5
X o.b=6
X
X or all at once:
X
X o={`a=5, `b=6}
X
X Objects are assigned by reference. This means that if you have an
object in one variable:
X
X x={1 2 3}
X
X And you assign it to another:
X
X y=x
X
X And then change one of the members of x:
X
X x[0]=5
X
X Then the change will appear both in x and in y
X
X
COMMENTS
X
X Everything from any # not in a string or string constant to the
end of the line is a comment.
X
X
FUNCTION LIBRARY
X
X len[a]
X
X Returns the length of string 'a' or number of element in
X array 'a'
X
X print[...]
X
X Prints the arguments
X
X a=get[]
X
X Get a line of input as a string
X
X x=atoi["2"]
X
X Converts a string to a number
X
X s=itoa[20]
X
X Convert a number to a string
SHAR_EOF
chmod 0600 README ||
echo 'restore of README failed'
Wc_c="`wc -c < 'README'`"
test 13692 -eq "$Wc_c" ||
echo 'README: original size 13692, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= TODO ==============
if test -f 'TODO' -a X"$1" != X"-c"; then
echo 'x - skipping TODO (File already exists)'
rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting TODO (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'TODO' &&
=-=-=-=-=
# Data definition
X
.name
X inherit name
X clear name
X name 5
X name 10
X .name
X name 10
X name 20
X
- Should remove args
X
& Should intersect arrays
X
clear x Need by reference to do this
X
dup(x) Copy an object non-recusively
X
foreach
X
make include take an expression instead of a string
X
should make an eval() function of some sort
X
=-=-=-=-=
Get stack depth recording straigtened out
X
=-=-=-=-=
Errors should fail a compile
Should either return a parse-tree or not return one.
Do more checking
X
=-=-=-=-=
By-reference variables?
Have to store entire path in by reference variable. Original
variable may not go away until all by ref. vars on it also go
away.
X
When we assign a variable to a variable in callfunc, both the variable
and a reference to the original would have to be stored to make it work
correctly for arg[] array. Then we'd need to add an operator '*' which
you'd have to use to set a variable indirectly.
X
* a instead of putting a on the stack, it puts what a refers to on
X the stack
X
=-=-=-=-=
Lambda function syntax
X
for ,, ; syntax is strange
SHAR_EOF
chmod 0600 TODO ||
echo 'restore of TODO failed'
Wc_c="`wc -c < 'TODO'`"
test 1098 -eq "$Wc_c" ||
echo 'TODO: original size 1098, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= codegen.c ==============
if test -f 'codegen.c' -a X"$1" != X"-c"; then
echo 'x - skipping codegen.c (File already exists)'
rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting codegen.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'codegen.c' &&
/* Code generator
X Copyright (C) 1993 Joseph H. Allen
X
This file is part of IVY
X
IVY is free software; you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation; either version 1, or (at your option) any later version.
X
IVY is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
details.
X
You should have received a copy of the GNU General Public License along with
IVY; see the file COPYING. If not, write to the Free Software Foundation,
675 Mass Ave, Cambridge, MA 02139, USA. */
X
#include <string.h>
#include <stdio.h>
#include "run.h"
#include "compile.h"
#include "codegen.h"
X
/* Code block being built */
static int *begcode; /* Start of the current block of code */
static int *code; /* Current address we're writing to */
static int codesize; /* Size of code-block */
X
static int rtn; /* List of offsets to return point */
X
static int curdepth; /* Stack depth recorder */
static int maxdepth;
static int itmdepth;
X
static int scopelvl; /* Current scoping level */
X
static int genl();
static void setlist();
static void addlist();
static int genbra();
static void gen();
static int genn();
X
/* Code block building functions */
X
/* Create a new code block */
X
void newcode()
X {
X begcode=code=(int *)malloc(sizeof(int)*(codesize=128));
X }
X
/* Append an integer to the code block */
X
int exemit(z)
X {
X int cod=code-begcode;
X begcode=(int *)realloc(begcode,sizeof(int)*(codesize+=128));
X code=begcode+cod;
X return *code++=z;
X }
X
#define emit(z) ((code==begcode+codesize)?exemit(z):(*code++=(z)))
X
/* Append a string to the code block */
X
void emits(s,len)
char *s;
X {
X int size=(len+sizeof(int))/sizeof(int);
X int x;
X emit(len);
X if(code+size>begcode+codesize)
X {
X int cod=code-begcode;
X begcode=(int *)realloc(begcode,sizeof(int)*(codesize+=128+size));
X code=begcode+cod;
X }
X for(x=0;x!=len;++x) ((char *)code)[x]=s[x];
X ((char *)code)[x]=0;
X code+=size;
X }
X
/* Stack depth recorder */
X
void psh(x)
X {
X emit(iPSH);
X emit(x);
X ++curdepth;
X ++itmdepth;
X if(curdepth>maxdepth) maxdepth=curdepth;
X }
X
void pop()
X {
X curdepth-=itmdepth;
X itmdepth=0;
X }
X
/* Tree printer */
X
void indent(x) { while(x--) printf(" "); }
X
void prtree(n,lvl)
NODE *n;
X {
X int x;
X if(n->what==&nNUM) indent(lvl), printf("%d",n->n);
X else if(n->what==&nSTR) indent(lvl), printf("\"%s\"",n->s);
X else if(n->what==&nVOID) indent(lvl), printf("VOID");
X else if(n->s) indent(lvl), printf("%s",n->s);
X else
X {
X indent(lvl), printf("(%s\n",n->what->name);
X if(n->l) prtree(n->l,lvl+2);
X if(n->r) prtree(n->r,lvl+2);
X indent(lvl), printf(")");
X }
X printf("\n");
X }
X
/* Disassembler */
X
void disasm(c)
int *c;
X {
X printf("; Max stack depth %d\n",*c++);
X for(;;) switch(*c++)
X {
X case iBRA: printf(" bra %d\n",*c++); break;
X case iBEQ: printf(" beq %d\n",*c++); break;
X case iBNE: printf(" bne %d\n",*c++); break;
X case iBGT: printf(" bgt %d\n",*c++); break;
X case iBLT: printf(" blt %d\n",*c++); break;
X case iBGE: printf(" bge %d\n",*c++); break;
X case iBLE: printf(" ble %d\n",*c++); break;
X case iCOM: printf(" com\n"); break;
X case iNEG: printf(" neg\n"); break;
X case iSHL: printf(" shl\n"); break;
X case iSHR: printf(" shr\n"); break;
X case iMUL: printf(" mul\n"); break;
X case iDIV: printf(" div\n"); break;
X case iMOD: printf(" mod\n"); break;
X case iAND: printf(" and\n"); break;
X case iADD: printf(" add\n"); break;
X case iSUB: printf(" sub\n"); break;
X case iOR: printf(" or\n"); break;
X case iXOR: printf(" xor\n"); break;
X case iCMP: printf(" cmp\n"); break;
X case iBEG: printf(" beg\n"); break;
X case iEND: printf(" end\n"); break;
X case iLOC: printf(" loc\n"); break;
X case iWTH: printf(" wth\n"); break;
X case iGET: printf(" get\n"); break;
X case iLEA: printf(" lea\n"); break;
X case iSET: printf(" set\n"); break;
X case iCALL: printf(" call\n"); break;
X case iCALLA: printf(" calla\n"); break;
X case iRTS: printf(" rts\n"); return;
X case iPOP: printf(" pop\n"); break;
X case iPSH:
X switch(*c++)
X {
X case tNUM: printf(" psh %d\n",*c++); break;
X case tSTR: printf(" psh \"%s\"\n",c+1); c+=(*c+sizeof(int))/sizeof(int)+1;
X break;
X case tVOID: printf(" psh void\n"); break;
X case tLST: printf(" pshlist %d\n",*c++); break;
X }
X }
X }
X
/* Loop break/continue point list */
X
static struct looplvl
X {
X struct looplvl *next; /* Next level */
X int cont; /* List of continue destinations */
X int brk; /* List of brk destinations */
X int scopelvl; /* Scoping level */
X } *looplvls=0;
X
void mklooplvl(cont,brk)
X {
X struct looplvl *ll=(struct looplvl *)malloc(sizeof(struct looplvl));
X ll->cont=cont;
X ll->brk=brk;
X ll->next=looplvls;
X ll->scopelvl=scopelvl;
X looplvls=ll;
X }
X
void rmlooplvl(cont,brk)
X {
X struct looplvl *ll=looplvls;
X looplvls=ll->next;
X setlist(ll->cont,cont);
X setlist(ll->brk,brk);
X free(ll);
X }
X
struct looplvl *findlvl(n)
X {
X struct looplvl *ll;
X if(!n) return 0;
X ll=looplvls; while(ll && --n) ll=ll->next;
X return ll;
X }
X
/* Generate an address */
X
static void gena(n)
NODE *n;
X {
X if(n->what==&nVOID) error(n->name,n->line,"incomplete expression");
X else if(n->what==&nCOMMA || n->what==&nEXTEND) genn(n->l), gena(n->r);
X else if(n->what==&nNAM)
X {
X psh(tSTR);
X emits(n->s,n->n);
X emit(iLEA);
X }
X else if(n->what==&nDEFUN && !n->l) gen(n);
X else if(n->what==&nCALL)
X {
X int nargs;
X nargs=genl(n->r);
X psh(tLST);
X emit(nargs);
X gena(n->l);
X emit(iCALLA);
X }
X else if(n->what==&nCALL1)
X {
X if(n->r->what!=&nNAM) error(n->r->name,n->r->line,"Invalid member name");
X psh(tSTR);
X emits(n->r->s,n->r->n);
X psh(tLST);
X emit(1);
X gena(n->l);
X emit(iCALLA);
X }
X else gen(n);
X /*error(n->name,n->line,"Invalid LVALUE"); */
X }
X
/* Count no. of comma seperated elements. Use for args and 1st expr of FOR */
X
static int cntlst(n)
NODE *n;
X {
X if(n->what==&nVOID) return 0;
X else if(n->what==&nCOMMA) return cntlst(n->l)+cntlst(n->r);
X else return 1;
X }
X
/* Generate list of comma seperated names (for function args) */
X
static int genlst(argv,initv,n)
char **argv;
int **initv;
NODE *n;
X {
X if(n->what==&nVOID) return 0;
X else if(n->what==&nCOMMA)
X {
X int x=genlst(argv,initv,n->l);
X return x+genlst(argv+x,initv+x,n->r);
X }
X else if(n->what==&nCALL && n->l->what==&nNAM && n->r->what==&nVOID)
X return argv[0]=strdup(n->l->s), initv[0]=0, 1;
X else if(n->what==&nNAM) return argv[0]=strdup(n->s), initv[0]=0, 1;
X else if(n->what==&nSET && n->l->what==&nNAM)
X return argv[0]=strdup(n->l->s), initv[0]=codegen(n->r), 1;
X else return error(n->name,n->line,"incorrect argument list %s",n->what->name), 0;
X }
X
/* Generate and count list (used to generate arg lists) */
X
static int genl(n)
NODE *n;
X {
X int result;
X if(n->what==&nVOID) return 0;
X else if(n->what==&nCOMMA)
X {
X result=genl(n->r);
X return result+genl(n->l);
X }
X else if(n->what==&nSET && n->l->what==&nQUOTE && n->l->r->what==&nNAM)
X {
X gen(n->r);
X psh(tSTR);
X emits(n->l->r->s,n->l->r->n);
X psh(tNARG);
X return 1;
X }
X else
X {
X gen(n);
X return 1;
X }
X }
X
/* Generate and count local command, don't emit initializers */
X
static int genll(n)
NODE *n;
X {
X if(n->what==&nVOID) return 0;
X else if(n->what==&nCOMMA)
X {
X int result=genll(n->r);
X return result+genll(n->l);
X }
X else if(n->what==&nNAM)
X {
X psh(tSTR);
X emits(n->s,n->n);
X return 1;
X }
X else if(n->what==&nSET && n->l->what==&nNAM)
X {
X psh(tSTR);
X emits(n->l->s,n->l->n);
X return 1;
X }
X else error(n->name,n->line,"incorrect local list");
X }
X
/* Generate initializers for local list */
X
static int genla(n)
NODE *n;
X {
X if(n->what==&nVOID) return 0;
X else if(n->what==&nCOMMA)
X {
X int result=genla(n->r);
X return result+genla(n->l);
X }
X else if(n->what==&nNAM) return 1;
X else if(n->what==&nSET && n->l->what==&nNAM)
X {
X genn(n);
X return 1;
X }
X else error(n->name,n->line,"incorrect local list");
X }
X
/* Generate if..elif..elif.. with no return value */
/* Returns list of branch offsets which should be set past final else */
X
genelif(n,v)
NODE *n;
X {
X if(n->what==&nVOID) return 0;
X else if(n->what==&nIF)
X {
X int els=genbra(n->l,1);
X int rtval;
X emit(iBEG);
X if(v) gen(n->r); else genn(n->r);
X emit(iEND);
X emit(iBRA);
X emit(0);
X rtval=code-1-begcode;
X setlist(els,code-begcode);
X return rtval;
X }
X else if(n->what==&nCOMMA && n->r->what==&nELSE && n->r->r->what==&nIF)
X {
X int z=genelif(n->l,v);
X if(!z) error(n->r->name,n->r->line,"else without if");
X else addlist(z,genelif(n->r->r,v));
X return z;
X }
X if(v) gen(n); else genn(n);
X return 0;
X }
X
/* Generate a value */
X
static void gen(n)
NODE *n;
X {
X if(n->what==&nEXTEND)
X genn(n->l), gen(n->r);
X else if(n->what==&nLIST)
X {
X int amnt=genl(n->r);
X psh(tLST);
X emit(amnt);
X }
X else if(n->what==&nNUM)
X {
X psh(tNUM);
X emit(n->n);
X }
X else if(n->what==&nSTR)
X {
X psh(tSTR);
X emits(n->s,n->n);
X }
X else if(n->what==&nNAM)
X {
X psh(tSTR);
X emits(n->s,n->n);
X emit(iGET);
X }
X else if(n->what==&nSET)
X {
X int sv;
X gen(n->r); sv=itmdepth;
X itmdepth=0; gena(n->l); pop();
X emit(iSET); itmdepth=sv;
X }
X else if(n->what==&nPOST)
X {
X int sv;
X gen(n->l); sv=itmdepth;
X itmdepth=0; gen(n->r);
X gena(n->l); pop();
X emit(iSET);
X emit(iPOP);
X itmdepth=sv;
X }
X else if(n->what==&nDEFUN && !n->l)
X {
X NODE *args=n->r->l;
X int *cod=codegen(n->r->r);
X OBJ *o;
X int argc=cntlst(args);
X char **argv=(char **)malloc(argc*sizeof(char *));
X int **initv=(int **)malloc(argc*sizeof(int *));
X genlst(argv,initv,args);
X o=mkobj(tFUNC,(void *)0,0,cod,argc,argv,initv);
X psh(tFUNC);
X emit((int)o);
X }
X else if(n->what==&nCOMMA)
X if(n->r->what==&nELSE)
X {
X int done=genelif(n->l,1);
X if(!done) error(n->r->name,n->r->line,"else w/o if error");
X if(n->r->r->what==&nIF)
X {
X addlist(done,genbra(n->r->r->l,1));
X n=n->r;
X }
X emit(iBEG);
X gen(n->r->r);
X emit(iEND);
X setlist(done,code-begcode);
X }
X else
X {
X genn(n->l);
X gen(n->r);
X }
X else if(n->what==&nEQ || n->what==&nNE ||
X n->what==&nGT || n->what==&nLT ||
X n->what==&nGE || n->what==&nLE ||
X n->what==&nLAND || n->what==&nLOR || n->what==&nNOT)
X {
X int b=genbra(n,1);
X psh(tNUM);
X emit(1);
X emit(iBRA);
X emit(4);
X setlist(b,code-begcode);
X psh(tNUM);
X emit(0);
X }
X else if(n->what==&nCALL)
X {
X int nargs=genl(n->r);
X psh(tLST);
X emit(nargs);
X gena(n->l);
X emit(iCALL);
X }
X else if(n->what==&nCALL1)
X {
X if(n->r->what!=&nNAM) error(n->r->name,n->r->line,"Invalid member name");
X psh(tSTR);
X emits(n->r->s,n->r->n);
X psh(tLST);
X emit(1);
X gena(n->l);
X emit(iCALL);
X }
X else if(n->what==&nCOM || n->what==&nNEG || n->what==&nSHL ||
X n->what==&nSHR || n->what==&nMUL || n->what==&nDIV ||
X n->what==&nMOD || n->what==&nAND || n->what==&nADD ||
X n->what==&nSUB || n->what==&nOR || n->what==&nXOR)
X {
X if(n->l) gen(n->l);
X if(n->r) gen(n->r);
X emit(n->what->i);
X if(n->r && n->l) pop();
X }
X else
X if(!genn(n)) psh(tVOID);
X }
X
/* Generate nothing (returns true if guarenteed to branch) */
X
static int genn(n)
NODE *n;
X {
X if(n->what==&nWITH)
X if(n->r->r)
X {
X int amnt;
X emit(iBEG); ++scopelvl;
X amnt=genl(n->l);
X psh(tLST);
X emit(amnt);
X emit(iWTH);
X genn(n->r);
X emit(iEND); --scopelvl;
X }
X else
X {
X int amnt=genl(n->l);
X psh(tLST);
X emit(amnt);
X emit(iWTH);
X }
X else if(n->what==&nLOCAL)
X if(n->r->r)
X {
X int amnt;
X emit(iBEG); ++scopelvl;
X amnt=genll(n->l);
X psh(tLST);
X emit(amnt);
X emit(iLOC);
X genla(n->l);
X genn(n->r);
X emit(iEND); --scopelvl;
X }
X else
X {
X int amnt=genll(n->l);
X psh(tLST);
X emit(amnt);
X emit(iLOC);
X genla(n->l);
X }
X else if(n->what==&nFOR)
X {
X int top, cont;
/* if(cntlst(n->l)!=3)
X error(n->l->name,n->l->line,"Incorrect no. args to FOR"); */
X genn(n->l->l->l);
X emit(iBEG); ++scopelvl;
X emit(iBRA);
X mklooplvl(code-begcode,0);
X emit(0);
X top=code-begcode;
X genn(n->r);
X genn(n->l->r);
X cont=code-begcode;
X setlist(genbra(n->l->l->r,0),top);
X rmlooplvl(cont,code-begcode);
X emit(iEND); --scopelvl;
X }
X else if(n->what==&nWHILE)
X {
X int top, cont;
X dowhile:
X emit(iBEG); ++scopelvl;
X emit(iBRA);
X mklooplvl(code-begcode,0);
X emit(0);
X top=code-begcode;
X genn(n->r);
X cont=code-begcode;
X setlist(genbra(n->l,0),top);
X rmlooplvl(cont,code-begcode);
X emit(iEND); --scopelvl;
X }
X else if(n->what==&nRETURN)
X {
X int z;
X if(n->r) gen(n->r);
X else psh(tVOID);
X for(z=0;z!=scopelvl;++z) emit(iEND);
X emit(iBRA);
X emit(0);
X if(rtn) addlist(rtn,code-1-begcode);
X else rtn=code-1-begcode;
X return 1;
X }
X else if(n->what==&nLOOP)
X {
X int cont;
X emit(iBEG); ++scopelvl;
X cont=code-begcode;
X mklooplvl((void *)0,(void *)0);
X genn(n->r);
X emit(iBRA); emit(cont-(code-begcode));
X rmlooplvl(cont,code-begcode);
X emit(iEND); --scopelvl;
X }
X else if(n->what==&nBREAK)
X {
X int nlvls=1;
X struct looplvl *ll;
X if(n->r->r)
X if(n->r->r->what==&nNUM) nlvls=n->r->r->n;
X else error(n->r->r->name,n->r->line,"Invalid argument to break");
X ll=findlvl(nlvls);
X if(ll)
X {
X int z;
X for(z=ll->scopelvl;z!=scopelvl;++z) emit(iEND);
X emit(iBRA);
X emit(0);
X if(ll->brk) addlist(ll->brk,code-begcode-1);
X else ll->brk=code-begcode-1;
X }
X else error(n->name,n->line,"break with no loop");
X return 1;
X }
X else if(n->what==&nCONT)
X {
X int nlvls=1;
X struct looplvl *ll;
X if(n->r->r)
X if(n->r->r->what==&nNUM) nlvls=n->r->r->n;
X else error(n->r->r->name,n->r->line,"Invalid argument to continue");
X ll=findlvl(nlvls);
X if(ll)
X {
X int z;
X for(z=ll->scopelvl;z!=scopelvl;++z) emit(iEND);
X emit(iBRA);
X emit(0);
X if(ll->cont) addlist(ll->cont,code-begcode-1);
X else ll->cont=code-begcode-1;
X }
X else error(n->name,n->line,"continue with no loop");
X return 1;
X }
X else if(n->what==&nUNTIL)
X {
X if(!looplvls) error(n->name,n->line,"until with no loop");
X if(looplvls->brk) addlist(looplvls->brk,genbra(n->r,0));
X else looplvls->brk=genbra(n->r,0);
X }
X else if(n->what==&nIF)
X {
X int no=genbra(n->l,1);
X emit(iBEG);
X genn(n->r);
X emit(iEND);
X setlist(no,code-begcode);
X }
X else if(n->what==&nELSE)
X {
X error(n->name,n->line,"else with no if");
X }
X else if(n->what==&nCOMMA)
X if(n->r->what==&nELSE)
X {
X int done=genelif(n->l,0);
X if(!done) error(n->r->name,n->r->line,"Else w/o if error");
X if(n->r->r->what==&nIF)
X {
X addlist(done,genbra(n->r->r->l,1));
X n=n->r;
X }
X emit(iBEG);
X genn(n->r->r);
X emit(iEND);
X setlist(done,code-begcode);
X }
X else
X {
X genn(n->l);
X genn(n->r);
X }
X else if(n->what==&nDEFUN)
X {
X char *name=n->l->s;
X NODE *args=n->r->l;
X int *cod=codegen(n->r->r);
X OBJ *o, *p;
X int argc=cntlst(args);
X char **argv=(char **)malloc(argc*sizeof(char *));
X int **initv=(int **)malloc(argc*sizeof(int *));
X genlst(argv,initv,args);
X o=mkobj(tFUNC,(void *)0,0,cod,argc,argv,initv);
X if(!sp) izrun();
X p=set(&vars->obj.v,name);
X rmval(&p->obj.v);
X p->obj.v.type=tFUNC;
X p->obj.v.v.obj=o;
X }
X else if(n->what==&nVOID) return 0;
X else
X {
X gen(n);
X emit(iPOP); pop();
X }
X return 0;
X }
X
/* Generate a branch. If 't' is set, then the block falls through if the result
X * is true and takes the branch if the result is false.
X *
X * If 't' is clear, then the block falls through if the result is false and
X * takes the branch if the reuslt is true.
X *
X * Return the address of the value which should be set to the branch offset
X */
X
/* Add branch list 'b' to end of branch list 'a' */
X
static void addlist(a,b)
X {
X while(begcode[a]) a= begcode[a];
X begcode[a]=b;
X }
X
/* Set each value in branch list 'a' to destination 'b' */
X
static void setlist(a,b)
X {
X int c;
X while(a) c= begcode[a], begcode[a]=b-a, a=c;
X }
X
static int genbra(n,t)
NODE *n;
X {
X if(n->what==&nEQ)
X {
X gen(n->l); gen(n->r);
X emit(iCMP);
X if(t) emit(iBNE); else emit(iBEQ);
X emit(0);
X pop();
X return code-begcode-1;
X }
X else if(n->what==&nNE)
X {
X gen(n->l); gen(n->r);
X emit(iCMP);
X if(t) emit(iBEQ); else emit(iBNE);
X emit(0);
X pop();
X return code-begcode-1;
X }
X else if(n->what==&nGT)
X {
X gen(n->l); gen(n->r);
X emit(iCMP);
X if(t) emit(iBLE); else emit(iBGT);
X emit(0);
X pop();
X return code-begcode-1;
X }
X else if(n->what==&nGE)
X {
X gen(n->l); gen(n->r);
X emit(iCMP);
X if(t) emit(iBLT); else emit(iBGE);
X emit(0);
X pop();
X return code-begcode-1;
X }
X else if(n->what==&nLT)
X {
X gen(n->l); gen(n->r);
X emit(iCMP);
X if(t) emit(iBGE); else emit(iBLT);
X emit(0);
X pop();
X return code-begcode-1;
X }
X else if(n->what==&nLE)
X {
X gen(n->l); gen(n->r);
X emit(iCMP);
X if(t) emit(iBGT); else emit(iBLE);
X emit(0);
X pop();
X return code-begcode-1;
X }
X else if(n->what==&nNOT)
X return genbra(n->r,!t);
X else if(n->what==&nLAND)
X {
X int b1=genbra(n->l,1);
X int b2;
X if(t) b2=genbra(n->r,1), addlist(b2,b1);
X else b2=genbra(n->r,0), addlist(b1,code-begcode);
X return b2;
X }
X else if(n->what==&nLOR)
X {
X int b1=genbra(n->l,0);
X int b2;
X if(t) b2=genbra(n->r,1), setlist(b1,code-begcode);
X else b2=genbra(n->r,0), addlist(b2,b1);
X return b2;
X }
X else
X {
X gen(n);
X if(t) emit(iBEQ); else emit(iBNE);
X emit(0);
X pop();
X return code-begcode-1;
X }
X }
X
/* Code generator: convert a parse-tree into pseudo-machine code */
X
int ptree=0;
int unasm=0;
X
int *codegen(n)
NODE *n;
X {
X int *ocode=code, *obegcode=begcode, ortn=rtn;
X int ocodesize=codesize, oscopelvl=scopelvl;
X int omax=maxdepth, ocur=curdepth, oitm=itmdepth;
X int *rtval;
X if(ptree) prtree(n,0), printf("\n");
X newcode();
X emit(0);
X rtn=0;
X maxdepth=0;
X curdepth=0;
X itmdepth=0;
X scopelvl=0;
X gen(n);
X if(rtn) setlist(rtn,code-begcode);
X emit(iRTS);
X rtval=begcode;
X *begcode=maxdepth;
X if(unasm) disasm(begcode);
X code=ocode; begcode=obegcode; codesize=ocodesize; rtn=ortn;
X scopelvl=oscopelvl;
X maxdepth=omax; curdepth=ocur; itmdepth=oitm;
X return rtval;
X }
X
/* Add a C function to the table */
X
void addfunc(name,argstr,cfunc)
char *name, *argstr;
void (*cfunc)();
X {
X char bf[1024];
X NODE *args;
X OBJ *o, *p;
X int argc;
X char **argv;
X int **initv;
X strcpy(bf,argstr);
X args=compargs(bf);
X argc=cntlst(args);
X argv=(char **)malloc(argc*sizeof(char *));
X initv=(int **)malloc(argc*sizeof(int *));
X genlst(argv,initv,args);
X o=mkobj(tFUNC,(void *)0,0,(void *)0,argc,argv,initv);
X o->obj.func.cfunc=cfunc;
X /* Put new function in table */
X p=set(&vars->obj.v,name);
X rmval(&p->obj.v);
X p->obj.v.type=tFUNC;
X p->obj.v.v.obj=o;
X }
SHAR_EOF
chmod 0600 codegen.c ||
echo 'restore of codegen.c failed'
Wc_c="`wc -c < 'codegen.c'`"
test 18500 -eq "$Wc_c" ||
echo 'codegen.c: original size 18500, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= codegen.h ==============
if test -f 'codegen.h' -a X"$1" != X"-c"; then
echo 'x - skipping codegen.h (File already exists)'
rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting codegen.h (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'codegen.h' &&
/* Code generator
X Copyright (C) 1993 Joseph H. Allen
X
This file is part of IVY
X
IVY is free software; you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation; either version 1, or (at your option) any later version.
X
IVY is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
details.
X
You should have received a copy of the GNU General Public License along with
IVY; see the file COPYING. If not, write to the Free Software Foundation,
675 Mass Ave, Cambridge, MA 02139, USA. */
X
#ifndef _Icodegen
#define _Icodegen 1
X
/* Convert a parse-tree into pseudo-machine code */
int *codegen();
X
/* A a C-function to the global table */
void addfunc();
X
extern int unasm;
extern int ptree;
X
#endif
SHAR_EOF
chmod 0600 codegen.h ||
echo 'restore of codegen.h failed'
Wc_c="`wc -c < 'codegen.h'`"
test 945 -eq "$Wc_c" ||
echo 'codegen.h: original size 945, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= compile.c ==============
if test -f 'compile.c' -a X"$1" != X"-c"; then
echo 'x - skipping compile.c (File already exists)'
rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting compile.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'compile.c' &&
/* Compiler
X Copyright (C) 1993 Joseph H. Allen
X
This file is part of IVY
X
IVY is free software; you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation; either version 1, or (at your option) any later version.
X
IVY is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
details.
X
You should have received a copy of the GNU General Public License along with
IVY; see the file COPYING. If not, write to the Free Software Foundation,
675 Mass Ave, Cambridge, MA 02139, USA. */
X
#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include "run.h"
#include "codegen.h"
#include "compile.h"
X
char *(*getmore)()=0; /* Function to get another line of input */
X
static char *ptr=""; /* Input pointer */
static int col=0; /* Column no. 'ptr' is at. 0 is first */
static int lvl= -1; /* Indentation level of current line */
static int line=0; /* Line number 'ptr' is on. 0 is first */
static char *name="stdin"; /* File name of current input file */
static int eof=0; /* Set when EOF encountered */
X
FILE *infile; /* Input file/buffer for 'include' command */
char inbuf[1024];
X
/* Print an error message */
X
void error(name,line,str,a,b,c,d)
char *name, *str;
X {
X fprintf(stderr,"\"%s\" %d: error: ",name,line);
X fprintf(stderr,str,a,b,c,d);
X fprintf(stderr,"\n");
X }
X
/* Skip over whitespace. Don't attempt to get more input */
X
void skipws()
X {
X while(1) switch(*ptr)
X {
X case ' ': ++ptr; ++col;
X break;
X
X case '\t': ++ptr; col+=8-col%8;
X break;
X
X case '#':
X case '\n': *ptr=0;
X case 0: return;
X
X default: if(lvl== -1) lvl=col;
X return;
X }
X }
X
/* Skip whitespace including ; */
X
void skipwss()
X {
X loop:
X skipws();
X if(*ptr==';')
X {
X ++ptr;
X goto loop;
X }
X }
X
/* Skip whitespace; get new lines if needed */
X
void skipwsm()
X {
X loop:
X skipws();
X if(!*ptr && getmore && !eof)
X if(ptr=getmore())
X {
X col=0;
X lvl= -1;
X ++line;
X goto loop;
X }
X else eof=1, ptr="";
X }
X
/* Skip whitespace; including ; */
X
void skipwssm()
X {
X loop:
X skipwsm();
X if(*ptr==';')
X {
X ++ptr, ++col;
X goto loop;
X }
X }
X
/* Table of operators and parse-tree node types */
X
/* NAME PREFIX INFIX POSTFIX PREC ASS METH INST ATOM */
/* Constants */
ATOM nNAM ={"nam" ,0 ,0 ,0 ,120 ,0 ,0 ,0 ,0};
ATOM nNUM ={"num" ,0 ,0 ,0 ,120 ,0 ,0 ,0 ,0};
ATOM nSTR ={"str" ,0 ,0 ,0 ,120 ,0 ,0 ,0 ,0};
X
ATOM nQUOTE ={"`" ,&nQUOTE,0 ,0 ,120 ,0 ,1 ,0 ,&nQUOTE};
X
ATOM nCALL1 ={"." ,0 ,&nCALL1,0 ,110 ,0 ,2 ,0 ,0};
X
ATOM nCALL ={"[" ,0 ,&nCALL ,0 ,100 ,0 ,66 ,0 ,0};
X
extern ATOM nPOINC, nPODEC;
ATOM nPRINC ={"++" ,&nPRINC,0 ,&nPOINC,90 ,0 ,5 ,0 ,&nADD};
ATOM nPRDEC ={"--" ,&nPRDEC,0 ,&nPODEC,90 ,0 ,5 ,0 ,&nSUB};
ATOM nPOINC ={"++" ,&nPRINC,0 ,&nPOINC,90 ,0 ,13 ,0 ,&nADD};
ATOM nPODEC ={"--" ,&nPRDEC,0 ,&nPODEC,90 ,0 ,13 ,0 ,&nSUB};
ATOM nCOM ={"~" ,&nCOM ,0 ,0 ,90 ,0 ,1 ,iCOM ,0};
ATOM nNEG ={"neg" ,&nNEG ,&nSUB ,0 ,90 ,0 ,1 ,iNEG ,0};
ATOM nNOT ={"!" ,&nNOT ,0 ,0 ,90 ,0 ,1 ,0 ,0};
X
ATOM nSHR ={">>" ,0 ,&nSHR ,0 ,80 ,0 ,2 ,iSHR ,0};
ATOM nSHL ={"<<" ,0 ,&nSHL ,0 ,80 ,0 ,2 ,iSHL ,0};
X
ATOM nMUL ={"*" ,0 ,&nMUL ,0 ,70 ,0 ,2 ,iMUL ,0};
ATOM nDIV ={"/" ,0 ,&nDIV ,0 ,70 ,0 ,2 ,iDIV ,0};
ATOM nMOD ={"%" ,&nMOD ,&nMOD ,0 ,70 ,0 ,2 ,iMOD ,0};
ATOM nAND ={"&" ,0 ,&nAND ,0 ,70 ,0 ,2 ,iAND ,0};
X
ATOM nADD ={"+" ,0 ,&nADD ,0 ,60 ,0 ,2 ,iADD ,0};
ATOM nSUB ={"-" ,&nNEG ,&nSUB ,0 ,60 ,0 ,2 ,iSUB ,0};
ATOM nOR ={"|" ,0 ,&nOR ,0 ,60 ,0 ,2 ,iOR ,0};
ATOM nXOR ={"^" ,0 ,&nXOR ,0 ,60 ,0 ,2 ,iXOR ,0};
X
ATOM nEQ ={"==" ,0 ,&nEQ ,0 ,50 ,0 ,2 ,iBEQ ,0};
ATOM nNE ={"!=" ,0 ,&nNE ,0 ,50 ,0 ,2 ,iBNE ,0};
ATOM nLT ={"<" ,0 ,&nLT ,0 ,50 ,0 ,2 ,iBLT ,0};
ATOM nGT ={">" ,0 ,&nGT ,0 ,50 ,0 ,2 ,iBGT ,0};
ATOM nLE ={"<=" ,0 ,&nLE ,0 ,50 ,0 ,2 ,iBLE ,0};
ATOM nGE ={">=" ,0 ,&nGE ,0 ,50 ,0 ,2 ,iBGE ,0};
X
ATOM nLAND ={"&&" ,0 ,&nLAND ,0 ,40 ,0 ,2 ,0 ,0};
X
ATOM nLOR ={"||" ,0 ,&nLOR ,0 ,30 ,0 ,2 ,0 ,0};
X
ATOM nSET ={"=" ,0 ,&nSET ,0 ,20 ,1 ,2 ,iSET ,0};
ATOM nDOTTO ={".=" ,0 ,&nDOTTO,0 ,20 ,1 ,6 ,0 ,&nCALL1};
ATOM nSHLTO ={"<<=" ,0 ,&nSHLTO,0 ,20 ,1 ,6 ,0 ,&nSHL};
ATOM nSHRTO ={">>=" ,0 ,&nSHRTO,0 ,20 ,1 ,6 ,0 ,&nSHR};
ATOM nMULTO ={"*=" ,0 ,&nMULTO,0 ,20 ,1 ,6 ,0 ,&nMUL};
ATOM nDIVTO ={"/=" ,0 ,&nDIVTO,0 ,20 ,1 ,6 ,0 ,&nDIV};
ATOM nMODTO ={"%=" ,0 ,&nMODTO,0 ,20 ,1 ,6 ,0 ,&nMOD};
ATOM nANDTO ={"&=" ,0 ,&nANDTO,0 ,20 ,1 ,6 ,0 ,&nAND};
ATOM nADDTO ={"+=" ,0 ,&nADDTO,0 ,20 ,1 ,6 ,0 ,&nADD};
ATOM nSUBTO ={"-=" ,0 ,&nSUBTO,0 ,20 ,1 ,6 ,0 ,&nSUB};
ATOM nXORTO ={"^=" ,0 ,&nXORTO,0 ,20 ,1 ,6 ,0 ,&nXOR};
ATOM nORTO ={"|=" ,0 ,&nORTO ,0 ,20 ,1 ,6 ,0 ,&nOR};
ATOM nPOST ={":" ,0 ,&nPOST ,0 ,20 ,1 ,10 ,0 ,0};
ATOM nDOTPO ={".:" ,0 ,&nDOTPO,0 ,20 ,1 ,14 ,0 ,&nCALL1};
ATOM nSHLPO ={"<<:" ,0 ,&nSHLPO,0 ,20 ,1 ,14 ,0 ,&nSHL};
ATOM nSHRPO ={">>:" ,0 ,&nSHRPO,0 ,20 ,1 ,14 ,0 ,&nSHR};
ATOM nMULPO ={"*:" ,0 ,&nMULPO,0 ,20 ,1 ,14 ,0 ,&nMUL};
ATOM nDIVPO ={"/:" ,0 ,&nDIVPO,0 ,20 ,1 ,14 ,0 ,&nDIV};
ATOM nMODPO ={"%:" ,0 ,&nMODPO,0 ,20 ,1 ,14 ,0 ,&nMOD};
ATOM nANDPO ={"&:" ,0 ,&nANDPO,0 ,20 ,1 ,14 ,0 ,&nAND};
ATOM nADDPO ={"+:" ,0 ,&nADDPO,0 ,20 ,1 ,14 ,0 ,&nADD};
ATOM nSUBPO ={"-:" ,0 ,&nSUBPO,0 ,20 ,1 ,14 ,0 ,&nSUB};
ATOM nXORPO ={"^:" ,0 ,&nXORPO,0 ,20 ,1 ,14 ,0 ,&nXOR};
ATOM nORPO ={"|:" ,0 ,&nORPO ,0 ,20 ,1 ,14 ,0 ,&nOR};
X
ATOM nEXTEND ={"\\" ,0 ,&nEXTEND,0 ,15 ,0 ,2 ,0 ,0};
X
ATOM nCOMMA ={"," ,0 ,&nCOMMA,0 ,10 ,0 ,2 ,0 ,0};
X
/* Special parse tree nodes */
/* A function definition */
ATOM nDEFUN ={"FUN" ,0 ,&nDEFUN,0 ,5 ,0 ,2 ,0 ,&nDEFUN};
X
/* A list [...] */
ATOM nLIST ={"LST" ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0};
X
/* Nothing */
ATOM nVOID ={"VOID",0 ,0 ,0 ,0 ,0 ,1 ,0 ,0};
X
/* Statements */
ATOM nIF ={"if" ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0};
ATOM nFOR ={"for" ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0};
ATOM nWHILE ={"while",0 ,0 ,0 ,0 ,0 ,1 ,0 ,0};
ATOM nWITH ={"with",0 ,0 ,0 ,0 ,0 ,1 ,0 ,0};
ATOM nLOCAL ={"local",0 ,0 ,0 ,0 ,0 ,1 ,0 ,0};
ATOM nELSE ={"else",0 ,0 ,0 ,0 ,0 ,2 ,0 ,0};
ATOM nLOOP ={"loop",0 ,0 ,0 ,0 ,0 ,2 ,0 ,0};
ATOM nUNTIL ={"until",0 ,0 ,0 ,0 ,0 ,3 ,0 ,0};
ATOM nBREAK ={"break",0 ,0 ,0 ,0 ,0 ,4 ,0 ,0};
ATOM nCONT ={"continue",0 ,0 ,0 ,0 ,0 ,4 ,0 ,0};
ATOM nRETURN ={"return",0 ,0 ,0 ,0 ,0 ,4 ,0 ,0};
ATOM nFOREACH ={"foreach",0 ,0 ,0 ,0 ,0 ,5 ,0 ,0};
ATOM nINCLUDE ={"include",0 ,0 ,0 ,0 ,0 ,6 ,0 ,0};
X
/* Construct a two operand node */
X
NODE *cons2(what,left,right)
ATOM *what;
NODE *left, *right;
X {
X if(!left || !right) { rm(right); rm(left); return 0; }
X else
X {
X NODE *n=(NODE *)malloc(sizeof(NODE));
X n->what=what;
X n->l=left;
X n->r=right;
X n->s=0;
X n->line=line;
X n->name=name;
X return n;
X }
X }
X
/* Construct a single operand node */
X
NODE *cons1(what,right)
ATOM *what;
NODE *right;
X {
X if(!right) return 0;
X else
X {
X NODE *n=(NODE *)malloc(sizeof(NODE));
X n->what=what;
X n->l=0;
X n->r=right;
X n->s=0;
X n->name=name;
X n->line=line;
X return n;
X }
X }
X
/* Construct an integer constant */
X
NODE *consnum(v)
X {
X NODE *n=(NODE *)malloc(sizeof(NODE));
X n->what=&nNUM;
X n->l=0;
X n->r=0;
X n->n=v;
X n->s=0;
X n->line=line;
X n->name=name;
X return n;
X }
X
/* Construct a string constant */
X
NODE *consstr(v,len)
char *v;
X {
X NODE *n=(NODE *)malloc(sizeof(NODE));
X n->what=&nSTR;
X n->l=0;
X n->r=0;
X n->s=v;
X n->n=len;
X n->line=line;
X n->name=name;
X return n;
X }
X
/* Construct an identifier */
X
NODE *consnam(v)
char *v;
X {
X NODE *n=(NODE *)malloc(sizeof(NODE));
X n->what=&nNAM;
X n->l=0;
X n->r=0;
X n->s=v;
X n->n=strlen(v);
X n->line=line;
X n->name=name;
X return n;
X }
X
/* Construct a void */
X
NODE *consvoid()
X {
X NODE *n=(NODE *)malloc(sizeof(NODE));
X n->what=&nVOID;
X n->l=0;
X n->r=0;
X n->s=0;
X n->n=0;
X n->line=line;
X n->name=name;
X return n;
X }
X
/* Construct an optional node */
X
NODE *opt(n)
NODE *n;
X {
X if(n) return n;
X else return consvoid();
X }
X
/* Duplicate a tree */
X
NODE *dup(o)
NODE *o;
X {
X NODE *n;
X if(!o) return 0;
X n=(NODE *)malloc(sizeof(NODE));
X n->what=o->what;
X if(o->s)
X {
X int x;
X n->s=(char *)malloc(o->n+1);
X for(x=0;x!=o->n;++x) n->s[x]=o->s[x];
X n->s[x]=0;
X }
X else n->s=0;
X n->n=o->n;
X n->r=dup(o->r);
X n->l=dup(o->l);
X n->name=o->name;
X n->line=o->line;
X return n;
X }
X
/* Eliminate a tree */
X
void rm(n)
NODE *n;
X {
X if(n)
X {
X rm(n->l);
X rm(n->r);
X if(n->s) free(n->s);
X free(n);
X }
X }
X
/* Operator scanner */
X
#define OPRTLEN 64
#define OPRLTLEN 128
char oprltab[OPRLTLEN]; /* Hash table of operator left-substrings */
ATOM *oprtab[OPRTLEN]; /* Hash table of operators */
unsigned long accu; /* Hash value accumulator */
char *start; /* Pointer to operator in input string */
X
ATOM *ioprtab[]=
X { &nCALL1, &nCALL, &nPRINC, &nPRDEC, &nCOM, &nSUB, &nNOT, &nSHR, &nSHL,
X &nMUL, &nDIV, &nMOD, &nAND, &nADD, &nOR, &nXOR, &nEQ, &nNE, &nGE, &nLE,
X &nGT, &nLT, &nLAND, &nLOR, &nSET, &nDOTTO, &nSHLTO, &nSHRTO, &nMULTO,
X &nDIVTO, &nMODTO, &nANDTO, &nADDTO, &nSUBTO, &nXORTO, &nORTO, &nPOST,
X &nDOTPO, &nSHLPO, &nSHRPO, &nMULPO, &nDIVPO, &nMODPO, &nANDPO, &nADDPO,
X &nSUBPO, &nXORPO, &nORPO, &nQUOTE, &nEXTEND, 0 };
X
void izoprtab()
X {
X int x;
X ATOM *t;
X for(x=0;t=ioprtab[x];++x)
X {
X char *s=t->name;
X accu=0; while(*s)
X {
X accu=hnext(accu,*s++);
X if(*s) ++oprltab[accu%OPRLTLEN];
X }
X t->next=oprtab[accu%OPRTLEN];
X oprtab[accu%OPRTLEN]=t;
X }
X }
X
ATOM *doopr()
X {
X unsigned long oaccu=accu; char *oops=ptr; int oopscol=col;
X char c;
X ATOM *t;
X do
X {
X if(!*ptr) break;
X accu=hnext(accu,*ptr++);
X c= *ptr; *ptr=0;
X for(t=oprtab[accu%OPRTLEN];t;t=t->next)
X if(!strcmp(start,t->name))
X {
X ATOM *u;
X *ptr=c;
X if(u=doopr()) return u;
X else return t;
X }
X *ptr=c;
X } while(oprltab[accu%OPRLTLEN]);
X accu=oaccu; ptr=oops; col=oopscol;
X return 0;
X }
X
/* Look up an operator */
X
ATOM *opr()
X {
X if(!start) izoprtab();
X accu=0;
X start=ptr;
X return doopr();
X }
X
/* Get a character which might be an escape sequence */
X
int escape()
X {
X if(*ptr=='\\')
X {
X ++ptr; ++col;
X switch(*ptr)
X {
X case '^':
X ++ptr; ++col;
X if(*ptr>='@' && *ptr<='_') return ++col, *ptr++-'@';
X else if(*ptr=='?') return ++col, ++ptr, 127;
X else return escape();
X
X case '8': case '9':
X return ++col, *ptr++-'0';
X
X case 'x': case 'X':
X {
X int num=0;
X ++col; ++ptr;
X if(*ptr>='0' && *ptr<='9') num=(++col, *ptr++-'0');
X else if(*ptr>='a' && *ptr<='f') num=(++col, *ptr++-'a'+10);
X else if(*ptr>='A' && *ptr<='F') num=(++col, *ptr++-'A'+10);
X if(*ptr>='0' && *ptr<='9') num=num*16+(++col, *ptr++-'0');
X else if(*ptr>='a' && *ptr<='f') num=num*16+(++col, *ptr++-'a'+10);
X else if(*ptr>='A' && *ptr<='F') num=num*16+(++col, *ptr++-'A'+10);
X return num;
X }
X
X case '0': case '1': case '2': case '3':
X case '4': case '5': case '6': case '7':
X {
X int num= *ptr++-'0'; ++col;
X if(*ptr>='0' && *ptr<='7')
X num=num*8+*ptr++-'0', ++col;
X if(*ptr>='0' && *ptr<='7')
X num=num*8+*ptr++-'0', ++col;
X return num;
X }
X
X case 'a': return ++ptr, ++col, 7;
X case 'b': return ++ptr, ++col, 8;
X case 'e': return ++ptr, ++col, 27;
X case 'f': return ++ptr, ++col, 12;
X case 'n': return ++ptr, ++col, 10;
X case 'r': return ++ptr, ++col, 13;
X case 't': return ++ptr, ++col, 9;
X
X case '\\': return ++col, *ptr++;
X
X default: return escape();
X }
X }
X else if(*ptr!='\t') return ++col, *ptr++;
SHAR_EOF
true || echo 'restore of compile.c failed'
fi
echo 'End of part 1'
echo 'File compile.c is continued in part 2'
echo 2 > _shar_seq_.tmp
exit 0
--
/* jha...@world.std.com (192.74.137.5) */ /* Joseph H. Allen */
int a[1817];main(z,p,q,r){for(p=80;q+p-80;p-=2*a[p])for(z=9;z--;)q=3&(r=time(0)
+r*57)/7,q=q?q-1?q-2?1-p%79?-1:0:p%79-77?1:0:p<1659?79:0:p>158?-79:0,q?!a[p+q*2
]?a[p+=a[p+=q]=q]=q:0:0;for(;q++-1817;)printf(q%79?"%c":"%c\n"," #"[!a[q-1]]);}