From: Eric S. Raymond Date: Wed, 2 Nov 1994 22:03:17 +0000 (+0000) Subject: Initial revision X-Git-Tag: 1-2~114 X-Git-Url: http://thyrsus.com/gitweb/?a=commitdiff_plain;h=101b8b0f176c813d6bbbb6380f2ffcdb3585532d;p=cupl.git Initial revision --- 101b8b0f176c813d6bbbb6380f2ffcdb3585532d diff --git a/cupl.h b/cupl.h new file mode 100644 index 0000000..6bdc971 --- /dev/null +++ b/cupl.h @@ -0,0 +1,61 @@ +/* cupl.h -- basic types for the CUPL interpreter/compiler */ + +/* maximum file size */ +#ifdef USG +#include +#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 */ diff --git a/cupl.l b/cupl.l new file mode 100644 index 0000000..9a7f1ed --- /dev/null +++ b/cupl.l @@ -0,0 +1,217 @@ +%{ +/* cupl.l -- lexical analyzer for the CUPL language */ + +#include +#include +#include +#include +#include +#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 */ diff --git a/interpret.c b/interpret.c new file mode 100644 index 0000000..e9f9c2f --- /dev/null +++ b/interpret.c @@ -0,0 +1,91 @@ +#include +#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 */ +