--- /dev/null
+Sat Sep 4 15:51:33 1999 Ryuichi Naitoh <night@ibmpc0.bfree.rim.or.jp>
+
+ * VERSION:
+ bcplc ¤ò CVS ¤Î´ÉÍý¤«¤éÂоݳ°¤Ë¤·¤¿¡£
+ ¥ª¥Ú¥ì¡¼¥¿ & ¤Î¥È¡¼¥¯¥ó¤ò TK_AND ¤«¤é TK_ANDOP ¤ËÊѹ¹¤·¤¿¡£
+ ¤Þ¤¿¡¢BE ¤È¤¤¤¦Í½Ìó¸ìÍѤΥȡ¼¥¯¥ó¤ò TK_AND ¤È¤·¤ÆÄêµÁ¤·¤¿¡£
+ procedure ¤Î¹½Ê¸ÄêµÁ¤Ë AND ¤¬Íè¤ë¾ì¹ç¤òÄɲä·¤¿¡£
--- /dev/null
+0.0.4
\ No newline at end of file
--- /dev/null
+Sun Sep 5 08:48:52 1999 Ryuichi Naitoh <night@ibmpc0.bfree.rim.or.jp>
+
+ * bcpl.h debug.c lexical.l misc.c parser.y
+ BCPL ¤ÎÆÃħ¤Î¤Ò¤È¤Ä¤Ç¤¢¤ë¡¢¥¿¥°ÉÕ¤¤Î¶è´Ö¤«¤Ã¤³¤ò»È¤Ã¤¿¤È¤¤Ë¡¢¶è´Ö¤«¤Ã
+ ¤³¤Î¾Êά¤Ç¤¤ëµ¡Ç½¤ò¥µ¥Ý¡¼¥È¤·¤¿¡£
+
+Sat Sep 4 15:50:48 1999 Ryuichi Naitoh <night@ibmpc0.bfree.rim.or.jp>
+
+ * .cvsignore: bcplc ¤ò CVS ¤Î´ÉÍý¤«¤éÂоݳ°¤Ë¤·¤¿¡£
+
+ * parser.y lexical.l
+ ¥ª¥Ú¥ì¡¼¥¿ & ¤Î¥È¡¼¥¯¥ó¤ò TK_AND ¤«¤é TK_ANDOP ¤ËÊѹ¹¤·¤¿¡£
+ ¤Þ¤¿¡¢BE ¤È¤¤¤¦Í½Ìó¸ìÍѤΥȡ¼¥¯¥ó¤ò TK_AND ¤È¤·¤ÆÄêµÁ¤·¤¿¡£
+ procedure ¤Î¹½Ê¸ÄêµÁ¤Ë AND ¤¬Íè¤ë¾ì¹ç¤òÄɲä·¤¿¡£
--- /dev/null
+#
+#
+#
+
+
+CFLAGS=
+
+all: bcplc
+
+bcplc: main.o lexical.o parser.tab.o makecode.o misc.o debug.o
+ cc -o bcplc main.o lexical.o parser.tab.o makecode.o misc.o debug.o -lfl
+
+
+main.o: main.c bcpl.h
+ cc $(CFLAGS) -c main.c
+
+misc.o: misc.c parser.tab.c bcpl.h
+ cc $(CFLAGS) -c misc.c
+
+debug.o: debug.c parser.tab.c bcpl.h
+ cc $(CFLAGS) -c debug.c
+
+lexical.o: lexical.c parser.tab.c bcpl.h
+ cc $(CFLAGS) -c lexical.c
+
+
+lexical.c: lexical.l bcpl.h
+ flex -olexical.c lexical.l
+
+parser.tab.o: parser.tab.c bcpl.h
+ cc $(CFLAGS) -c parser.tab.c
+
+parser.tab.c: parser.y bcpl.h
+ bison -v -t -d parser.y
+
+
+
+clean:
+ rm -f bcplc *.o parser.tab.c parser.tab.h *~ core lexical.c parser.output
+
--- /dev/null
+/*
+ *
+ */
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <malloc.h>
+
+
+#define MAX_STRING_LENGTH 255
+#define MAX_TAG 10
+
+struct symbol
+{
+ int type;
+ struct symbol *hash;
+ int length;
+ char *value;
+};
+
+
+struct string
+{
+ int type;
+ int length;
+ char *value;
+};
+
+
+struct character
+{
+ int type;
+ int value;
+};
+
+
+struct number
+{
+ int type;
+ int value;
+};
+
+
+struct node
+{
+ int type;
+ void *head;
+ void *body;
+ void *next;
+};
+
+
+#define OP_MANIFEST 1
+#define OP_CONST 2
+#define OP_DECLARE 3
+#define OP_GLOBAL 4
+#define OP_EXPR 5
+#define OP_PLUSOP 6
+#define OP_SUBOP 7
+#define OP_FUNCTION 8
+#define OP_ARGS 9
+#define OP_STATEMENT 10
+#define OP_PROCEDURE 11
+#define OP_CALL 12
+#define OP_VALOF 13
+#define OP_RETURN 14
+#define OP_VARIABLE 15
+#define OP_CONST_LIST 16
+#define OP_INITIALVAR 17
+#define OP_IF 18
+#define OP_WHILE 19
+#define OP_SET 20 /* ÂåÆþ */
+#define OP_STATIC 21
+#define OP_MULTOP 22
+#define OP_DIVOP 23
+#define OP_LT 24
+#define OP_GT 25
+#define OP_OR 26
+#define OP_AND 27
+#define OP_EQUAL 28
+#define OP_VECIS 29 /* ! */
+#define OP_SWITCHON 30
+#define OP_CASE 31
+#define OP_GE 32
+#define OP_LE 33
+#define OP_REPEATUNTIL 34
+#define OP_CASECONT 35
+#define OP_GET 36
+#define OP_BLOCK 37
+
+
+extern struct symbol *make_symbol ();
+extern struct string *make_string ();
+extern struct node *make_node ();
+extern struct number *make_number ();
+
+extern void debug_print ();
+
+extern int nlcount;
--- /dev/null
+/*
+ *
+ *
+ */
+
+
+#include "bcpl.h"
+#include "parser.tab.h"
+
+
+extern void print_node ();
+static void print_symbol ();
+static void print_string ();
+static void print_number ();
+static void print_const ();
+static void print_declare ();
+static void print_func ();
+static void print_proc ();
+static void print_call ();
+static void print_expr ();
+static void print_args ();
+static void print_arglist ();
+static void print_statement ();
+static void print_return ();
+static void print_variable ();
+static void print_initialized_variable ();
+static void print_initial_list ();
+static void print_assign (struct node *nodep, int indent);
+static void print_if ();
+static void print_while ();
+static void print_switchon (struct node *nodep, int indent);
+static void print_case (struct node *nodep, int indent);
+static void print_repeatuntil (struct node *nodep, int indent);
+static void print_get (struct node *nodep, int indent);
+static void print_block (struct node *nodep, int indent);
+
+static struct debug_entry *get_entry ();
+
+
+struct debug_entry
+{
+ int type;
+ char *nicname;
+ void (*f)();
+};
+
+
+struct debug_entry debug_table[] =
+{
+ { OP_DECLARE, "declare", print_declare },
+ { OP_MANIFEST, "manifest", print_node },
+ { OP_CONST, "const", print_const },
+ { OP_GLOBAL, "global", print_node },
+ { OP_STATIC, "static", print_node },
+ { OP_FUNCTION, "func", print_func },
+ { OP_PROCEDURE, "proc", print_proc },
+ { OP_ARGS, "args", print_arglist },
+ { OP_PLUSOP, "+", print_expr },
+ { OP_SUBOP, "-", print_expr },
+ { OP_MULTOP, "*", print_expr },
+ { OP_DIVOP, "/", print_expr },
+ { OP_GT, "<", print_expr },
+ { OP_LT, ">", print_expr },
+ { OP_GE, "<=", print_expr },
+ { OP_LE, ">=", print_expr },
+ { OP_AND, "&", print_expr },
+ { OP_OR, "|", print_expr },
+ { OP_EQUAL, "=", print_expr },
+ { OP_VECIS, "!", print_expr },
+
+ { OP_STATEMENT, "- ", print_statement },
+ { OP_CALL, "Call", print_call },
+ { OP_RETURN, "return", print_return },
+ { OP_VALOF, "valof", print_node },
+ { OP_VARIABLE, "var", print_variable },
+ { OP_INITIALVAR, "initvar", print_initialized_variable },
+ { OP_SET, "assign", print_assign },
+ { OP_IF, "if", print_if },
+ { OP_WHILE, "whlie", print_while },
+ { OP_SWITCHON, "switchon", print_switchon },
+ { OP_CASE, "case", print_case },
+ { OP_CASECONT, "case", print_case },
+ { OP_REPEATUNTIL, "repeatuntil", print_repeatuntil },
+ { OP_GET, "GET", print_get },
+ { OP_BLOCK, "BLOCK", print_block },
+
+ { TK_SYMBOL, "symbol", print_symbol },
+ { TK_STRING, "string", print_string },
+ { TK_NUMBER, "number", print_number },
+ { 0, NULL, NULL },
+};
+
+
+static struct debug_entry *
+get_entry (nodep)
+ struct node *nodep;
+{
+ int i;
+
+ if (nodep == NULL)
+ return (NULL);
+
+ for (i = 0; debug_table[i].type != 0; i++)
+ {
+ if (nodep->type == debug_table[i].type)
+ {
+ return (&debug_table[i]);
+ }
+ }
+ return (NULL);
+}
+
+
+static
+print_space (int n)
+{
+ int i;
+
+ for (i = 0; i < n; i++)
+ {
+ printf (" ");
+ }
+}
+
+
+void
+debug_print (struct node *nodep, int indent)
+{
+ struct debug_entry *entp, *p;
+
+ if (nodep == NULL)
+ return;
+
+ entp = get_entry (nodep);
+ if (entp == NULL)
+ return;
+
+ (entp->f)(nodep, indent);
+}
+
+
+void
+print_node (struct node *nodep, int indent)
+{
+ struct debug_entry *entp, *p;
+
+ if (nodep == NULL)
+ return;
+
+ entp = get_entry (nodep);
+ print_space (indent);
+ printf ("[%s]\n", entp->nicname);
+ if (p = get_entry (nodep->head))
+ {
+ (p->f)(nodep->head, indent + 2);
+ }
+
+ if (p = get_entry (nodep->body))
+ {
+ (p->f)(nodep->body, indent + 2);
+ }
+
+ if (p = get_entry (nodep->next))
+ {
+ (p->f)(nodep->next, indent + 2);
+ }
+}
+
+
+static void
+print_symbol (struct symbol *symbolp, int indent)
+{
+ print_space (indent);
+ printf ("<%s>", symbolp->value);
+}
+
+
+static void
+print_string (struct string *strp, int indent)
+{
+ print_space (indent);
+ printf ("<string>\"%s\"", strp->value);
+}
+
+static void
+print_number (struct number *nump, int indent)
+{
+ print_space (indent);
+ printf ("%d", nump->value);
+}
+
+
+static void
+print_declare (struct node *nodep, int indent)
+{
+ struct symbol *sp;
+ struct number *np;
+
+ sp = nodep->head;
+ print_space (indent);
+ printf ("[declare]\n");
+ debug_print (nodep->head, indent + 10);
+ if (nodep->next)
+ {
+ print_declare (nodep->next, indent);
+ }
+}
+
+static void
+print_const (struct node *nodep, int indent)
+{
+ struct symbol *sp;
+ struct number *np;
+
+ sp = nodep->head;
+ np = nodep->body;
+ print_space (indent);
+ printf ("[const]\t%s,%d\n", sp->value, np->value);
+ if (nodep->next)
+ {
+ print_const (nodep->next, indent);
+ }
+}
+
+static void
+print_func (struct node *nodep, int indent)
+{
+ struct symbol *sp;
+ struct nodep *argp;
+ struct nodep *exp;
+
+ sp = nodep->head;
+ argp = nodep->body;
+ exp = nodep->next;
+
+ print_space (indent);
+ printf ("[function] %s\n", sp->value);
+ debug_print ((void *)argp, indent + 2);
+ debug_print ((void *)exp, indent + 2);
+/* printf ("\n"); ** */
+}
+
+static void
+print_proc (struct node *nodep, int indent)
+{
+ struct symbol *sp;
+ struct nodep *argp;
+ struct nodep *body;
+
+ sp = nodep->head;
+ argp = nodep->body;
+ body = nodep->next;
+
+ print_space (indent);
+ printf ("[procedure] %s\n", sp->value);
+ debug_print ((void *)argp, indent + 2);
+ debug_print ((void *)body, indent + 2);
+}
+
+
+static void
+print_call (struct node *nodep, int indent)
+{
+ struct symbol *sp;
+ struct node *argp;
+
+ sp = nodep->head;
+ argp = nodep->body;
+
+ print_space (indent);
+ printf ("[call] %s(", sp->value);
+ print_args ((void *)argp, indent + 2);
+ printf (")");
+}
+
+
+static void
+print_arglist (struct node *nodep, int indent)
+{
+ print_space (indent);
+ printf ("[args] ");
+ print_args (nodep, indent);
+ printf ("\n");
+}
+
+
+static void
+print_args (struct node *nodep, int indent)
+{
+ struct symbol *sp;
+ struct node *argp;
+
+ if (nodep == NULL)
+ return;
+
+ sp = nodep->head;
+ argp = nodep->next;
+ if (sp->type == TK_SYMBOL)
+ {
+ printf ("%s", sp->value);
+ }
+ else
+ {
+ debug_print ((struct node *)sp, 0);
+ }
+
+ if (argp)
+ {
+ printf (", ");
+ print_args (argp, indent);
+ }
+}
+
+static void
+print_expr (struct node *nodep, int indent)
+{
+ struct debug_entry *entp;
+ struct node *ex1, *ex2;
+
+ ex1 = nodep->head;
+ ex2 = nodep->body;
+ entp = get_entry (nodep);
+
+ print_space (indent);
+ printf ("(%s", entp->nicname);
+ if (ex1)
+ {
+ printf (" ");
+ debug_print (ex1, 0);
+ }
+ if (ex2)
+ {
+ printf (" ");
+ debug_print (ex2, 0);
+ }
+ printf (")");
+}
+
+
+static void
+print_statement (struct node *nodep, int indent)
+{
+ struct debug_entry *entp;
+ struct node *body, *next;
+
+ body = nodep->head;
+ next = nodep->next;
+ entp = get_entry (nodep);
+
+ print_space (indent);
+ printf ("[S] ");
+ if (body)
+ {
+ switch (body->type)
+ {
+ case OP_IF:
+ case OP_WHILE:
+ case OP_SWITCHON:
+ case OP_REPEATUNTIL:
+ case OP_BLOCK:
+ debug_print (body, indent);
+ break;
+
+ default:
+ debug_print (body, 0);
+ printf ("\n");
+ break;
+ }
+ }
+ if (next)
+ {
+ debug_print (next, indent);
+ }
+}
+
+
+static void
+print_variable (struct node *nodep, int indent)
+{
+ struct debug_entry *entp;
+ struct symbol *body;
+ struct node *next;
+
+ body = nodep->head;
+ next = nodep->next;
+ entp = get_entry (nodep);
+
+ print_space (indent);
+ printf ("[Var] ");
+ if (body)
+ {
+ if (body->type == TK_SYMBOL)
+ {
+ printf ("%s", body->value);
+ }
+ else
+ {
+ debug_print ((struct node *)body, 0);
+ }
+ }
+ if (next)
+ {
+ printf (", ");
+ print_args (next, 0);
+ }
+}
+
+
+static void
+print_assign (struct node *nodep, int indent)
+{
+ struct node *body, *head;
+
+ head = nodep->head;
+ body = nodep->body;
+ print_space (indent);
+ printf ("[assign] ");
+ if (head)
+ {
+ debug_print (head, 0);
+ }
+
+ printf (" := ");
+
+ if (body)
+ {
+ debug_print (body, 0);
+ }
+}
+
+
+static void
+print_return (struct node *nodep, int indent)
+{
+ struct node *body;
+
+ body = nodep->head;
+ print_space (indent);
+ printf ("[return] ");
+ if (body)
+ {
+ debug_print (body, 0);
+ }
+}
+
+
+static void
+print_initialized_variable (struct node *nodep, int indent)
+{
+ struct node *body, *next;
+
+ body = nodep->head;
+ next = nodep->body;
+
+ print_space (indent);
+ if (body)
+ {
+ print_variable (body, 0);
+ }
+
+ if (next)
+ {
+ printf (" = ");
+ print_initial_list (next);
+ }
+}
+
+
+static void
+print_initial_list (struct node *nodep)
+{
+ struct number *nump;
+
+ if (nodep == NULL)
+ return;
+
+ nump = nodep->head;
+ if (nump->type == TK_NUMBER)
+ {
+ printf ("%d", nump->value);
+ }
+ else
+ {
+ print_node ((struct node *)nump, 0);
+ }
+
+ if (nodep->next)
+ {
+ printf (", ");
+ print_initial_list (nodep->next);
+ }
+}
+
+static void
+print_if (struct node *nodep, int indent)
+{
+ struct node *head, *body;
+
+ printf ("[IF] ( ");
+ head = nodep->head;
+ body = nodep->body;
+ debug_print ((struct node *)head, 0);
+ printf (" ) \n");
+ debug_print ((struct node *)body, indent + 4);
+}
+
+
+static void
+print_while (struct node *nodep, int indent)
+{
+ struct node *head, *body;
+
+ printf ("[WHILE] ( ");
+ head = nodep->head;
+ body = nodep->body;
+ debug_print ((struct node *)head, 0);
+ printf (" )\n");
+ debug_print ((struct node *)body, indent + 4);
+}
+
+
+static void
+print_switchon (struct node *nodep, int indent)
+{
+ struct node *expr, *caselist;
+
+ printf ("[SWITCHON] ( ");
+ expr = nodep->head;
+ caselist = nodep->body;
+
+ debug_print (expr, 0);
+ printf (" )\n");
+ debug_print (caselist, indent + 4);
+}
+
+
+static void
+print_case (struct node *nodep, int indent)
+{
+ print_space (indent);
+ printf ("[CASE] ( ");
+ debug_print (nodep->head, 0);
+ printf (" )\n");
+ debug_print (nodep->body, indent + 8);
+ if (nodep->next)
+ {
+ print_case (nodep->next, indent);
+ }
+}
+
+static void
+print_repeatuntil (struct node *nodep, int indent)
+{
+ struct node *head, *body;
+
+ printf ("[REEATUNTIL] ( ");
+ head = nodep->head;
+ body = nodep->body;
+ debug_print ((struct node *)body, 0);
+ printf (" )\n");
+ debug_print ((struct node *)head, indent + 4);
+}
+
+static void
+print_get (struct node *nodep, int indent)
+{
+ print_space (indent);
+ printf ("[GET] ");
+ debug_print ((struct node *)nodep->body, 0);
+ printf ("\n\n");
+}
+
+static void
+print_block (struct node *nodep, int indent)
+{
+ printf ("[BLOCK]\n");
+ debug_print ((struct node *)nodep->head, indent + 4);
+ printf ("\n");
+}
+
+
--- /dev/null
+%{
+
+#include "bcpl.h"
+#include "parser.tab.h"
+
+char string_buf[MAX_STRING_LENGTH];
+char *string_buf_ptr;
+
+#define yylex zzlex
+
+%}
+
+%x STRING
+
+%%
+
+
+[\t ]+ /* ignore */
+
+\/\/.*\n { nlcount++; /* (comment) */ }
+
+MANIFEST { return (TK_MANIFEST); }
+GLOBAL { return (TK_GLOBAL); }
+STATIC { return (TK_STATIC); }
+LET { return (TK_LET); }
+BE { return (TK_BE); }
+RETURN { return (TK_RETURN); }
+VALOF { return (TK_VALOF); }
+WHILE { return (TK_WHILE); }
+IF { return (TK_IF); }
+RESULTIS { return (TK_RESULTIS); }
+DO { return (TK_DO); }
+THEN { return (TK_DO); }
+SWITCHON { return (TK_SWITCHON); }
+CASE { return (TK_CASE); }
+CASEEND { return (TK_CASEEND); }
+INTO { return (TK_INTO); }
+REPEATUNTIL { return (TK_REPEATUNTIL); }
+GET { return (TK_GET); }
+AND { return (TK_AND); }
+
+#[0-7]+ { yylval.numberp = make_number (&yytext[1], 8); return (TK_NUMBER); }
+#X[0-9A-Fa-f]+ { yylval.numberp = make_number (&yytext[2], 16); return (TK_NUMBER); }
+[0-9]+ { yylval.numberp = make_number (yytext, 10); return (TK_NUMBER); }
+
+"," { return (TK_COMMA); }
+"$(" { return (TK_BEGIN); }
+"$)" { return (TK_END); }
+"$("[a-zA-Z]+ { return (TK_BEGIN); }
+"$)"[a-zA-Z]+ { return (TK_END); }
+":=" { return (TK_ASSIGN); }
+":" { return (TK_COLON); }
+";" { return (TK_SEMICOLON); }
+"=" { return (TK_EQUAL); }
+"*" { return (TK_MULTOP); }
+"/" { return (TK_DIVOP); }
+"+" { return (TK_PLUSOP); }
+"-" { return (TK_SUBOP); }
+">" { return (TK_LT); }
+">=" { return (TK_LE); }
+"<" { return (TK_GT); }
+"<=" { return (TK_GE); }
+"&" { return (TK_ANDOP); }
+"|" { return (TK_OROP); }
+"!" { return (TK_VECIS); }
+")" { return (TK_RP); }
+"(" { return (TK_LP); }
+
+\" { string_buf_ptr = string_buf; BEGIN(STRING); }
+
+
+<STRING>\" { /* saw closing quote - all done */
+ BEGIN(INITIAL);
+ *string_buf_ptr = '\0';
+ /* return string constant token type and
+ * value to parser
+ */
+ yylval.stringp = make_string (string_buf);
+ return (TK_STRING);
+ }
+
+<STRING>\n {
+ /* error - unterminated string constant */
+ /* generate error message */
+ fprintf (stderr, "string unterminated.\n");
+ exit (0);
+ }
+
+<STRING>\\[0-7]{1,3} {
+ /* octal escape sequence */
+ int result;
+
+ (void) sscanf( yytext + 1, "%o", &result );
+
+ if ( result > 0xff )
+ {
+ fprintf (stderr, "range over for escape\n");
+ /* error, constant is out-of-bounds */
+ }
+
+ *string_buf_ptr++ = result;
+ }
+
+<STRING>\\[0-9]+ {
+ /* generate error - bad escape sequence; something
+ * like '\48' or '\0777777'
+ */
+ }
+
+<STRING>"*N" { *string_buf_ptr++ = '\n'; }
+<STRING>"*T" { *string_buf_ptr++ = '\t'; }
+<STRING>"*R" { *string_buf_ptr++ = '\r'; }
+<STRING>"**" { *string_buf_ptr++ = '*'; }
+
+<STRING>"*n" { *string_buf_ptr++ = yytext[1]; }
+
+<STRING>[^\\\n\"]+ {
+ char *yptr = yytext;
+ while ( *yptr )
+ *string_buf_ptr++ = *yptr++;
+ }
+
+
+[a-zA-Z\.][a-zA-Z\.0-9]* { yylval.symbolp = make_symbol (yytext); return TK_SYMBOL; }
+
+
+\n { nlcount++; }
+
+
+%%
--- /dev/null
+/*
+ *
+ */
+
+#include "bcpl.h"
+
+int nlcount;
+
+
+int
+main (int ac, char **av)
+{
+ extern struct node *noderoot;
+ extern FILE *yyin;
+
+ nlcount = 1;
+
+ /* option check... */
+ if (ac < 2)
+ {
+ fprintf (stderr, "usage: %s files...\n", av[0]);
+ exit (0);
+ }
+
+ /* input file setup... */
+ yyin = fopen (av[1], "r");
+ if (yyin == NULL)
+ {
+ fprintf (stderr, "Can not open source file (%s)\n", av[1]);
+ exit (0);
+ }
+
+ if (yyparse () == 1)
+ {
+ printf ("syntax error: compiler stop.\n");
+ exit (0);
+ }
+
+ debug_print (noderoot, 0);
+
+ make_code ();
+}
+
+
+yyerror ()
+{
+ extern char *yytext;
+
+ fprintf (stderr, "line %d: syntax error\n", nlcount);
+ fprintf (stderr, "yytext: %s\n", yytext);
+}
+
--- /dev/null
+/*
+ *
+ */
+
+#include "bcpl.h"
+
+make_code ()
+{
+}
--- /dev/null
+/*
+ *
+ */
+
+
+#include "bcpl.h"
+#include "parser.tab.h"
+
+extern char *yytext;
+
+struct symbol *
+make_symbol (char *sym)
+{
+ struct symbol *p;
+
+ p = (struct symbol *)calloc (sizeof (struct symbol), 1);
+ if (p == NULL)
+ {
+ return (NULL);
+ }
+
+ p->type = TK_SYMBOL;
+ p->hash = NULL;
+ p->length = strlen (sym);
+ p->value = strdup (sym);
+ return (p);
+}
+
+
+struct number *
+make_number (char *s, int base)
+{
+ struct number *p;
+ int n;
+
+ if (base == 10)
+ n = atoi (s);
+ else if (base == 8)
+ sscanf (s, "%o", &n);
+ else if (base == 16)
+ sscanf (s, "%x", &n);
+
+ p = (struct number *)calloc (sizeof (struct number), 1);
+ if (p == NULL)
+ {
+ return (NULL);
+ }
+ p->type = TK_NUMBER;
+ p->value = n;
+ return (p);
+}
+
+struct string *
+make_string (char *s)
+{
+ struct string *p;
+
+ p = (struct string *)calloc (sizeof (struct string), 1);
+ if (p == NULL)
+ {
+ return (NULL);
+ }
+
+ p->type = TK_STRING;
+ p->length = strlen (s);
+ p->value = strdup (s);
+ return (p);
+}
+
+
+struct node *
+make_node (int type, void *a, void *b, void *c)
+{
+ struct node *p;
+
+ p = (struct node *)calloc (sizeof (struct node), 1);
+ if (p == NULL)
+ {
+ return (NULL);
+ }
+
+ p->type = type;
+ p->head = a;
+ p->body = b;
+ p->next = c;
+ return (p);
+}
+
+\f
+static char *tag_stack[MAX_TAG];
+int tag_stack_top = 0;
+
+int
+yylex ()
+{
+ int token;
+ static char tag[MAX_STRING_LENGTH];
+ char tmptag[MAX_STRING_LENGTH];
+
+ printf ("yylex\n");
+start:
+ if (tag[0] != '\0')
+ {
+ if (pop_tag (tmptag) == -1)
+ {
+ printf ("pop_tag error\n");
+ return (-1);
+ }
+
+ if (strcmp (tag, tmptag) == 0)
+ {
+ tag[0] = '\0';
+ }
+ printf ("return TK_END\n");
+ return (TK_END);
+ }
+
+ token = zzlex ();
+ if (token == TK_BEGIN)
+ {
+ if (yytext[2] != '\0')
+ {
+ printf ("PUSH: tag: \"$(%s\"\n", &yytext[2]);
+ push_tag (&yytext[2]);
+ }
+ }
+ else if (token == TK_END)
+ {
+ if (yytext[2] != '\0')
+ {
+ if (check_tag (&yytext[2]) < 0)
+ {
+ /* error -- not found tag. */
+ }
+ else
+ {
+ strcpy (tag, &yytext[2]);
+ printf ("tag is found. \"%s\"\n", tag);
+ goto start;
+ }
+ }
+ }
+ return (token);
+}
+
+
+int
+check_tag (char *tag)
+{
+ int i;
+
+ for (i = 0; i < tag_stack_top; i++)
+ {
+ if (strcmp (tag, tag_stack[i]) == 0)
+ {
+ return (i);
+ }
+ }
+ return (-1);
+}
+
+int
+push_tag (char *tag)
+{
+ tag_stack[tag_stack_top] = strdup (tag);
+ tag_stack_top++;
+ return (tag_stack_top);
+}
+
+
+int
+pop_tag (char tag[])
+{
+ if (tag_stack_top == 0)
+ {
+ return (-1);
+ }
+
+ strcpy (tag, tag_stack[tag_stack_top - 1]);
+ free (tag_stack[tag_stack_top - 1]);
+ tag_stack_top--;
+ return (tag_stack_top);
+}
--- /dev/null
+/*
+ * Copyright (C) 1999 Ryuichi Naitoh
+ *
+ *
+ */
+
+/* $Id* */
+%{
+
+#include "bcpl.h"
+
+struct node *noderoot;
+
+%}
+
+%union{
+ struct symbol *symbolp;
+ struct string *stringp;
+ struct character *character;
+ struct node *nodep;
+ struct number *numberp;
+};
+
+
+%token TK_BEGIN
+%token TK_END
+%token TK_EQUAL
+%token TK_COMMA
+%token TK_GLOBAL
+%token TK_COLON
+%token TK_MULTOP
+%token TK_DIVOP
+%token TK_PLUSOP
+%token TK_SUBOP
+%token TK_RP TK_LP
+%token TK_SEMICOLON
+%token TK_ASSIGN
+%token TK_GT /* < */
+%token TK_LT /* > */
+%token TK_GE /* <= */
+%token TK_LE /* >= */
+%token TK_ANDOP /* & */
+%token TK_OROP /* | */
+%token TK_VECIS /* ! */
+
+/* ͽÌó¸ì : 'TK_' ¤òºï¤Ã¤¿»Ä¤ê¤¬Í½Ìó¸ì¤ÈÅù¤·¤¤ */
+%token TK_MANIFEST
+%token TK_AND
+%token TK_LET
+%token TK_VALOF
+%token TK_RETURN
+%token TK_BE
+%token TK_IF
+%token TK_WHILE
+%token TK_DO
+%token TK_UNLESS
+%token TK_TEST
+%token TK_UNTIL
+%token TK_STATIC
+%token TK_RESULTIS
+%token TK_FOR
+%token TK_SWITCHON
+%token TK_CASE
+%token TK_CASEEND
+%token TK_INTO
+%token TK_REPEATUNTIL
+%token TK_GET
+
+%token <symbolp>TK_SYMBOL
+%token <stringp>TK_STRING
+%token <numberp>TK_NUMBER
+
+%type <nodep>program
+%type <nodep>declare.list
+%type <nodep>declare.manifest
+%type <nodep>manifest.list
+%type <nodep>declare.global
+%type <nodep>global.list
+%type <nodep>declare.function
+%type <nodep>argument.list argument
+%type <nodep>expression
+%type <nodep>declare.procedure
+%type <nodep>statement.list
+%type <nodep>statement
+%type <nodep>call.function
+%type <nodep>expression.list
+%type <nodep>declare.variable.list
+%type <nodep>declare.variable
+%type <nodep>declare.get
+%type <nodep>initialize.list
+%type <nodep>if.head if.statement
+%type <nodep>while.statement
+%type <nodep>declare.static
+%type <nodep>switchon.statement
+%type <nodep>case.statement.list
+%type <nodep>repeatuntil.statement
+
+
+%right TK_ASSIGN
+%left TK_ANDOP TK_OROP
+%left TK_PLUSOP TK_SUBOP
+%left TK_MULTOP TK_DIVOP TK_GT TK_LT TK_GE TK_LE TK_EQUAL TK_VECIS
+%left TK_NUMBER TK_SYMBOL
+
+
+%start program
+
+%%
+
+program
+ : declare.list { noderoot = $1; }
+
+declare.list
+ : /* empty */ { $$ = NULL; }
+ | declare.manifest declare.list { $$ = make_node (OP_DECLARE, $1, NULL, $2); }
+ | declare.global declare.list { $$ = make_node (OP_DECLARE, $1, NULL, $2); }
+ | declare.function declare.list { $$ = make_node (OP_DECLARE, $1, NULL, $2); }
+ | declare.procedure declare.list { $$ = make_node (OP_DECLARE, $1, NULL, $2); }
+ | declare.static declare.list { $$ = make_node (OP_DECLARE, $1, NULL, $2); }
+ | declare.get declare.list { $$ = make_node (OP_DECLARE, $1, NULL, $2); }
+ ;
+
+declare.manifest
+ : TK_MANIFEST TK_BEGIN manifest.list TK_END
+ { $$ = make_node (OP_MANIFEST, $3, NULL, NULL);
+ }
+
+manifest.list
+ : /* empty */ { $$ = NULL; }
+ | TK_SYMBOL TK_EQUAL TK_NUMBER { $$ = make_node (OP_CONST, $1, $3, NULL); }
+ ;
+ | TK_SYMBOL TK_EQUAL TK_NUMBER TK_COMMA manifest.list
+ { $$ = make_node (OP_CONST, $1, $3, $5); }
+ ;
+
+declare.global
+ : TK_GLOBAL TK_BEGIN global.list TK_END { $$ = make_node (OP_GLOBAL, $3, NULL, NULL); }
+
+global.list
+ : /* empty */ { $$ = NULL; }
+ | TK_SYMBOL TK_COLON TK_NUMBER { $$ = make_node (OP_CONST, $1, $3, NULL); }
+ | TK_SYMBOL TK_COLON TK_NUMBER TK_COMMA global.list
+ { $$ = make_node (OP_CONST, $1, $3, $5); }
+ ;
+
+declare.function
+ : TK_LET TK_SYMBOL argument.list TK_EQUAL expression
+ { $$ = make_node (OP_FUNCTION, $2, $3, $5); }
+ ;
+
+declare.procedure
+ : TK_LET TK_SYMBOL argument.list TK_BE TK_BEGIN statement.list TK_END
+ { $$ = make_node (OP_PROCEDURE, $2, $3, $6); }
+ | TK_AND TK_SYMBOL argument.list TK_BE TK_BEGIN statement.list TK_END
+ { $$ = make_node (OP_PROCEDURE, $2, $3, $6); }
+ ;
+
+declare.static
+ : TK_STATIC TK_BEGIN global.list TK_END
+ { $$ = make_node (OP_STATIC, $3, NULL, NULL); }
+ ;
+
+declare.get
+ : TK_GET TK_STRING { $$ = make_node (OP_GET, NULL, $2, NULL); }
+ ;
+
+statement.list
+ : /* empty */ { $$ = NULL; }
+ | statement statement.list { $$ = make_node (OP_STATEMENT, $1, NULL, $2); }
+ | repeatuntil.statement statement.list { $$ = make_node (OP_STATEMENT, $1, NULL, $2); }
+ ;
+
+statement
+ : expression TK_SEMICOLON { $$ = $1; }
+ | declare.variable.list TK_SEMICOLON { $$ = $1; }
+ | TK_RETURN TK_LP expression TK_RP TK_SEMICOLON
+ { $$ = make_node (OP_RETURN, $3, NULL, NULL); }
+ | TK_RESULTIS TK_LP expression TK_RP TK_SEMICOLON
+ { $$ = make_node (OP_RETURN, $3, NULL, NULL); }
+ | if.statement { $$ = $1; }
+ | while.statement { $$ = $1; }
+ | switchon.statement { $$ = $1; }
+ | TK_BEGIN statement.list TK_END { $$ = make_node (OP_BLOCK, $2, NULL, NULL); }
+ ;
+
+if.statement
+ : if.head statement { $$ = make_node (OP_IF, $1, $2, NULL); }
+ | if.head TK_BEGIN statement.list TK_END
+ { $$ = make_node (OP_IF, $1, $3, NULL); }
+ ;
+
+if.head
+ : TK_IF expression TK_DO { $$ = $2; }
+ ;
+
+while.statement
+ : TK_WHILE expression TK_DO statement { $$ = make_node (OP_WHILE, $2, $4, NULL); }
+ | TK_WHILE expression TK_DO TK_BEGIN statement.list TK_END
+ { $$ = make_node (OP_WHILE, $2, $5, NULL); }
+ ;
+
+switchon.statement
+ : TK_SWITCHON expression TK_INTO TK_BEGIN case.statement.list TK_END { $$ = make_node (OP_SWITCHON, $2, $5, NULL); }
+ ;
+
+case.statement.list
+ : TK_CASE expression TK_COLON statement.list { $$ = make_node (OP_CASECONT, $2, $4, NULL); }
+ | TK_CASE expression TK_COLON statement.list TK_CASEEND { $$ = make_node (OP_CASE, $2, $4, NULL); }
+ | TK_CASE expression TK_COLON statement.list TK_CASEEND case.statement.list { $$ = make_node (OP_CASE, $2, $4, $6); }
+ ;
+
+repeatuntil.statement
+ : TK_BEGIN statement.list TK_END TK_REPEATUNTIL expression { $$ = make_node (OP_REPEATUNTIL, $2, $5, NULL); }
+ ;
+
+declare.variable.list
+ : TK_LET declare.variable { $$ = $2; }
+ | TK_LET declare.variable TK_EQUAL initialize.list
+ { $$ = make_node (OP_INITIALVAR, $2, $4, NULL); }
+ ;
+
+declare.variable
+ : TK_SYMBOL TK_COMMA declare.variable { $$ = make_node (OP_VARIABLE, $1, NULL, $3); }
+ | TK_SYMBOL { $$ = make_node (OP_VARIABLE, $1, NULL, NULL); }
+ ;
+
+initialize.list
+ : TK_NUMBER TK_COMMA initialize.list { $$ = make_node (OP_CONST_LIST, $1, NULL, $3); }
+ | TK_NUMBER { $$ = make_node (OP_CONST_LIST, $1, NULL, NULL); }
+ ;
+
+
+call.function
+ : TK_SYMBOL TK_LP TK_RP { $$ = make_node (OP_CALL, $1, NULL, NULL); }
+ | TK_SYMBOL TK_LP expression.list TK_RP { $$ = make_node (OP_CALL, $1, $3, NULL); }
+ ;
+
+argument.list
+ : TK_LP argument TK_RP { $$ = $2; }
+ | TK_LP TK_RP { $$ = NULL; }
+ ;
+
+argument
+ : TK_SYMBOL TK_COMMA argument { $$ = make_node (OP_ARGS, $1, NULL, $3); }
+ | TK_SYMBOL { $$ = make_node (OP_ARGS, $1, NULL, NULL); }
+ ;
+
+expression.list
+ : expression TK_COMMA expression.list { $$ = make_node (OP_ARGS, $1, NULL, $3); }
+ ;
+ | expression { $$ = make_node (OP_ARGS, $1, NULL, NULL); }
+ ;
+
+expression
+ : TK_NUMBER { $$ = (struct node *)$1; }
+ | TK_SYMBOL { $$ = (struct node *)$1; }
+ | TK_VALOF TK_BEGIN statement.list TK_END
+ { $$ = make_node (OP_VALOF, $3, NULL, NULL); }
+ | TK_STRING { $$ = (struct node *)$1; }
+ | call.function { $$ = $1; }
+ | TK_LP expression TK_RP { $$ = $2; }
+ | expression TK_PLUSOP expression { $$ = make_node (OP_PLUSOP, $1, $3, NULL); }
+ | expression TK_SUBOP expression { $$ = make_node (OP_SUBOP, $1, $3, NULL); }
+ | expression TK_MULTOP expression { $$ = make_node (OP_MULTOP, $1, $3, NULL); }
+ | expression TK_DIVOP expression { $$ = make_node (OP_DIVOP, $1, $3, NULL); }
+ | expression TK_GT expression { $$ = make_node (OP_GT, $1, $3, NULL); }
+ | expression TK_LT expression { $$ = make_node (OP_LT, $1, $3, NULL); }
+ | expression TK_GE expression { $$ = make_node (OP_GE, $1, $3, NULL); }
+ | expression TK_LE expression { $$ = make_node (OP_LE, $1, $3, NULL); }
+ | expression TK_ANDOP expression { $$ = make_node (OP_AND, $1, $3, NULL); }
+ | expression TK_OROP expression { $$ = make_node (OP_OR, $1, $3, NULL); }
+ | expression TK_EQUAL expression { $$ = make_node (OP_EQUAL, $1, $3, NULL); }
+ | expression TK_ASSIGN expression { $$ = make_node (OP_SET, $1, $3, NULL); }
+ | expression TK_VECIS expression { $$ = make_node (OP_VECIS, $1, $3, NULL); }
+ ;
+
+%%
--- /dev/null
+//
+// bcpl sample program.
+//
+
+GET "STD.H"
+
+MANIFEST $( FOO = 1,
+ BAR = 2,
+ $)
+
+GLOBAL $( FOO:1, BAR:2 $)
+
+STATIC $( foo: 1 $)
+
+
+LET start (argc, argv) BE
+$(
+ LET val;
+
+ writef ("program name is %s *N", argv ! 0);
+
+ val = atoi (argv ! 1);
+
+ SWITCHON val INTO
+ $(
+ CASE 1: writef ("value is 1*N");
+ CASEEND
+
+ CASE 2: writef ("value is 2*N");
+ CASEEND
+ $)
+
+ $(
+ writef ("val = %d*N", val);
+ val := val - 1;
+ $) REPEATUNTIL val < 0
+
+ writef ("end.*N");
+$)
+
+AND foo () BE
+$(aa
+ LET val;
+
+ $(bb
+ val := 1 + 1 * 2;
+ writef ("val = %d*N", val);
+
+
+$)aa
\ No newline at end of file
OSDN Git Service
