--- /dev/null
+/* cupl.h -- basic types for the CUPL interpreter/compiler */
+
+/* maximum file size */
+#ifdef USG
+#include <limits.h>
+#else
+#define PATH_MAX 1024
+#endif
+
+#define MAXPERFORM 64 /* depth of perform stack */
+#define MAXVARS 1024 /* maximum variables */
+#define MAXNAME 10 /* maximum length of variable names */
+#define MAXSTR 256 /* maximum string size */
+
+#ifndef CUPLDIR
+#define CUPLDIR "/usr/lib/cupl/"
+#endif /* CUPLDIR */
+
+#define EXT ".cupl" /* CUPL source file extension */
+
+#ifndef TRUE
+typedef int bool;
+#define TRUE 1
+#define FALSE 0
+#endif /* TRUE */
+
+/*
+ * This is the node structure for parse trees.
+ */
+typedef struct edon
+{
+ int type; /* type of NODE if *left || *right */
+ union
+ {
+ struct /* for parse-tree nodes */
+ {
+ struct edon *left;
+ struct edon *right;
+ } n;
+
+ double numval; /* for numbers */
+
+ char *string; /* for string literals */
+
+ struct /* for label values */
+ {
+ struct edon *dest;
+ char *string;
+ } l;
+ } u;
+}
+node;
+
+#define NOMEM "out of memory\n"
+
+extern char *tokdump(int value);
+extern void yyerror(const char *errmsg);
+extern void interpret(node *tree);
+extern int verbose;
+
+/* cupl.h ends here */
--- /dev/null
+%{
+/* cupl.l -- lexical analyzer for the CUPL language */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <string.h>
+#include <memory.h>
+#include <stdlib.h>
+#include "tokens.h"
+#include "cupl.h"
+
+extern char *strdup(const char *s);
+
+typedef struct lvar_t
+{
+ struct lvar_t *next;
+ node *node;
+}
+lvar;
+
+static lvar *idlist;
+
+static node *intern_number(double);
+static node *intern_identifier(char *);
+static node *intern_string(char *);
+%}
+
+D [0-9][0-9]*
+N [0-9.]+
+
+%%
+COMMENT.*\n ;
+
+ABS {return(ABS);}
+ALL {return(ALL);}
+ALLOCATE {return(ALLOCATE);}
+AND {return(AND);}
+ATAN {return(ATAN);}
+BLOCK {return(BLOCK);}
+BY {return(BY);}
+COMMENT {return(COMMENT);}
+COS {return(COS);}
+DET {return(DET);}
+DOT {return(DOT);}
+ELSE {return(ELSE);}
+END {return(END);}
+EXP {return(EXP);}
+FLOOR {return(FLOOR);}
+FOR {return(FOR);}
+GE {return(GE);}
+GO {return(GO);}
+GT {return(GT);}
+IDN {return(IDN);}
+IF {return(IF);}
+INV {return(INV);}
+LE {return(LE);}
+LET {return(LET);}
+LN {return(LN);}
+LOG {return(LOG);}
+LT {return(LT);}
+MAX {return(MAX);}
+MIN {return(MIN);}
+NE {return(NE);}
+OR {return(OR);}
+PERFORM {return(PERFORM);}
+POSMAX {return(POSMAX);}
+POSMIN {return(POSMIN);}
+RAND {return(RAND);}
+READ {return(READ);}
+SGM {return(SGM);}
+SIN {return(SIN);}
+SQRT {return(SQRT);}
+STOP {return(STOP);}
+THEN {return(THEN);}
+TIMES {return(TIMES);}
+TO {return(TO);}
+TRC {return(TRC);}
+TRN {return(TRN);}
+WATCH {return(WATCH);}
+WHILE {return(WHILE);}
+WRITE {return(WRITE);}
+
+"*DATA" {return(DATA);}
+
+[A-Z][A-Z0-9]* {yylval.node = intern_identifier(yytext); return(IDENTIFIER);}
+-?{N}E-?{D} {yylval.node = intern_number(atof(yytext)); return(NUMBER);}
+-?{N} {yylval.node = intern_number(atof(yytext)); return(NUMBER);}
+'[^']*' {yylval.node = intern_string(yytext); return(STRING);}
+
+"**" {return(POWER);}
+[+*/().,=-] {return(yytext[0]);}
+
+[ \t\n] ;
+
+%%
+
+static node *intern_identifier(char *str)
+{
+ register lvar *n;
+ node *new;
+
+ new = (node *)NULL;
+ for (n = idlist; n; n = n->next)
+ if (strcmp(n->node->u.string, str) == 0)
+ {
+ new = n->node;
+ break;
+ }
+ if (!n)
+ {
+ /* get a node */
+ if ((new = (node *)malloc(sizeof(node)))==(node *)NULL)
+ {
+ (void) puts("Out of memory while interning ID.");
+ exit(1);
+ }
+
+ /* stuff the node with the identifier vakue */
+ new->type = IDENTIFIER;
+ new->u.string = strdup(str);
+
+ /* link it into the recognition list */
+ n = (lvar *)malloc(sizeof(lvar));
+ n->next = idlist;
+ n->node = new;
+ idlist = n;
+
+#ifdef PARSEDEBUG
+ if (verbose >= 2)
+ (void) printf("intern: %9x (IDENTIFIER: %s)\n",
+ new, str);
+#endif /* PARSEDEBUG */
+ }
+
+ return(new);
+}
+
+static node *intern_number(double numval)
+{
+ node *new;
+
+ /* get a node */
+ if ((new = (node *)malloc(sizeof(node))) == (node *)NULL)
+ {
+ (void) puts(NOMEM);
+ exit(1);
+ }
+
+ new->type = NUMBER;
+ new->u.numval = numval;
+
+#ifdef PARSEDEBUG
+ if (verbose >= 2)
+ (void) printf("intern: %x (NUMBER: %d)\n", new, numval);
+#endif /* PARSEDEBUG */
+ return(new);
+}
+
+static node *intern_string(char *str)
+{
+ node *new;
+
+ /* get a node */
+ if ((new = (node *)malloc(sizeof(node)))==(node *)NULL)
+ {
+ (void) puts("Out of memory while interning string.");
+ exit(1);
+ }
+
+ str[strlen(str) - 1] = '\0';
+
+ new->type = STRING;
+ new->u.string = strdup(str + 1);
+
+#ifdef PARSEDEBUG
+ if (verbose >= 2)
+ (void) printf("intern: %9x (STRING: '%s')\n",
+ new, new->u.string);
+#endif /* PARSEDEBUG */
+
+ return(new);
+}
+
+void yyerror(const char *str)
+{
+ (void) fprintf(stderr, "cupl: line %d, %s\n", yylineno, str);
+}
+
+int yywrap()
+{
+ return(EOF);
+}
+
+#ifdef MAIN
+YYSTYPE yylval;
+
+main()
+{
+ int t;
+
+ while ((t = yylex()) > 0)
+ {
+ if (t == NUMBER)
+ (void) printf("NUMBER: %f\n", yylval.numval);
+ else if (t == NEWLINE)
+ (void) printf("NEWLINE\n");
+ else if (t == STRING)
+ (void) printf("STRING: %s\n", yylval.string);
+ else if (t == IDENTIFIER)
+ (void) printf("IDENTIFIER: %s\n", yylval.string);
+ else
+ (void) printf("keyword %3d: %s\n", t, tokdump(t));
+ }
+}
+#endif /* MAIN */
+
+/* cupl.l ends here */
--- /dev/null
+#include <stdio.h>
+#include "cupl.h"
+#include "tokens.h"
+
+/* this structure represents a CUPL variable */
+typedef struct rav
+{
+ char name[MAXNAME + 1]; /* name of variable */
+ int type; /* type (syntax class) */
+ int rank;
+ union
+ {
+ struct
+ {
+ int length;
+ double *parts;
+ } vector; /* a vector */
+
+ struct
+ {
+ int width, depth;
+ double *parts;
+ } matrix; /* a matrix */
+
+ char *string;
+
+ struct
+ {
+ long lineno; /* source line number */
+ long addr; /* label seek offset */
+ int refcount; /* count of JUMPS and PERFORM to it */
+ }
+ label;
+#define BAD_LABEL -1L /* out-of-band labeladdr value */
+ } v;
+}
+variable;
+
+#ifdef PARSEDEBUG
+/*
+ * Note: This prettyprint routine tries to keep cons lists of elements of the
+ * same type at the same indent level. It does this by foregoing the normal
+ * indent for the right-hand child of a cons if the child is the same type as
+ * the parent cons.
+ */
+static void prettyprint(node *tree, int indent)
+/* prettyprint a parse tree */
+{
+#define INDENT 2
+ int n;
+
+ if (tree == (node *)NULL)
+ return;
+
+ for (n = 0; n < indent; n++)
+ (void) putchar(' ');
+
+ if (tree->type == NUMBER)
+ (void) printf("NUMBER: %f\n", tree->u.numval);
+ else if (tree->type == IDENTIFIER)
+ (void) printf("IDENTIFIER: %s\n", tree->u.string);
+ else if (tree->type == STRING)
+ (void) printf("STRING: '%s'\n", tree->u.string);
+ else
+ {
+ (void) printf("%-20s", tokdump(tree->type));
+ if (verbose >= 2)
+ (void) printf(" (%x -> %x, %x)",
+ tree,
+ tree->u.n.left,
+ tree->u.n.right);
+ (void) putchar('\n');
+ prettyprint(tree->u.n.left,
+ indent + INDENT);
+ prettyprint(tree->u.n.right,
+ indent + INDENT * (tree->type != tree->u.n.right->type));
+ }
+}
+#endif /* PARSEDEBUG */
+
+void interpret(node *tree)
+/* interpret a program parse tree */
+{
+#ifdef PARSEDEBUG
+ if (verbose > 0)
+ prettyprint(tree, 0);
+#endif /* PARSEDEBUG */
+}
+
+/* interpret.c ends here */
+
projects / cupl.git / commitdiff